@@ -27,8 +27,9 @@ module Control.Distributed.Process.Internal.Types
2727 , StaticLabel(..)
2828 , Static(..)
2929 , Closure(..)
30− , CallReply(..)
3130 , RemoteTable(..)
31+ , SerializableDict(..)
32+ , RuntimeSerializableSupport(..)
3233 -- * Messages
3334 , Message(..)
3435 -- * Node controller user-visible data types
@@ -57,14 +58,14 @@ module Control.Distributed.Process.Internal.Types
5758 , typedChannels
5859 , typedChannelWithId
5960 , remoteTableLabels
60− , remoteTableSenders
61+ , remoteTableDicts
6162 , remoteTableLabel
62− , remoteTableSender
63+ , remoteTableDict
6364 ) where
6465
6566import Data.Map (Map)
6667import Data.Int (Int32)
67−import Data.Typeable (Typeable, TypeRep)
68+import Data.Typeable (Typeable)
6869import Data.Binary (Binary(put, get), putWord8, getWord8)
6970import Data.ByteString.Lazy (ByteString)
7071import Data.Accessor (Accessor, accessor)
@@ -208,8 +209,9 @@ data ReceivePort a =
208209
209210data StaticLabel =
210211 UserStatic String
211− -- Special support for 'call'
212− | Call
212+ -- Built-in closures
213+ | ClosureReturn
214+ | ClosureSend
213215 -- Generic closure combinators
214216 | ClosureApply
215217 | ClosureConst
@@ -234,16 +236,28 @@ newtype Static a = Static StaticLabel
234236data Closure a = Closure (Static (ByteString -> a)) ByteString
235237 deriving (Typeable, Show)
236238
237−-- | Used for the implementation of 'call'
238−newtype CallReply a = CallReply a
239− deriving (Typeable, Binary)
240−
241239-- | Used to fake 'static' (see paper)
242240data RemoteTable = RemoteTable {
241+ -- | If the user creates a closure of type @a -> Closure b@ from a function
242+ -- @f : a -> b@, then '_remoteTableLabels' should have an entry for "f"
243+ -- of type @ByteString -> b@ (basically, @f . encode@)
243244 _remoteTableLabels :: Map String Dynamic
244− , _remoteTableSenders :: Map TypeRep Dynamic
245+ -- | Runtime counterpart to SerializableDict
246+ , _remoteTableDicts :: Map String RuntimeSerializableSupport
245247 }
246248
249+-- | Reification of 'Serializable' (see "Control.Distributed.Process.Closure")
250+data SerializableDict a where
251+ SerializableDict :: Serializable a => String -> SerializableDict a
252+ deriving (Typeable)
253+
254+-- | Runtime support for implementing "polymorphic" functions with a
255+-- Serializable qualifier (sendClosure, returnClosure, ..).
256+data RuntimeSerializableSupport = RuntimeSerializableSupport {
257+ rssSend :: Dynamic
258+ , rssReturn :: Dynamic
259+ }
260+
247261--------------------------------------------------------------------------------
248262-- Messages --
249263--------------------------------------------------------------------------------
@@ -413,36 +427,38 @@ instance Binary Identifier where
413427
414428instance Binary StaticLabel where
415429 put (UserStatic string) = putWord8 0 >> put string
416− put Call = putWord8 1
417− put ClosureApply = putWord8 2
418− put ClosureConst = putWord8 3
419− put ClosureUnit = putWord8 4
420− put CpId = putWord8 5
421− put CpComp = putWord8 6
422− put CpFirst = putWord8 7
423− put CpSwap = putWord8 8
424− put CpCopy = putWord8 9
425− put CpLeft = putWord8 10
426− put CpMirror = putWord8 11
427− put CpUntag = putWord8 12
428− put CpApply = putWord8 13
430+ put ClosureReturn = putWord8 1
431+ put ClosureSend = putWord8 2
432+ put ClosureApply = putWord8 3
433+ put ClosureConst = putWord8 4
434+ put ClosureUnit = putWord8 5
435+ put CpId = putWord8 6
436+ put CpComp = putWord8 7
437+ put CpFirst = putWord8 8
438+ put CpSwap = putWord8 9
439+ put CpCopy = putWord8 10
440+ put CpLeft = putWord8 11
441+ put CpMirror = putWord8 12
442+ put CpUntag = putWord8 13
443+ put CpApply = putWord8 14
429444 get = do
430445 header <- getWord8
431446 case header of
432447 0 -> UserStatic <$> get
433− 1 -> return Call
434− 2 -> return ClosureApply
435− 3 -> return ClosureConst
436− 4 -> return ClosureUnit
437− 5 -> return CpId
438− 6 -> return CpComp
439− 7 -> return CpFirst
440− 8 -> return CpSwap
441− 9 -> return CpCopy
442− 10 -> return CpLeft
443− 11 -> return CpMirror
444− 12 -> return CpUntag
445− 13 -> return CpApply
448+ 1 -> return ClosureReturn
449+ 2 -> return ClosureSend
450+ 3 -> return ClosureApply
451+ 4 -> return ClosureConst
452+ 5 -> return ClosureUnit
453+ 6 -> return CpId
454+ 7 -> return CpComp
455+ 8 -> return CpFirst
456+ 9 -> return CpSwap
457+ 10 -> return CpCopy
458+ 11 -> return CpLeft
459+ 12 -> return CpMirror
460+ 13 -> return CpUntag
461+ 14 -> return CpApply
446462 _ -> fail "StaticLabel.get: invalid"
447463
448464
@@ -481,14 +497,14 @@ typedChannelWithId cid = typedChannels >>> DAC.mapMaybe cid
481497remoteTableLabels :: Accessor RemoteTable (Map String Dynamic)
482498remoteTableLabels = accessor _remoteTableLabels (\ls tbl -> tbl { _remoteTableLabels = ls })
483499
484−remoteTableSenders :: Accessor RemoteTable (Map TypeRep Dynamic)
485−remoteTableSenders = accessor _remoteTableSenders (\es tbl -> tbl { _remoteTableSenders = es })
500+remoteTableDicts :: Accessor RemoteTable (Map String RuntimeSerializableSupport)
501+remoteTableDicts = accessor _remoteTableDicts (\ds tbl -> tbl { _remoteTableDicts = ds })
486502
487503remoteTableLabel :: String -> Accessor RemoteTable (Maybe Dynamic)
488504remoteTableLabel label = remoteTableLabels >>> DAC.mapMaybe label
489505
490−remoteTableSender :: TypeRep -> Accessor RemoteTable (Maybe Dynamic)
491−remoteTableSender typ = remoteTableSenders >>> DAC.mapMaybe typ
506+remoteTableDict :: String -> Accessor RemoteTable (Maybe RuntimeSerializableSupport)
507+remoteTableDict label = remoteTableDicts >>> DAC.mapMaybe label
492508
493509--------------------------------------------------------------------------------
494510-- MessageT monad --