{-# LANGUAGE ScopedTypeVariables
, MultiParamTypeClasses
, FlexibleInstances
, FunctionalDependencies
, FlexibleContexts
, UndecidableInstances
, KindSignatures
, GADTs
, EmptyDataDecls
, TypeOperators
, DeriveDataTypeable #-}
module Control.Distributed.Process.Internal.Closure.Explicit
(
RemoteRegister
, MkTDict(..)
, mkStaticVal
, mkClosureValSingle
, mkClosureVal
, call'
) where
import Control.Distributed.Static
import Control.Distributed.Process.Serializable
import Control.Distributed.Process.Internal.Closure.BuiltIn
(
staticDecode
)
import Control.Distributed.Process
import Data.Rank1Dynamic
import Data.Rank1Typeable
import Data.Binary(encode,put,get,Binary)
import qualified Data.ByteString.Lazy as B
import Data.Kind (Type)
type RemoteRegister = RemoteTable -> RemoteTable
mkStaticVal :: Serializable a => String -> a -> (Static a, RemoteRegister)
mkStaticVal :: forall a.
Serializable a =>
String -> a -> (Static a, RemoteRegister)
mkStaticVal String
n a
v = (String -> Static a
forall a. String -> Static a
staticLabel String
n_s, String -> Dynamic -> RemoteRegister
registerStatic String
n_s (a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic a
v))
where n_s :: String
n_s = String
n
class MkTDict a where
mkTDict :: String -> a -> RemoteRegister
instance (Serializable b) => MkTDict (Process b) where
mkTDict :: String -> Process b -> RemoteRegister
mkTDict String
_ Process b
_ = String -> Dynamic -> RemoteRegister
registerStatic (TypeRep -> String
forall a. Show a => a -> String
show (b -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (b
forall a. HasCallStack => a
undefined :: b)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"__staticDict") (SerializableDict b -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (SerializableDict b
forall a. Serializable a => SerializableDict a
SerializableDict :: SerializableDict b))
instance MkTDict a where
mkTDict :: String -> a -> RemoteRegister
mkTDict String
_ a
_ = RemoteRegister
forall a. a -> a
id
mkClosureValSingle :: forall a b. (Serializable a, Typeable b, MkTDict b) => String -> (a -> b) -> (a -> Closure b, RemoteRegister)
mkClosureValSingle :: forall a b.
(Serializable a, Typeable b, MkTDict b) =>
String -> (a -> b) -> (a -> Closure b, RemoteRegister)
mkClosureValSingle String
n a -> b
v = (a -> Closure b
c, String -> Dynamic -> RemoteRegister
registerStatic String
n_s ((a -> b) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic a -> b
v) RemoteRegister -> RemoteRegister -> RemoteRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Dynamic -> RemoteRegister
registerStatic String
n_sdict (SerializableDict a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic SerializableDict a
sdict) RemoteRegister -> RemoteRegister -> RemoteRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> b -> RemoteRegister
forall a. MkTDict a => String -> a -> RemoteRegister
mkTDict String
n_tdict (b
forall a. HasCallStack => a
undefined :: b)
) where
n_s :: String
n_s = String
n
n_sdict :: String
n_sdict = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"__sdict"
n_tdict :: String
n_tdict = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"__tdict"
c :: a -> Closure b
c = Static (ByteString -> b) -> ByteString -> Closure b
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure Static (ByteString -> b)
decoder (ByteString -> Closure b) -> (a -> ByteString) -> a -> Closure b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Binary a => a -> ByteString
encode
decoder :: Static (ByteString -> b)
decoder = (String -> Static (a -> b)
forall a. String -> Static a
staticLabel String
n_s :: Static (a -> b)) Static (a -> b)
-> Static (ByteString -> a) -> Static (ByteString -> b)
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (SerializableDict a) -> Static (ByteString -> a)
forall a.
Typeable a =>
Static (SerializableDict a) -> Static (ByteString -> a)
staticDecode (String -> Static (SerializableDict a)
forall a. String -> Static a
staticLabel String
n_sdict :: Static (SerializableDict a))
sdict :: (SerializableDict a)
sdict :: SerializableDict a
sdict = SerializableDict a
forall a. Serializable a => SerializableDict a
SerializableDict
mkClosureVal :: forall func argTuple result closureFunction.
(Curry (argTuple -> Closure result) closureFunction,
MkTDict result,
Uncurry HTrue argTuple func result,
Typeable result, Serializable argTuple, IsFunction func HTrue) =>
String -> func -> (closureFunction, RemoteRegister)
mkClosureVal :: forall func argTuple result closureFunction.
(Curry (argTuple -> Closure result) closureFunction,
MkTDict result, Uncurry HTrue argTuple func result,
Typeable result, Serializable argTuple, IsFunction func HTrue) =>
String -> func -> (closureFunction, RemoteRegister)
mkClosureVal String
n func
v = ((argTuple -> Closure result) -> closureFunction
forall a b. Curry a b => a -> b
curryFun argTuple -> Closure result
c, RemoteRegister
rtable)
where
uv :: argTuple -> result
uv :: argTuple -> result
uv = Fun argTuple func result -> func -> argTuple -> result
forall args func result.
Fun args func result -> func -> args -> result
uncurry' Fun argTuple func result
forall args func result.
Uncurry'' args func result =>
Fun args func result
reify func
v
n_s :: String
n_s = String
n
n_sdict :: String
n_sdict = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"__sdict"
n_tdict :: String
n_tdict = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"__tdict"
c :: argTuple -> Closure result
c :: argTuple -> Closure result
c = Static (ByteString -> result) -> ByteString -> Closure result
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure Static (ByteString -> result)
decoder (ByteString -> Closure result)
-> (argTuple -> ByteString) -> argTuple -> Closure result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. argTuple -> ByteString
forall a. Binary a => a -> ByteString
encode
decoder :: Static (B.ByteString -> result)
decoder :: Static (ByteString -> result)
decoder = (String -> Static (argTuple -> result)
forall a. String -> Static a
staticLabel String
n_s :: Static (argTuple -> result)) Static (argTuple -> result)
-> Static (ByteString -> argTuple) -> Static (ByteString -> result)
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (SerializableDict argTuple)
-> Static (ByteString -> argTuple)
forall a.
Typeable a =>
Static (SerializableDict a) -> Static (ByteString -> a)
staticDecode (String -> Static (SerializableDict argTuple)
forall a. String -> Static a
staticLabel String
n_sdict :: Static (SerializableDict argTuple))
rtable :: RemoteRegister
rtable = String -> Dynamic -> RemoteRegister
registerStatic String
n_s ((argTuple -> result) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic argTuple -> result
uv) RemoteRegister -> RemoteRegister -> RemoteRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Dynamic -> RemoteRegister
registerStatic String
n_sdict (SerializableDict argTuple -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic SerializableDict argTuple
sdict) RemoteRegister -> RemoteRegister -> RemoteRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> result -> RemoteRegister
forall a. MkTDict a => String -> a -> RemoteRegister
mkTDict String
n_tdict (result
forall a. HasCallStack => a
undefined :: result)
sdict :: (SerializableDict argTuple)
sdict :: SerializableDict argTuple
sdict = SerializableDict argTuple
forall a. Serializable a => SerializableDict a
SerializableDict
call' :: forall a. Serializable a => NodeId -> Closure (Process a) -> Process a
call' :: forall a.
Serializable a =>
NodeId -> Closure (Process a) -> Process a
call' = Static (SerializableDict a)
-> NodeId -> Closure (Process a) -> Process a
forall a.
Serializable a =>
Static (SerializableDict a)
-> NodeId -> Closure (Process a) -> Process a
call (String -> Static (SerializableDict a)
forall a. String -> Static a
staticLabel (String -> Static (SerializableDict a))
-> String -> Static (SerializableDict a)
forall a b. (a -> b) -> a -> b
$ (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a -> TypeRep) -> a -> TypeRep
forall a b. (a -> b) -> a -> b
$ (a
forall a. HasCallStack => a
undefined :: a)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"__staticDict")
data EndOfTuple deriving Typeable
instance Binary EndOfTuple where
put :: EndOfTuple -> Put
put EndOfTuple
_ = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
get :: Get EndOfTuple
get = EndOfTuple -> Get EndOfTuple
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return EndOfTuple
forall a. HasCallStack => a
undefined
class Curry a b | a -> b where
curryFun :: a -> b
instance Curry ((a, EndOfTuple) -> b) (a -> b) where
curryFun :: ((a, EndOfTuple) -> b) -> a -> b
curryFun (a, EndOfTuple) -> b
f = \a
x -> (a, EndOfTuple) -> b
f (a
x,EndOfTuple
forall a. HasCallStack => a
undefined)
instance Curry (b -> c) r => Curry ((a,b) -> c) (a -> r) where
curryFun :: ((a, b) -> c) -> a -> r
curryFun (a, b) -> c
f = \a
x -> (b -> c) -> r
forall a b. Curry a b => a -> b
curryFun (\b
y -> ((a, b) -> c
f (a
x,b
y)))
data HTrue
data HFalse
data Fun :: Type -> Type -> Type -> Type where
Done :: Fun EndOfTuple r r
Moar :: Fun xs f r -> Fun (x,xs) (x -> f) r
class Uncurry'' args func result | func -> args, func -> result, args result -> func where
reify :: Fun args func result
class Uncurry flag args func result | flag func -> args, flag func -> result, args result -> func where
reify' :: flag -> Fun args func result
instance Uncurry'' rest f r => Uncurry HTrue (a,rest) (a -> f) r where
reify' :: HTrue -> Fun (a, rest) (a -> f) r
reify' HTrue
_ = Fun rest f r -> Fun (a, rest) (a -> f) r
forall xs f r x. Fun xs f r -> Fun (x, xs) (x -> f) r
Moar Fun rest f r
forall args func result.
Uncurry'' args func result =>
Fun args func result
reify
instance Uncurry HFalse EndOfTuple a a where
reify' :: HFalse -> Fun EndOfTuple a a
reify' HFalse
_ = Fun EndOfTuple a a
forall r. Fun EndOfTuple r r
Done
instance (IsFunction func b, Uncurry b args func result) => Uncurry'' args func result where
reify :: Fun args func result
reify = b -> Fun args func result
forall flag args func result.
Uncurry flag args func result =>
flag -> Fun args func result
reify' (b
forall a. HasCallStack => a
undefined :: b)
uncurry' :: Fun args func result -> func -> args -> result
uncurry' :: forall args func result.
Fun args func result -> func -> args -> result
uncurry' Fun args func result
Done func
r args
_ = func
result
r
uncurry' (Moar Fun xs f result
fun) func
f (x
x,xs
xs) = Fun xs f result -> f -> xs -> result
forall args func result.
Fun args func result -> func -> args -> result
uncurry' Fun xs f result
fun (func
x -> f
f x
x) xs
xs
class IsFunction t b | t -> b
instance (b ~ HTrue) => IsFunction (a -> c) b
instance (b ~ HFalse) => IsFunction a b