distributed-process 0.2.2.0 → 0.2.3.0

raw patch · 9 files changed

+60/−39 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• distributed-process.cabal +1/−1
• src/Control/Distributed/Process.hs +2/−2
• src/Control/Distributed/Process/Closure.hs +7/−0
• src/Control/Distributed/Process/Internal/Closure/CP.hs +2/−2
• src/Control/Distributed/Process/Internal/Closure/Resolution.hs +7/−7
• src/Control/Distributed/Process/Internal/Primitives.hs +3/−4
• src/Control/Distributed/Process/Internal/Types.hs +35/−16
• src/Control/Distributed/Process/Node.hs +2/−6
• tests/TestClosure.hs +1/−1

@@ -1,5 +1,5 @@ Name:          distributed-process -Version:       0.2.2.0+Version:       0.2.3.0 Cabal-Version: >=1.8 Build-Type:    Simple License:       BSD3 

@@ -63,7 +63,7 @@   , PortMonitorNotification(..)   , DiedReason(..)     -- * Closures-  , Closure+  , Closure(..)   , Static   , unClosure   , RemoteTable@@ -115,7 +115,7 @@   , ProcessId(..)   , Process(..)   , Closure(..)-  , Static(..)+  , Static   , MonitorRef(..)   , ProcessMonitorNotification(..)   , NodeMonitorNotification(..)

@@ -35,6 +35,13 @@ -- >            . Mn.__remoteTable -- >            $ initRemoteTable  --+-- NOTE: If you get a type error from ghc along these lines+--+-- >  The exact Name `a_a30k' is not in scope+-- >       Probable cause: you used a unique name (NameU) in Template Haskell but did not bind it+--+-- then you need to enable the @ScopedTypeVariables@ language extension.+-- -- [Dealing with type class qualifiers] --  -- Although 'mkStatic' supports polymorphic types, it does not support

@@ -117,9 +117,9 @@  -- | Resolve a closure unClosure :: Static a -> ByteString -> Process Dynamic-unClosure (Static label) env = do+unClosure static env = do   rtable <- remoteTable . processNode <$> ask -  case resolveClosure rtable label env of+  case resolveClosure rtable static env of     Nothing  -> fail "Derived.unClosure: resolveClosure failed"     Just dyn -> return dyn 

@@ -17,18 +17,18 @@   ) import Control.Distributed.Process.Internal.TypeRep () -- Binary instances   -resolveStatic :: RemoteTable -> StaticLabel -> Maybe Dynamic-resolveStatic rtable (StaticLabel string typ) = do+resolveStatic :: RemoteTable -> Static a -> Maybe Dynamic+resolveStatic rtable (Static (StaticLabel string typ)) = do   Dynamic _ val <- rtable ^. remoteTableLabel string   return (Dynamic typ val)-resolveStatic rtable (StaticApply static1 static2) = do-  f <- resolveStatic rtable static1-  x <- resolveStatic rtable static2+resolveStatic rtable (Static (StaticApply static1 static2)) = do+  f <- resolveStatic rtable (Static static1)+  x <- resolveStatic rtable (Static static2)   f `dynApply` x-resolveStatic _rtable (StaticDuplicate static typ) = +resolveStatic _rtable (Static (StaticDuplicate static typ)) =    return $ Dynamic typ (unsafeCoerce# (Static static)) -resolveClosure :: RemoteTable -> StaticLabel -> ByteString -> Maybe Dynamic+resolveClosure :: RemoteTable -> Static a -> ByteString -> Maybe Dynamic resolveClosure rtable static env = do   decoder <- resolveStatic rtable static   decoder `dynApply` toDyn env

@@ -118,7 +118,6 @@   , DidUnlinkPort(..)   , WhereIsReply(..)   , createMessage-  , Static(..)   , runLocalProcess   ) import Control.Distributed.Process.Internal.Node (sendMessage, sendBinary) @@ -503,10 +502,10 @@  -- | Deserialize a closure unClosure :: forall a. Typeable a => Closure a -> Process a-unClosure (Closure (Static label) env) = do+unClosure (Closure static env) = do     rtable <- remoteTable . processNode <$> ask -    case resolveClosure rtable label env of-      Nothing  -> error $ "Unregistered closure " ++ show label+    case resolveClosure rtable static env of+      Nothing  -> error $ "Unregistered closure " ++ show static        Just dyn -> return $ fromDyn dyn (throw (typeError dyn))   where     typeError dyn = userError $ "lookupStatic type error: " 

@@ -78,7 +78,7 @@ import Data.Int (Int32) import Data.Maybe (fromJust) import Data.Typeable (Typeable, TypeRep, typeOf, funResultTy)-import Data.Binary (Binary(put, get), putWord8, getWord8, encode)+import Data.Binary (Binary(put, get), putWord8, getWord8, encode, Put, Get) import qualified Data.ByteString as BSS (ByteString, concat) import qualified Data.ByteString.Lazy as BSL    ( ByteString@@ -109,7 +109,7 @@   ) import Control.Distributed.Process.Internal.CQueue (CQueue) import Control.Distributed.Process.Internal.Dynamic (Dynamic) -import Control.Distributed.Process.Internal.TypeRep () -- Binary instances+import Control.Distributed.Process.Internal.TypeRep (compareTypeRep) -- and Binary instances  -------------------------------------------------------------------------------- -- Node and process identifiers                                               --@@ -265,7 +265,15 @@   | StaticDuplicate StaticLabel TypeRep   deriving (Typeable, Show) --- | A static value is top-level bound or the application of two static values+-- | A static value is top-level bound or the application of two static values.+--+-- You construct static values using 'Control.Distributed.Process.Closure.mkStatic'+-- or 'staticApply'. 'Static' has a serializable instance for all /Typeable/ 'a':+--+-- > instance Typeable a => Serializable (Static a) +--+-- The 'Typeable' constraint (not present in the original Cloud Haskell paper)+-- makes it possible to do a type check during deserialization. newtype Static a = Static StaticLabel    deriving (Typeable, Show) @@ -518,9 +526,9 @@       4 -> return DiedUnknownId        _ -> fail "DiedReason.get: invalid" -instance Binary (Closure a) where-  put (Closure (Static label) env) = put label >> put env-  get = Closure <$> (Static <$> get) <*> get +instance Typeable a => Binary (Closure a) where+  put (Closure static env) = put static >> put env+  get = Closure <$> get <*> get   instance Binary DidSpawn where   put (DidSpawn ref pid) = put ref >> put pid@@ -542,17 +550,28 @@       2 -> SendPortIdentifier <$> get        _ -> fail "Identifier.get: invalid" -instance Binary StaticLabel where-  put (StaticLabel string typ)    = putWord8 0 >> put string >> put typ -  put (StaticApply label1 label2) = putWord8 1 >> put label1 >> put label2-  put (StaticDuplicate label typ) = putWord8 2 >> put label >> put typ+-- We don't want StaticLabel to be its own Binary instance+putStaticLabel :: StaticLabel -> Put+putStaticLabel (StaticLabel string typ)    = putWord8 0 >> put string >> put typ +putStaticLabel (StaticApply label1 label2) = putWord8 1 >> putStaticLabel label1 >> putStaticLabel label2+putStaticLabel (StaticDuplicate label typ) = putWord8 2 >> putStaticLabel label >> put typ++getStaticLabel :: Get StaticLabel+getStaticLabel = do+  header <- getWord8+  case header of+    0 -> StaticLabel <$> get <*> get+    1 -> StaticApply <$> getStaticLabel <*> getStaticLabel+    2 -> StaticDuplicate <$> getStaticLabel <*> get+    _ -> fail "StaticLabel.get: invalid" ++instance Typeable a => Binary (Static a) where+  put (Static label) = putStaticLabel label   get = do-    header <- getWord8-    case header of-      0 -> StaticLabel <$> get <*> get-      1 -> StaticApply <$> get <*> get-      2 -> StaticDuplicate <$> get <*> get-      _ -> fail "StaticLabel.get: invalid" +    label <- getStaticLabel+    if typeOfStaticLabel label `compareTypeRep` typeOf (undefined :: a)+      then return $ Static label +      else fail "Static.get: type error"  instance Binary WhereIsReply where   put (WhereIsReply label mPid) = put label >> put mPid

@@ -99,7 +99,6 @@   , SpawnRef   , DidSpawn(..)   , Closure(..)-  , Static(..)   , Message   , TypedChannel(..)   , Identifier(..)@@ -135,9 +134,6 @@                 $ RemoteTable Map.empty  -- | Initialize a new local node. --- --- Note that proper Cloud Haskell initialization and configuration is still --- to do. newLocalNode :: NT.Transport -> RemoteTable -> IO LocalNode newLocalNode transport rtable = do     mEndPoint <- NT.newEndPoint transport@@ -608,9 +604,9 @@  -- | Lookup a local closure  unClosure :: Typeable a => Closure a -> NC (Maybe a)-unClosure (Closure (Static label) env) = do+unClosure (Closure static env) = do   rtable <- remoteTable <$> ask-  return (resolveClosure rtable label env >>= fromDynamic)+  return (resolveClosure rtable static env >>= fromDynamic)  -- | Check if an identifier refers to a valid local object isValidLocalIdentifier :: Identifier -> NC Bool

@@ -12,7 +12,7 @@ import Control.Distributed.Process import Control.Distributed.Process.Closure import Control.Distributed.Process.Node-import Control.Distributed.Process.Internal.Types (Closure(..), Static(..), StaticLabel(..))+import Control.Distributed.Process.Internal.Types (Static(Static), StaticLabel(StaticLabel)) import TestAuxiliary  sdictInt :: SerializableDict Int