distributed-static 0.2.1.1 → 0.3.0.0
raw patch · 3 files changed
+98/−71 lines, 3 filesdep ~binarydep ~rank1dynamicnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: binary, rank1dynamic
API changes (from Hackage documentation)
Files
- ChangeLog +20/−0
- distributed-static.cabal +14/−7
- src/Control/Distributed/Static.hs +64/−64
+ ChangeLog view
@@ -0,0 +1,20 @@+2014-05-30 Tim Watson <watson.timothy@gmail.com> 0.3.0.0++* Bump binary dependency++2012-11-22 Edsko de Vries <edsko@well-typed.com> 0.2.1.1++* Relax package bounds to allow for Binary 0.6++2012-10-03 Edsko de Vries <edsko@well-typed.com> 0.2.1++* Add support for 'staticFlip'++2012-08-16 Edsko de Vries <edsko@well-typed.com> 0.2++* Hide the 'Closure' constructor and export 'closure' instead so that we are+free to change the internal representation++2012-08-10 Edsko de Vries <edsko@well-typed.com> 0.1++* Initial release
distributed-static.cabal view
@@ -1,5 +1,5 @@ Name: distributed-static-Version: 0.2.1.1+Version: 0.3.0.0 Synopsis: Compositional, type-safe, polymorphic static values and closures Description: /Towards Haskell in the Cloud/ (Epstein et al, Haskell Symposium 2011) introduces the concept of /static/ values:@@ -14,24 +14,31 @@ 'RemoteTable'). In this module we implement this mimickry and various extensions: type safety (including for polymorphic static values) and compositionality.-Homepage: http://www.github.com/haskell-distributed/distributed-process+Homepage: http://haskell-distributed.github.com License: BSD3 License-File: LICENSE Author: Edsko de Vries-Maintainer: edsko@well-typed.com+Maintainer: edsko@well-typed.com, watson.timothy@gmail.com+Bug-Reports: https://cloud-haskell.atlassian.net/browse/DS Copyright: Well-Typed LLP Category: Control Build-Type: Simple-Cabal-Version: >=1.8+Cabal-Version: >=1.10+extra-source-files: ChangeLog +Source-Repository head+ Type: git+ Location: https://github.com/haskell-distributed/distributed-static+ Library Exposed-Modules: Control.Distributed.Static Build-Depends: base >= 4 && < 5,- rank1dynamic >= 0.1 && < 0.2,+ rank1dynamic >= 0.1 && < 0.3, containers >= 0.4 && < 0.6, bytestring >= 0.9 && < 0.11,- binary >= 0.5 && < 0.7 + binary >= 0.5 && < 0.8 HS-Source-Dirs: src- Extensions: DeriveDataTypeable,+ Default-Language: Haskell2010+ Default-Extensions: DeriveDataTypeable ScopedTypeVariables GHC-Options: -Wall
src/Control/Distributed/Static.hs view
@@ -1,9 +1,9 @@--- | /Towards Haskell in the Cloud/ (Epstein et al, Haskell Symposium 2011) +-- | /Towards Haskell in the Cloud/ (Epstein et al, Haskell Symposium 2011) -- introduces the concept of /static/ values: values that are known at compile--- time. In a distributed setting where all nodes are running the same +-- time. In a distributed setting where all nodes are running the same -- executable, static values can be serialized simply by transmitting a code -- pointer to the value. This however requires special compiler support, which--- is not yet available in ghc. We can mimick the behaviour by keeping an +-- is not yet available in ghc. We can mimick the behaviour by keeping an -- explicit mapping ('RemoteTable') from labels to values (and making sure that -- all distributed nodes are using the same 'RemoteTable'). In this module -- we implement this mimickry and various extensions.@@ -13,13 +13,13 @@ -- The paper stipulates that 'Static' values should have a free 'Binary' -- instance: ----- > instance Binary (Static a) +-- > instance Binary (Static a) -- -- This however is not (runtime) type safe: for instance, what would be the -- behaviour of ----- > f :: Static Int -> Static Bool --- > f = decode . encode +-- > f :: Static Int -> Static Bool+-- > f = decode . encode -- -- For this reason we work only with 'Typeable' terms in this module, and -- implement runtime checks@@ -34,7 +34,7 @@ -- -- Since the runtime mapping ('RemoteTable') contains values of different types, -- it maps labels ('String's) to 'Data.Rank1Dynamic.Dynamic' values. Again, we--- use the implementation from "Data.Rank1Dynamic" so that we can store +-- use the implementation from "Data.Rank1Dynamic" so that we can store -- polymorphic dynamic values. -- -- [Compositionality]@@ -43,18 +43,18 @@ -- way to combine two static values and get a static value out of it. This -- makes sense when interpreting static strictly as /known at compile time/, -- but it severely limits expressiveness. However, the main motivation for--- 'static' is not that they are known at compile time but rather that +-- 'static' is not that they are known at compile time but rather that -- /they provide a free/ 'Binary' /instance/. We therefore provide two basic -- constructors for 'Static' values: -- -- > staticLabel :: String -> Static a -- > staticApply :: Static (a -> b) -> Static a -> Static b ----- The first constructor refers to a label in a 'RemoteTable'. The second +-- The first constructor refers to a label in a 'RemoteTable'. The second -- allows to apply a static function to a static argument, and makes 'Static' -- compositional: once we have 'staticApply' we can implement numerous derived -- combinators on 'Static' values (we define a few in this module; see--- 'staticCompose', 'staticSplit', and 'staticConst'). +-- 'staticCompose', 'staticSplit', and 'staticConst'). -- -- [Closures] --@@ -67,7 +67,7 @@ -- -- See /Towards Haskell in the Cloud/ for the rationale behind representing -- the function closure environment in serialized ('ByteString') form. Any--- static value can trivially be turned into a 'Closure' ('staticClosure'). +-- static value can trivially be turned into a 'Closure' ('staticClosure'). -- Moreover, since 'Static' is now compositional, we can also define derived -- operators on 'Closure' values ('closureApplyStatic', 'closureApply', -- 'closureCompose', 'closureSplit').@@ -76,9 +76,9 @@ -- -- Suppose we are working in the context of some distributed environment, with -- a monadic type 'Process' representing processes, 'NodeId' representing node--- addresses and 'ProcessId' representing process addresses. Suppose further --- that we have a primitive --- +-- addresses and 'ProcessId' representing process addresses. Suppose further+-- that we have a primitive+-- -- > sendInt :: ProcessId -> Int -> Process () -- -- We might want to define@@ -106,7 +106,7 @@ -- > sendIntClosure :: ProcessId -> Closure (Int -> Process ()) -- > sendIntClosure pid = closure decoder (encode pid) -- > where--- > decoder :: Static (ByteString -> Int -> Process ()) +-- > decoder :: Static (ByteString -> Int -> Process ()) -- > decoder = sendIntStatic `staticCompose` decodeProcessIdStatic -- -- [Polymorphic example]@@ -118,8 +118,8 @@ -- which turns a process that computes an integer into a process that computes -- the integer and then sends it someplace else. ----- We can define --- +-- We can define+-- -- > bindStatic :: (Typeable a, Typeable b) => Static (Process a -> (a -> Process b) -> Process b) -- > bindStatic = staticLabel "$bind" --@@ -132,7 +132,7 @@ -- -- (Note that we are using the special 'Data.Rank1Typeable.ANY1' and -- 'Data.Rank1Typeable.ANY2' types from "Data.Rank1Typeable" to represent this--- polymorphic value.) Once we have a static bind we can define +-- polymorphic value.) Once we have a static bind we can define -- -- > sendIntResult :: ProcessId -> Closure (Process Int) -> Closure (Process ()) -- > sendIntResult pid cl = bindStatic `closureApplyStatic` cl `closureApply` sendIntClosure pid@@ -157,7 +157,7 @@ -- > sendDict BinaryDict = send -- -- Now 'sendDict' is a normal polymorphic value:--- +-- -- > sendDictStatic :: Static (BinaryDict a -> ProcessId -> a -> Process ()) -- > sendDictStatic = staticLabel "$sendDict" -- >@@ -165,20 +165,20 @@ -- > rtable = ... -- > . registerStatic "$sendDict" (sendDict :: BinaryDict ANY -> ProcessId -> ANY -> Process ()) -- > $ initRemoteTable--- +-- -- so that we can define -- -- > sendClosure :: Static (BinaryDict a) -> Process a -> Closure (a -> Process ()) -- > sendClosure dict pid = closure decoder (encode pid) -- > where -- > decoder :: Static (ByteString -> a -> Process ())--- > decoder = (sendDictStatic `staticApply` dict) `staticCompose` decodeProcessIdStatic +-- > decoder = (sendDictStatic `staticApply` dict) `staticCompose` decodeProcessIdStatic -- -- [Word of Caution] -- -- You should not /define/ functions on 'ANY' and co. For example, the following -- definition of 'rtable' is incorrect:--- +-- -- > rtable :: RemoteTable -- > rtable = registerStatic "$sdictSendPort" sdictSendPort -- > $ initRemoteTable@@ -186,7 +186,7 @@ -- > sdictSendPort :: SerializableDict ANY -> SerializableDict (SendPort ANY) -- > sdictSendPort SerializableDict = SerializableDict ----- This definition of 'sdictSendPort' ignores its argument completely, and +-- This definition of 'sdictSendPort' ignores its argument completely, and -- constructs a 'SerializableDict' for the /monomorphic/ type @SendPort ANY@, -- which isn't what you want. Instead, you should do --@@ -196,8 +196,8 @@ -- > where -- > sdictSendPort :: forall a. SerializableDict a -> SerializableDict (SendPort a) -- > sdictSendPort SerializableDict = SerializableDict-module Control.Distributed.Static - ( -- * Static values +module Control.Distributed.Static+ ( -- * Static values Static , staticLabel , staticApply@@ -215,15 +215,15 @@ , closureApply , closureCompose , closureSplit- -- * Resolution + -- * Resolution , RemoteTable , initRemoteTable , registerStatic- , unstatic - , unclosure + , unstatic+ , unclosure ) where -import Data.Binary +import Data.Binary ( Binary(get, put) , Put , Get@@ -238,7 +238,7 @@ import Control.Applicative ((<$>), (<*>)) import Control.Arrow as Arrow ((***), app) import Data.Rank1Dynamic (Dynamic, toDynamic, fromDynamic, dynApply)-import Data.Rank1Typeable +import Data.Rank1Typeable ( Typeable , typeOf , ANY1@@ -258,7 +258,7 @@ deriving (Typeable, Show) -- | A static value. Static is opaque; see 'staticLabel' and 'staticApply'.-newtype Static a = Static StaticLabel +newtype Static a = Static StaticLabel deriving (Typeable, Show) instance Typeable a => Binary (Static a) where@@ -272,9 +272,9 @@ -- We don't want StaticLabel to be its own Binary instance putStaticLabel :: StaticLabel -> Put-putStaticLabel (StaticLabel string) = - putWord8 0 >> put string -putStaticLabel (StaticApply label1 label2) = +putStaticLabel (StaticLabel string) =+ putWord8 0 >> put string+putStaticLabel (StaticApply label1 label2) = putWord8 1 >> putStaticLabel label1 >> putStaticLabel label2 getStaticLabel :: Get StaticLabel@@ -283,14 +283,14 @@ case header of 0 -> StaticLabel <$> get 1 -> StaticApply <$> getStaticLabel <*> getStaticLabel- _ -> fail "StaticLabel.get: invalid" - + _ -> fail "StaticLabel.get: invalid"+ -- | Create a primitive static value.--- +-- -- It is the responsibility of the client code to make sure the corresponding -- entry in the 'RemoteTable' has the appropriate type. staticLabel :: String -> Static a-staticLabel = Static . StaticLabel +staticLabel = Static . StaticLabel -- | Apply two static values staticApply :: Static (a -> b) -> Static a -> Static b@@ -300,12 +300,12 @@ -- Eliminating static values -- -------------------------------------------------------------------------------- --- | Runtime dictionary for 'unstatic' lookups +-- | Runtime dictionary for 'unstatic' lookups newtype RemoteTable = RemoteTable (Map String Dynamic) -- | Initial remote table initRemoteTable :: RemoteTable-initRemoteTable = +initRemoteTable = registerStatic "$compose" (toDynamic ((.) :: (ANY2 -> ANY3) -> (ANY1 -> ANY2) -> ANY1 -> ANY3)) . registerStatic "$const" (toDynamic (const :: ANY1 -> ANY2 -> ANY1)) . registerStatic "$split" (toDynamic ((***) :: (ANY1 -> ANY3) -> (ANY2 -> ANY4) -> (ANY1, ANY2) -> (ANY3, ANY4)))@@ -321,23 +321,23 @@ -- Pseudo-type: RemoteTable -> Static a -> a resolveStaticLabel :: RemoteTable -> StaticLabel -> Either String Dynamic-resolveStaticLabel (RemoteTable rtable) (StaticLabel label) = +resolveStaticLabel (RemoteTable rtable) (StaticLabel label) = case Map.lookup label rtable of Nothing -> Left $ "Invalid static label '" ++ label ++ "'" Just d -> Right d resolveStaticLabel rtable (StaticApply label1 label2) = do- f <- resolveStaticLabel rtable label1 + f <- resolveStaticLabel rtable label1 x <- resolveStaticLabel rtable label2 f `dynApply` x -- | Resolve a static value unstatic :: Typeable a => RemoteTable -> Static a -> Either String a-unstatic rtable (Static static) = do - dyn <- resolveStaticLabel rtable static +unstatic rtable (Static static) = do+ dyn <- resolveStaticLabel rtable static fromDynamic dyn ----------------------------------------------------------------------------------- Closures -- +-- Closures -- -------------------------------------------------------------------------------- -- | A closure is a static value and an encoded environment@@ -346,16 +346,16 @@ instance Typeable a => Binary (Closure a) where put (Closure static env) = put static >> put env- get = Closure <$> get <*> get + get = Closure <$> get <*> get closure :: Static (ByteString -> a) -- ^ Decoder -> ByteString -- ^ Encoded closure environment -> Closure a-closure = Closure +closure = Closure -- | Resolve a closure unclosure :: Typeable a => RemoteTable -> Closure a -> Either String a-unclosure rtable (Closure static env) = do +unclosure rtable (Closure static env) = do f <- unstatic rtable static return (f env) @@ -368,18 +368,18 @@ -------------------------------------------------------------------------------- -- | Static version of ('Prelude..')-composeStatic :: (Typeable a, Typeable b, Typeable c) +composeStatic :: (Typeable a, Typeable b, Typeable c) => Static ((b -> c) -> (a -> b) -> a -> c)-composeStatic = staticLabel "$compose" +composeStatic = staticLabel "$compose" -- | Static version of 'const' constStatic :: (Typeable a, Typeable b) => Static (a -> b -> a)-constStatic = staticLabel "$const" +constStatic = staticLabel "$const" -- | Static version of ('Arrow.***')-splitStatic :: (Typeable a, Typeable a', Typeable b, Typeable b') - => Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b')) +splitStatic :: (Typeable a, Typeable a', Typeable b, Typeable b')+ => Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b')) splitStatic = staticLabel "$split" -- | Static version of 'Arrow.app'@@ -390,31 +390,31 @@ -- | Static version of 'flip' flipStatic :: (Typeable a, Typeable b, Typeable c) => Static ((a -> b -> c) -> b -> a -> c)-flipStatic = staticLabel "$flip" +flipStatic = staticLabel "$flip" -------------------------------------------------------------------------------- -- Combinators on static values -- -------------------------------------------------------------------------------- --- | Static version of ('Prelude..') +-- | Static version of ('Prelude..') staticCompose :: (Typeable a, Typeable b, Typeable c) => Static (b -> c) -> Static (a -> b) -> Static (a -> c) staticCompose g f = composeStatic `staticApply` g `staticApply` f -- | Static version of ('Control.Arrow.***')-staticSplit :: (Typeable a, Typeable a', Typeable b, Typeable b') +staticSplit :: (Typeable a, Typeable a', Typeable b, Typeable b') => Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b')) staticSplit f g = splitStatic `staticApply` f `staticApply` g -- | Static version of 'Prelude.const' staticConst :: (Typeable a, Typeable b) => Static a -> Static (b -> a)-staticConst x = constStatic `staticApply` x +staticConst x = constStatic `staticApply` x -- | Static version of 'Prelude.flip' staticFlip :: (Typeable a, Typeable b, Typeable c) => Static (a -> b -> c) -> Static (b -> a -> c)-staticFlip f = flipStatic `staticApply` f +staticFlip f = flipStatic `staticApply` f -------------------------------------------------------------------------------- -- Combinators on Closures --@@ -423,7 +423,7 @@ -- | Apply a static function to a closure closureApplyStatic :: (Typeable a, Typeable b) => Static (a -> b) -> Closure a -> Closure b-closureApplyStatic f (Closure decoder env) = +closureApplyStatic f (Closure decoder env) = closure (f `staticCompose` decoder) env decodeEnvPairStatic :: Static (ByteString -> (ByteString, ByteString))@@ -432,15 +432,15 @@ -- | Closure application closureApply :: forall a b. (Typeable a, Typeable b) => Closure (a -> b) -> Closure a -> Closure b-closureApply (Closure fdec fenv) (Closure xdec xenv) = +closureApply (Closure fdec fenv) (Closure xdec xenv) = closure decoder (encode (fenv, xenv)) where decoder :: Static (ByteString -> b)- decoder = appStatic + decoder = appStatic `staticCompose` (fdec `staticSplit` xdec) `staticCompose`- decodeEnvPairStatic + decodeEnvPairStatic -- | Closure composition closureCompose :: (Typeable a, Typeable b, Typeable c)@@ -448,6 +448,6 @@ closureCompose g f = composeStatic `closureApplyStatic` g `closureApply` f -- | Closure version of ('Arrow.***')-closureSplit :: (Typeable a, Typeable a', Typeable b, Typeable b') +closureSplit :: (Typeable a, Typeable a', Typeable b, Typeable b') => Closure (a -> b) -> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))-closureSplit f g = splitStatic `closureApplyStatic` f `closureApply` g +closureSplit f g = splitStatic `closureApplyStatic` f `closureApply` g