bcc7a80 · distributed-process

git.iko.soy/distributed-process

Bumb version 0.2.3/Serializable Static

commitbcc7a80b8de3ef8089a73699141df844c2b38a15 authorEdsko de Vries <edsko@well-typed.com> dateThu 2 Aug 2012, 13:20 (14 years ago) parent13ac8e7

9 files changed+55−36

compare with master

unifiedsplit

distributed-process-azure/src/Control/Distributed/Process/Backend/Azure.hs+1−1 distributed-process/ChangeLog+3−1 distributed-process/src/Control/Distributed/Process.hs+1−1 distributed-process/src/Control/Distributed/Process/Internal/Closure/CP.hs+2−2 distributed-process/src/Control/Distributed/Process/Internal/Closure/Resolution.hs+7−7 distributed-process/src/Control/Distributed/Process/Internal/Primitives.hs+3−4 distributed-process/src/Control/Distributed/Process/Internal/Types.hs+35−16 distributed-process/src/Control/Distributed/Process/Node.hs+2−3 distributed-process/tests/TestClosure.hs+1−1

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

@@ -79,7 +79,7 @@ encodeToStdout = liftIO . BSL.putStr . encode

7979encodeToStdoutDict :: SerializableDict a -> a -> Process ()

8080encodeToStdoutDict SerializableDict = encodeToStdout

8181

82−remotable ['encodeToStdoutDict]

82+remotable ['encodeToStdout]

8383

8484-- | Azure backend

8585data Backend = Backend {

distributed-process/ChangeLog+3−1

@@ -1,6 +1,8 @@

1−2012-08-02 Edsko de Vries <edsko@well-typed.com> 0.2.2.1

1+2012-08-02 Edsko de Vries <edsko@well-typed.com> 0.2.3.0

33* Expose the constructors of Closure

4+* Add instance (Typeable a => Serializable (Static a)) and make sure we only

5+use the internal representation of Static where really necessary

46* Improved docs

682012-07-31 Edsko de Vries <edsko@well-typed.com> 0.2.2.0

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

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

115115 , ProcessId(..)

116116 , Process(..)

117117 , Closure(..)

118− , Static(..)

118+ , Static

119119 , MonitorRef(..)

120120 , ProcessMonitorNotification(..)

121121 , NodeMonitorNotification(..)

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

@@ -117,9 +117,9 @@ sdictComp = SerializableDict

117117

118118-- | Resolve a closure

119119unClosure :: Static a -> ByteString -> Process Dynamic

120−unClosure (Static label) env = do

120+unClosure static env = do

121121 rtable <- remoteTable . processNode <$> ask

122− case resolveClosure rtable label env of

122+ case resolveClosure rtable static env of

123123 Nothing -> fail "Derived.unClosure: resolveClosure failed"

124124 Just dyn -> return dyn

125125

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

@@ -17,18 +17,18 @@ import Control.Distributed.Process.Internal.Dynamic

1717 )

1818import Control.Distributed.Process.Internal.TypeRep () -- Binary instances

1919

20−resolveStatic :: RemoteTable -> StaticLabel -> Maybe Dynamic

21−resolveStatic rtable (StaticLabel string typ) = do

20+resolveStatic :: RemoteTable -> Static a -> Maybe Dynamic

21+resolveStatic rtable (Static (StaticLabel string typ)) = do

2222 Dynamic _ val <- rtable ^. remoteTableLabel string

2323 return (Dynamic typ val)

24−resolveStatic rtable (StaticApply static1 static2) = do

25− f <- resolveStatic rtable static1

26− x <- resolveStatic rtable static2

24+resolveStatic rtable (Static (StaticApply static1 static2)) = do

25+ f <- resolveStatic rtable (Static static1)

26+ x <- resolveStatic rtable (Static static2)

2727 f `dynApply` x

28−resolveStatic _rtable (StaticDuplicate static typ) =

28+resolveStatic _rtable (Static (StaticDuplicate static typ)) =

2929 return $ Dynamic typ (unsafeCoerce# (Static static))

3030

31−resolveClosure :: RemoteTable -> StaticLabel -> ByteString -> Maybe Dynamic

31+resolveClosure :: RemoteTable -> Static a -> ByteString -> Maybe Dynamic

3232resolveClosure rtable static env = do

3333 decoder <- resolveStatic rtable static

3434 decoder `dynApply` toDyn env

distributed-process/src/Control/Distributed/Process/Internal/Primitives.hs+3−4

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

118118 , DidUnlinkPort(..)

119119 , WhereIsReply(..)

120120 , createMessage

121− , Static(..)

122121 , runLocalProcess

123122 )

124123import Control.Distributed.Process.Internal.Node (sendMessage, sendBinary)

@@ -503,10 +502,10 @@ nsendRemote nid label msg =

503502

504503-- | Deserialize a closure

505504unClosure :: forall a. Typeable a => Closure a -> Process a

506−unClosure (Closure (Static label) env) = do

505+unClosure (Closure static env) = do

507506 rtable <- remoteTable . processNode <$> ask

508− case resolveClosure rtable label env of

509− Nothing -> error $ "Unregistered closure " ++ show label

507+ case resolveClosure rtable static env of

508+ Nothing -> error $ "Unregistered closure " ++ show static

510509 Just dyn -> return $ fromDyn dyn (throw (typeError dyn))

511510 where

512511 typeError dyn = userError $ "lookupStatic type error: "

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

@@ -78,7 +78,7 @@ import Data.Map (Map)

7878import Data.Int (Int32)

7979import Data.Maybe (fromJust)

8080import Data.Typeable (Typeable, TypeRep, typeOf, funResultTy)

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

81+import Data.Binary (Binary(put, get), putWord8, getWord8, encode, Put, Get)

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

8383import qualified Data.ByteString.Lazy as BSL

8484 ( ByteString

@@ -109,7 +109,7 @@ import Control.Distributed.Process.Serializable

109109 )

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

111111import Control.Distributed.Process.Internal.Dynamic (Dynamic)

112−import Control.Distributed.Process.Internal.TypeRep () -- Binary instances

112+import Control.Distributed.Process.Internal.TypeRep (compareTypeRep) -- and Binary instances

113113

114114--------------------------------------------------------------------------------

115115-- Node and process identifiers --

@@ -265,7 +265,15 @@ data StaticLabel =

265265 | StaticDuplicate StaticLabel TypeRep

266266 deriving (Typeable, Show)

267267

268−-- | A static value is top-level bound or the application of two static values

268+-- | A static value is top-level bound or the application of two static values.

269+--

270+-- You construct static values using 'Control.Distributed.Process.Closure.mkStatic'

271+-- or 'staticApply'. 'Static' has a serializable instance for all /Typeable/ 'a':

272+--

273+-- > instance Typeable a => Serializable (Static a)

274+--

275+-- The 'Typeable' constraint (not present in the original Cloud Haskell paper)

276+-- makes it possible to do a type check during deserialization.

269277newtype Static a = Static StaticLabel

270278 deriving (Typeable, Show)

271279

@@ -518,9 +526,9 @@ instance Binary DiedReason where

518526 4 -> return DiedUnknownId

519527 _ -> fail "DiedReason.get: invalid"

520528

521−instance Binary (Closure a) where

522− put (Closure (Static label) env) = put label >> put env

523− get = Closure <$> (Static <$> get) <*> get

529+instance Typeable a => Binary (Closure a) where

530+ put (Closure static env) = put static >> put env

531+ get = Closure <$> get <*> get

524532

525533instance Binary DidSpawn where

526534 put (DidSpawn ref pid) = put ref >> put pid

@@ -542,17 +550,28 @@ instance Binary Identifier where

542550 2 -> SendPortIdentifier <$> get

543551 _ -> fail "Identifier.get: invalid"

544552

545−instance Binary StaticLabel where

546− put (StaticLabel string typ) = putWord8 0 >> put string >> put typ

547− put (StaticApply label1 label2) = putWord8 1 >> put label1 >> put label2

548− put (StaticDuplicate label typ) = putWord8 2 >> put label >> put typ

553+-- We don't want StaticLabel to be its own Binary instance

554+putStaticLabel :: StaticLabel -> Put

555+putStaticLabel (StaticLabel string typ) = putWord8 0 >> put string >> put typ

556+putStaticLabel (StaticApply label1 label2) = putWord8 1 >> putStaticLabel label1 >> putStaticLabel label2

557+putStaticLabel (StaticDuplicate label typ) = putWord8 2 >> putStaticLabel label >> put typ

558+

559+getStaticLabel :: Get StaticLabel

560+getStaticLabel = do

561+ header <- getWord8

562+ case header of

563+ 0 -> StaticLabel <$> get <*> get

564+ 1 -> StaticApply <$> getStaticLabel <*> getStaticLabel

565+ 2 -> StaticDuplicate <$> getStaticLabel <*> get

566+ _ -> fail "StaticLabel.get: invalid"

567+

568+instance Typeable a => Binary (Static a) where

569+ put (Static label) = putStaticLabel label

549570 get = do

550− header <- getWord8

551− case header of

552− 0 -> StaticLabel <$> get <*> get

553− 1 -> StaticApply <$> get <*> get

554− 2 -> StaticDuplicate <$> get <*> get

555− _ -> fail "StaticLabel.get: invalid"

571+ label <- getStaticLabel

572+ if typeOfStaticLabel label `compareTypeRep` typeOf (undefined :: a)

573+ then return $ Static label

574+ else fail "Static.get: type error"

556575

557576instance Binary WhereIsReply where

558577 put (WhereIsReply label mPid) = put label >> put mPid

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

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

9999 , SpawnRef

100100 , DidSpawn(..)

101101 , Closure(..)

102− , Static(..)

103102 , Message

104103 , TypedChannel(..)

105104 , Identifier(..)

@@ -605,9 +604,9 @@ isLocal nid ident = nodeOf ident == localNodeId nid

605604

606605-- | Lookup a local closure

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

608−unClosure (Closure (Static label) env) = do

607+unClosure (Closure static env) = do

609608 rtable <- remoteTable <$> ask

610− return (resolveClosure rtable label env >>= fromDynamic)

609+ return (resolveClosure rtable static env >>= fromDynamic)

611610

612611-- | Check if an identifier refers to a valid local object

613612isValidLocalIdentifier :: Identifier -> NC Bool

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

@@ -12,7 +12,7 @@ import Network.Transport.TCP (createTransport, defaultTCPParameters)

1212import Control.Distributed.Process

1313import Control.Distributed.Process.Closure

1414import Control.Distributed.Process.Node

15−import Control.Distributed.Process.Internal.Types (Closure(..), Static(..), StaticLabel(..))

15+import Control.Distributed.Process.Internal.Types (Static(Static), StaticLabel(StaticLabel))

1616import TestAuxiliary

1717

1818sdictInt :: SerializableDict Int