module Control.Distributed.Process.Internal.Closure.Combinators
(
closureApply
, closureConst
, closureUnit
, CP
, cpIntro
, cpElim
, cpId
, cpComp
, cpFirst
, cpSwap
, cpSecond
, cpPair
, cpCopy
, cpFanOut
, cpLeft
, cpMirror
, cpRight
, cpEither
, cpUntag
, cpFanIn
, cpApply
, cpBind
, cpSeq
) where
import Prelude hiding (lookup)
import qualified Data.ByteString.Lazy as BS (empty)
import Data.Binary (encode)
import Data.Typeable (typeOf, Typeable)
import Control.Distributed.Process.Internal.Types
( Closure(..)
, Static(..)
, StaticLabel(..)
, Process
)
import Control.Distributed.Process.Internal.TypeRep ()
closureApply :: Closure (a -> b) -> Closure a -> Closure b
closureApply (Closure (Static labelf) envf) (Closure (Static labelx) envx) =
Closure (Static ClosureApply) $ encode (labelf, envf, labelx, envx)
closureConst :: forall a b. (Typeable a, Typeable b)
=> Closure (a -> b -> a)
closureConst = Closure (Static ClosureConst) (encode $ typeOf aux)
where
aux :: a -> b -> a
aux = undefined
closureUnit :: Closure ()
closureUnit = Closure (Static ClosureUnit) BS.empty
type CP a b = Closure (a -> Process b)
cpIntro :: (Typeable a, Typeable b)
=> Closure (Process b) -> CP a b
cpIntro = closureApply closureConst
cpElim :: Typeable a
=> CP () a -> Closure (Process a)
cpElim = flip closureApply closureUnit
cpId :: forall a. Typeable a
=> CP a a
cpId = Closure (Static CpId) (encode $ typeOf aux)
where
aux :: a -> Process a
aux = undefined
cpComp :: forall a b c. (Typeable a, Typeable b, Typeable c)
=> CP a b -> CP b c -> CP a c
cpComp f g = comp `closureApply` f `closureApply` g
where
comp :: Closure ((a -> Process b) -> (b -> Process c) -> a -> Process c)
comp = Closure (Static CpComp) (encode $ typeOf aux)
aux :: (a -> Process b) -> (b -> Process c) -> a -> Process c
aux = undefined
cpFirst :: forall a b c. (Typeable a, Typeable b, Typeable c)
=> CP a b -> CP (a, c) (b, c)
cpFirst = closureApply first
where
first :: Closure ((a -> Process b) -> (a, c) -> Process (b, c))
first = Closure (Static CpFirst) (encode $ typeOf aux)
aux :: (a -> Process b) -> (a, c) -> Process (b, c)
aux = undefined
cpSwap :: forall a b. (Typeable a, Typeable b)
=> CP (a, b) (b, a)
cpSwap = Closure (Static CpSwap) (encode $ typeOf aux)
where
aux :: (a, b) -> Process (b, a)
aux = undefined
cpSecond :: (Typeable a, Typeable b, Typeable c)
=> CP a b -> CP (c, a) (c, b)
cpSecond f = cpSwap `cpComp` cpFirst f `cpComp` cpSwap
cpPair :: (Typeable a, Typeable a', Typeable b, Typeable b')
=> CP a b -> CP a' b' -> CP (a, a') (b, b')
cpPair f g = cpFirst f `cpComp` cpSecond g
cpCopy :: forall a. Typeable a
=> CP a (a, a)
cpCopy = Closure (Static CpCopy) (encode $ typeOf aux)
where
aux :: a -> Process (a, a)
aux = undefined
cpFanOut :: (Typeable a, Typeable b, Typeable c)
=> CP a b -> CP a c -> CP a (b, c)
cpFanOut f g = cpCopy `cpComp` (f `cpPair` g)
cpLeft :: forall a b c. (Typeable a, Typeable b, Typeable c)
=> CP a b -> CP (Either a c) (Either b c)
cpLeft = closureApply left
where
left :: Closure ((a -> Process b) -> Either a c -> Process (Either b c))
left = Closure (Static CpLeft) (encode $ typeOf aux)
aux :: (a -> Process b) -> Either a c -> Process (Either b c)
aux = undefined
cpMirror :: forall a b. (Typeable a, Typeable b)
=> CP (Either a b) (Either b a)
cpMirror = Closure (Static CpMirror) (encode $ typeOf aux)
where
aux :: Either a b -> Process (Either b a)
aux = undefined
cpRight :: forall a b c. (Typeable a, Typeable b, Typeable c)
=> CP a b -> CP (Either c a) (Either c b)
cpRight f = cpMirror `cpComp` cpLeft f `cpComp` cpMirror
cpEither :: (Typeable a, Typeable a', Typeable b, Typeable b')
=> CP a b -> CP a' b' -> CP (Either a a') (Either b b')
cpEither f g = cpLeft f `cpComp` cpRight g
cpUntag :: forall a. Typeable a
=> CP (Either a a) a
cpUntag = Closure (Static CpUntag) (encode $ typeOf aux)
where
aux :: Either a a -> Process a
aux = undefined
cpFanIn :: (Typeable a, Typeable b, Typeable c)
=> CP a c -> CP b c -> CP (Either a b) c
cpFanIn f g = (f `cpEither` g) `cpComp` cpUntag
cpApply :: forall a b. (Typeable a, Typeable b)
=> CP (CP a b, a) b
cpApply = Closure (Static CpApply) $ encode ( typeOf aux
, typeOf (undefined :: a)
, typeOf (undefined :: Process b)
)
where
aux :: (Closure (a -> Process b), a) -> Process b
aux = undefined
cpBind :: (Typeable a, Typeable b)
=> Closure (Process a) -> Closure (a -> Process b) -> Closure (Process b)
cpBind x f = cpElim $ cpIntro x `cpComp` f
cpSeq :: Closure (Process ()) -> Closure (Process ()) -> Closure (Process ())
cpSeq p q = p `cpBind` cpIntro q