git.iko.soy/distributed-process
on master help sign in
Bumb version of 0.2.1.3. Add spawnLocal (and co)
commit648ad93d93ab0ccec9b33cbd06c76cf3cc298ee1 authorEdsko de Vries <edsko@edsko.net> dateFri 20 Jul 2012, 13:15 (14 years ago) parentef0ef4d
4 files changed+52−1
compare with master
unifiedsplit
distributed-process/ChangeLog+5 distributed-process/distributed-process.cabal+1−1 distributed-process/src/Control/Distributed/Process.hs+27 distributed-process/tests/TestCH.hs+19
distributed-process/ChangeLog+5
@@ -1,3 +1,8 @@
1+2012-07-20 Edsko de Vries <edsko@well-typed.com> 0.2.1.3
2+
3+* Improve docs
4+* Local versions of spawn
5+
162012-07-16 Edsko de Vries <edsko@well-typed.com> 0.2.1.2
27
38* Base 4.6 compatibility
distributed-process/distributed-process.cabal+1−1
@@ -1,5 +1,5 @@
11Name: distributed-process
2−Version: 0.2.1.2
2+Version: 0.2.1.3
33Cabal-Version: >=1.8
44Build-Type: Simple
55License: BSD3
distributed-process/src/Control/Distributed/Process.hs+27
@@ -89,6 +89,9 @@ module Control.Distributed.Process
8989 , spawnMonitor
9090 , spawnChannel
9191 , DidSpawn(..)
92+ -- * Local versions of spawn
93+ , spawnLocal
94+ , spawnChannelLocal
9295 ) where
9396
9497
@@ -121,6 +124,7 @@ import Control.Distributed.Process.Internal.Types
121124 , SerializableDict(..)
122125 , SendPortId(..)
123126 , WhereIsReply(..)
127+ , procMsg
124128 )
125129import Control.Distributed.Process.Internal.Closure.CP
126130 ( cpSeq
@@ -190,6 +194,8 @@ import Control.Distributed.Process.Internal.Primitives
190194 , spawnAsync
191195 )
192196import Control.Distributed.Process.Serializable (Serializable)
197+import Control.Distributed.Process.Internal.MessageT (getLocalNode)
198+import Control.Distributed.Process.Node (forkProcess)
193199
194200-- INTERNAL NOTES
195201--
@@ -355,3 +361,24 @@ spawnChannel dict nid proc = do
355361 (cpSend (sdictSendPort dict) pid `cpSplit` proc)
356362 `cpBind`
357363 cpCancelL
364+
365+--------------------------------------------------------------------------------
366+-- Local versions of spawn --
367+--------------------------------------------------------------------------------
368+
369+-- | Spawn a process on the local node
370+spawnLocal :: Process () -> Process ProcessId
371+spawnLocal proc = do
372+ node <- procMsg $ getLocalNode
373+ liftIO $ forkProcess node proc
374+
375+-- | Create a new typed channel, spawn a process on the local node, passing it
376+-- the receive port, and return the send port
377+spawnChannelLocal :: Serializable a
378+ => (ReceivePort a -> Process ())
379+ -> Process (SendPort a)
380+spawnChannelLocal proc = do
381+ node <- procMsg $ getLocalNode
382+ (sport, rport) <- newChan
383+ _ <- liftIO $ forkProcess node (proc rport)
384+ return sport
distributed-process/tests/TestCH.hs+19
@@ -560,6 +560,24 @@ testRemoteRegistry transport = do
560560 True <- return $ pingServer == pid'
561561 return ()
562562
563+testSpawnLocal :: NT.Transport -> IO ()
564+testSpawnLocal transport = do
565+ node <- newLocalNode transport initRemoteTable
566+
567+ runProcess node $ do
568+ us <- getSelfPid
569+
570+ pid <- spawnLocal $ do
571+ sport <- expect
572+ sendChan sport (1234 :: Int)
573+
574+ sport <- spawnChannelLocal $ \rport -> do
575+ (1234 :: Int) <- receiveChan rport
576+ send us ()
577+
578+ send pid sport
579+ expect
580+
563581main :: IO ()
564582main = do
565583 Right transport <- createTransport "127.0.0.1" "8080" defaultTCPParameters
@@ -574,6 +592,7 @@ main = do
574592 , ("Terminate", testTerminate transport)
575593 , ("Registry", testRegistry transport)
576594 , ("RemoteRegistry", testRemoteRegistry transport)
595+ , ("SpawnLocal", testSpawnLocal transport)
577596 -- Monitoring processes
578597 --
579598 -- The "missing" combinations in the list below don't make much sense, as