e0dec7d · distributed-process

git.iko.soy/distributed-process

on master help sign in

More compositional way of supporting 'call'

e0dec7dEdsko de Vries14 years ago

distributed-process/distributed-process.cabal+3−3

compare with master

unifiedsplit

@@ -26,7 +26,7 @@ Library

26 Control.Distributed.Process.Serializable,

27 Control.Distributed.Process.Closure,

28 Control.Distributed.Process.Node

29− Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification

29+ Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification, RankNTypes

30 ghc-options: -Wall

31 HS-Source-Dirs: src

@@ -46,7 +46,7 @@ Test-Suite TestCH

46 stm,

47 ghc-prim,

48 network-transport >= 0.1

49− Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification

49+ Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification, RankNTypes

50 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

51 HS-Source-Dirs: tests src

@@ -67,6 +67,6 @@ Test-Suite TestClosure

67 template-haskell,

68 stm,

69 network-transport >= 0.1

70− Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification

70+ Extensions: ExplicitForAll, ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, ExistentialQuantification, RankNTypes

71 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind

72 HS-Source-Dirs: tests src

distributed-process/src/Control/Distributed/Process.hs+15−15

@@ -61,9 +61,9 @@ module Control.Distributed.Process

61 ) where

63import Prelude hiding (catch)

64+import Data.Maybe (fromJust)

64import Data.Binary (decode, encode)

65import Data.Binary (decode, encode)

65−import Data.Typeable (Typeable)

66+import Data.Typeable (Typeable, typeOf)

66−import qualified Data.Map as Map ((!))

67import Control.Monad.Reader (ask)

68import Control.Monad.IO.Class (MonadIO, liftIO)

69import qualified Control.Monad.Trans.Class as Trans (lift)

@@ -118,13 +118,14 @@ import Control.Distributed.Process.Internal.Types

118 , TypedChannel(..)

119 , ChannelId(..)

120 , Identifier(..)

121+ , resolveClosure

121 )

122 )

122import Control.Distributed.Process.Internal.MessageT

123import Control.Distributed.Process.Internal.MessageT

123 ( sendMessage

124 ( sendMessage

124 , sendBinary

125 , sendBinary

125 , getLocalNode

126 , getLocalNode

126 )

127 )

127−import Control.Distributed.Process.Internal.Dynamic (fromDyn)

128+import Control.Distributed.Process.Internal.Dynamic (fromDyn, dynTypeRep)

128

129

129-- INTERNAL NOTES

130-- INTERNAL NOTES

130--

131--

@@ -314,9 +315,9 @@ spawn nid proc = do

314

315

315-- | Run a process remotely and wait for it to reply

316-- | Run a process remotely and wait for it to reply

316call :: Serializable a => NodeId -> Closure (Process a) -> Process a

317call :: Serializable a => NodeId -> Closure (Process a) -> Process a

317−call nid proc@(Closure (Static label) _) = do

318+call nid (Closure (Static label) env) = do

318 us <- getSelfPid

319 us <- getSelfPid

319− spawn nid (Closure (Static (label ++ "__call")) (encode (proc, us)))

320+ spawn nid (Closure (Static "$call") (encode (label, env, us)))

320 CallReply a <- expect

321 CallReply a <- expect

321 return a

322 return a

322

323

@@ -366,10 +367,16 @@ unmonitor = sendCtrlMsg Nothing . Unmonitor

366--------------------------------------------------------------------------------

367--------------------------------------------------------------------------------

367

368

368-- | Deserialize a closure

369-- | Deserialize a closure

369−unClosure :: Typeable a => Closure a -> Process a

370+unClosure :: forall a. Typeable a => Closure a -> Process a

370unClosure (Closure (Static label) env) = do

371unClosure (Closure (Static label) env) = do

371− dec <- lookupStatic label

372+ rtable <- remoteTable <$> lift getLocalNode

373+ let dyn = fromJust (resolveClosure rtable label)

374+ dec = fromDyn dyn (throw (typeError dyn))

372− return (dec env)

375+ return (dec env)

376+ where

377+ typeError proc = userError $ "lookupStatic type error: "

378+ ++ "cannot match " ++ show (dynTypeRep proc)

379+ ++ "against " ++ show (typeOf (undefined :: a))

373

380

374--------------------------------------------------------------------------------

381--------------------------------------------------------------------------------

375-- Auxiliary API --

382-- Auxiliary API --

@@ -435,12 +442,5 @@ sendCtrlMsg mNid signal = do

435 Just nid ->

442 Just nid ->

436 lift $ sendBinary (NodeIdentifier nid) msg

443 lift $ sendBinary (NodeIdentifier nid) msg

437

444

438−lookupStatic :: Typeable a => String -> Process a

439−lookupStatic label = do

440− rtable <- remoteTable <$> lift getLocalNode

441− return $ fromDyn (rtable Map.! label) (throw typeError)

442− where

443− typeError = userError "lookupStatic type error"

444−

445lift :: MessageT IO a -> Process a

446lift = Process . Trans.lift

distributed-process/src/Control/Distributed/Process/Closure.hs+19−25

@@ -44,9 +44,8 @@ module Control.Distributed.Process.Closure (remotable, mkClosure) where

44import Prelude hiding (lookup)

45import Data.ByteString.Lazy (ByteString)

46import Data.Binary (encode, decode)

47−import qualified Data.Map as Map (insert)

47+import Data.Typeable (typeOf)

48import Control.Applicative ((<$>))

49−import Control.Monad (join)

50import Language.Haskell.TH

49import Language.Haskell.TH

51 ( -- Q monad and operations

50 ( -- Q monad and operations

52 Q

51 Q

@@ -80,8 +79,10 @@ import Control.Distributed.Process.Internal.Types

80 , Process

79 , Process

81 , ProcessId

80 , ProcessId

82 , CallReply(..)

81 , CallReply(..)

82+ , registerLabel

83+ , registerSender

83 )

84 )

84−import Control.Distributed.Process (send, unClosure)

85+import Control.Distributed.Process (send)

85import Control.Distributed.Process.Internal.Dynamic (toDyn)

86import Control.Distributed.Process.Internal.Dynamic (toDyn)

87--------------------------------------------------------------------------------

88--------------------------------------------------------------------------------

@@ -115,11 +116,10 @@ createMetaData is =

115--

116--

116-- Given an (f :: a -> b) in module M, create:

117-- Given an (f :: a -> b) in module M, create:

117-- 1. f__closure :: a -> Closure b,

118-- 1. f__closure :: a -> Closure b,

118−-- 2. Map.insert "M.f" (toDyn ((f . enc) :: ByteString -> b))

119+-- 2. registerLabel "M.f" (toDyn ((f . enc) :: ByteString -> b))

119--

120--

120-- Moreover, if b is of the form Process c, then additionally create

121-- Moreover, if b is of the form Process c, then additionally create

121−-- 3. Map.insert "M.f__call" (... :: ByteString -> Process ())

122+-- 3. registerSender (Process c) (send :: ProcessId -> c -> Process ())

122−-- (see 'generateCallClosure')

123generateDefs :: Name -> Q ([Dec], [Q Exp])

124generateDefs n = do

125 mType <- getType n

@@ -127,18 +127,17 @@ generateDefs n = do

127 Just (origName, ArrowT `AppT` arg `AppT` res) -> do

128 (closure, label) <- generateClosure origName (return arg) (return res)

129 let decoder = generateDecoder origName (return res)

130− insert = [| Map.insert $(stringE label) (toDyn $decoder) |]

130+ insert = [| registerLabel $(stringE label) (toDyn $decoder) |]

131−

131+

132 -- Generate special closure to support 'call'

133 mResult <- processResult res

134 insert' <- case mResult of

135 Nothing ->

136 return []

137 Just result -> do

138− let encoder = generateCallClosure origName (return result)

138+ let sender = generateSender result

139− label' = label ++ "__call"

140 return . return $

139 return . return $

141− [| Map.insert $(stringE label') (toDyn $encoder) |]

140+ [| registerSender $(typeToTypeRep res) (toDyn $sender) |]

142

141

143 return (closure, insert : insert')

142 return (closure, insert : insert')

144 _ ->

143 _ ->

@@ -157,38 +156,33 @@ generateClosure n arg res = do

157 label = show $ n

156 label = show $ n

158

157

159-- | If 't' is of the form 'Process b', return 'Just b'

158-- | If 't' is of the form 'Process b', return 'Just b'

160−processResult :: Type -> Q (Maybe Type)

159+processResult :: Type -> Q (Maybe (Q Type))

161processResult t = do

160processResult t = do

162 process <- [t| Process |]

161 process <- [t| Process |]

163 case t of

162 case t of

164− p `AppT` a | p == process -> return $ Just a

163+ p `AppT` a | p == process -> return . Just . return $ a

165 _ -> return Nothing

164 _ -> return Nothing

166

165

167-- | Generate the decoder (see 'generateDefs')

166-- | Generate the decoder (see 'generateDefs')

168generateDecoder :: Name -> Q Type -> Q Exp

167generateDecoder :: Name -> Q Type -> Q Exp

169generateDecoder n res = [| $(varE n) . decode :: ByteString -> $res |]

168generateDecoder n res = [| $(varE n) . decode :: ByteString -> $res |]

170

169

171−-- | Generate the call-closure. This is necessary to support 'call'

170+-- | Generate the sender. This is necessary to support 'call'

172−generateCallClosure :: Name -> Q Type -> Q Exp

171+generateSender :: Q Type -> Q Exp

173−generateCallClosure n t =

172+generateSender tp =

174− [| (\env -> do

173+ [| (\pid -> send pid . CallReply) :: ProcessId -> $tp -> Process () |]

175− let (cl, them) = decode env :: (Closure (Process $t), ProcessId)

176− join (unClosure cl) >>= send them . CallReply

177− ) :: ByteString -> Process ()

178− |]

179

174

180-- | The name for the function that generates the closure

175-- | The name for the function that generates the closure

181closureName :: Name -> Name

176closureName :: Name -> Name

182closureName n = mkName $ nameBase n ++ "__closure"

177closureName n = mkName $ nameBase n ++ "__closure"

183

178

184−-- | The name for the decoder

185−decoderName :: Name -> Name

186−decoderName n = mkName $ nameBase n ++ "__dec"

187−

188--------------------------------------------------------------------------------

179--------------------------------------------------------------------------------

189-- Generic Template Haskell auxiliary functions --

180-- Generic Template Haskell auxiliary functions --

190--------------------------------------------------------------------------------

181--------------------------------------------------------------------------------

191

182

183+typeToTypeRep :: Type -> Q Exp

184+typeToTypeRep tp = [| typeOf (undefined :: $(return tp)) |]

185+

192-- | Compose a set of expressions

186-- | Compose a set of expressions

193compose :: [Q Exp] -> Q Exp

187compose :: [Q Exp] -> Q Exp

194compose [] = [| id |]

188compose [] = [| id |]

distributed-process/src/Control/Distributed/Process/Internal/Dynamic.hs+26−19

@@ -10,8 +10,11 @@ module Control.Distributed.Process.Internal.Dynamic

10 , toDyn

11 , fromDyn

12 , fromDynamic

13− , dynBindIO

13+ , dynTypeRep

14− , dynBindIO'

14+ , dynBind

15+ , dynBind'

16+ , dynApply

17+ , dynApp

15 ) where

18 ) where

17import Data.Typeable

20import Data.Typeable

@@ -19,7 +22,6 @@ import Data.Typeable

19 , TypeRep

22 , TypeRep

20 , typeOf

23 , typeOf

21 , TyCon

24 , TyCon

22− , typeRepTyCon

23 , splitTyConApp

25 , splitTyConApp

24 , funResultTy

26 , funResultTy

25 )

27 )

@@ -49,24 +51,29 @@ dynTypeRep (Dynamic t _) = t

49instance Show Dynamic where

51instance Show Dynamic where

50 show = show . dynTypeRep

52 show = show . dynTypeRep

52−tyConIO :: TyCon

53−tyConIO = typeRepTyCon (typeOf (undefined :: IO ()))

54−

55−bindIO :: IO a -> (a -> IO b) -> IO b

56−bindIO = (>>=)

57−

58−dynBindIO :: Dynamic -> Dynamic -> Maybe Dynamic

54+dynBind :: TyCon -> (forall a b. m a -> (a -> m b) -> m b) -> Dynamic -> Dynamic -> Maybe Dynamic

59−-- IO a -> (a -> IO b) -> IO b

60−dynBindIO (Dynamic t1 x) (Dynamic t2 f) =

55+dynBind m bind (Dynamic t1 x) (Dynamic t2 f) =

61 case splitTyConApp t1 of

56 case splitTyConApp t1 of

62− (io, [a]) | io == tyConIO ->

57+ (m', [a]) | m' == m ->

63 case funResultTy t2 a of

58 case funResultTy t2 a of

64− Just ioB -> Just (Dynamic ioB (GHC.unsafeCoerce# bindIO x f))

59+ Just mb -> Just (Dynamic mb (GHC.unsafeCoerce# bind x f))

65 _ -> Nothing

60 _ -> Nothing

66 _ -> Nothing

61 _ -> Nothing

67−

62+

68−dynBindIO' :: Dynamic -> Dynamic -> Dynamic

63+dynBind' :: TyCon -> (forall a b. m a -> (a -> m b) -> m b) -> Dynamic -> Dynamic -> Dynamic

69−dynBindIO' x f = fromMaybe (error typeError) (dynBindIO x f)

64+dynBind' m bind x f = fromMaybe (error typeError) (dynBind m bind x f)

65+ where

66+ typeError = "Type error in dynamic bind.\nCan't bind " ++ show x ++ " to " ++ show f

67+

68+dynApply :: Dynamic -> Dynamic -> Maybe Dynamic

69+dynApply (Dynamic t1 f) (Dynamic t2 x) =

70+ case funResultTy t1 t2 of

71+ Just t3 -> Just (Dynamic t3 (GHC.unsafeCoerce# f x))

72+ Nothing -> Nothing

73+

74+dynApp :: Dynamic -> Dynamic -> Dynamic

75+dynApp f x = fromMaybe (error typeError) (dynApply f x)

70 where

76 where

71− typeError = "Type error in dynamic bind.\n"

77+ typeError = "Type error in dynamic application.\n"

72− ++ "Can't bind " ++ show x ++ " to " ++ show f

78+ ++ "Can't apply function " ++ show f

79+ ++ " to argument " ++ show x

distributed-process/src/Control/Distributed/Process/Internal/Types.hs+82−27

@@ -1,10 +1,7 @@

1-- | We collect all types used internally in a single module to avoid using

2-- mutually recursive modules

3module Control.Distributed.Process.Internal.Types

4− ( -- * Global CH state

5− RemoteTable

6− , initRemoteTable

7− , -- * Node and process identifiers

4+ ( -- * Node and process identifiers

8 NodeId(..)

5 NodeId(..)

9 , LocalProcessId(..)

6 , LocalProcessId(..)

10 , ProcessId(..)

7 , ProcessId(..)

@@ -26,6 +23,11 @@ module Control.Distributed.Process.Internal.Types

26 , Static(..)

23 , Static(..)

27 , Closure(..)

24 , Closure(..)

28 , CallReply(..)

25 , CallReply(..)

26+ , RemoteTable

27+ , initRemoteTable

28+ , registerLabel

29+ , registerSender

30+ , resolveClosure

29 -- * Messages

31 -- * Messages

30 , Message(..)

32 , Message(..)

31 -- * Node controller user-visible data types

33 -- * Node controller user-visible data types

@@ -63,12 +65,17 @@ module Control.Distributed.Process.Internal.Types

63import Data.Map (Map)

65import Data.Map (Map)

64import qualified Data.Map as Map (empty)

66import qualified Data.Map as Map (empty)

65import Data.Int (Int32)

67import Data.Int (Int32)

66−import Data.Typeable (Typeable)

68+import Data.Typeable (Typeable, TypeRep, TyCon, typeRepTyCon, typeOf)

67−import Data.Binary (Binary, encode, put, get, putWord8, getWord8)

69+import Data.Binary (Binary, encode, decode, put, get, putWord8, getWord8)

68import Data.ByteString.Lazy (ByteString)

70import Data.ByteString.Lazy (ByteString)

69−import Data.Accessor (Accessor, accessor)

71+import Data.Accessor (Accessor, accessor, (^=), (^.))

70import qualified Data.Accessor.Container as DAC (mapMaybe)

72import qualified Data.Accessor.Container as DAC (mapMaybe)

71−import qualified Data.ByteString.Lazy as BSL (ByteString, toChunks, fromChunks, splitAt)

73+import qualified Data.ByteString.Lazy as BSL

74+ ( ByteString

75+ , toChunks

76+ , fromChunks

77+ , splitAt

78+ )

72import qualified Data.ByteString as BSS (ByteString, concat)

79import qualified Data.ByteString as BSS (ByteString, concat)

73import Control.Category ((>>>))

80import Control.Category ((>>>))

74import Control.Exception (Exception)

81import Control.Exception (Exception)

@@ -81,26 +88,23 @@ import Control.Applicative (Applicative, (<$>), (<*>))

81import Control.Monad.Reader (MonadReader(..), ReaderT, runReaderT)

88import Control.Monad.Reader (MonadReader(..), ReaderT, runReaderT)

82import Control.Monad.IO.Class (MonadIO)

89import Control.Monad.IO.Class (MonadIO)

83import Control.Monad.State (MonadState, StateT, evalStateT)

90import Control.Monad.State (MonadState, StateT, evalStateT)

84−import Control.Distributed.Process.Serializable ( Fingerprint

91+import Control.Distributed.Process.Serializable

92+ ( Fingerprint

85− , Serializable

93+ , Serializable

86− , encodeFingerprint

94+ , encodeFingerprint

87− , decodeFingerprint

95+ , decodeFingerprint

88− , fingerprint

96+ , fingerprint

89− , sizeOfFingerprint

97+ , sizeOfFingerprint

90− )

98+ )

91import Control.Distributed.Process.Internal.CQueue (CQueue)

99import Control.Distributed.Process.Internal.CQueue (CQueue)

92−import Control.Distributed.Process.Internal.Dynamic (Dynamic)

100+import Control.Distributed.Process.Internal.Dynamic

93−

101+ ( Dynamic

94−--------------------------------------------------------------------------------

102+ , toDyn

95−-- Global state --

103+ , fromDynamic

96−--------------------------------------------------------------------------------

104+ , dynTypeRep

97−

105+ , dynApp

98−-- | Used to fake 'static' (see paper)

106+ , dynBind

99−type RemoteTable = Map String Dynamic

107+ )

100−

101−-- | Initial (empty) remote-call meta data

102−initRemoteTable :: RemoteTable

103−initRemoteTable = Map.empty

104

108

105--------------------------------------------------------------------------------

109--------------------------------------------------------------------------------

106-- Node and process identifiers --

110-- Node and process identifiers --

@@ -231,6 +235,45 @@ data Closure a = Closure (Static (ByteString -> a)) ByteString

231newtype CallReply a = CallReply a

235newtype CallReply a = CallReply a

232 deriving (Typeable, Binary)

236 deriving (Typeable, Binary)

233

237

238+-- | Used to fake 'static' (see paper)

239+data RemoteTable = RemoteTable {

240+ _remoteTableLabels :: Map String Dynamic

241+ , _remoteTableSenders :: Map TypeRep Dynamic

242+ }

243+

244+-- | Initial (empty) remote-call meta data

245+initRemoteTable :: RemoteTable

246+initRemoteTable = RemoteTable Map.empty Map.empty

247+

248+registerLabel :: String -> Dynamic -> RemoteTable -> RemoteTable

249+registerLabel label dyn = remoteTableLabel label ^= Just dyn

250+

251+registerSender :: TypeRep -> Dynamic -> RemoteTable -> RemoteTable

252+registerSender typ dyn = remoteTableSender typ ^= Just dyn

253+

254+resolveClosure :: RemoteTable -> String -> Maybe Dynamic

255+resolveClosure rtable "$call" = Just (toDyn aux)

256+ where

257+ -- TODO: error handling

258+ aux :: ByteString -> Process ()

259+ aux env = do

260+ let (label, env', pid) = decode env :: (String, ByteString, ProcessId)

261+ Just proc = resolveClosure rtable label

262+ proc' = dynApp proc (toDyn env')

263+ Just enc = rtable ^. remoteTableSender (dynTypeRep proc')

264+ enc' = dynApp enc (toDyn pid)

265+ Just bound = dynBind tyConProcess bindProcess proc' enc'

266+ Just proc'' = fromDynamic bound

267+ proc''

268+

269+resolveClosure rtable label = rtable ^. remoteTableLabel label

270+

271+tyConProcess :: TyCon

272+tyConProcess = typeRepTyCon (typeOf (undefined :: Process ()))

273+

274+bindProcess :: Process a -> (a -> Process b) -> Process b

275+bindProcess = (>>=)

276+

234--------------------------------------------------------------------------------

277--------------------------------------------------------------------------------

235-- Messages --

278-- Messages --

236--------------------------------------------------------------------------------

279--------------------------------------------------------------------------------

@@ -449,6 +492,18 @@ typedChannels = accessor _typedChannels (\cs st -> st { _typedChannels = cs })

449typedChannelWithId :: LocalChannelId -> Accessor LocalProcessState (Maybe TypedChannel)

492typedChannelWithId :: LocalChannelId -> Accessor LocalProcessState (Maybe TypedChannel)

450typedChannelWithId cid = typedChannels >>> DAC.mapMaybe cid

493typedChannelWithId cid = typedChannels >>> DAC.mapMaybe cid

451

494

495+remoteTableLabels :: Accessor RemoteTable (Map String Dynamic)

496+remoteTableLabels = accessor _remoteTableLabels (\ls tbl -> tbl { _remoteTableLabels = ls })

497+

498+remoteTableSenders :: Accessor RemoteTable (Map TypeRep Dynamic)

499+remoteTableSenders = accessor _remoteTableSenders (\es tbl -> tbl { _remoteTableSenders = es })

500+

501+remoteTableLabel :: String -> Accessor RemoteTable (Maybe Dynamic)

502+remoteTableLabel label = remoteTableLabels >>> DAC.mapMaybe label

503+

504+remoteTableSender :: TypeRep -> Accessor RemoteTable (Maybe Dynamic)

505+remoteTableSender typ = remoteTableSenders >>> DAC.mapMaybe typ

506+

452--------------------------------------------------------------------------------

507--------------------------------------------------------------------------------

453-- MessageT monad --

508-- MessageT monad --

454--------------------------------------------------------------------------------

509--------------------------------------------------------------------------------

distributed-process/src/Control/Distributed/Process/Node.hs+11−6

@@ -91,6 +91,7 @@ import Control.Distributed.Process.Internal.Types

91 , Identifier(..)

92 , ChannelId(..)

93 , typedChannelWithId

94+ , resolveClosure

94 )

95 )

95import Control.Distributed.Process.Serializable (Serializable)

96import Control.Distributed.Process.Serializable (Serializable)

96import Control.Distributed.Process.Internal.MessageT

97import Control.Distributed.Process.Internal.MessageT

@@ -429,11 +430,15 @@ ncEffectProcessDied pid reason = do

429ncEffectSpawn :: ProcessId -> Closure (Process ()) -> SpawnRef -> NC ()

430ncEffectSpawn :: ProcessId -> Closure (Process ()) -> SpawnRef -> NC ()

430ncEffectSpawn pid cProc ref = do

431ncEffectSpawn pid cProc ref = do

431 mProc <- unClosure cProc

432 mProc <- unClosure cProc

433+ case mProc of

434+ Just proc -> do

435+ node <- lift getLocalNode

436+ pid' <- liftIO $ forkProcess node proc

437+ lift $ sendMessage (ProcessIdentifier pid) (DidSpawn ref pid')

438+ Nothing ->

432− -- TODO: what should we do when unClosure returns Nothing?

439+ -- TODO: what should we do when unClosure returns Nothing?

433− forM_ mProc $ \proc -> do

440+ liftIO . putStrLn $ "Error: closure " ++ show cProc ++ " not found"

434− node <- lift getLocalNode

441+

435− pid' <- liftIO $ forkProcess node proc

436− lift $ sendMessage (ProcessIdentifier pid) (DidSpawn ref pid')

437

442

438--------------------------------------------------------------------------------

443--------------------------------------------------------------------------------

439-- Auxiliary --

444-- Auxiliary --

@@ -488,7 +493,7 @@ isLocal nid pid = processNodeId pid == localNodeId nid

488unClosure :: Typeable a => Closure a -> NC (Maybe a)

493unClosure :: Typeable a => Closure a -> NC (Maybe a)

489unClosure (Closure (Static label) env) = do

494unClosure (Closure (Static label) env) = do

490 rtable <- remoteTable <$> lift getLocalNode

495 rtable <- remoteTable <$> lift getLocalNode

491− case Map.lookup label rtable of

496+ case resolveClosure rtable label of

492 Nothing -> return Nothing

497 Nothing -> return Nothing

493 Just dyn -> case fromDynamic dyn of

498 Just dyn -> case fromDynamic dyn of

494 Nothing -> return Nothing

499 Nothing -> return Nothing