Safe Haskell | None |
---|---|
Language | Haskell2010 |
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
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
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.
- Compositionality
Static values as described in the paper are not compositional: there is no
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
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
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
).
- Closures
Closures in functional programming arise when we partially apply a function.
A closure is a code pointer together with a runtime data structure that
represents the value of the free variables of the function. A Closure
represents these closures explicitly so that they can be serialized:
data Closure a = Closure (Static (ByteString -> a)) ByteString
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
).
Moreover, since Static
is now compositional, we can also define derived
operators on Closure
values (closureApplyStatic
, closureApply
,
closureCompose
, closureSplit
).
- Monomorphic example
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
sendInt :: ProcessId -> Int -> Process ()
We might want to define
sendIntClosure :: ProcessId -> Closure (Int -> Process ())
In order to do that, we need a static version of send
, and a static
decoder for ProcessId
:
sendIntStatic :: Static (ProcessId -> Int -> Process ()) sendIntStatic = staticLabel "$send"
decodeProcessIdStatic :: Static (ByteString -> Int) decodeProcessIdStatic = staticLabel "$decodeProcessId"
where of course we have to make sure to use an appropriate RemoteTable
:
rtable :: RemoteTable rtable = registerStatic "$send" (toDynamic sendInt) . registerStatic "$decodeProcessId" (toDynamic (decode :: ByteString -> Int)) $ initRemoteTable
We can now define sendIntClosure
:
sendIntClosure :: ProcessId -> Closure (Int -> Process ()) sendIntClosure pid = closure decoder (encode pid) where decoder :: Static (ByteString -> Int -> Process ()) decoder = sendIntStatic `staticCompose` decodeProcessIdStatic
- Polymorphic example
Suppose we wanted to define a primitive
sendIntResult :: ProcessId -> Closure (Process Int) -> Closure (Process ())
which turns a process that computes an integer into a process that computes the integer and then sends it someplace else.
We can define
bindStatic :: (Typeable a, Typeable b) => Static (Process a -> (a -> Process b) -> Process b) bindStatic = staticLabel "$bind"
provided that we register this label:
rtable :: RemoteTable rtable = ... . registerStatic "$bind" ((>>=) :: Process ANY1 -> (ANY1 -> Process ANY2) -> Process ANY2) $ initRemoteTable
(Note that we are using the special ANY1
and
ANY2
types from Data.Rank1Typeable to represent this
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
- Dealing with qualified types
In the above we were careful to avoid qualified types. Suppose that we have instead
send :: Binary a => ProcessId -> a -> Process ()
If we now want to define sendClosure
, analogous to sendIntClosure
above,
we somehow need to include the Binary
instance in the closure -- after
all, we can ship this closure someplace else, where it needs to accept an
a
, then encode it, and send it off. In order to do this, we need to turn
the Binary instance into an explicit dictionary:
data BinaryDict a where BinaryDict :: Binary a => BinaryDict a sendDict :: BinaryDict a -> ProcessId -> a -> Process () sendDict BinaryDict = send
Now sendDict
is a normal polymorphic value:
sendDictStatic :: Static (BinaryDict a -> ProcessId -> a -> Process ()) sendDictStatic = staticLabel "$sendDict" rtable :: RemoteTable 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
- 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 where sdictSendPort :: SerializableDict ANY -> SerializableDict (SendPort ANY) sdictSendPort SerializableDict = SerializableDict
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
rtable :: RemoteTable rtable = registerStatic "$sdictSendPort" (sdictSendPort :: SerializableDict ANY -> SerializableDict (SendPort ANY)) $ initRemoteTable where sdictSendPort :: forall a. SerializableDict a -> SerializableDict (SendPort a) sdictSendPort SerializableDict = SerializableDict
Synopsis
- data Static a
- staticLabel :: String -> Static a
- staticApply :: Static (a -> b) -> Static a -> Static b
- staticPtr :: Typeable a => StaticPtr a -> Static a
- staticApplyPtr :: (Typeable a, Typeable b) => StaticPtr (a -> b) -> Static a -> Static b
- staticCompose :: Static (b -> c) -> Static (a -> b) -> Static (a -> c)
- staticSplit :: Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b'))
- staticConst :: Static a -> Static (b -> a)
- staticFlip :: Static (a -> b -> c) -> Static (b -> a -> c)
- data Closure a
- closure :: Static (ByteString -> a) -> ByteString -> Closure a
- staticClosure :: Static a -> Closure a
- closureApplyStatic :: Static (a -> b) -> Closure a -> Closure b
- closureApply :: Closure (a -> b) -> Closure a -> Closure b
- closureCompose :: Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
- closureSplit :: Closure (a -> b) -> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))
- data RemoteTable
- initRemoteTable :: RemoteTable
- registerStatic :: String -> Dynamic -> RemoteTable -> RemoteTable
- unstatic :: Typeable a => RemoteTable -> Static a -> Either String a
- unclosure :: Typeable a => RemoteTable -> Closure a -> Either String a
Static values
A static value. Static is opaque; see staticLabel
and staticApply
.
staticLabel :: String -> Static a Source #
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.
staticPtr :: Typeable a => StaticPtr a -> Static a Source #
Construct a static value from a static pointer
Since 0.3.4.0.
staticApplyPtr :: (Typeable a, Typeable b) => StaticPtr (a -> b) -> Static a -> Static b Source #
Apply a static pointer to a static value
Since 0.3.4.0.
Derived static combinators
staticCompose :: Static (b -> c) -> Static (a -> b) -> Static (a -> c) Source #
Static version of (.
)
staticSplit :: Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b')) Source #
Static version of (***
)
Closures
A closure is a static value and an encoded environment
:: Static (ByteString -> a) | Decoder |
-> ByteString | Encoded closure environment |
-> Closure a |
Derived closure combinators
staticClosure :: Static a -> Closure a Source #
Convert a static value into a closure.
closureApplyStatic :: Static (a -> b) -> Closure a -> Closure b Source #
Apply a static function to a closure
closureCompose :: Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c) Source #
Closure composition
closureSplit :: Closure (a -> b) -> Closure (a' -> b') -> Closure ((a, a') -> (b, b')) Source #
Closure version of (***
)
Resolution
data RemoteTable Source #
Runtime dictionary for unstatic
lookups
initRemoteTable :: RemoteTable Source #
Initial remote table
registerStatic :: String -> Dynamic -> RemoteTable -> RemoteTable Source #
Register a static label