@@ -1,44 +1,201 @@
1−-- | /Towards Haskell in the Cloud/ introduces a new typing construct called
2−-- @static@. Unfortunately, ghc does not yet include support for @static@. In
3−-- this module we provide a workaround, which at the same time also extends
4−-- the functionality of @static@ as described in the paper and makes it more
5−-- expressive.
1+-- | /Towards Haskell in the Cloud/ (Epstein et al, Haskell Symposium 2011)
2+-- introduces the concept of /static/ values: values that are known at compile
3+-- time. In a distributed setting where all nodes are running the same
4+-- executable, static values can be serialized simply by transmitting a code
5+-- pointer to the value. This however requires special compiler support, which
6+-- is not yet available in ghc. We can mimick the behaviour by keeping an
7+-- explicit mapping ('RemoteTable') from labels to values (and making sure that
8+-- all distributed nodes are using the same 'RemoteTable'). In this module
9+-- we implement this mimickry and various extensions.
10+--
11+-- [Dynamic type checking]
12+--
13+-- The paper stipulates that 'Static' values should have a free 'Binary'
14+-- instance:
15+--
16+-- > instance Binary (Static a)
17+--
18+-- This however is not (runtime) type safe: for instance, what would be the
19+-- behaviour of
20+--
21+-- > f :: Static Int -> Static Bool
22+-- > f = decode . encode
23+--
24+-- For this reason we work only with 'Typeable' terms in this module, and
25+-- implement runtime checks
26+--
27+-- > instance Typeable a => Binary (Static a)
28+--
29+-- The above function 'f' typechecks but throws an exception if executed. The
30+-- type representation we use, however, is not the standard
31+-- 'Data.Typeable.TypeRep' from "Data.Typeable" but
32+-- 'Data.Rank1Typeable.TypeRep' from "Data.Rank1Typeable". This means that we
33+-- can represent polymorphic static values (see below for an example).
34+--
35+-- Since the runtime mapping ('RemoteTable') contains values of different types,
36+-- it maps labels ('String's) to 'Data.Rank1Dynamic.Dynamic' values. Again, we
37+-- use the implementation from "Data.Rank1Dynamic" so that we can store
38+-- polymorphic dynamic values.
39+--
40+-- [Compositionality]
41+--
42+-- Static values as described in the paper are not compositional: there is no
43+-- way to combine two static values and get a static value out of it. This
44+-- makes sense when interpreting static strictly as /known at compile time/,
45+-- but it severely limits expressiveness. However, the main motivation for
46+-- 'static' is not that they are known at compile time but rather that
47+-- /they provide a free/ 'Binary' /instance/. We therefore provide two basic
48+-- constructors for 'Static' values:
49+--
50+-- > staticLabel :: String -> Static a
51+-- > staticApply :: Static (a -> b) -> Static a -> Static b
52+--
53+-- The first constructor refers to a label in a 'RemoteTable'. The second
54+-- allows to apply a static function to a static argument, and makes 'Static'
55+-- compositional: once we have 'staticApply' we can implement numerous derived
56+-- combinators on 'Static' values (we define a few in this module; see
57+-- 'staticCompose', 'staticSplit', and 'staticConst').
58+--
59+-- [Closures]
60+--
61+-- Closures in functional programming arise when we partially apply a function.
62+-- A closure is a code pointer together with a runtime data structure that
63+-- represents the value of the free variables of the function. A 'Closure'
64+-- represents these closures explicitly so that they can be serialized:
65+--
66+-- > data Closure a = Closure (Static (ByteString -> a)) ByteString
67+--
68+-- See /Towards Haskell in the Cloud/ for the rationale behind representing
69+-- the function closure environment in serialized ('ByteString') form. Any
70+-- static value can trivially be turned into a 'Closure' ('staticClosure').
71+-- Moreover, since 'Static' is now compositional, we can also define derived
72+-- operators on 'Closure' values ('closureApplyStatic', 'closureApply',
73+-- 'closureCompose', 'closureSplit').
74+--
75+-- [Monomorphic example]
76+--
77+-- Suppose we are working in the context of some distributed environment, with
78+-- a monadic type 'Process' representing processes, 'NodeId' representing node
79+-- addresses and 'ProcessId' representing process addresses. Suppose further
80+-- that we have a primitive
681--
7−-- The main idea (already discussed in /Towards Haskell in the Cloud/, section
8−-- /Faking It/) is to maintain a runtime mapping from labels (strings) to
9−-- values. A basic static value (introduced using 'staticLabel') then is an
10−-- index into this runtime mapping. It is the responsibility of the client code
11−-- to make sure that the corresponding value in the 'RemoteTable' matches the
12−-- type of the label, although we do runtime type checks where possible. For
13−-- this reason, we only work with 'Typeable' values in this module.
82+-- > sendInt :: ProcessId -> Int -> Process ()
83+--
84+-- We might want to define
85+--
86+-- > sendIntClosure :: ProcessId -> Closure (Int -> Process ())
87+--
88+-- In order to do that, we need a static version of 'send', and a static
89+-- decoder for 'ProcessId':
90+--
91+-- > sendIntStatic :: Static (ProcessId -> Int -> Process ())
92+-- > sendIntStatic = staticLabel "$send"
93+--
94+-- > decodeProcessIdStatic :: Static (ByteString -> Int)
95+-- > decodeProcessIdStatic = staticLabel "$decodeProcessId"
96+--
97+-- where of course we have to make sure to use an appropriate 'RemoteTable':
98+--
99+-- > rtable :: RemoteTable
100+-- > rtable = registerStatic "$send" (toDynamic sendInt)
101+-- > . registerStatic "$decodeProcessId" (toDynamic (decode :: ByteString -> Int))
102+-- > $ initRemoteTable
103+--
104+-- We can now define 'sendIntClosure':
105+--
106+-- > sendIntClosure :: ProcessId -> Closure (Int -> Process ())
107+-- > sendIntClosure pid = Closure decoder (encode pid)
108+-- > where
109+-- > decoder :: Static (ByteString -> Int -> Process ())
110+-- > decoder = sendIntStatic `staticCompose` decodeProcessIdStatic
111+--
112+-- [Polymorphic example]
113+--
114+-- Suppose we wanted to define a primitive
115+--
116+-- > sendIntResult :: ProcessId -> Closure (Process Int) -> Closure (Process ())
117+--
118+-- which turns a process that computes an integer into a process that computes
119+-- the integer and then sends it someplace else.
120+--
121+-- We can define
122+--
123+-- > bindStatic :: (Typeable a, Typeable b) => Static (Process a -> (a -> Process b) -> Process b)
124+-- > bindStatic = staticLabel "$bind"
125+--
126+-- provided that we register this label:
127+--
128+-- > rtable :: RemoteTable
129+-- > rtable = ...
130+-- > . registerStatic "$bind" ((>>=) :: Process ANY1 -> (ANY1 -> Process ANY2) -> Process ANY2)
131+-- > $ initRemoteTable
132+--
133+-- (Note that we are using the special 'Data.Rank1Typeable.ANY1' and
134+-- 'Data.Rank1Typeable.ANY2' types from "Data.Rank1Typeable" to represent this
135+-- polymorphic value.) Once we have a static bind we can define
136+--
137+-- > sendIntResult :: ProcessId -> Closure (Process Int) -> Closure (Process ())
138+-- > sendIntResult pid cl = bindStatic `closureApplyStatic` cl `closureApply` sendIntClosure pid
139+--
140+-- [Dealing with qualified types]
141+--
142+-- In the above we were careful to avoid qualified types. Suppose that we have
143+-- instead
144+--
145+-- > send :: Binary a => ProcessId -> a -> Process ()
146+--
147+-- If we now want to define 'sendClosure', analogous to 'sendIntClosure' above,
148+-- we somehow need to include the 'Binary' instance in the closure -- after
149+-- all, we can ship this closure someplace else, where it needs to accept an
150+-- 'a', /then encode it/, and send it off. In order to do this, we need to turn
151+-- the Binary instance into an explicit dictionary:
152+--
153+-- > data BinaryDict a where
154+-- > BinaryDict :: Binary a => BinaryDict a
155+-- >
156+-- > sendDict :: BinaryDict a -> ProcessId -> a -> Process ()
157+-- > sendDict BinaryDict = send
158+--
159+-- Now 'sendDict' is a normal polymorphic value:
160+--
161+-- > sendDictStatic :: Static (BinaryDict a -> ProcessId -> a -> Process ())
162+-- > sendDictStatic = staticLabel "$sendDict"
163+-- >
164+-- > rtable :: RemoteTable
165+-- > rtable = ...
166+-- > . registerStatic "$sendDict" (sendDict :: BinaryDict ANY -> ProcessId -> ANY -> Process ())
167+-- > $ initRemoteTable
168+--
169+-- so that we can define
170+--
171+-- > sendClosure :: Static (BinaryDict a) -> Process a -> Closure (a -> Process ())
172+-- > sendClosure dict pid = Closure decoder (encode pid)
173+-- > where
174+-- > decoder :: Static (ByteString -> a -> Process ())
175+-- > decoder = (sendDictStatic `staticApply` dict) `staticCompose` decodeProcessIdStatic
14176module Control.Distributed.Static
15− ( -- * Introducing static values
177+ ( -- * Static values
16178 Static
17179 , staticLabel
18180 , staticApply
19− , staticDuplicate
20− -- * Eliminating static values
21− , RemoteTable
22− , initRemoteTable
23− , registerStatic
24− , unstatic
25− -- * Closures
26− , Closure(Closure)
27− , unclosure
28− , staticClosure
29− -- * Combinators on static values
181+ -- * Derived static combinators
30182 , staticCompose
31183 , staticSplit
32184 , staticConst
33− -- * Combinators on closures
185+ -- * Closures
186+ , Closure(Closure)
187+ -- * Derived closure combinators
188+ , staticClosure
34189 , closureApplyStatic
35190 , closureApply
36191 , closureCompose
37192 , closureSplit
38− -- * Re-exports
39− , Typeable
40− , Dynamic
41− , toDynamic
193+ -- * Resolution
194+ , RemoteTable
195+ , initRemoteTable
196+ , registerStatic
197+ , unstatic
198+ , unclosure
42199 ) where
43200
44201import Prelude hiding (const, fst, snd)
@@ -61,7 +218,6 @@ import Data.Rank1Dynamic (Dynamic, toDynamic, fromDynamic, dynApply)
61218import Data.Rank1Typeable
62219 ( Typeable
63220 , typeOf
64− , ANY
65221 , ANY1
66222 , ANY2
67223 , ANY3
@@ -76,11 +232,9 @@ import Data.Rank1Typeable
76232data StaticLabel =
77233 StaticLabel String
78234 | StaticApply StaticLabel StaticLabel
79− | StaticDuplicate StaticLabel
80235 deriving (Typeable, Show)
81236
82−-- | A static value. Static is opaque; see 'staticLabel', 'staticApply',
83−-- 'staticDuplicate' or 'staticTypeOf'.
237+-- | A static value. Static is opaque; see 'staticLabel' and 'staticApply'.
84238newtype Static a = Static StaticLabel
85239 deriving (Typeable, Show)
86240
@@ -99,8 +253,6 @@ putStaticLabel (StaticLabel string) =
99253 putWord8 0 >> put string
100254putStaticLabel (StaticApply label1 label2) =
101255 putWord8 1 >> putStaticLabel label1 >> putStaticLabel label2
102−putStaticLabel (StaticDuplicate label) =
103− putWord8 2 >> putStaticLabel label
104256
105257getStaticLabel :: Get StaticLabel
106258getStaticLabel = do
@@ -108,24 +260,19 @@ getStaticLabel = do
108260 case header of
109261 0 -> StaticLabel <$> get
110262 1 -> StaticApply <$> getStaticLabel <*> getStaticLabel
111− 2 -> StaticDuplicate <$> getStaticLabel
112263 _ -> fail "StaticLabel.get: invalid"
113264
114265-- | Create a primitive static value.
115266--
116267-- It is the responsibility of the client code to make sure the corresponding
117268-- entry in the 'RemoteTable' has the appropriate type.
118−staticLabel :: forall a. String -> Static a
269+staticLabel :: String -> Static a
119270staticLabel = Static . StaticLabel
120271
121272-- | Apply two static values
122273staticApply :: Static (a -> b) -> Static a -> Static b
123274staticApply (Static f) (Static x) = Static (StaticApply f x)
124275
125−-- | Co-monadic 'duplicate' for static values
126−staticDuplicate :: forall a. Static a -> Static (Static a)
127−staticDuplicate (Static x) = Static (StaticDuplicate x)
128−
129276--------------------------------------------------------------------------------
130277-- Eliminating static values --
131278--------------------------------------------------------------------------------
@@ -166,20 +313,15 @@ registerStatic label dyn (RemoteTable rtable)
166313-- Pseudo-type: RemoteTable -> Static a -> a
167314resolveStaticLabel :: RemoteTable -> StaticLabel -> Either String Dynamic
168315resolveStaticLabel (RemoteTable rtable) (StaticLabel label) =
169− case Map.lookup label rtable of
170− Nothing -> Left $ "Invalid static label '" ++ label ++ "'"
171− Just d -> Right d
316+ case Map.lookup label rtable of
317+ Nothing -> Left $ "Invalid static label '" ++ label ++ "'"
318+ Just d -> Right d
172319resolveStaticLabel rtable (StaticApply label1 label2) = do
173− f <- resolveStaticLabel rtable label1
174− x <- resolveStaticLabel rtable label2
175− f `dynApply` x
176−resolveStaticLabel rtable (StaticDuplicate label) = do
177− x <- resolveStaticLabel rtable label -- Resolve only to get type info
178− toDynamic mkStatic `dynApply` x
179− where
180− mkStatic :: ANY -> Static ANY
181− mkStatic _ = Static label
320+ f <- resolveStaticLabel rtable label1
321+ x <- resolveStaticLabel rtable label2
322+ f `dynApply` x
182323
324+-- | Resolve a static value
183325unstatic :: Typeable a => RemoteTable -> Static a -> Either String a
184326unstatic rtable (Static static) = do
185327 dyn <- resolveStaticLabel rtable static
@@ -204,7 +346,7 @@ unclosure rtable (Closure static env) = do
204346 return (f env)
205347
206348-- | Convert a static value into a closure.
207−staticClosure :: forall a. Typeable a => Static a -> Closure a
349+staticClosure :: Typeable a => Static a -> Closure a
208350staticClosure static = Closure (staticConst static) empty
209351
210352--------------------------------------------------------------------------------
@@ -235,14 +377,17 @@ appStatic = staticLabel "$app"
235377-- Combinators on static values --
236378--------------------------------------------------------------------------------
237379
380+-- | Static version of ('Prelude..')
238381staticCompose :: (Typeable a, Typeable b, Typeable c)
239382 => Static (b -> c) -> Static (a -> b) -> Static (a -> c)
240383staticCompose g f = composeStatic `staticApply` g `staticApply` f
241384
385+-- | Static version of ('Control.Arrow.***')
242386staticSplit :: (Typeable a, Typeable a', Typeable b, Typeable b')
243387 => Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b'))
244388staticSplit f g = splitStatic `staticApply` f `staticApply` g
245389
390+-- | Static version of 'Prelude.const'
246391staticConst :: (Typeable a, Typeable b)
247392 => Static a -> Static (b -> a)
248393staticConst x = constStatic `staticApply` x
@@ -251,7 +396,8 @@ staticConst x = constStatic `staticApply` x
251396-- Combinators on Closures --
252397--------------------------------------------------------------------------------
253398
254−closureApplyStatic :: forall a b. (Typeable a, Typeable b)
399+-- | Apply a static function to a closure
400+closureApplyStatic :: (Typeable a, Typeable b)
255401 => Static (a -> b) -> Closure a -> Closure b
256402closureApplyStatic f (Closure decoder env) =
257403 Closure (f `staticCompose` decoder) env
@@ -259,6 +405,7 @@ closureApplyStatic f (Closure decoder env) =
259405decodeEnvPairStatic :: Static (ByteString -> (ByteString, ByteString))
260406decodeEnvPairStatic = staticLabel "$decodeEnvPair"
261407
408+-- | Closure application
262409closureApply :: forall a b. (Typeable a, Typeable b)
263410 => Closure (a -> b) -> Closure a -> Closure b
264411closureApply (Closure fdec fenv) (Closure xdec xenv) =
@@ -271,10 +418,12 @@ closureApply (Closure fdec fenv) (Closure xdec xenv) =
271418 `staticCompose`
272419 decodeEnvPairStatic
273420
421+-- | Closure composition
274422closureCompose :: (Typeable a, Typeable b, Typeable c)
275423 => Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
276424closureCompose g f = composeStatic `closureApplyStatic` g `closureApply` f
277425
426+-- | Closure version of ('Arrow.***')
278427closureSplit :: (Typeable a, Typeable a', Typeable b, Typeable b')
279428 => Closure (a -> b) -> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))
280429closureSplit f g = splitStatic `closureApplyStatic` f `closureApply` g