3c804ea · distributed-process

git.iko.soy/distributed-process

Remove label from SerializableDict

commit3c804eac479c433d17eb5ed8c431e6d55bcb78d6 authorEdsko de Vries <edsko@edsko.net> dateThu 28 Jun 2012, 15:54 (14 years ago) parent38091bb

7 files changed+24−22

compare with master

unifiedsplit

distributed-process/src/Control/Distributed/Process.hs+1−1 distributed-process/src/Control/Distributed/Process/Closure.hs+2−3 distributed-process/src/Control/Distributed/Process/Internal/Closure.hs+5−4 distributed-process/src/Control/Distributed/Process/Internal/Closure/BuiltIn.hs+7−6 distributed-process/src/Control/Distributed/Process/Internal/Closure/TH.hs+3−2 distributed-process/src/Control/Distributed/Process/Internal/Types.hs+5−5 distributed-process/tests/TestClosure.hs+1−1

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

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

321321

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

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

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

324+call sdict@SerializableDict nid proc = do

325325 us <- getSelfPid

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

327327 expect

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

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

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

6464--

6565-- > serializableDictInt :: SerializableDict Int

66−-- > serializableDictInt = SerializableDict "serializableDictInt"

66+-- > serializableDictInt = SerializableDict

6767--

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

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

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

69+-- type is not serializable.

7170module Control.Distributed.Process.Closure

7271 ( -- * User-defined closures

7372 remotable

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

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

99import Data.Accessor ((^.))

1010import Data.ByteString.Lazy (ByteString)

1111import Data.Binary (decode)

12+import Data.Typeable (TypeRep)

1213import Control.Distributed.Process.Internal.Types

1314 ( RemoteTable(RemoteTable)

1415 , remoteTableLabel

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

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

4344-- Built-in closures

4445resolveClosure rtable ClosureSend env = do

45− rss <- rtable ^. remoteTableDict label

46+ rss <- rtable ^. remoteTableDict typ

4647 rssSend rss `dynApply` toDyn pid

4748 where

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

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

4950resolveClosure rtable ClosureReturn env = do

50− rss <- rtable ^. remoteTableDict label

51+ rss <- rtable ^. remoteTableDict typ

5152 rssReturn rss `dynApply` toDyn arg

5253 where

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

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

5455-- Generic closure combinators

5556resolveClosure rtable ClosureApply env = do

5657 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

77 ) where

99import Data.Binary (encode)

10+import Data.Typeable (typeOf)

1011import Control.Distributed.Process (link)

1112import Control.Distributed.Process.Internal.Types

1213 ( ProcessId

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

3031linkClosure = $(mkClosure 'link)

3132

3233-- | Closure version of 'send'

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

34−sendClosure (SerializableDict label) pid =

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

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

35+sendClosure SerializableDict pid =

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

3637

3738-- | Return any value

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

39−returnClosure (SerializableDict label) val =

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

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

40+returnClosure SerializableDict 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)

1111import Data.ByteString.Lazy (ByteString)

1212import Data.Binary (encode, decode)

1313import Data.Accessor ((^=))

14+import Data.Typeable (typeOf)

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

1516import Language.Haskell.TH

1617 ( -- Q monad and operations

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

132133registerLabel label dyn = remoteTableLabel label ^= Just dyn

133134

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

135−registerSerializableDict (SerializableDict label) =

136+registerSerializableDict SerializableDict =

136137 -- TODO: Code duplication with Process

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

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

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

144145 rssSend = toDyn send

145146 , rssReturn = toDyn ret

146147 }

147− in remoteTableDict label ^= Just rss

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

148149

149150--------------------------------------------------------------------------------

150151-- 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

6565

6666import Data.Map (Map)

6767import Data.Int (Int32)

68−import Data.Typeable (Typeable)

68+import Data.Typeable (Typeable, TypeRep)

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

7070import Data.ByteString.Lazy (ByteString)

7171import Data.Accessor (Accessor, accessor)

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

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

244244 _remoteTableLabels :: Map String Dynamic

245245 -- | Runtime counterpart to SerializableDict

246− , _remoteTableDicts :: Map String RuntimeSerializableSupport

246+ , _remoteTableDicts :: Map TypeRep RuntimeSerializableSupport

247247 }

248248

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

250250data SerializableDict a where

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

251+ SerializableDict :: Serializable a => SerializableDict a

252252 deriving (Typeable)

253253

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

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

497497remoteTableLabels :: Accessor RemoteTable (Map String Dynamic)

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

499499

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

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

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

502502

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

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

505505

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

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

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

508508

509509--------------------------------------------------------------------------------

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

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

1414import TestAuxiliary

1515

1616serializableDictInt :: SerializableDict Int

17−serializableDictInt = SerializableDict "serializableDictInt"

17+serializableDictInt = SerializableDict

1818

1919addInt :: Int -> Int -> Int

2020addInt x y = x + y