distributed-process-0.2.3.0: Cloud Haskell: Erlang-style concurrency in Haskell

Safe HaskellNone

Control.Distributed.Process.Closure

Contents

Description

Static values and Closures

Static values

Towards Haskell in the Cloud (Epstein et al., Haskell Symposium 2011) proposes a new type construct called static that characterizes values that are known statically. There is no support for static in ghc yet, however, so we emulate it using Template Haskell. Given a top-level definition

 f :: forall a1 .. an. T
 f = ...

you can use a Template Haskell splice to create a static version of f:

 $(mkStatic 'f) :: forall a1 .. an. (Typeable a1, .., Typeable an) => Static T

Every module that you write that contains calls to mkStatic needs to have a call to remotable:

 remotable [ 'f, 'g, ... ]

where you must pass every function (or other value) that you pass as an argument to mkStatic. The call to remotable will create a definition

 __remoteTable :: RemoteTable -> RemoteTable

which can be used to construct the RemoteTable used to initialize Cloud Haskell. You should have (at most) one call to remotable per module, and compose all created functions when initializing Cloud Haskell:

 let rtable :: RemoteTable 
     rtable = M1.__remoteTable
            . M2.__remoteTable
            . ...
            . 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 qualified types. For instance, you cannot call mkStatic on

 decode :: Serializable a => ByteString -> a

Instead, you will need to reify the type class dictionary. Cloud Haskell comes with a reified version of Serializable:

 data SerializableDict a where
   SerializableDict :: Serializable a => SerializableDict a

Using the reified dictionary you can define

 decodeDict :: SerializableDict a -> ByteString -> a
 decodeDict SerializableDict = decode

where decodeDict is a normal (unqualified) polymorphic value and hence can be passed as an argument to remotable:

 $(mkStatic 'decodeDict) :: Typeable a => Static (SerializableDict a -> ByteString -> a)
Composing static values

The version of static provided by this implementation of Cloud Haskell is strictly more expressive than the one proposed in the paper, and additionally supports

 staticApply :: Static (a -> b) -> Static a -> Static b

This is extremely useful. For example, Cloud Haskell comes with staticDecode defined as

 staticDecode :: Typeable a => Static (SerializableDict a) -> Static (ByteString -> a)
 staticDecode dict = $(mkStatic 'decodeDict) `staticApply` dict 

staticDecode is used when defining closures (see below), and makes essential use of staticApply.

Support for staticApply also makes it possible to define a rich set of combinators on static values, a number of which are provided in this module.

Static serialization dictionaries

Many Cloud Haskell primitives (like staticDecode, above) require static serialization dictionaries. In principle these dictionaries require nothing special; for instance, given some serializable type T you can define

 sdictT :: SerializableDict T
 sdictT = SerializableDict

and then have

 $(mkStatic 'sdictT) :: Static (SerializableDict T)

However, since these dictionaries are so frequently required Cloud Haskell provides special support for them. When you call remotable on a monomorphic function f :: T1 -> T2

 remotable ['f]

then a serialization dictionary is automatically created for you, which you can access with

 $(functionSDict 'f) :: Static (SerializableDict T1)

In addition, if f :: T1 -> Process T2, then a second dictionary is created

 $(functionTDict 'f) :: Static (SerializableDict T2)
Closures

Suppose you have a process

 isPrime :: Integer -> Process Bool 

Then

 $(mkClosure 'isPrime) :: Integer -> Closure (Process Bool)

which you can then call, for example, to have a remote node check if a number is prime.

In general, if you have a monomorphic function

 f :: T1 -> T2

then

 $(mkClosure 'f) :: T1 -> Closure T2

provided that T1 is serializable (*).

Creating closures manually

You don't need to use mkClosure, however. Closures are defined exactly as described in Towards Haskell in the Cloud:

 data Closure a = Closure (Static (ByteString -> a)) ByteString

The splice $(mkClosure 'isPrime) above expands to (prettified a bit):

 let decoder :: Static (ByteString -> Process Bool) 
     decoder = $(mkStatic 'isPrime) 
             `staticCompose`  
               staticDecode $(functionSDict 'isPrime)
 in Closure decoder (encode n)

where staticCompose is composition of static functions. Note that mkClosure makes use of the static serialization dictionary (functionSDict) created by remotable.

Combinators on Closures

Support for staticApply (described above) also means that we can define combinators on Closures, and we provide a number of them in this module, the most important of which is cpBind. Have a look at the implementation of call for an example use.

Example

Here is a small self-contained example that uses closures and serialization dictionaries. It makes use of the Control.Distributed.Process.SimpleLocalnet Cloud Haskell backend.

 {-# LANGUAGE TemplateHaskell #-}
 import System.Environment (getArgs)
 import Control.Distributed.Process
 import Control.Distributed.Process.Closure
 import Control.Distributed.Process.Backend.SimpleLocalnet
 import Control.Distributed.Process.Node (initRemoteTable)
 
 isPrime :: Integer -> Process Bool
 isPrime n = return . (n `elem`) . takeWhile (<= n) . sieve $ [2..]
   where
     sieve :: [Integer] -> [Integer]
     sieve (p : xs) = p : sieve [x | x <- xs, x `mod` p > 0]
 
 remotable ['isPrime]
 
 master :: [NodeId] -> Process ()
 master [] = liftIO $ putStrLn "no slaves"
 master (slave:_) = do
   isPrime79 <- call $(functionTDict 'isPrime) slave ($(mkClosure 'isPrime) (79 :: Integer))
   liftIO $ print isPrime79 
 
 main :: IO ()
 main = do
   args <- getArgs
   case args of
     ["master", host, port] -> do
       backend <- initializeBackend host port rtable 
       startMaster backend master 
     ["slave", host, port] -> do
       backend <- initializeBackend host port rtable 
       startSlave backend
   where
     rtable :: RemoteTable
     rtable = __remoteTable initRemoteTable 
Notes

(*) If T1 is not serializable you will get a type error in the generated code. Unfortunately, the Template Haskell infrastructure cannot check a priori if T1 is serializable or not due to a bug in the Template Haskell libraries (http://hackage.haskell.org/trac/ghc/ticket/7066)

(**) Even though staticDecode is passed an explicit serialization dictionary, we still need the Typeable constraint because Static is not the true static. If it was, we could unstatic the dictionary and pattern match on it to bring the Typeable instance into scope, but unless proper static support is added to ghc we need both the type class argument and the explicit dictionary.

Synopsis

Creating static values

remotable :: [Name] -> Q [Dec]Source

Create the closure, decoder, and metadata definitions for the given list of functions

mkStatic :: Name -> Q ExpSource

Construct a static value.

If f : forall a1 .. an. T then $(mkStatic 'f) :: forall a1 .. an. Static T. Be sure to pass f to remotable.

Template-Haskell support for creating closures

mkClosure :: Name -> Q ExpSource

Create a closure

If f : T1 -> T2 is a monomorphic function then $(mkClosure 'f) :: T1 -> Closure T2. Be sure to pass f to remotable.

functionSDict :: Name -> Q ExpSource

If f : T1 -> T2 is a monomorphic function then $(functionSDict 'f) :: Static (SerializableDict T1).

Be sure to pass f to remotable.

functionTDict :: Name -> Q ExpSource

If f : T1 -> Process T2 is a monomorphic function then $(functionTDict 'f) :: Static (SerializableDict T2).

Be sure to pass f to remotable.

Primitive operations on static values

staticApply :: Static (a -> b) -> Static a -> Static bSource

Apply two static values

staticDuplicate :: forall a. Typeable a => Static a -> Static (Static a)Source

Co-monadic duplicate for static values

Static functionals

staticConst :: (Typeable a, Typeable b) => Static (a -> b -> a)Source

Static version of const

staticFlip :: (Typeable a, Typeable b, Typeable c) => Static (a -> b -> c) -> Static (b -> a -> c)Source

Static version of flip

staticFst :: (Typeable a, Typeable b) => Static ((a, b) -> a)Source

Static version of fst

staticSnd :: (Typeable a, Typeable b) => Static ((a, b) -> b)Source

Static version of snd

staticCompose :: (Typeable a, Typeable b, Typeable c) => Static (b -> c) -> Static (a -> b) -> Static (a -> c)Source

Static version of (.)

staticFirst :: (Typeable a, Typeable b, Typeable c) => Static ((a -> b) -> (a, c) -> (b, c))Source

Static version of first

staticSecond :: (Typeable a, Typeable b, Typeable c) => Static ((a -> b) -> (c, a) -> (c, b))Source

Static version of second

staticSplit :: (Typeable a, Typeable b, Typeable c, Typeable d) => Static (a -> c) -> Static (b -> d) -> Static ((a, b) -> (c, d))Source

Static version of (***)

Static constants

staticUnit :: Static ()Source

Static version of '()'

Creating closures

staticDecode :: Typeable a => Static (SerializableDict a) -> Static (ByteString -> a)Source

Static decoder, given a static serialization dictionary.

See module documentation of Control.Distributed.Process.Closure for an example.

staticClosure :: forall a. Typeable a => Static a -> Closure aSource

Convert a static value into a closure.

toClosure :: forall a. Serializable a => Static (SerializableDict a) -> a -> Closure aSource

Convert a serializable value into a closure.

Serialization dictionaries (and their static versions)

sdictUnit :: Static (SerializableDict ())Source

Serialization dictionary for '()'

Definition of CP and the generalized arrow combinators

type CP a b = Closure (a -> Process b)Source

'CP a b' represents the closure of a process parameterized by a and returning b. 'CP a b' forms a (restricted) generalized arrow (http://www.cs.berkeley.edu/~megacz/garrows/)

cpIntro :: forall a b. (Typeable a, Typeable b) => Closure (Process b) -> Closure (a -> Process b)Source

CP introduction form

cpElim :: forall a. Typeable a => CP () a -> Closure (Process a)Source

CP elimination form

cpId :: Typeable a => CP a aSource

Identity (Closure version of return)

cpComp :: forall a b c. (Typeable a, Typeable b, Typeable c) => CP a b -> CP b c -> CP a cSource

Left-to-right composition (Closure version of >=>)

cpFirst :: forall a b c. (Typeable a, Typeable b, Typeable c) => CP a b -> CP (a, c) (b, c)Source

First

cpSecond :: forall a b c. (Typeable a, Typeable b, Typeable c) => CP a b -> CP (c, a) (c, b)Source

Second

cpSplit :: (Typeable a, Typeable b, Typeable c, Typeable d) => CP a c -> CP b d -> CP (a, b) (c, d)Source

Split (Like ***)

cpCancelL :: Typeable a => CP ((), a) aSource

Left cancellation

cpCancelR :: Typeable a => CP (a, ()) aSource

Right cancellation

Closure versions of CH primitives

cpLink :: ProcessId -> Closure (Process ())Source

Closure version of link

cpUnlink :: ProcessId -> Closure (Process ())Source

Closure version of unlink

cpSend :: forall a. Typeable a => Static (SerializableDict a) -> ProcessId -> Closure (a -> Process ())Source

Closure version of send

cpExpect :: Typeable a => Static (SerializableDict a) -> Closure (Process a)Source

Closure version of expect

Closure (Process a) as a not-quite-monad

cpReturn :: forall a. Serializable a => Static (SerializableDict a) -> a -> Closure (Process a)Source

Not-quite-monadic return

cpBind :: forall a b. (Typeable a, Typeable b) => Closure (Process a) -> Closure (a -> Process b) -> Closure (Process b)Source

Not-quite-monadic bind (>>=)

cpSeq :: Closure (Process ()) -> Closure (Process ()) -> Closure (Process ())Source

Monadic sequencing (>>)