@@ -1,13 +1,31 @@
11-- | Implementation of 'Closure' that works around the absence of 'static'.
22--
3−-- [Example usage]
3+-- [Built-in closures]
4+--
5+-- We offer a number of standard commonly useful closures.
6+--
7+-- [Closure combinators]
8+--
9+-- Closures combinators allow to create closures from other closures. For
10+-- example, 'spawnSupervised' is defined as follows:
11+--
12+-- > spawnSupervised :: NodeId
13+-- > -> Closure (Process ())
14+-- > -> Process (ProcessId, MonitorRef)
15+-- > spawnSupervised nid proc = do
16+-- > us <- getSelfPid
17+-- > them <- spawn nid (linkClosure us `cpSeq` proc)
18+-- > ref <- monitor them
19+-- > return (them, ref)
20+--
21+-- [User-defined closures]
422--
523-- Suppose we have a monomorphic function
624--
725-- > addInt :: Int -> Int -> Int
826-- > addInt x y = x + y
927--
10−-- Then
28+-- Then the Template Haskell splice
1129--
1230-- > remotable ['addInt]
1331--
@@ -20,7 +38,7 @@
2038--
2139-- > unClosure :: Typeable a => Closure a -> Process a
2240--
23−-- In general, given a monomorphic function @f : a -> b@ the corresponding
41+-- In general, given a monomorphic function @f :: a -> b@ the corresponding
2442-- function @$(mkClosure 'f)@ will have type @a -> Closure b@.
2543--
2644-- The call to 'remotable' will also generate a function
@@ -39,9 +57,11 @@
3957--
4058-- See Section 6, /Faking It/, of /Towards Haskell in the Cloud/ for more info.
4159module Control.Distributed.Process.Closure
42− ( -- * Primitive closures
60+ ( -- * User-defined closures
4361 remotable
4462 , mkClosure
63+ -- * Built-in closures
64+ , linkClosure
4565 -- * Generic closure combinators
4666 , closureApply
4767 , closureConst
@@ -70,156 +90,33 @@ module Control.Distributed.Process.Closure
7090 , cpSeq
7191 ) where
7292
73−import Prelude hiding (lookup)
74−import qualified Data.ByteString.Lazy as BS (empty)
75−import Data.Binary (encode)
76−import Data.Typeable (typeOf, Typeable)
77−import Control.Distributed.Process.Internal.Types
78− ( Closure(..)
79− , Static(..)
80− , StaticLabel(..)
81− , Process
82− )
8393import Control.Distributed.Process.Internal.Closure.TH (remotable, mkClosure)
84−
85−--------------------------------------------------------------------------------
86−-- Generic closure combinators --
87−--------------------------------------------------------------------------------
88−
89−closureApply :: Closure (a -> b) -> Closure a -> Closure b
90−closureApply (Closure (Static labelf) envf) (Closure (Static labelx) envx) =
91− Closure (Static ClosureApply) $ encode (labelf, envf, labelx, envx)
92−
93−closureConst :: forall a b. (Typeable a, Typeable b)
94− => Closure (a -> b -> a)
95−closureConst = Closure (Static ClosureConst) (encode $ typeOf aux)
96− where
97− aux :: a -> b -> a
98− aux = undefined
99−
100−closureUnit :: Closure ()
101−closureUnit = Closure (Static ClosureUnit) BS.empty
102−
103−--------------------------------------------------------------------------------
104−-- Arrow combinators for processes --
105−--------------------------------------------------------------------------------
106−
107−type CP a b = Closure (a -> Process b)
108−
109−cpIntro :: (Typeable a, Typeable b)
110− => Closure (Process b) -> CP a b
111−cpIntro = closureApply closureConst
112−
113−cpElim :: Typeable a
114− => CP () a -> Closure (Process a)
115−cpElim = flip closureApply closureUnit
116−
117−cpId :: forall a. Typeable a
118− => CP a a
119−cpId = Closure (Static CpId) (encode $ typeOf aux)
120− where
121− aux :: a -> Process a
122− aux = undefined
123−
124−cpComp :: forall a b c. (Typeable a, Typeable b, Typeable c)
125− => CP a b -> CP b c -> CP a c
126−cpComp f g = comp `closureApply` f `closureApply` g
127− where
128− comp :: Closure ((a -> Process b) -> (b -> Process c) -> a -> Process c)
129− comp = Closure (Static CpComp) (encode $ typeOf aux)
130−
131− aux :: (a -> Process b) -> (b -> Process c) -> a -> Process c
132− aux = undefined
133−
134−cpFirst :: forall a b c. (Typeable a, Typeable b, Typeable c)
135− => CP a b -> CP (a, c) (b, c)
136−cpFirst = closureApply first
137− where
138− first :: Closure ((a -> Process b) -> (a, c) -> Process (b, c))
139− first = Closure (Static CpFirst) (encode $ typeOf aux)
140−
141− aux :: (a -> Process b) -> (a, c) -> Process (b, c)
142− aux = undefined
143−
144−cpSwap :: forall a b. (Typeable a, Typeable b)
145− => CP (a, b) (b, a)
146−cpSwap = Closure (Static CpSwap) (encode $ typeOf aux)
147− where
148− aux :: (a, b) -> Process (b, a)
149− aux = undefined
150−
151−cpSecond :: (Typeable a, Typeable b, Typeable c)
152− => CP a b -> CP (c, a) (c, b)
153−cpSecond f = cpSwap `cpComp` cpFirst f `cpComp` cpSwap
154−
155−cpPair :: (Typeable a, Typeable a', Typeable b, Typeable b')
156− => CP a b -> CP a' b' -> CP (a, a') (b, b')
157−cpPair f g = cpFirst f `cpComp` cpSecond g
158−
159−cpCopy :: forall a. Typeable a
160− => CP a (a, a)
161−cpCopy = Closure (Static CpCopy) (encode $ typeOf aux)
162− where
163− aux :: a -> Process (a, a)
164− aux = undefined
165−
166−cpFanOut :: (Typeable a, Typeable b, Typeable c)
167− => CP a b -> CP a c -> CP a (b, c)
168−cpFanOut f g = cpCopy `cpComp` (f `cpPair` g)
169−
170−cpLeft :: forall a b c. (Typeable a, Typeable b, Typeable c)
171− => CP a b -> CP (Either a c) (Either b c)
172−cpLeft = closureApply left
173− where
174− left :: Closure ((a -> Process b) -> Either a c -> Process (Either b c))
175− left = Closure (Static CpLeft) (encode $ typeOf aux)
176−
177− aux :: (a -> Process b) -> Either a c -> Process (Either b c)
178− aux = undefined
179−
180−cpMirror :: forall a b. (Typeable a, Typeable b)
181− => CP (Either a b) (Either b a)
182−cpMirror = Closure (Static CpMirror) (encode $ typeOf aux)
183− where
184− aux :: Either a b -> Process (Either b a)
185− aux = undefined
186−
187−cpRight :: forall a b c. (Typeable a, Typeable b, Typeable c)
188− => CP a b -> CP (Either c a) (Either c b)
189−cpRight f = cpMirror `cpComp` cpLeft f `cpComp` cpMirror
190−
191−cpEither :: (Typeable a, Typeable a', Typeable b, Typeable b')
192− => CP a b -> CP a' b' -> CP (Either a a') (Either b b')
193−cpEither f g = cpLeft f `cpComp` cpRight g
194−
195−cpUntag :: forall a. Typeable a
196− => CP (Either a a) a
197−cpUntag = Closure (Static CpUntag) (encode $ typeOf aux)
198− where
199− aux :: Either a a -> Process a
200− aux = undefined
201−
202−cpFanIn :: (Typeable a, Typeable b, Typeable c)
203− => CP a c -> CP b c -> CP (Either a b) c
204−cpFanIn f g = (f `cpEither` g) `cpComp` cpUntag
205−
206−cpApply :: forall a b. (Typeable a, Typeable b)
207− => CP (CP a b, a) b
208−cpApply = Closure (Static CpApply) $ encode ( typeOf aux
209− , typeOf (undefined :: a)
210− , typeOf (undefined :: Process b)
211− )
212− where
213− aux :: (Closure (a -> Process b), a) -> Process b
214− aux = undefined
215−
216−--------------------------------------------------------------------------------
217−-- Some derived operators for processes --
218−--------------------------------------------------------------------------------
219−
220−cpBind :: (Typeable a, Typeable b)
221− => Closure (Process a) -> Closure (a -> Process b) -> Closure (Process b)
222−cpBind x f = cpElim $ cpIntro x `cpComp` f
223−
224−cpSeq :: Closure (Process ()) -> Closure (Process ()) -> Closure (Process ())
225−cpSeq p q = p `cpBind` cpIntro q
94+import Control.Distributed.Process.Internal.Closure.BuiltIn (linkClosure)
95+import Control.Distributed.Process.Internal.Closure.Combinators
96+ ( -- Generic combinators
97+ closureApply
98+ , closureConst
99+ , closureUnit
100+ -- Arrow combinators for processes
101+ , CP
102+ , cpIntro
103+ , cpElim
104+ , cpId
105+ , cpComp
106+ , cpFirst
107+ , cpSwap
108+ , cpSecond
109+ , cpPair
110+ , cpCopy
111+ , cpFanOut
112+ , cpLeft
113+ , cpMirror
114+ , cpRight
115+ , cpEither
116+ , cpUntag
117+ , cpFanIn
118+ , cpApply
119+ -- Derived process operators
120+ , cpBind
121+ , cpSeq
122+ )