packages feed

hdph-closure (empty) → 0.0.1

raw patch · 10 files changed

+1700/−0 lines, 10 filesdep +arraydep +basedep +bytestringsetup-changed

Dependencies added: array, base, bytestring, cereal, containers, deepseq, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Patrick Maier, Rob Stewart, 2012++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the names of the copyright holders nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,32 @@+The Explicit Closures of Haskell Distributed Parallel Haskell+=============================================================++**Haskell distributed parallel Haskell (HdpH)** is a Haskell DSL for+parallel computation on distributed-memory architectures. HdpH is+implemented entirely in Haskell but does make use of a few GHC extensions,+most notably TemplateHaskell.++HpdH uses _explicit closures_ to communicate serialised thunks across+the network.+This package exports the fully polymorphic explicit closure representation+of HdpH, for use by HdpH or other packages.++HdpH, including the explicit closure representation, is described in some detail in the paper [Implementing a High-level Distributed-Memory Parallel Haskell in Haskell](http://www.macs.hw.ac.uk/~pm175/papers/Maier_Trinder_IFL2011_XT.pdf).++This release is considered alpha stage.+++Building HdpH explicit closure support+--------------------------------------++Should be straightforward from the cabalised package `hdph-closure`.+++References+----------++1.  Patrick Maier, Phil Trinder.+    [Implementing a High-level Distributed-Memory Parallel Haskell in Haskell](http://www.macs.hw.ac.uk/~pm175/papers/Maier_Trinder_IFL2011_XT.pdf).+    Proc. 2011 Symposium on Implementation and Application of Functional Languages (IFL 2011), Springer LNCS 7257, pp. 35-50.++2.  [HdpH development repository](https://github.com/PatrickMaier/HdpH) on github.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TODO.md view
@@ -0,0 +1,23 @@+The Explicit Closures of Haskell Distributed Parallel Haskell+=============================================================++To Do List+----------++* Clean up build.++    * Add `-Wall` switch to cabal file.++* Improve documentation.++    * Make documentation self-contained; omitting references to package `hdph`.+    * Add self-contained example programs.++* Generate instance declarations for classes like 'ToClosure' via Template+  Haskell. This would avoid the risk of programmers accidentally specifying+  recusive instances.++* Support serialisation via `Data.Binary` in addition (or instead of?)+  `Data.Serialize`.++* Finally: Implement proper compiler support for `Static`.
+ hdph-closure.cabal view
@@ -0,0 +1,33 @@+name:          hdph-closure+version:       0.0.1+synopsis:      Explicit closures in Haskell distributed parallel Haskell+description:   Explicit closures are serialisable representations of thunks.+               This package exports the fully polymorphic explicit closures+               of HdpH (Haskell distributed parallel Haskell), for use+               by HdpH or other packages.+homepage:      https://github.com/PatrickMaier/HdpH+license:       BSD3+license-file:  LICENSE+author:        Patrick Maier <C.Patrick.Maier@gmail.com>+maintainer:    Patrick Maier <C.Patrick.Maier@gmail.com>+stability:     experimental+category:      Control, Distributed Computing+tested-with:   GHC == 7.4.1 || == 7.6.2+build-type:    Simple+cabal-version: >= 1.8++Library+  exposed-modules: Control.Parallel.HdpH.Closure+  other-modules:   Control.Parallel.HdpH.Closure.Internal,+                   Control.Parallel.HdpH.Closure.Static,+                   Control.Parallel.HdpH.Closure.Static.State,+                   Control.Parallel.HdpH.Closure.Static.Type+  build-depends:   template-haskell,+                   array >= 0.1 && < 0.5,+                   base >= 4 && < 5,+                   cereal >= 0.3.3 && < 0.4,+                   bytestring == 0.10.*,+                   containers >= 0.1 && < 0.6,+                   deepseq >= 1.1 && < 2+  hs-source-dirs:  src+  ghc-options:
+ src/Control/Parallel/HdpH/Closure.hs view
@@ -0,0 +1,642 @@+-- This module implements /explicit closures/ as described in [2] below.+-- It makes extensive use of Template Haskell, and due to TH's stage+-- restrictions, internals like the actual closure representation are+-- delegated to module 'Control.Parallel.HdpH.Closure.Internal'.+--+-- Author: Patrick Maier+-----------------------------------------------------------------------------++-- | Explicit Closures, inspired by [1] and refined by [2].+--+-- References:+--+-- (1) Epstein, Black, Peyton-Jones. /Towards Haskell in the Cloud/.+--     Haskell Symposium 2011.+--+-- (2) Maier, Trinder. /Implementing a High-level Distributed-Memory/+--     /Parallel Haskell in Haskell/. IFL 2011.+--++{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Control.Parallel.HdpH.Closure+  ( -- * Explicit Closures+    -- ** Key facts+    -- $KeyFacts++    -- ** The Closure type constructor+    Closure,++    -- ** Caveat: Deserialisation is not type safe+    -- $Deserialisation++    -- ** Closure elimination+    unClosure,++    -- ** Forcing Closures+    forceClosure,++    -- ** Categorical operations on function Closures+    -- | A /function Closure/ is a Closure of type @'Closure' (a -> b)@.+    idC,+    termC,+    compC,+    apC,++    -- ** Construction of value Closures+    -- | A /value Closure/ is a Closure, which when eliminated (from its +    -- serialisable representation, at least) yields an evaluated value +    -- (rather than an unevaluated thunk).+    toClosure,+    ToClosure(+      locToClosure+    ),+    StaticToClosure,+    staticToClosure,++    -- ** Safe Closure construction+    mkClosure,+    mkClosureLoc,+    LocT,+    here,++    -- ** Unsafe Closure construction+    unsafeMkClosure,++    -- * Static terms+    -- | A term @t@ is called /static/ if it could be declared at the toplevel.+    -- That is, @t@ is static if all free variables occuring in @t@ are +    -- toplevel.++    -- ** The Static type constructor+    Static,++    -- ** Static declaration and registration+    StaticDecl,+    declare,+    register,+    showStaticTable,++    -- ** Static deserialisers+    -- | A @'Static'@ /environment deserialiser/ is a term of type+    -- @'Static' ('Env' -> a)@, for some type @a@, and is part+    -- of the serialisable representation of an explicit Closure.+    static,+    static_,+    staticLoc,+    staticLoc_,++    -- * Serialised environment+    -- | A /serialised enviroment/ is part of the serialisable representation+    -- of an explicit Closure.+    Env,+    encodeEnv,+    decodeEnv,++    -- * This module's Static declaration+    declareStatic++    -- * Tutorial on safe Closure construction+    -- $Tutorial+  ) where++import Prelude+import Control.DeepSeq (NFData, deepseq)+import Data.Monoid (mconcat)+import Data.Serialize (Serialize)++import Control.Parallel.HdpH.Closure.Internal   -- re-export whole module+import Control.Parallel.HdpH.Closure.Static+       (Static, StaticDecl, declare, register, showStaticTable)+++-----------------------------------------------------------------------------+-- $KeyFacts+--+-- An /explicit Closure/ is a term of type @Closure t@, wrapping a thunk+-- of type @t@. Henceforth, we will write /Closure/ (capitalised) to mean +-- an explicit Closure, and /closure/ (in lower case) to mean an ordinary+-- Haskell closure (ie. a thunk).+--+-- The @'Closure'@ type constructor is abstract (see reference [2] or+-- module 'Control.Parallel.HdpH.Closure.Internal' for its internal /dual/+-- representation).+--+-- The function @'unClosure'@ returns the thunk wrapped in a Closure.+--+-- The function @'unsafeMkClosure'@ constructs Closures but is considered+-- /unsafe/ because it exposes the internal dual representation, and+-- relies on the programmer to guarantee consistency.+--+-- Article [2] proposes a /safe/ Closure construction @$(mkClosure [|...|])@+-- where the @...@ is an arbitrary thunk. Due to current limitations of the+-- GHC (namely missing support for the @'Static'@ type constructor),+-- this module provides only limited variants of @$(mkClosure [|...|])@.+-- The restrictions on the the thunk @...@ are+--+-- * either @...@ is a toplevel variable (also called a /static closure/),+--+-- * or @...@ is a toplevel variable (also called a /closure abstraction/)+--   applied to a tuple of local variables.+--+-- As a matter of nomenclature, functions operating on Closures will either+-- contain the string @Closure@ (like @'unClosure'@ and @'mkClosure'@) or will+-- end in the suffix @C@ (like the categorical operations @'idC'@ and+-- @'compC'@).+--+-- Some identities involving Closures:+--+-- (1) @unClosure $ unsafeMkClosure x fun env = x@+--+-- (2) @unClosure $ toClosure x = x@+--+-- (3) @unClosure $(mkClosure [| stat_clo |]) = stat_clo@+--+-- (4) @unClosure $(mkClosure [| clo_abs free_vars |]) = clo_abs free_vars@+--+++-----------------------------------------------------------------------------+-- $Deserialisation+--+-- Deserialising a serialised value via the methods of class+-- @'Data.Binary.Binary'@ (or @'Data.Serialize.Serialize'@) is not type safe.+-- For instance, the compiler will happily assign type @Int -> Bool@ to+--+-- > decodeBool . encodeInt where+-- >     decodeBool = decode :: ByteString -> Bool+-- >     encodeInt  = encode :: Int -> ByteString+--+-- This type coercion will only fail at runtime, when (and if) the decoder for+-- @Bool@ stumbles over unexepected input values. Hence deserialising can be +-- viewed as an assertion that the serialised byte string represents a value+-- of the type @decode@ expects to see. A well-written decoder will check+-- this assertion on deserialisation, and will abort with an error message+-- if the assertion fails.+--+-- HdpH treats Closure deserialisation similarly as an assertion that the+-- serialised byte string represents a value of the expected Closure type.+-- However, HdpH does not check whether the assertion holds. Instead it+-- subverts the type system via @unsafeCoerce@, with potentially disastrous+-- consequences (like seg faults) in cases where the assertion fails.+--+-- The up side of this design choice is a simpler Closure representation+-- without runtime type reflection.+-- The down side is that Closure deserialisation has to be treated with+-- /extreme care/.+-- HdpH, for instance, avoids the pitfalls of Closure deserialisation by+-- making sure only Closures of the fixed type @Closure (Par ())@ are+-- serialised and deserialised.+++-----------------------------------------------------------------------------+-- $Tutorial+--+-- This guide will demonstrate the safe construction of explicit Closures+-- in HdpH through a series of examples.+--+--+-- [Constructing plain Closures]+--+-- The first example is the definition of the Closure transformation+-- @apC@. It is defined in [2] (where it is called @mapClosure@) by eliminating+-- the Closures of its arguments, and constructing a new Closure of the the+-- resulting application, as follows:+--+-- > apC :: Closure (a -> b) -> Closure a -> Closure b+-- > apC clo_f clo_x =+-- >   $(mkClosure [|unClosure clo_f $ unClosure clo_x|])+--+-- If @'Static'@ were fully supported by GHC then @'mkClosure'@ would abstract+-- the free local variables (here @clo_f@ and @clo_x@) in its quoted argument,+-- serialise a tuple of these variables, and construct a suitable @'Static'@+-- deserialiser. In short, expanding the above Template Haskell splice+-- would yield the following definition:+--+-- > apC clo_f clo_x =+-- >   let thk = unClosure clo_f $ unClosure clo_x+-- >       env = encodeEnv (clo_f, clo_x)+-- >       fun = static $ \ env -> let (clo_f, clo_x) = decodeEnv env+-- >                                 in unClosure clo_f $ unClosure clo_x+-- >     in unsafeMkClosure thk fun env+--+-- However, the current implementation of @'mkClosure'@ cannot do this because+-- there is no term former @static@. Instead, the current implementation+-- of @'mkClosure'@ expects its quoted argument to be in a one of two special+-- forms: either it is a single /toplevel/ variable, or an application of a+-- /toplevel/ variable to a tuple of free variables. To distinguish the two+-- forms, Closures constructed from single toplevel variables will be called+-- /static/ (because like static terms they do not capture any variables).+--+-- Here is the definition of @apC@ as an example of how to construct a+-- general, non-static Closure.+--+-- > apC clo_f clo_x =+-- >   $(mkClosure [|apC_abs (clo_f, clo_x)|])+-- >+-- > apC_abs :: (Closure (a -> b), Closure a) -> b+-- > apC_abs (clo_f, clo_x) = unClosure clo_f $ unClosure clo_x+--+-- First, the programmer must manually define a toplevel /closure abstraction/+-- @apC_abs@ which abstracts a tuple @(clo_f, clo_x)@ of free local variables+-- occuring in the expression to be converted into a Closure. (Usually, the+-- programmer would want the closure abstraction @apC_abs@ to be inlined.)+--+-- Second, the programmer constructs the explicit Closure via a Template +-- Haskell splice @$(mkClosure [|apC_abs (clo_f, clo_x)|])@, where the quoted +-- expression @apC_abs (clo_f, clo_x)@ is an application of the toplevel closure+-- abstraction to a tuple of free local variables. It is important+-- that this actual tuple of variables matches /exactly/ the formal tuple+-- in the definition of the closure abstraction. In fact, best practice is+-- for the quoted expression to textually match the left-hand side of the+-- definition of the closure abstraction.+--+-- Finally, a @'Static'@ deserialiser corresponding to the toplevel closure+-- abstraction must be declared. To this end, this module exports a Template+-- Haskell function @'static'@ which converts the name of a toplevel closure+-- abstraction into a @'Static'@ deserialiser, and a function @'declare'@ which+-- turns the @'Static'@ deserialiser into a @'Static'@ declaration. These +-- should be used as follows; see also the definition of @declareStatic@ below.+--+-- > declare $(static 'apC_abs)+--+--+-- The second example is the definition of the static Closure @idC@, which+-- lifts the identity function to a function Closure.+-- The definition is a follows; see also code towards the end of this file.+--+-- > idC :: Closure (a -> a)+-- > idC = $(mkClosure [|id|])+--+-- The expression to be converted into a Closure, the variable @'id'@, does not+-- contain any free local variables, so there is no need to abstract a tuple+-- of free variables. In fact, the expression is already a toplevel variable,+-- so there is also no need to define a new toplevel closure abstraction either.+-- Thus, the programmer constructs the static Closure via the the Template+-- Haskell splice @$(mkClosure [|id|])@, where the quoted expression @'id'@+-- is a toplevel variable.+--+-- The programmer must also declare a @'Static'@ deserialiser corresponding to+-- the toplevel variable of which the static Closure was created. This is done+-- as follows; see also the definition of @declareStatic@ below. +--+-- > declare $(static_ 'id)+--+-- Note the use of @'static_'@ instead of @'static'@ to create a @'Static'@+-- deserialiser for a /static/ Closure, ie. a @'Static'@ deserialiser that does+-- not actually deserialise any free variables. Accidentally mixing up+-- @'static'@ and @'static_'@ may lead to runtime errors!+--+--+-- [Constructing families of Closures]+--+-- A problem arises with Closures whose type is not only polymorphic (as eg.+-- the type of @idC@ above) but also constrained by type classes. The problem+-- here is that the class constraint has to be resolved statically, as there+-- is no way of attaching implicit dictionaries to a Closure (because these+-- dictionaries would have to be serialised as well). However, there is a+-- way of safely constructing such constrained Closures. The idea is to+-- actually construct a family of Closures, indexed by source locations.+-- The indices are produced by certain type class instances, effectively+-- turning the location-based into a type-based indexing. We illustrate+-- this method on two examples.+--+-- The first example is the function @toClosure@ which converts any suitable+-- value into a Closure, forcing the value upon serialisation. The /suitable/+-- values are those whose type is an instance of class+-- @'Data.Serialize.Serialize'@, so one would expect @toClosure@ to have the +-- following implementation and @'Static'@ declaration:+--+-- > toClosure :: (Serialize a) => a -> Closure a+-- > toClosure val = $(mkClosure [| id val |])+-- >+-- > declare $(static 'id)+--+-- However, this does not compile - the last line complains from an ambiguous+-- type variable @a@ in the constrait @Serialize a@.+--+-- The solution is to define a new type class @ToClosure@ as a subclass of+-- the given @'Data.Serialize.Serialize'@ constraint, and use instances of+-- @ToClosure@ to index a family of Closures. The indexing is done by +-- @locToClosure@, the only member of class @ToClosure@, as follows.+--+-- > class (Serialize a) => ToClosure a where+-- >   locToClosure :: LocT a+-- >+-- > toClosure :: (ToClosure a) => a -> Closure a+-- > toClosure val = $(mkClosureLoc [| id val |]) locToClosure+--+-- Note that the above splice @$(mkClosureLoc [|id val|])@ generates a family+-- of type @'LocT' a -> 'Closure' a@. Applying that family to the index+-- @locToClosure@ yields the actual Closure. On the face of it, indexing+-- appears to be location based, but actually the family generated by+-- @'mkClosureLoc'@ never evaluates the index; thanks to the phantom type+-- argument of @'LocT'@ the indexing is really done statically on the types.+-- (Though the location information is necessary to tag the associated+-- @'Static'@ deserialisers, and will be evaluated when constructing the+-- @'Static'@ table.)+--+-- What this achieves is reducing the constraint on @toClosure@ from+-- @'Data.Serialize.Serialize'@ to @ToClosure@. Hence @toClosure@ is only+-- available for types for which the programmer explicitly instantiates +-- @ToClosure@. These instances are very simple, see the following two samples.+--+-- > instance ToClosure Int where locToClosure = $(here)+-- > instance ToClosure (Closure a) where locToClosure = $(here)+--+-- Note that the two instances are entirely identical, in fact all instances+-- of @ToClosure@ must be identical. In particular, instances must not+-- be recursive, so that the number of types instantiating @ToClosure@+-- matches exactly the number of instance declarations in the source code.+-- All an instance does is record its location in the source code via+-- @locToClosure@, making @locToClosure@ a key for @ToClosure@ instances.+--+-- The programmer must declare the @'Static'@ deserialisers associated with+-- the above family of Closures. More precisely, she must declare one+-- deserialiser per @ToClosure@ instance. This is done by defining a+-- family of @'Static'@ deserialisers, similar to the family of Closures.+--+-- > type StaticToClosure a = Static (Env -> a)+-- >+-- > staticToClosure :: (ToClosure a) => StaticToClosure a+-- > staticToClosure = $(staticLoc 'id) locToClosure+--+-- Note that the splice @$(staticLoc 'id)@ above generates a family of+-- type @'LocT' a -> 'Static' ('Env' -> a)@. Applying that family to the index+-- @locToClosure@ yields an actual @'Static'@ deserialiser. The type synomyn+-- @StaticToClosure@ is a mere convenience to improve readability, as will+-- become evident when actually declaring the @'Static'@ deserialisers+-- (particularly in the second example).+--+-- It remains to actually declare the @'Static'@ deserialisers, one per instance+-- of @ToClosure@. Since @'Static'@ declarations form a monoid, the programmer+-- can simply concatenate all these declarations. So, given the above sample+-- @ToClosure@ instances, the programmer would declare the associated+-- deserialisers as follows.+--+-- > Data.Monoid.mconcat+-- >   [declare (staticToClosure :: StaticToClosure Int),+-- >    declare (staticToClosure :: forall a . StaticToClosure (Closure a))]+--+--+-- The second example of families of Closures is @forceCC@, which wraps+-- @forceC@ into a Closure, where @forceC@ is defined as follows:+--+-- > forceC :: (NFData a, ToClosure a) => Strategy (Closure a)+-- > forceC clo = return $! forceClosure clo+--+-- Note that @forceC@ lifts @'forceClosure'@ to a /strategy/ in the @Par@+-- monad; please see module @Control.Parallel.HdpH.Strategies@ for the+-- definition of the @Strategy@ type constructor.+--+-- Ideally, @forceCC@ would be implemented simply like this:+--+-- > forceCC :: (NFData a, ToClosure a) => Closure (Strategy (Closure a))+-- > forceCC = $(mkClosure [|forceC|])+--+-- However, the type class constraint demands that @forceCC@ generate a family+-- of Closures; in fact, it must generate a family of /static/ Closures because +-- @forceC@, the expression quoted in the Template Haskell splice, is a single+-- toplevel variable. The actual implementation of @forceCC@ is as follows:+--+-- > class (NFData a, ToClosure a) => ForceCC a where+-- >   locForceCC :: LocT (Strategy (Closure a))+-- >+-- > forceCC :: (ForceCC a) => Closure (Strategy (Closure a))+-- > forceCC = $(mkClosureLoc [| forceC |]) locForceCC+--+-- Above is the first part of the code, the definition of a new type class+-- @ForceCC@ and the defintion of @forceCC@ itself. Note the complex phantom+-- type argument of @locForceCC@; this is dictated by the splice+-- @$(mkClosureLoc [|forceC|])@ which is of type+-- @'LocT' (Strategy ('Closure' a)) -> 'Closure' (Strategy ('Closure' a))@.+-- Instances of class @ForceCC@ are very similar to instances of @ToClosure@,+-- cf. the following two samples.+--+-- > instance ForceCC Int where locForceCC = $(here)+-- > instance ForceCC (Closure a) where locForceCC = $(here)+--+-- Along with the family of Closures there is a family of @'Static'@+-- deserialisers, defined as follows. Note the use of @'staticLoc_'@ because+-- @'forceCC'@ generates a family of /static/ Closures.+--+-- > type StaticForceCC a = Static (Env -> Strategy (Closure a))+-- >+-- > staticForceCC :: (ForceCC a) => StaticForceCC a+-- > staticForceCC = $(staticLoc_ 'forceC) locForceCC+--+-- It remains to actually declare the @'Static'@ deserialisers, one per+-- @ForceCC@ instance. Again, this is very similar to declaring the+-- deserialisers linked to @ToClosure@ instances. But note how the type+-- synonym @StaticForceCC@ improves readability of the declaration - just try+-- expanding the last line of the following declaration.+--+-- > Data.Monoid.mconcat+-- >   [declare (staticForceCC :: StaticForceCC Int),+-- >    declare (staticForceCC :: forall a . StaticForceCC (Closure a))]+--+--+-- [Registering @'Static'@ deserialisers]+--+-- All @'Static'@ deserialisers need to be declared, as shown above.+-- By convention, each module must concatenate all such @'Static'@ declarations+-- (including declarations in imported modules) into a single @'Static'@+-- declaration. The @Main@ module, finally, must /register/ its @'Static'@+-- declaration (which by convention includes all declarations in imported+-- modules) at the beginning of the @main@ function, to create the @'Static'@+-- table. This section shows how to concatenate and register @'Static'@+-- declarations.+--+-- First, concatenating @'Static'@ declarations. As shown above, a @'Static'@+-- deserialiser can be turned into a @'Static'@ declaration (of type+-- @'StaticDecl'@) by applying @'declare'@. The type @'StaticDecl'@ is an+-- instance of class @'Data.Monoid.Monoid'@, so @'Static'@ declarations can be+-- concatenated via the @'mconcat'@ operation. In fact, @'StaticDecl'@ is not+-- just a monoid but a commutative and idempotent monoid, thanks to the+-- way @'Static'@ deserialisers are constructed. That means that @'Static'@+-- declarations can be concatenated repeatedly and in any order without+-- changing the result.+--+-- As a matter of convention, every module which constructs explicit Closures+-- must export a term @declareStatic :: StaticDecl@, a comprehensive declaration+-- of all the module's @'Static'@ deserialisers, including all @'Static'@+-- deserialisers of imported modules. The latter is required because the module+-- may call  imported functions which in turn depend on their modules'+-- @'Static'@ deserialisers.+--+-- > declareStatic :: StaticDecl+-- > declareStatic = Data.Monoid.mconcat+-- >   [declare $(static_ 'id),+-- >    declare $(static_ 'constUnit),+-- >    declare $(static 'compC_abs),+-- >    declare $(static 'apC_abs),+-- >    declare (staticToClosure :: forall a . StaticToClosure (Closure a))]+--+-- Above is a simple example of such a comprehensive Static declaration,+-- the declaration of this module. Note that the order of the list argument+-- to @'mconcat'@ does not matter because because @'StaticDecl'@ is a+-- commutative monoid. Below is a more complex example, taken from a HdpH+-- program.+--+-- > declareStatic :: StaticDecl+-- > declareStatic = Data.Monoid.mconcat+-- >   [Control.Parallel.HdpH.declareStatic,+-- >    Control.Parallel.HdpH.Strategies.declareStatic,+-- >    declare (staticToClosure :: StaticToClosure Int),+-- >    declare (staticToClosure :: StaticToClosure [Int]),+-- >    declare (staticToClosure :: StaticToClosure Integer),+-- >    declare (staticForceCC :: StaticForceCC Integer),+-- >    declare $(static 'spark_sum_euler_abs),+-- >    declare $(static_ 'sum_totient),+-- >    declare $(static_ 'totient)]+--+-- This declaration does concatenate the Static declarations of two imported+-- modules, @Control.Parllel.HdpH@ and @Control.Parallel.HdpH.Strategies@.+-- Actually, the latter also imports the former, so+-- @Control.Parallel.HdpH.Strategies.declareStatic@ already concatenates+-- @Control.Parallel.HdpH.declareStatic@, and so the above call to+-- @Control.Parallel.HdpH.declareStatic@ could be omitted. However, that+-- omission is only justified in the knowledge of implementation details of+-- @Control.Parallel.HdpH.Strategies@ (namely its import graph). The convention+-- that @'Static'@ declarations of /all/ imported modules must be concatenated,+-- regardless of whether they are transitively concatenated by other imported+-- modules, is more robust; the resulting @'Static'@ declaration is the same+-- anyway, thanks to @'StaticDecl'@ being an idempotent monoid.+--+-- A general rule how to deal with imports and @'Static'@ declarations:+-- If module @M1@ imports another module @M2@, and+-- if @M2@ exports a variable @declareStatic :: StaticDecl@+-- then @M1@ must export its own @declareStatic :: StaticDecl@,+-- which needs to concatenate @M2.declareStatic@ (amongst other declarations).+-- Note that the rule applies even if @M1@ ostensibly imports "nothing"+-- from @M2@, eg. @M1@ imports @M2@ with the clause @import M2 ()@. For+-- this clause may still import instance declarations from @M2@, and those+-- instances may depend on M2's @'Static'@ deserialisers.+--+--+-- Finally, registering a @'Static'@ declaration. This must be done exactly once+-- in the @Main@ module, right at the start of @main@, by calling the function+-- @'register'@ on the @Main@ module's comprehensive @'Static'@ declaration.+-- This is shown in sample code below, taken from a HdpH program.+-- Note that any actions executed prior to @'register'@ (ie. the @hSetBuffering@+-- calls) must not involve explicit Closures.+--+-- > main :: IO ()+-- > main = do+-- >   hSetBuffering stdout LineBuffering+-- >   hSetBuffering stderr LineBuffering+-- >   register declareStatic+-- >   ...+++-----------------------------------------------------------------------------+-- Static declaration++-- 'ToClosure' instance for Closures, only recording indexing location;+-- all instances of 'ToClosure' look like this.+instance ToClosure (Closure a) where locToClosure = $(here)++declareStatic :: StaticDecl+declareStatic = mconcat+  [declare $(static_ 'id),+   declare $(static_ 'constUnit),+   declare $(static 'compC_abs),+   declare $(static 'apC_abs),+   declare (staticToClosure :: forall a . StaticToClosure (Closure a))]+     -- Declaration of indexed Static deserialiser for 'toClosure';+     -- all declarations of 'staticToClosure' look like this.+++-----------------------------------------------------------------------------+-- Value Closure construction++-- | @toClosure x@ constructs a value Closure wrapping @x@, provided the+-- type of @x@ is an instance of class @'ToClosure'@.+-- Note that the serialised representation of the resulting Closure stores a+-- serialised representation (as per class @'Data.Serialize.Serialize'@) of+-- @x@, so serialising the resulting Closure will force @x@ (hence could be+-- costly). However, Closure construction itself is cheap.+toClosure :: (ToClosure a) => a -> Closure a+toClosure val = $(mkClosureLoc [| id val |]) locToClosure++-- | Indexing class, recording types which support the @'toClosure'@ operation;+-- see the tutorial below for a more thorough explanation.+-- Note that @ToClosure@ is a subclass of @'Data.Serialize.Serialize'@.+class (Serialize a) => ToClosure a where+  -- | Only method of class @ToClosure@, recording the source location+  -- where an instance of @ToClosure@ is declared.+  locToClosure :: LocT a++-- | Type synonym for declaring the @'Static'@ deserialisers required by+-- @'ToClosure'@ instances; see the tutorial below for a more thorough +-- explanation.+type StaticToClosure a = Static (Env -> a)++-- | @'Static'@ deserialiser required by a @'ToClosure'@ instance;+-- see the tutorial below for a more thorough explanation.+staticToClosure :: (ToClosure a) => StaticToClosure a+staticToClosure = $(staticLoc 'id) locToClosure+++-----------------------------------------------------------------------------+-- fully forcing Closures++-- | @forceClosure@ fully forces its argument, ie. fully normalises the thunk.+-- Importantly, @forceClosure@ also updates the serialisable closure+-- represention in order to keep it in sync with the normalised thunk.+-- Note that only the thunk of the resulting Closure is in normal form;+-- for the serialisable representation to also be in normal form, the resulting+-- Closure must be forced by @'deepseq'@.+--+-- Note that @forceClosure clo@ does not have the same effect as+--+-- * @'Control.DeepSeq.force' clo@ (because @forceClosure@ updates the closure+--   representation), or+--+-- * @'Control.DeepSeq.force' $ toClosure $ unClosure clo@ (because+--   @forceClosure@ does not force the resulting Closure's serialisable+--   representation).+--+forceClosure :: (NFData a, ToClosure a) => Closure a -> Closure a+forceClosure clo = x `deepseq` toClosure x where x = unClosure clo++-- Note that it does not make sense to construct a variant of @forceClosure@+-- that would evaluate the thunk inside a Closure head-strict only. The reason +-- is that serialising such a Closure would turn it into a fully forced one.+++------------------------------------------------------------------------------+-- Categorical operations on function Closures++-- | Identity arrow wrapped in a Closure.+idC :: Closure (a -> a)+idC = $(mkClosure [| id |])+++-- | Terminal arrow wrapped in a Closure.+termC :: Closure (a -> ())+termC = $(mkClosure [| constUnit |])++{-# INLINE constUnit #-}+constUnit :: a -> ()+constUnit = const ()+++-- | Composition of function Closures.+compC :: Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)+compC clo_g clo_f = $(mkClosure [| compC_abs (clo_g, clo_f) |])++{-# INLINE compC_abs #-}+compC_abs :: (Closure (b -> c), Closure (a -> b)) -> (a -> c)+compC_abs (clo_g, clo_f) = unClosure clo_g . unClosure clo_f+++-- | Application of a function Closure to another Closure.+-- Behaves like the @ap@ operation of an applicative functor.+apC :: Closure (a -> b) -> Closure a -> Closure b+apC clo_f clo_x = $(mkClosure [| apC_abs (clo_f, clo_x) |])++{-# INLINE apC_abs #-}+apC_abs :: (Closure (a -> b), Closure a) -> b+apC_abs (clo_f, clo_x) = unClosure clo_f $ unClosure clo_x
+ src/Control/Parallel/HdpH/Closure/Internal.hs view
@@ -0,0 +1,443 @@+-- Closure representation, inspired by [1] and refined by [2].+--   [1] Epstein et al. "Haskell for the cloud". Haskell Symposium 2011.+--   [2] Maier, Trinder. "Implementing a High-level Distributed-Memory+--       Parallel Haskell in Haskell". IFL 2011.+-- Internal module necessary to satisfy Template Haskell stage restrictions.+--+-- Author: Patrick Maier+-----------------------------------------------------------------------------++-- The module 'Control.Parallel.HdpH.Closure' implements /explicit closures/ +-- as described in [2]. Due to Template Haskell stage restrictions, the module+-- has to be split into two halves. This is the half that that defines internals+-- like the actual closure representation and Template Haskell macros on it.+-- The higher level stuff (including a tutorial on expclicit closures) is in+-- module 'Control.Parallel.HdpH.Closure'.++{-# LANGUAGE TemplateHaskell #-}++module Control.Parallel.HdpH.Closure.Internal+  ( -- source locations with phantom type attached+    LocT,             -- instances: Eq, Ord, Show+    here,             -- :: ExpQ++    -- serialised environment+    Env,              -- instances: Eq, Ord, Show, NFData, Serialize+    encodeEnv,        -- :: (Serialize a) => a -> Env+    decodeEnv,        -- :: (Serialize a) => Env -> a++    -- Closure type constructor+    Closure,          -- instances: Show, NFData, Serialize++    -- introducing and eliminating Closures+    unsafeMkClosure,  -- :: a -> Static (Env -> a) -> Env -> Closure a+    unClosure,        -- :: Closure a -> a++    -- safe Closure construction+    mkClosure,        -- :: ExpQ -> ExpQ+    mkClosureLoc,     -- :: ExpQ -> ExpQ++    -- static deserializers+    static,           -- :: Name -> ExpQ+    staticLoc,        -- :: Name -> ExpQ+    static_,          -- :: Name -> ExpQ+    staticLoc_        -- :: Name -> ExpQ+  ) where++import Prelude+import Control.DeepSeq (NFData(rnf))+import Data.ByteString.Lazy (ByteString, unpack, foldl')+import Data.Functor ((<$>))+import Data.Serialize (Serialize)+import qualified Data.Serialize (put, get, encodeLazy, decodeLazy)+import Language.Haskell.TH+       (Exp(AppE, VarE, TupE, ConE), ExpQ, Lit,+        appsE, lam1E, conE, varE, global, litE, varP, stringL, tupleDataName)+import qualified Language.Haskell.TH as TH (Loc(..), location)+import Language.Haskell.TH.Syntax+       (Name(Name), NameFlavour(NameG, NameL), NameSpace(VarName, DataName),+        newName, pkgString, modString, occString)++import Control.Parallel.HdpH.Closure.Static (Static, unstatic, staticAs)+++-----------------------------------------------------------------------------+-- source locations with phantom type attached++-- | A value of type @'LocT a'@ is a representation of a Haskell source location+-- (or more precisely, the location of a Template Haskell slice, as produced by+-- @'here'@). Additionally, this location is annotated with a phantom type 'a',+-- which is used for mapping location indexing to type indexing.+newtype LocT a = LocT { unLocT :: String } deriving (Eq, Ord)++instance Show (LocT a) where+  show = unLocT++-- | Template Haskell construct returning its own location when spliced.+here :: ExpQ+here = do+  loc <- TH.location+  appsE [conE 'LocT, litE $ stringL $ showLoc loc]+++-----------------------------------------------------------------------------+-- serialised environments++-- | Abstract type of serialised environments.+newtype Env = Env ByteString deriving (Eq, Ord)++instance Show Env where+  showsPrec _ (Env env) = shows env++instance NFData Env where+  rnf (Env env) = foldl' (\ _ -> rnf) () env++instance Serialize Env where+  put (Env env) = Data.Serialize.put env+  get = Env <$> Data.Serialize.get++-- | Creates a serialised environment from a given value of type @a@.+encodeEnv :: (Serialize a) => a -> Env+encodeEnv x = Env $ Data.Serialize.encodeLazy x++-- | Deserialises a serialised environment producing a value of type @a@.+-- Note that the programmer asserts that the environment can be deserialised+-- at type @a@, a type mismatch may abort or crash the program.+decodeEnv :: (Serialize a) => Env -> a+decodeEnv (Env env) =+  case Data.Serialize.decodeLazy env of+    Right x  -> x+    Left msg -> error $ "Control.Parallel.HdpH.Closure.decodeEnv " +++                        showEnvPrefix 20 env ++ ": " ++ msg+++-----------------------------------------------------------------------------+-- 'Closure' type constructor++-- | An explicit Closure, ie. a term of type @Closure a@, maintains a dual+-- representation of an actual closure (ie. a thunk) of type @a@.+--+-- (1) One half of that representation is the actual closure, the /thunk/+--     of type @a@.+--+-- (2) The other half is a serialisable representation of the thunk,+--     consisting of a @'Static'@ environment deserialiser, of type+--     @'Static' ('Env' -> a)@, plus a serialised environment of type @'Env'@.+--+-- Representation (1) is used for computing with Closures while+-- representation (2) is used for serialising and communicating Closures+-- across the network.+--+data Closure a = Closure+                   a                    -- actual thunk+                   (Static (Env -> a))  -- Static environment deserialiser+                   Env                  -- serialised environment+++-----------------------------------------------------------------------------+-- Show/NFData/Serialize instances for 'Closure'+--+-- Note that these instances are uniform for all 'Closure a' types since+-- they ignore the type argument 'a'.++-- NOTE: These instances obey a contract between Serialize and NFData+-- * A type is an instance of NFData iff it is an instance of Serialize.+-- * A value is forced by 'rnf' to the same extent it is forced by+--   'rnf . encode'.++-- NOTE: Phil is unhappy with this contract. He argues that 'rnf' should+--       fully force the Closure (and thus evaluate further than 'rnf . encode'+--       would). His argument is essentially that 'rnf' should act on+--       explicit Closures as it acts on thunks. Which would mean+--       that 'NFData (Closure a)' can only be defined given a '(Serialize a)'+--       context.+--+--       Here is the killer argument against Phil's proposal: Because of the+--       type of 'rnf', it can only evaluate its argument as a side effect;+--       it cannot actually change its representation. However, forcing an+--       explicit Closure must change its representation (at least if we+--       want to preserve the evaluation status across serialisation).++instance NFData (Closure a) where+  -- force the serialisable rep but not the actual thunk+  rnf (Closure _ fun env) = rnf fun `seq` rnf env+++instance Serialize (Closure a) where+  -- serialise the serialisable rep but not the actual thunk+  put (Closure _ fun env) = Data.Serialize.put fun >>+                            Data.Serialize.put env++  -- deserialise the serialisable rep and lazily re-instate the actual thunk+  get = do fun <- Data.Serialize.get+           env <- Data.Serialize.get+           let thk = (unstatic fun) env+           return $ Closure thk fun env+++instance Show (Closure a) where  -- for debugging only; show serialisable rep+  showsPrec _ (Closure _ fun env) = showString "Closure(" . shows fun .+                                    showString "," . shows env . showString ")"+++-----------------------------------------------------------------------------+-- introducing and eliminating Closures++-- | Eliminates a Closure by returning its thunk.+-- This operation is cheap.+{-# INLINE unClosure #-}+unClosure :: Closure a -> a+unClosure (Closure thk _ _) = thk+++-- | @unsafeMkClosure thk fun env@ constructs a Closure that+--+-- (1) wraps the thunk @thk@ and+--+-- (2) whose serialised representation consists of the @'Static'@ deserialiser+--    @fun@ and the serialised environment @env@.+--+-- This operation is cheap and does not require Template Haskell support,+-- but it is /unsafe/ because it relies on the programmer to ensure that+-- both closure representations evaluate to the same term.+{-# INLINE unsafeMkClosure #-}+unsafeMkClosure :: a -> Static (Env -> a) -> Env -> Closure a+unsafeMkClosure thk fun env = Closure thk fun env+++-----------------------------------------------------------------------------+-- safely constructing Closures from closure abstractions++-- | Template Haskell transformation constructing a Closure from a given thunk.+-- The thunk must either be a single toplevel closure (in which case the result+-- is a /static/ Closure), or an application of a toplevel closure+-- abstraction to a tuple of local variables.+-- See the tutorial below for how to use @mkClosure@.+mkClosure :: ExpQ -> ExpQ+mkClosure thkQ = do+  thk <- thkQ+  let funQ = case thk of+               AppE (VarE clo_abs_name) _ -> static clo_abs_name+               AppE (ConE clo_abs_name) _ -> static clo_abs_name+               VarE clo_name              -> static_ clo_name+               ConE clo_name              -> static_ clo_name+               _ -> error "mkClosure: impossible case"+  let envQ = case thk of+               AppE _ free_vars -> appsE [global 'encodeEnv, return free_vars]+               _                -> [| encodeEnv () |]+  let cloQ = appsE [conE 'Closure, thkQ, funQ, envQ]+  case thk of+    AppE (VarE clo_abs_name) free_vars+      | isGlobalVarName clo_abs_name && isLocalVars free_vars -> cloQ+    AppE (ConE clo_abs_name) free_vars+      | isGlobalDataName clo_abs_name && isLocalVars free_vars -> cloQ+    VarE clo_name+      | isGlobalVarName clo_name -> cloQ+    ConE clo_name+      | isGlobalDataName clo_name -> cloQ+    _ -> fail $ "Control.Parallel.HdpH.Closure.mkClosure: " +++                "argument not of the form 'globalVarOrCon' or " +++                "'globalVarOrCon (localVar_1,...,localVar_n)'"+++-- | Template Haskell transformation constructing a family of Closures from a+-- given thunk. The family is indexed by location (that's what the suffix @Loc@+-- stands for).+-- The thunk must either be a single toplevel closure (in which case the result+-- is a family of /static/ Closures), or an application of a toplevel closure+-- abstraction to a tuple of local variables.+-- See the tutorial below for how to use @mkClosureLoc@.+mkClosureLoc :: ExpQ -> ExpQ+mkClosureLoc thkQ = do+  thk <- thkQ+  let funQ = case thk of+               AppE (VarE clo_abs_name) _ -> staticLoc clo_abs_name+               AppE (ConE clo_abs_name) _ -> staticLoc clo_abs_name+               VarE clo_name              -> staticLoc_ clo_name+               ConE clo_name              -> staticLoc_ clo_name+               _ -> error "mkClosureLoc: impossible case"+  let envQ = case thk of+               AppE _ free_vars -> appsE [global 'encodeEnv, return free_vars]+               _                -> [| encodeEnv () |]+  loc <- newName "loc"+  let cloQ = lam1E (varP loc) $+               appsE [conE 'Closure, thkQ, appsE [funQ, varE loc], envQ]+  case thk of+    AppE (VarE clo_abs_name) free_vars+      | isGlobalVarName clo_abs_name && isLocalVars free_vars -> cloQ+    AppE (ConE clo_abs_name) free_vars+      | isGlobalDataName clo_abs_name && isLocalVars free_vars -> cloQ+    VarE clo_name+      | isGlobalVarName clo_name -> cloQ+    ConE clo_name+      | isGlobalDataName clo_name -> cloQ+    _ -> fail $ "Control.Parallel.HdpH.Closure.mkClosureLoc: " +++                "argument not of the form 'globalVarOrCon' or " +++                "'globalVarOrCon (localVar_1,...,localVar_n)'"+++-----------------------------------------------------------------------------+-- Static deserializers++-- | Template Haskell transformation converting a toplevel closure abstraction+-- (given by its name) into a @'Static'@ deserialiser.+-- See the tutorial below for how to use @static@.+static :: Name -> ExpQ+static name =+  case tryLabelClosureAbs name of+    Just (clo_abs, label) -> appsE [global 'mkStatic, clo_abs, litE label]+    Nothing -> fail $ "Control.Parallel.HdpH.Closure.static: " +++                      show name ++ " not a global variable or constructor name"++-- Called by 'static'.+{-# INLINE mkStatic #-}+mkStatic :: (Serialize a)+         => (a -> b) -> String -> Static (Env -> b)+mkStatic clo_abs label =+  staticAs (clo_abs . decodeEnv) label+++-- | Template Haskell transformation converting a static toplevel closure+-- (given by its name) into a @'Static'@ deserialiser.+-- Note that a static closure ignores its empty environment (which is+-- what the suffix @_@ is meant to signify).+-- See the tutorial below for how to use @static_@.+static_ :: Name -> ExpQ+static_ name =+  case tryLabelClosureAbs name of+    Just (clo, label) -> appsE [global 'mkStatic_, clo, litE label]+    Nothing -> fail $ "Control.Parallel.HdpH.Closure.static_: " +++                      show name ++ " not a global variable or constructor name"++-- Called by 'static_'.+{-# INLINE mkStatic_ #-}+mkStatic_ :: b -> String -> Static (Env -> b)+mkStatic_ clo label =+  staticAs (const clo) $ "_/" ++ label+++-- | Template Haskell transformation converting a toplevel closure abstraction+-- (given by its name) into a family of @'Static'@ deserialisers indexed by+-- location (that's what the suffix @Loc@ stands for).+-- See the tutorial below for how to use @staticLoc@.+staticLoc :: Name -> ExpQ+staticLoc name =+  case tryLabelClosureAbs name of+    Just (clo_abs, label) -> appsE [global 'mkStaticLoc, clo_abs, litE label]+    Nothing -> fail $ "Control.Parallel.HdpH.Closure.staticLoc: " +++                      show name ++ " not a global variable or constructor name"++-- Called by 'staticLoc'.+{-# INLINE mkStaticLoc #-}+mkStaticLoc :: (Serialize a)+            => (a -> b) -> String -> (LocT b -> Static (Env -> b))+mkStaticLoc clo_abs label =+  \ loc -> staticAs (clo_abs . decodeEnv) $+             label ++ "{loc=" ++ show loc ++ "}"+++-- | Template Haskell transformation converting a static toplevel closure+-- (given by its name) into a family of @'Static'@ deserialisers indexed by+-- location (that's what the suffix @Loc@ stands for).+-- Note that a static closure ignores its empty environment (which is+-- what the suffix @_@ is meant to signify).+-- See the tutorial below for how to use @staticLoc_@.+staticLoc_ :: Name -> ExpQ+staticLoc_ name =+  case tryLabelClosureAbs name of+    Just (clo, label) -> appsE [global 'mkStaticLoc_, clo, litE label]+    Nothing -> fail $ "Control.Parallel.HdpH.Closure.staticLoc_: " +++                      show name ++ " not a global variable or constructor name"++-- Called by 'staticLoc_'.+{-# INLINE mkStaticLoc_ #-}+mkStaticLoc_ :: b -> String -> (LocT b -> Static (Env -> b))+mkStaticLoc_ clo label =+  \ loc -> staticAs (const clo) $+             "_/" ++ label ++ "{loc=" ++ show loc ++ "}"+++-----------------------------------------------------------------------------+-- auxiliary stuff: operations involving variable names++-- Expects the argument to be a global variable or constructor name.+-- If so, returns a pair consisting of an expression (the closure abstraction+-- or static closure named by the argument) and a label representing the name;+-- otherwise returns Nothing.+{-# INLINE tryLabelClosureAbs #-}+tryLabelClosureAbs :: Name -> Maybe (ExpQ, Lit)+tryLabelClosureAbs name =+  let mkLabel pkg' mod' occ' = stringL $ pkgString pkg' ++ "/" +++                                         modString mod' ++ "." +++                                         occString occ'+    in case name of+         Name occ' (NameG VarName pkg' mod') ->+           Just (varE name, mkLabel pkg' mod' occ')+         Name occ' (NameG DataName pkg' mod') ->+           Just (conE name, mkLabel pkg' mod' occ')+         _ -> Nothing+++-- True iff the argument is a global variable name.+{-# INLINE isGlobalVarName #-}+isGlobalVarName :: Name -> Bool+isGlobalVarName (Name _ (NameG VarName _ _)) = True+isGlobalVarName _                            = False++-- True iff the argument is a data constructor name.+{-# INLINE isGlobalDataName #-}+isGlobalDataName :: Name -> Bool+isGlobalDataName (Name _ (NameG DataName _ _)) = True+isGlobalDataName _                             = False+++-- True iff the expression is a local variable.+{-# INLINE isLocalVar #-}+isLocalVar :: Exp -> Bool+isLocalVar (VarE (Name _ (NameL _))) = True+isLocalVar _                         = False++-- True iff the expression is a (possibly empty) tuple of local variables.+-- NOTE: Empty tuples are only properly recognized from GHC 7.4 onwards+--       (prior to 7.4 empty tuples were represented as unit values).+{-# INLINE isLocalVarTuple #-}+isLocalVarTuple :: Exp -> Bool+isLocalVarTuple (TupE exps) = all isLocalVar exps      -- non-empty tuples+isLocalVarTuple (ConE name) = name == tupleDataName 0  -- empty tuple+isLocalVarTuple _           = False++-- True iff the expression is a local variable or a tuple of local variables.+{-# INLINE isLocalVars #-}+isLocalVars :: Exp -> Bool+isLocalVars expr = isLocalVar expr || isLocalVarTuple expr+++-----------------------------------------------------------------------------+-- auxiliary stuff: various show operations++-- Show Template Haskell location.+-- Should be defined in module Language.Haskell.TH.+{-# INLINE showLoc #-}+showLoc :: TH.Loc -> String+showLoc loc = showsLoc loc ""+  where+    showsLoc loc' = showString (TH.loc_package loc')  . showString "/" .+                    showString (TH.loc_module loc')   . showString ":" .+                    showString (TH.loc_filename loc') . showString "@" .+                    shows (TH.loc_start loc')         . showString "-" .+                    shows (TH.loc_end loc')+++-- Show first 'n' bytes of 'env'.+showEnvPrefix :: Int -> ByteString -> String+showEnvPrefix n env = showListUpto n (unpack env) ""+++-- Show first 'n' list elements+showListUpto :: (Show a) => Int -> [a] -> String -> String+showListUpto _ []     = showString "[]"+showListUpto n (x:xs) = showString "[" . shows x . go (n - 1) xs+  where+    go _ [] = showString "]"+    go k (z:zs) | k > 0     = showString "," . shows z . go (k - 1) zs+                | otherwise = showString ",...]"
+ src/Control/Parallel/HdpH/Closure/Static.hs view
@@ -0,0 +1,391 @@+-- 'Static' support, mimicking+--   [1] Epstein et al. "Haskell for the cloud". Haskell Symposium 2011.+--+-- Author: Patrick Maier+-----------------------------------------------------------------------------++-- The 'Static' type constructor as proposed in [1] is not yet supported+-- by GHC (as of version 7.4.1). This module provides a workaround that+-- necessarily differs in some aspects. However, the type constructor 'Static'+-- itself and its eliminator 'unstatic' work exactly as proposed in [1].+--+-- Differences between 'Control.Parallel.HdpH.Closure.Static' and a builtin+-- 'Static' are:+-- o Static values must be declared at toplevel+-- o Static terms must be explicitly named (via 'staticAs')+-- o Static terms must be explicitly declared and registered before use++{-# OPTIONS_GHC -fno-warn-orphans #-}  -- orphan instances unproblematic; types+                                       -- affected either internal or abstract++module Control.Parallel.HdpH.Closure.Static+  ( -- * 'Static' type constructor+    Static,      -- instances: Eq, Ord, Show, NFData, Serialize++    -- * introducing 'Static'+    staticAs,    -- :: a -> String -> Static a++    -- * eliminating 'Static'+    unstatic,    -- :: Static a -> a++    -- * declaring Static terms+    StaticDecl,  -- instances: Monoid, Show+    declare,     -- :: Static a -> StaticDecl++    -- * registering a Static declaration in the global Static table+    register,    -- :: StaticDecl -> IO ()++    -- * show contents of the global Static table+    showStaticTable  -- :: [String]+  ) where++import Prelude+import Control.DeepSeq (NFData(rnf))+import Control.Exception (evaluate)+import Control.Monad (unless)+import Data.Array (listArray, (!), bounds, elems)+import Data.Bits (shiftL, xor)+import Data.Functor ((<$>))+import Data.IORef (readIORef, atomicModifyIORef)+import Data.Int (Int32)+import Data.List (foldl')+import qualified Data.Map as Map (empty, singleton, union, unions, keys, elems)+import Data.Monoid (Monoid(mempty, mappend, mconcat))+import Data.Serialize (Serialize)+import qualified Data.Serialize (put, get)+import System.IO.Unsafe (unsafePerformIO)+import Unsafe.Coerce (unsafeCoerce)++import Control.Parallel.HdpH.Closure.Static.State (sTblRef)+import Control.Parallel.HdpH.Closure.Static.Type+       (StaticLabel(StaticLabel), hash, name, +        StaticIndex,+        Static(Static), label, index, unstatic, +        AnyStatic(Any),+        StaticDecl(StaticDecl), unStaticDecl)+++-----------------------------------------------------------------------------+-- Key facts about 'Static'+--+-- o We say that a term 't' /captures/ a variable 'x' if 'x' occurs free+--   in 't' and 'x' is not declared at the top-level. (That is, this notion+--   of capture is sensitive to the context.)+--+-- o We call a term 't' /static/ if it could be declared at the top-level,+--   that is if does not capture any variables. In contrast, we call a+--   term /Static/ if it is of type 'Static t' for some type 't'.+--+-- o In principle, a term 'stat' of type 'Static t' acts as serialisable+--   reference to a static term of type 't'. However, here we realise+--   terms of type 'Static t' as a triple consisting of such a serialisable+--   reference (an index in the global Static table), a reference name+--   (a unique label of type String) and the refered-to static term itself.+--+-- o Only the serialisable reference is actually serialised when a Static term +--   'stat' is serialised. The link between that reference and the associated +--   Static term 'stat' is established by a registry, the /Static table/,+--   mapping indices to /registered/ Static terms.+--+-- o There are two ways of obtaining a term 'stat :: Static t'. By introducing+--   it with the smart constructor 'staticAs', or by deserialising it.+--   The latter assumes that the Static table has been initialised before+--   and has been initialised identically across all nodes; failing this+--   requirement may result in horrible crashes.+--+-- o Applications using this module (even indirectly) must go through two+--   distinct phases: +--   (1) Introduce and register all Static terms (of which, by their nature, +--       there can only be a statically bounded number) but do neither+--       serialise nor deserialise any Static terms. +--   (2) Serialise and Deserialise Static terms at will but do not attempt+---      to register any new Static terms.+++-----------------------------------------------------------------------------+-- How to register Static terms+--+-- Every module which introduces Static terms via 'staticAs' must export+-- a term 'declareStatic :: StaticDecl' for declaring these terms. The+-- main module must import all these 'declareStatic' terms, concat them +-- to form a global Static declaration, and register that declaration.+--+-- To demonstrate the simplest example, suppose module 'M1' introduces two+-- Static terms (as top-level variables).+-- +-- > x_Static :: Static Int+-- > x_Static = staticAs 42 "Fully_Qualified_Name_Of_M1.x"+-- >+-- > f_Static :: Static ([a] -> Int)+-- > f_Static = staticAs f "Fully_Qualified_Name_Of_M1.f"+-- >   where+-- >     f []     = 0+-- >     f (_:xs) = 1 + f xs+--+-- Then 'M1' ought to export+--+-- > declareStatic :: StaticDecl+-- > declareStatic = Data.Monoid.mconcat+-- >                   [declare x_Static,+-- >                    declare f_Static]+--+-- Now suppose module 'M3' imports 'M1'. It doesn't matter whether 'M3'+-- imports the Static terms of 'M1' directly; any function exported by+-- 'M1' may depend on its Static terms being registered, so 'M3' must+-- ensure that registration happens. Suppose further that 'M3' also imports+-- a module 'M2' which requires some other Static terms to be registered,+-- and that 'M3' itself introduces a term 'x_Static :: Static Bool'+-- (eg. by 'x_Static = staticAs True "Fully_Qualified_Name_Of_M3.x").+-- In this case, 'M3' ought to export the following+--+-- > declareStatic :: StaticDecl+-- > declareStatic = Data.Monoid.mconcat+-- >                   [M1.declareStatic,+-- >                    M2.declareStatic,+-- >                    declare x_Static]+--+-- Note that 'M2' may import 'M1' and so the definition of 'M2.declareStatic'+-- may contain a call to 'M1.declareStatic', in which case the above 'mconcat'+-- would process the data in 'M1.declareStatic' twice. This is of no concern,+-- thanks to the defintion of 'mconcat', as long as the reference name+-- (the second argument of 'staticAs') of each Static term is unique.+--+-- The 'Main' module must define a term 'declareStatic', similar to+-- 'M3.declareStatic' above. This term must then be passed to 'register'+-- right at the start of the 'main' action.+--+-- > main :: IO ()+-- > main = do+-- >   register declareStatic+-- >   ...+--+-- The module 'Control.Parallel.HdpH.Closure' offers more convenient support+-- for declaring and registering Static terms linked to explicit closures.+++-----------------------------------------------------------------------------+-- Static terms (abstract outwith this module)+--+-- NOTE: Static labels are hyperstrict.+--       Static terms are strict in their label part.+--       Static terms are not strict in their index part, the evaluation+--       of which is delayed until the Static term is scrutinised, eg. by+--       comparisons or by serialisation. However, a Static term+--       produced by deserialisation is strict in its index part.++-- Constructs a 'StaticLabel' out of a name 'nm' (which is usually a fully+-- qualified toplevel variable name).+-- This constructor ensures that the resulting 'StaticLabel' is hyperstrict;+-- this constructor is not to be exported.+-- NOTE: Hyperstrictness is guaranteed by the strictness flags in the data+--       declaration of 'StaticLabel'. For the 'hash' field this already+--       implies full normalisation, computing the hash also fully normalises+--       the 'name' field.+mkStaticLabel :: String -> StaticLabel+mkStaticLabel nm = StaticLabel { hash = hashString nm, name = nm }+++-- Constructs a Static term referring to the given static value 'val'+-- and identified by the given reference name 'nm'.+-- NOTE: Strictness flag on 'label' forces that field to WHNF (which conincides+--       with NF due to hyperstrictness of 'StaticLabel').+staticAs :: a -> String -> Static a+staticAs val nm =+  Static { label = lbl, index = findIndex lbl, unstatic = val }+    where+      lbl = mkStaticLabel nm+++-----------------------------------------------------------------------------+-- Eq/Ord/Show/NFData instances for 'StaticLabel'++instance Eq StaticLabel where+  lbl1 == lbl2 = hash lbl1 == hash lbl2 &&   -- compare 'hash' first+                 name lbl1 == name lbl2++instance Ord StaticLabel where+  compare lbl1 lbl2 =+    case compare (hash lbl1) (hash lbl2) of  -- compare 'hash' 1st+      LT -> LT+      GT -> GT+      EQ -> compare (name lbl1) (name lbl2)++instance Show StaticLabel where+  showsPrec _ lbl = showString (name lbl)  -- show only reference name++instance NFData StaticLabel -- default inst suffices (due to hyperstrictness)+++-----------------------------------------------------------------------------+-- Eq/Ord/Show/NFData instances for 'Static';+-- all of these instance force the 'index' part of a Static term but not the+-- refered-to static term; the 'label' part plays no role except for 'Show'.++instance Eq (Static a) where+  stat1 == stat2 = index stat1 == index stat2++instance Ord (Static a) where+  stat1 <= stat2 = index stat1 <= index stat2++instance Show (Static a) where+  showsPrec _ stat =+    showString "Static[" . shows (index stat) . showString "]=" .+    shows (label stat)++instance NFData (Static a) where+  rnf stat = index stat `seq` ()  -- forcing 'index' also forces strict 'label'+++-----------------------------------------------------------------------------+-- Serialize instance for 'Static'++instance Serialize (Static a) where+  put = Data.Serialize.put . index+  get = resolve <$> Data.Serialize.get+        -- NOTES:+        -- o Hyperstrictness is enforced by 'resolve' (and by construction+        --   of the Static table).+        -- o Serialisation crashes if the Static term is not yet registered.+        -- o Deserialisation crashes if the index passed to 'resolve' is+        --   out of bounds (but that can only happen when deserialising+        --   a bytestring that wasn't generated from a registered Static term).+++-- Resolves an index obtained from deserialisation into a Static term+-- by accessing the index in the global Static table; assumes that the+-- index is in bounds.+resolve :: StaticIndex -> Static a+resolve i =+  case (unsafePerformIO $ readIORef sTblRef) ! i of+    Any stat -> unsafeCoerce stat++-- Why 'unsafeCoerce' in safe in 'resolve':+--+-- o Static terms can only be introduced by the smart constructor 'staticAs'.+--+-- o We assume that the 'label' part of a Static term (as constructed by +--   'staticAs') is a /key/.  That is, whenever terms 'stat1 :: Static t1' +--   and 'stat2 :: Static t2' are introduced by 'staticAs' such that +--   'label stat1 == label stat2' then 'unstatic stat1 :: t1' is identical +--   to 'unstatic stat2 :: t2' (which also implies that the types 't1' and +--   't2' are identical). This assumption is justified if labels are+--   derived from fully qualified top-level names.+--+-- o Likewise, we assume that the 'index' part of a Static term is a /key/.+--   This follows from 'label' being a key and from the way the Static table+--   is constructed by 'register'.+--+-- o Thus, we can safely super-impose (using 'unsafeCoerce') the return type+--   'Static a' of 'resolve' on the returned Static term. This type will+--   have been dictated by the calling context of 'resolve', ie. by the+--   calling context of deserialisation.+++-----------------------------------------------------------------------------+-- Operations on existential 'Static' wrapper++instance Show AnyStatic where+  showsPrec _ (Any stat) = shows stat++instance NFData AnyStatic where+  rnf (Any stat) = rnf stat++getLabel :: AnyStatic -> StaticLabel+getLabel (Any stat) = label stat++setIndex :: StaticIndex -> AnyStatic -> AnyStatic+setIndex i (Any stat) = Any $ stat { index = i }+++-----------------------------------------------------------------------------+-- Static declarations (abstract outwith this module)++-- Promotes the given Static term to a Static declaration (by mapping the+-- label to the Static term, existentially wrapped).+declare :: Static a -> StaticDecl+declare stat = StaticDecl $ Map.singleton (label stat) (Any stat)+-- ^ Promotes a given @'Static'@ reference to a @'Static'@ declaration+-- consisting exactly of the given @'Static'@ reference (and the static term+-- it refers to).+-- See the tutorial below for how to declare @'Static'@ references.+++-- Static declarations form a monoid, at least if we assume that 'label'+-- is a /key/ for Static terms, ie. distinct Static terms will have+-- distinct labels. Note that this assumption is not checked: If it fails+-- then type safety of deserialisation can be compromised. The 'Static'+-- support in module 'HpdH.Closure', however, should guarantee the above+-- /key property/.+instance Monoid StaticDecl where+  mempty = StaticDecl Map.empty+  sd1 `mappend` sd2 = StaticDecl (unStaticDecl sd1 `Map.union` unStaticDecl sd2)+  mconcat = StaticDecl . Map.unions . map unStaticDecl+++-- Show instance only for debugging; only shows domain of 'StaticDecl'+instance Show StaticDecl where+  showsPrec _ sd = showString "StaticDecl " .+                   shows (Map.keys $ unStaticDecl sd)+++-----------------------------------------------------------------------------+-- Static table++-- | Registers the given @'Static'@ declaration; that is, stores the+-- declaration in the global @'Static'@ /table/. Must be called exactly once,+-- before any operations involving @'Static'@ references (or explicit Closures).+-- See the tutorial below for how to register a @'Static'@ declaration.+register :: StaticDecl -> IO ()+register sd = do+  let stats = zipWith setIndex [1..] (Map.elems $ unStaticDecl sd)+  let table = listArray (1, fromIntegral $ length stats) stats+  evaluate (rnf table)  -- force table to normal form+  ok <- atomicModifyIORef sTblRef $ \ old_table ->+          if snd (bounds old_table) < 1+            then (table, True)+            else (old_table, False)+  unless ok $+    error "Control.Parallel.HdpH.Closure.register: 2nd attempt"+++-- Converts a Static label into a Static index by means of binary search;+-- not exported and to be called only after registration.+findIndex :: StaticLabel -> StaticIndex+findIndex lbl = search (bounds table)+  where+    table = unsafePerformIO $ readIORef sTblRef+    search (lower, upper)+      | lower > upper = error msg+      | otherwise     = case cmp of+                          EQ -> i+                          LT -> search (lower, i - 1)+                          GT -> search (i + 1, upper)+        where+          i = (lower + upper) `div` 2+          cmp = compare lbl (getLabel $ table ! i)+          msg = "Control.Parallel.HdpH.Closure.Static.findIndex: " +++                show lbl ++ " not found"+++-- | Emits the contents of the global @'Static'@ table as a list of Strings,+-- one per entry. Useful for debugging; not to be called prior to registration.+showStaticTable :: [String]+showStaticTable = map show $ elems table+  where+    table = unsafePerformIO $ readIORef sTblRef+++-----------------------------------------------------------------------------+-- auxiliary stuff: hashing strings; adapted from Data.Hashable.++hashStringWithSalt :: Int32 -> String -> Int32+hashStringWithSalt = foldl' (\ h ch -> h `combine` toEnum (fromEnum ch))+                       where+                         combine :: Int32 -> Int32 -> Int32+                         combine h1 h2 = (h1 + h1 `shiftL` 5) `xor` h2++-- NOTE: Hashing fully evaluates the String argument as a side effect.+hashString :: String -> Int32+hashString = hashStringWithSalt defaultSalt+               where+                 defaultSalt = 5381
+ src/Control/Parallel/HdpH/Closure/Static/State.hs view
@@ -0,0 +1,26 @@+-- 'Static' support; state+--+-- Author: Patrick Maier+-----------------------------------------------------------------------------++{-# OPTIONS_GHC -fno-cse #-}  -- to protect unsafePerformIO hack++module Control.Parallel.HdpH.Closure.Static.State+  ( -- * reference to 'Static' declaration+    sTblRef  -- :: IORef StaticTable+  ) where++import Prelude+import Data.Array (array)+import Data.IORef (IORef, newIORef)+import System.IO.Unsafe (unsafePerformIO)++import Control.Parallel.HdpH.Closure.Static.Type (StaticTable)+++-----------------------------------------------------------------------------+-- reference to global static table, initially empty++sTblRef :: IORef StaticTable+sTblRef = unsafePerformIO $ newIORef $ array (1,0)  []+{-# NOINLINE sTblRef #-}   -- required to protect unsafePerformIO hack
+ src/Control/Parallel/HdpH/Closure/Static/Type.hs view
@@ -0,0 +1,78 @@+-- 'Static' support; types+--+-- Author: Patrick Maier+-----------------------------------------------------------------------------++{-# LANGUAGE GADTs #-}++module Control.Parallel.HdpH.Closure.Static.Type+  ( -- * 'Static' things (and constituent parts)+    Static(..),+    StaticLabel(..),+    StaticIndex,++    -- * 'Static' declarations and table+    StaticDecl(..),+    StaticTable,+    AnyStatic(..)+  ) where++import Prelude+import Data.Array (Array)+import Data.Int (Int32)+import Data.Map (Map)+import Data.Word (Word32)+++-----------------------------------------------------------------------------+-- Static things++-- A Static label consists of a 'name'; additionally, there is 32-bit hash+-- value (for faster comparisons). Note that all fields are strict.+data StaticLabel = StaticLabel { hash :: !Int32,+                                 name :: !String }+++-- A Static index, that is an index into the global Static table.+type StaticIndex = Word32+++-- A term of type 'Static a' (ie. essentially referring to a term of type 'a'+-- not capturing any free variables) is represented as+-- * a Static label, acting as a key,+-- * an index into the global Static table (also acting as a key), and+-- * the referred-to term (in field 'unstatic').+-- Note that the label is strict but the refereed-to term and the index are not;+-- the evaluation of the index is delayed until serialisation.+data Static a = Static { label    :: !StaticLabel,+                         index    :: StaticIndex,+                         unstatic :: a }+-- ^ A term of type @Static a@ is a serialisable reference to a /static/ term+-- of type @a@.++-- Existential Static type (wrapper for 'Static t' in heterogenous maps)+data AnyStatic where+  Any :: Static a -> AnyStatic+++-----------------------------------------------------------------------------+-- Static declarations++-- A Static declaration maps Static labels to Static terms containing+-- selfsame labels.+-- NOTE: Each image stored in 'StaticDecl' is actually of type 'Static a'+--       for some 'a'. However, to fit into the map, we wrap all these types+--       into the existential 'AnyStatic'.+newtype StaticDecl = StaticDecl { unStaticDecl :: Map StaticLabel AnyStatic }+-- ^ A @'Static'@ declaration is a collection of static terms together with+-- their serialisable @'Static'@ references.+-- @'Static'@ declarations form a monoid, and can be combined by methods of+-- class @'Data.Monoid.Monoid'@.+++-----------------------------------------------------------------------------+-- Static table++-- Global Static table, mapping static indices to existentially wrapped+-- Static terms.+type StaticTable = Array StaticIndex AnyStatic