3c804ea · distributed-process

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

compare with master

unifiedsplit

@@ -321,7 +321,7 @@ spawn nid proc = do

321

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

323call :: SerializableDict a -> NodeId -> Closure (Process a) -> Process a

324−call sdict@(SerializableDict _) nid proc = do

324+call sdict@SerializableDict nid proc = do

325 us <- getSelfPid

326 spawn nid (proc `cpBind` sendClosure sdict us)

327 expect

distributed-process/src/Control/Distributed/Process/Closure.hs+2−3

@@ -63,11 +63,10 @@

63-- explicit (reified) serializable dictionary. To create such a dictionary do

64--

65-- > serializableDictInt :: SerializableDict Int

66−-- > serializableDictInt = SerializableDict "serializableDictInt"

66+-- > serializableDictInt = SerializableDict

67--

68-- and then pass @'serialiableDictInt@ to 'remotable'. This will fail if the

69−-- type is not serializable. Make sure that the string argument to provide

69+-- type is not serializable.

70−-- in the definition of your dictionary matches the function name.

71module Control.Distributed.Process.Closure

70module Control.Distributed.Process.Closure

72 ( -- * User-defined closures

71 ( -- * User-defined closures

73 remotable

72 remotable

distributed-process/src/Control/Distributed/Process/Internal/Closure.hs+5−4

@@ -9,6 +9,7 @@ import qualified Data.Map as Map (empty)

9import Data.Accessor ((^.))

10import Data.ByteString.Lazy (ByteString)

11import Data.Binary (decode)

12+import Data.Typeable (TypeRep)

12import Control.Distributed.Process.Internal.Types

13import Control.Distributed.Process.Internal.Types

13 ( RemoteTable(RemoteTable)

14 ( RemoteTable(RemoteTable)

14 , remoteTableLabel

15 , remoteTableLabel

@@ -42,15 +43,15 @@ initRemoteTable = BuiltIn.remoteTable (RemoteTable Map.empty Map.empty)

42resolveClosure :: RemoteTable -> StaticLabel -> ByteString -> Maybe Dynamic

43resolveClosure :: RemoteTable -> StaticLabel -> ByteString -> Maybe Dynamic

43-- Built-in closures

44-- Built-in closures

44resolveClosure rtable ClosureSend env = do

45resolveClosure rtable ClosureSend env = do

45− rss <- rtable ^. remoteTableDict label

46+ rss <- rtable ^. remoteTableDict typ

46 rssSend rss `dynApply` toDyn pid

47 rssSend rss `dynApply` toDyn pid

47 where

48 where

48− (label, pid) = decode env :: (String, ProcessId)

49+ (typ, pid) = decode env :: (TypeRep, ProcessId)

49resolveClosure rtable ClosureReturn env = do

50resolveClosure rtable ClosureReturn env = do

50− rss <- rtable ^. remoteTableDict label

51+ rss <- rtable ^. remoteTableDict typ

51 rssReturn rss `dynApply` toDyn arg

52 rssReturn rss `dynApply` toDyn arg

52 where

53 where

53− (label, arg) = decode env :: (String, ByteString)

54+ (typ, arg) = decode env :: (TypeRep, ByteString)

54-- Generic closure combinators

55-- Generic closure combinators

55resolveClosure rtable ClosureApply env = do

56resolveClosure rtable ClosureApply env = do

56 f <- resolveClosure rtable labelf envf

57 f <- resolveClosure rtable labelf envf

distributed-process/src/Control/Distributed/Process/Internal/Closure/BuiltIn.hs+7−6

@@ -7,6 +7,7 @@ module Control.Distributed.Process.Internal.Closure.BuiltIn

7 ) where

8

9import Data.Binary (encode)

10+import Data.Typeable (typeOf)

10import Control.Distributed.Process (link)

11import Control.Distributed.Process (link)

11import Control.Distributed.Process.Internal.Types

12import Control.Distributed.Process.Internal.Types

12 ( ProcessId

13 ( ProcessId

@@ -30,11 +31,11 @@ linkClosure :: ProcessId -> Closure (Process ())

30linkClosure = $(mkClosure 'link)

31linkClosure = $(mkClosure 'link)

31

32

32-- | Closure version of 'send'

33-- | Closure version of 'send'

33−sendClosure :: SerializableDict a -> ProcessId -> Closure (a -> Process ())

34+sendClosure :: forall a. SerializableDict a -> ProcessId -> Closure (a -> Process ())

34−sendClosure (SerializableDict label) pid =

35+sendClosure SerializableDict pid =

35− Closure (Static ClosureSend) (encode (label, pid))

36+ Closure (Static ClosureSend) (encode (typeOf (undefined :: a), pid))

36

37

37-- | Return any value

38-- | Return any value

38−returnClosure :: SerializableDict a -> a -> Closure (Process a)

39+returnClosure :: forall a. SerializableDict a -> a -> Closure (Process a)

39−returnClosure (SerializableDict label) val =

40+returnClosure SerializableDict val =

40− Closure (Static ClosureReturn) (encode (label, encode val))

41+ Closure (Static ClosureReturn) (encode (typeOf (undefined :: a), encode val))

distributed-process/src/Control/Distributed/Process/Internal/Closure/TH.hs+3−2

@@ -11,6 +11,7 @@ import Prelude hiding (lookup)

11import Data.ByteString.Lazy (ByteString)

12import Data.Binary (encode, decode)

13import Data.Accessor ((^=))

14+import Data.Typeable (typeOf)

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

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

15import Language.Haskell.TH

16import Language.Haskell.TH

16 ( -- Q monad and operations

17 ( -- Q monad and operations

@@ -132,7 +133,7 @@ registerLabel :: String -> Dynamic -> RemoteTable -> RemoteTable

132registerLabel label dyn = remoteTableLabel label ^= Just dyn

133registerLabel label dyn = remoteTableLabel label ^= Just dyn

133

134

134registerSerializableDict :: forall a. SerializableDict a -> RemoteTable -> RemoteTable

135registerSerializableDict :: forall a. SerializableDict a -> RemoteTable -> RemoteTable

135−registerSerializableDict (SerializableDict label) =

136+registerSerializableDict SerializableDict =

136 -- TODO: Code duplication with Process

137 -- TODO: Code duplication with Process

137 let send :: ProcessId -> a -> Process ()

138 let send :: ProcessId -> a -> Process ()

138 send pid a = procMsg $ sendMessage (ProcessIdentifier pid) a

139 send pid a = procMsg $ sendMessage (ProcessIdentifier pid) a

@@ -144,7 +145,7 @@ registerSerializableDict (SerializableDict label) =

144 rssSend = toDyn send

145 rssSend = toDyn send

145 , rssReturn = toDyn ret

146 , rssReturn = toDyn ret

146 }

147 }

147− in remoteTableDict label ^= Just rss

148+ in remoteTableDict (typeOf (undefined :: a)) ^= Just rss

148

149

149--------------------------------------------------------------------------------

150--------------------------------------------------------------------------------

150-- Generic Template Haskell auxiliary functions --

151-- Generic Template Haskell auxiliary functions --

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

@@ -65,7 +65,7 @@ module Control.Distributed.Process.Internal.Types

65

66import Data.Map (Map)

67import Data.Int (Int32)

68−import Data.Typeable (Typeable)

68+import Data.Typeable (Typeable, TypeRep)

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

70import Data.ByteString.Lazy (ByteString)

71import Data.Accessor (Accessor, accessor)

@@ -243,12 +243,12 @@ data RemoteTable = RemoteTable {

243 -- of type @ByteString -> b@ (basically, @f . encode@)

244 _remoteTableLabels :: Map String Dynamic

245 -- | Runtime counterpart to SerializableDict

246− , _remoteTableDicts :: Map String RuntimeSerializableSupport

246+ , _remoteTableDicts :: Map TypeRep RuntimeSerializableSupport

247 }

248

249-- | Reification of 'Serializable' (see "Control.Distributed.Process.Closure")

250data SerializableDict a where

251− SerializableDict :: Serializable a => String -> SerializableDict a

251+ SerializableDict :: Serializable a => SerializableDict a

252 deriving (Typeable)

253

254-- | Runtime support for implementing "polymorphic" functions with a

@@ -497,13 +497,13 @@ typedChannelWithId cid = typedChannels >>> DAC.mapMaybe cid

497remoteTableLabels :: Accessor RemoteTable (Map String Dynamic)

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

499

500−remoteTableDicts :: Accessor RemoteTable (Map String RuntimeSerializableSupport)

500+remoteTableDicts :: Accessor RemoteTable (Map TypeRep RuntimeSerializableSupport)

501remoteTableDicts = accessor _remoteTableDicts (\ds tbl -> tbl { _remoteTableDicts = ds })

502

503remoteTableLabel :: String -> Accessor RemoteTable (Maybe Dynamic)

504remoteTableLabel label = remoteTableLabels >>> DAC.mapMaybe label

505

506−remoteTableDict :: String -> Accessor RemoteTable (Maybe RuntimeSerializableSupport)

506+remoteTableDict :: TypeRep -> Accessor RemoteTable (Maybe RuntimeSerializableSupport)

507remoteTableDict label = remoteTableDicts >>> DAC.mapMaybe label

508

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

distributed-process/tests/TestClosure.hs+1−1

@@ -14,7 +14,7 @@ import Control.Distributed.Process.Node

14import TestAuxiliary

15

16serializableDictInt :: SerializableDict Int

17−serializableDictInt = SerializableDict "serializableDictInt"

17+serializableDictInt = SerializableDict

18

19addInt :: Int -> Int -> Int

20addInt x y = x + y