{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE RoleAnnotations #-}
module Control.Distributed.Static
(
Static
, staticLabel
, staticApply
, staticPtr
, staticApplyPtr
, staticCompose
, staticSplit
, staticConst
, staticFlip
, Closure
, closure
, staticClosure
, closureApplyStatic
, closureApply
, closureCompose
, closureSplit
, RemoteTable
, initRemoteTable
, registerStatic
, unstatic
, unclosure
) where
import Data.Binary
( Binary(get, put)
, Put
, Get
, putWord8
, getWord8
, encode
, decode
)
import Data.ByteString.Lazy (ByteString, empty)
import Data.Map (Map)
import qualified Data.Map as Map (lookup, empty, insert)
import Control.Arrow as Arrow ((***), app)
import Control.DeepSeq (NFData(rnf), force)
import Data.Rank1Dynamic (Dynamic, toDynamic, fromDynamic, dynApply)
import Data.Rank1Typeable
( Typeable
, ANY1
, ANY2
, ANY3
, ANY4
, TypeRep
, typeOf
)
import qualified GHC.Exts as GHC (Any)
import GHC.StaticPtr
import GHC.Fingerprint.Type (Fingerprint(..))
import System.IO.Unsafe (unsafePerformIO)
import Data.Rank1Dynamic (unsafeToDynamic)
import Unsafe.Coerce (unsafeCoerce)
data SDynamic = SDynamic TypeRep (StaticPtr GHC.Any)
deriving (Typeable)
instance Show SDynamic where
show :: SDynamic -> String
show (SDynamic TypeRep
typ StaticPtr Any
ptr) =
let spi :: StaticPtrInfo
spi = StaticPtr Any -> StaticPtrInfo
forall a. StaticPtr a -> StaticPtrInfo
staticPtrInfo StaticPtr Any
ptr
(Int
line, Int
col) = StaticPtrInfo -> (Int, Int)
spInfoSrcLoc StaticPtrInfo
spi
in [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"<<static ", StaticPtrInfo -> String
spInfoModuleName StaticPtrInfo
spi, String
":", Int -> String
forall a. Show a => a -> String
show Int
line, String
":"
, Int -> String
forall a. Show a => a -> String
show Int
col, String
" :: ", TypeRep -> String
forall a. Show a => a -> String
show TypeRep
typ, String
">>"
]
instance Eq SDynamic where
SDynamic TypeRep
_ StaticPtr Any
ptr1 == :: SDynamic -> SDynamic -> Bool
== SDynamic TypeRep
_ StaticPtr Any
ptr2 =
StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr1 StaticKey -> StaticKey -> Bool
forall a. Eq a => a -> a -> Bool
== StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr2
instance Ord SDynamic where
SDynamic TypeRep
_ StaticPtr Any
ptr1 compare :: SDynamic -> SDynamic -> Ordering
`compare` SDynamic TypeRep
_ StaticPtr Any
ptr2 =
StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr1 StaticKey -> StaticKey -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr2
data StaticLabel =
StaticLabel String
| StaticApply !StaticLabel !StaticLabel
| StaticPtr SDynamic
deriving (StaticLabel -> StaticLabel -> Bool
(StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> Bool) -> Eq StaticLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticLabel -> StaticLabel -> Bool
== :: StaticLabel -> StaticLabel -> Bool
$c/= :: StaticLabel -> StaticLabel -> Bool
/= :: StaticLabel -> StaticLabel -> Bool
Eq, Eq StaticLabel
Eq StaticLabel =>
(StaticLabel -> StaticLabel -> Ordering)
-> (StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> Bool)
-> (StaticLabel -> StaticLabel -> StaticLabel)
-> (StaticLabel -> StaticLabel -> StaticLabel)
-> Ord StaticLabel
StaticLabel -> StaticLabel -> Bool
StaticLabel -> StaticLabel -> Ordering
StaticLabel -> StaticLabel -> StaticLabel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StaticLabel -> StaticLabel -> Ordering
compare :: StaticLabel -> StaticLabel -> Ordering
$c< :: StaticLabel -> StaticLabel -> Bool
< :: StaticLabel -> StaticLabel -> Bool
$c<= :: StaticLabel -> StaticLabel -> Bool
<= :: StaticLabel -> StaticLabel -> Bool
$c> :: StaticLabel -> StaticLabel -> Bool
> :: StaticLabel -> StaticLabel -> Bool
$c>= :: StaticLabel -> StaticLabel -> Bool
>= :: StaticLabel -> StaticLabel -> Bool
$cmax :: StaticLabel -> StaticLabel -> StaticLabel
max :: StaticLabel -> StaticLabel -> StaticLabel
$cmin :: StaticLabel -> StaticLabel -> StaticLabel
min :: StaticLabel -> StaticLabel -> StaticLabel
Ord, Typeable, Int -> StaticLabel -> ShowS
[StaticLabel] -> ShowS
StaticLabel -> String
(Int -> StaticLabel -> ShowS)
-> (StaticLabel -> String)
-> ([StaticLabel] -> ShowS)
-> Show StaticLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticLabel -> ShowS
showsPrec :: Int -> StaticLabel -> ShowS
$cshow :: StaticLabel -> String
show :: StaticLabel -> String
$cshowList :: [StaticLabel] -> ShowS
showList :: [StaticLabel] -> ShowS
Show)
instance NFData StaticLabel where
rnf :: StaticLabel -> ()
rnf (StaticLabel String
s) = String -> ()
forall a. NFData a => a -> ()
rnf String
s
rnf (StaticApply StaticLabel
a StaticLabel
b) = StaticLabel -> ()
forall a. NFData a => a -> ()
rnf StaticLabel
a () -> () -> ()
forall a b. a -> b -> b
`seq` StaticLabel -> ()
forall a. NFData a => a -> ()
rnf StaticLabel
b
rnf (StaticPtr (SDynamic TypeRep
_a StaticPtr Any
_b)) = ()
newtype Static a = Static StaticLabel
deriving (Static a -> Static a -> Bool
(Static a -> Static a -> Bool)
-> (Static a -> Static a -> Bool) -> Eq (Static a)
forall a. Static a -> Static a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Static a -> Static a -> Bool
== :: Static a -> Static a -> Bool
$c/= :: forall a. Static a -> Static a -> Bool
/= :: Static a -> Static a -> Bool
Eq, Eq (Static a)
Eq (Static a) =>
(Static a -> Static a -> Ordering)
-> (Static a -> Static a -> Bool)
-> (Static a -> Static a -> Bool)
-> (Static a -> Static a -> Bool)
-> (Static a -> Static a -> Bool)
-> (Static a -> Static a -> Static a)
-> (Static a -> Static a -> Static a)
-> Ord (Static a)
Static a -> Static a -> Bool
Static a -> Static a -> Ordering
Static a -> Static a -> Static a
forall a. Eq (Static a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Static a -> Static a -> Bool
forall a. Static a -> Static a -> Ordering
forall a. Static a -> Static a -> Static a
$ccompare :: forall a. Static a -> Static a -> Ordering
compare :: Static a -> Static a -> Ordering
$c< :: forall a. Static a -> Static a -> Bool
< :: Static a -> Static a -> Bool
$c<= :: forall a. Static a -> Static a -> Bool
<= :: Static a -> Static a -> Bool
$c> :: forall a. Static a -> Static a -> Bool
> :: Static a -> Static a -> Bool
$c>= :: forall a. Static a -> Static a -> Bool
>= :: Static a -> Static a -> Bool
$cmax :: forall a. Static a -> Static a -> Static a
max :: Static a -> Static a -> Static a
$cmin :: forall a. Static a -> Static a -> Static a
min :: Static a -> Static a -> Static a
Ord, Typeable, Int -> Static a -> ShowS
[Static a] -> ShowS
Static a -> String
(Int -> Static a -> ShowS)
-> (Static a -> String) -> ([Static a] -> ShowS) -> Show (Static a)
forall a. Int -> Static a -> ShowS
forall a. [Static a] -> ShowS
forall a. Static a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Static a -> ShowS
showsPrec :: Int -> Static a -> ShowS
$cshow :: forall a. Static a -> String
show :: Static a -> String
$cshowList :: forall a. [Static a] -> ShowS
showList :: [Static a] -> ShowS
Show)
type role Static nominal
instance NFData (Static a) where
rnf :: Static a -> ()
rnf (Static StaticLabel
s) = StaticLabel -> ()
forall a. NFData a => a -> ()
rnf StaticLabel
s
instance Binary (Static a) where
put :: Static a -> Put
put (Static StaticLabel
label) = StaticLabel -> Put
putStaticLabel StaticLabel
label
get :: Get (Static a)
get = StaticLabel -> Static a
forall a. StaticLabel -> Static a
Static (StaticLabel -> Static a) -> Get StaticLabel -> Get (Static a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get StaticLabel
getStaticLabel
putStaticLabel :: StaticLabel -> Put
putStaticLabel :: StaticLabel -> Put
putStaticLabel (StaticLabel String
string) =
Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
string
putStaticLabel (StaticApply StaticLabel
label1 StaticLabel
label2) =
Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StaticLabel -> Put
putStaticLabel StaticLabel
label1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StaticLabel -> Put
putStaticLabel StaticLabel
label2
putStaticLabel (StaticPtr (SDynamic TypeRep
typ StaticPtr Any
ptr)) =
let Fingerprint Word64
hi Word64
lo = StaticPtr Any -> StaticKey
forall a. StaticPtr a -> StaticKey
staticKey StaticPtr Any
ptr
in Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TypeRep -> Put
forall t. Binary t => t -> Put
put TypeRep
typ Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
forall t. Binary t => t -> Put
put Word64
hi Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
forall t. Binary t => t -> Put
put Word64
lo
getStaticLabel :: Get StaticLabel
getStaticLabel :: Get StaticLabel
getStaticLabel = do
Word8
header <- Get Word8
getWord8
case Word8
header of
Word8
0 -> String -> StaticLabel
StaticLabel (String -> StaticLabel) -> Get String -> Get StaticLabel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
Word8
1 -> StaticLabel -> StaticLabel -> StaticLabel
StaticApply (StaticLabel -> StaticLabel -> StaticLabel)
-> Get StaticLabel -> Get (StaticLabel -> StaticLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get StaticLabel
getStaticLabel Get (StaticLabel -> StaticLabel)
-> Get StaticLabel -> Get StaticLabel
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get StaticLabel
getStaticLabel
Word8
2 -> do TypeRep
typ <- Get TypeRep
forall t. Binary t => Get t
get
Word64
hi <- Get Word64
forall t. Binary t => Get t
get
Word64
lo <- Get Word64
forall t. Binary t => Get t
get
let key :: StaticKey
key = Word64 -> Word64 -> StaticKey
Fingerprint Word64
hi Word64
lo
case StaticKey -> Maybe (StaticPtr Any)
forall a. StaticKey -> Maybe (StaticPtr a)
unsaferLookupStaticPtr StaticKey
key of
Maybe (StaticPtr Any)
Nothing -> String -> Get StaticLabel
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"StaticLabel.get: invalid pointer"
Just StaticPtr Any
ptr -> StaticLabel -> Get StaticLabel
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (StaticLabel -> Get StaticLabel) -> StaticLabel -> Get StaticLabel
forall a b. (a -> b) -> a -> b
$ SDynamic -> StaticLabel
StaticPtr (TypeRep -> StaticPtr Any -> SDynamic
SDynamic TypeRep
typ StaticPtr Any
ptr)
Word8
_ -> String -> Get StaticLabel
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"StaticLabel.get: invalid"
unsaferLookupStaticPtr :: StaticKey -> Maybe (StaticPtr a)
unsaferLookupStaticPtr :: forall a. StaticKey -> Maybe (StaticPtr a)
unsaferLookupStaticPtr = IO (Maybe (StaticPtr a)) -> Maybe (StaticPtr a)
forall a. IO a -> a
unsafePerformIO (IO (Maybe (StaticPtr a)) -> Maybe (StaticPtr a))
-> (StaticKey -> IO (Maybe (StaticPtr a)))
-> StaticKey
-> Maybe (StaticPtr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticKey -> IO (Maybe (StaticPtr a))
forall a. StaticKey -> IO (Maybe (StaticPtr a))
unsafeLookupStaticPtr
staticLabel :: String -> Static a
staticLabel :: forall a. String -> Static a
staticLabel = StaticLabel -> Static a
forall a. StaticLabel -> Static a
Static (StaticLabel -> Static a)
-> (String -> StaticLabel) -> String -> Static a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StaticLabel
StaticLabel (String -> StaticLabel) -> ShowS -> String -> StaticLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. NFData a => a -> a
force
staticApply :: Static (a -> b) -> Static a -> Static b
staticApply :: forall a b. Static (a -> b) -> Static a -> Static b
staticApply (Static StaticLabel
f) (Static StaticLabel
x) = StaticLabel -> Static b
forall a. StaticLabel -> Static a
Static (StaticLabel -> StaticLabel -> StaticLabel
StaticApply StaticLabel
f StaticLabel
x)
staticPtr :: forall a. Typeable a => StaticPtr a -> Static a
staticPtr :: forall a. Typeable a => StaticPtr a -> Static a
staticPtr StaticPtr a
x = StaticLabel -> Static a
forall a. StaticLabel -> Static a
Static (StaticLabel -> Static a)
-> (SDynamic -> StaticLabel) -> SDynamic -> Static a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDynamic -> StaticLabel
StaticPtr
(SDynamic -> Static a) -> SDynamic -> Static a
forall a b. (a -> b) -> a -> b
$ TypeRep -> StaticPtr Any -> SDynamic
SDynamic (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined :: a)) (StaticPtr a -> StaticPtr Any
forall a b. a -> b
unsafeCoerce StaticPtr a
x)
staticApplyPtr :: (Typeable a, Typeable b)
=> StaticPtr (a -> b) -> Static a -> Static b
staticApplyPtr :: forall a b.
(Typeable a, Typeable b) =>
StaticPtr (a -> b) -> Static a -> Static b
staticApplyPtr = Static (a -> b) -> Static a -> Static b
forall a b. Static (a -> b) -> Static a -> Static b
staticApply (Static (a -> b) -> Static a -> Static b)
-> (StaticPtr (a -> b) -> Static (a -> b))
-> StaticPtr (a -> b)
-> Static a
-> Static b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticPtr (a -> b) -> Static (a -> b)
forall a. Typeable a => StaticPtr a -> Static a
staticPtr
newtype RemoteTable = RemoteTable (Map String Dynamic)
initRemoteTable :: RemoteTable
initRemoteTable :: RemoteTable
initRemoteTable =
String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$compose" (((ANY2 -> ANY3) -> (ANY1 -> ANY2) -> ANY1 -> ANY3) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY2 -> ANY3) -> (ANY1 -> ANY2) -> ANY1 -> ANY3
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) :: (ANY2 -> ANY3) -> (ANY1 -> ANY2) -> ANY1 -> ANY3))
(RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$const" ((ANY1 -> ANY2 -> ANY1) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (ANY1 -> ANY2 -> ANY1
forall a b. a -> b -> a
const :: ANY1 -> ANY2 -> ANY1))
(RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$split" (((ANY1 -> ANY3) -> (ANY2 -> ANY4) -> (ANY1, ANY2) -> (ANY3, ANY4))
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY1 -> ANY3) -> (ANY2 -> ANY4) -> (ANY1, ANY2) -> (ANY3, ANY4)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) :: (ANY1 -> ANY3) -> (ANY2 -> ANY4) -> (ANY1, ANY2) -> (ANY3, ANY4)))
(RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$app" (((ANY1 -> ANY2, ANY1) -> ANY2) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY1 -> ANY2, ANY1) -> ANY2
forall b c. (b -> c, b) -> c
forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
app :: (ANY1 -> ANY2, ANY1) -> ANY2))
(RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$decodeEnvPair" ((ByteString -> (ByteString, ByteString)) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (ByteString -> (ByteString, ByteString)
forall a. Binary a => ByteString -> a
decode :: ByteString -> (ByteString, ByteString)))
(RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$flip" (((ANY1 -> ANY2 -> ANY3) -> ANY2 -> ANY1 -> ANY3) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY1 -> ANY2 -> ANY3) -> ANY2 -> ANY1 -> ANY3
forall a b c. (a -> b -> c) -> b -> a -> c
flip :: (ANY1 -> ANY2 -> ANY3) -> ANY2 -> ANY1 -> ANY3))
(RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall a b. (a -> b) -> a -> b
$ Map String Dynamic -> RemoteTable
RemoteTable Map String Dynamic
forall k a. Map k a
Map.empty
registerStatic :: String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic :: String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
label Dynamic
dyn (RemoteTable Map String Dynamic
rtable)
= Map String Dynamic -> RemoteTable
RemoteTable (String -> Dynamic -> Map String Dynamic -> Map String Dynamic
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
label Dynamic
dyn Map String Dynamic
rtable)
resolveStaticLabel :: RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel :: RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel (RemoteTable Map String Dynamic
rtable) (StaticLabel String
label) =
case String -> Map String Dynamic -> Maybe Dynamic
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
label Map String Dynamic
rtable of
Maybe Dynamic
Nothing -> String -> Either String Dynamic
forall a b. a -> Either a b
Left (String -> Either String Dynamic)
-> String -> Either String Dynamic
forall a b. (a -> b) -> a -> b
$ String
"Invalid static label '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
Just Dynamic
d -> Dynamic -> Either String Dynamic
forall a b. b -> Either a b
Right Dynamic
d
resolveStaticLabel RemoteTable
rtable (StaticApply StaticLabel
label1 StaticLabel
label2) = do
Dynamic
f <- RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel RemoteTable
rtable StaticLabel
label1
Dynamic
x <- RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel RemoteTable
rtable StaticLabel
label2
Dynamic
f Dynamic -> Dynamic -> Either String Dynamic
`dynApply` Dynamic
x
resolveStaticLabel RemoteTable
_ (StaticPtr (SDynamic TypeRep
typ StaticPtr Any
ptr)) =
Dynamic -> Either String Dynamic
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic -> Either String Dynamic)
-> Dynamic -> Either String Dynamic
forall a b. (a -> b) -> a -> b
$ TypeRep -> Any -> Dynamic
forall a. TypeRep -> a -> Dynamic
unsafeToDynamic TypeRep
typ (StaticPtr Any -> Any
forall a. StaticPtr a -> a
deRefStaticPtr StaticPtr Any
ptr)
unstatic :: Typeable a => RemoteTable -> Static a -> Either String a
unstatic :: forall a. Typeable a => RemoteTable -> Static a -> Either String a
unstatic RemoteTable
rtable (Static StaticLabel
label) = do
Dynamic
dyn <- RemoteTable -> StaticLabel -> Either String Dynamic
resolveStaticLabel RemoteTable
rtable StaticLabel
label
Dynamic -> Either String a
forall a. Typeable a => Dynamic -> Either String a
fromDynamic Dynamic
dyn
data Closure a = Closure !(Static (ByteString -> a)) !ByteString
deriving (Closure a -> Closure a -> Bool
(Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Bool) -> Eq (Closure a)
forall a. Closure a -> Closure a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Closure a -> Closure a -> Bool
== :: Closure a -> Closure a -> Bool
$c/= :: forall a. Closure a -> Closure a -> Bool
/= :: Closure a -> Closure a -> Bool
Eq, Eq (Closure a)
Eq (Closure a) =>
(Closure a -> Closure a -> Ordering)
-> (Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Bool)
-> (Closure a -> Closure a -> Closure a)
-> (Closure a -> Closure a -> Closure a)
-> Ord (Closure a)
Closure a -> Closure a -> Bool
Closure a -> Closure a -> Ordering
Closure a -> Closure a -> Closure a
forall a. Eq (Closure a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Closure a -> Closure a -> Bool
forall a. Closure a -> Closure a -> Ordering
forall a. Closure a -> Closure a -> Closure a
$ccompare :: forall a. Closure a -> Closure a -> Ordering
compare :: Closure a -> Closure a -> Ordering
$c< :: forall a. Closure a -> Closure a -> Bool
< :: Closure a -> Closure a -> Bool
$c<= :: forall a. Closure a -> Closure a -> Bool
<= :: Closure a -> Closure a -> Bool
$c> :: forall a. Closure a -> Closure a -> Bool
> :: Closure a -> Closure a -> Bool
$c>= :: forall a. Closure a -> Closure a -> Bool
>= :: Closure a -> Closure a -> Bool
$cmax :: forall a. Closure a -> Closure a -> Closure a
max :: Closure a -> Closure a -> Closure a
$cmin :: forall a. Closure a -> Closure a -> Closure a
min :: Closure a -> Closure a -> Closure a
Ord, Typeable, Int -> Closure a -> ShowS
[Closure a] -> ShowS
Closure a -> String
(Int -> Closure a -> ShowS)
-> (Closure a -> String)
-> ([Closure a] -> ShowS)
-> Show (Closure a)
forall a. Int -> Closure a -> ShowS
forall a. [Closure a] -> ShowS
forall a. Closure a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Closure a -> ShowS
showsPrec :: Int -> Closure a -> ShowS
$cshow :: forall a. Closure a -> String
show :: Closure a -> String
$cshowList :: forall a. [Closure a] -> ShowS
showList :: [Closure a] -> ShowS
Show)
instance Binary (Closure a) where
put :: Closure a -> Put
put (Closure Static (ByteString -> a)
st ByteString
env) = Static (ByteString -> a) -> Put
forall t. Binary t => t -> Put
put Static (ByteString -> a)
st Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
env
get :: Get (Closure a)
get = Static (ByteString -> a) -> ByteString -> Closure a
forall a. Static (ByteString -> a) -> ByteString -> Closure a
Closure (Static (ByteString -> a) -> ByteString -> Closure a)
-> Get (Static (ByteString -> a)) -> Get (ByteString -> Closure a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Static (ByteString -> a))
forall t. Binary t => Get t
get Get (ByteString -> Closure a) -> Get ByteString -> Get (Closure a)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
forall t. Binary t => Get t
get
instance NFData (Closure a) where rnf :: Closure a -> ()
rnf (Closure Static (ByteString -> a)
f ByteString
b) = Static (ByteString -> a) -> ()
forall a. NFData a => a -> ()
rnf Static (ByteString -> a)
f () -> () -> ()
forall a b. a -> b -> b
`seq` ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
b
closure :: Static (ByteString -> a)
-> ByteString
-> Closure a
closure :: forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure = Static (ByteString -> a) -> ByteString -> Closure a
forall a. Static (ByteString -> a) -> ByteString -> Closure a
Closure
unclosure :: Typeable a => RemoteTable -> Closure a -> Either String a
unclosure :: forall a. Typeable a => RemoteTable -> Closure a -> Either String a
unclosure RemoteTable
rtable (Closure Static (ByteString -> a)
dec ByteString
env) = do
ByteString -> a
f <- RemoteTable
-> Static (ByteString -> a) -> Either String (ByteString -> a)
forall a. Typeable a => RemoteTable -> Static a -> Either String a
unstatic RemoteTable
rtable Static (ByteString -> a)
dec
a -> Either String a
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> a
f ByteString
env)
staticClosure :: Static a -> Closure a
staticClosure :: forall a. Static a -> Closure a
staticClosure Static a
dec = Static (ByteString -> a) -> ByteString -> Closure a
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure (Static a -> Static (ByteString -> a)
forall a b. Static a -> Static (b -> a)
staticConst Static a
dec) ByteString
empty
composeStatic :: Static ((b -> c) -> (a -> b) -> a -> c)
composeStatic :: forall b c a. Static ((b -> c) -> (a -> b) -> a -> c)
composeStatic = String -> Static ((b -> c) -> (a -> b) -> a -> c)
forall a. String -> Static a
staticLabel String
"$compose"
constStatic :: Static (a -> b -> a)
constStatic :: forall a b. Static (a -> b -> a)
constStatic = String -> Static (a -> b -> a)
forall a. String -> Static a
staticLabel String
"$const"
splitStatic :: Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
splitStatic :: forall a b a' b'.
Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
splitStatic = String -> Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
forall a. String -> Static a
staticLabel String
"$split"
appStatic :: Static ((a -> b, a) -> b)
appStatic :: forall a b. Static ((a -> b, a) -> b)
appStatic = String -> Static ((a -> b, a) -> b)
forall a. String -> Static a
staticLabel String
"$app"
flipStatic :: Static ((a -> b -> c) -> b -> a -> c)
flipStatic :: forall a b c. Static ((a -> b -> c) -> b -> a -> c)
flipStatic = String -> Static ((a -> b -> c) -> b -> a -> c)
forall a. String -> Static a
staticLabel String
"$flip"
staticCompose :: Static (b -> c) -> Static (a -> b) -> Static (a -> c)
staticCompose :: forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
staticCompose Static (b -> c)
g Static (a -> b)
f = Static ((b -> c) -> (a -> b) -> a -> c)
forall b c a. Static ((b -> c) -> (a -> b) -> a -> c)
composeStatic Static ((b -> c) -> (a -> b) -> a -> c)
-> Static (b -> c) -> Static ((a -> b) -> a -> c)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (b -> c)
g Static ((a -> b) -> a -> c) -> Static (a -> b) -> Static (a -> c)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (a -> b)
f
staticSplit :: Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b'))
staticSplit :: forall a b a' b'.
Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b'))
staticSplit Static (a -> b)
f Static (a' -> b')
g = Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
forall a b a' b'.
Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
splitStatic Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
-> Static (a -> b) -> Static ((a' -> b') -> (a, a') -> (b, b'))
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (a -> b)
f Static ((a' -> b') -> (a, a') -> (b, b'))
-> Static (a' -> b') -> Static ((a, a') -> (b, b'))
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (a' -> b')
g
staticConst :: Static a -> Static (b -> a)
staticConst :: forall a b. Static a -> Static (b -> a)
staticConst Static a
x = Static (a -> b -> a)
forall a b. Static (a -> b -> a)
constStatic Static (a -> b -> a) -> Static a -> Static (b -> a)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static a
x
staticFlip :: Static (a -> b -> c) -> Static (b -> a -> c)
staticFlip :: forall a b c. Static (a -> b -> c) -> Static (b -> a -> c)
staticFlip Static (a -> b -> c)
f = Static ((a -> b -> c) -> b -> a -> c)
forall a b c. Static ((a -> b -> c) -> b -> a -> c)
flipStatic Static ((a -> b -> c) -> b -> a -> c)
-> Static (a -> b -> c) -> Static (b -> a -> c)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (a -> b -> c)
f
closureApplyStatic :: Static (a -> b) -> Closure a -> Closure b
closureApplyStatic :: forall a b. Static (a -> b) -> Closure a -> Closure b
closureApplyStatic Static (a -> b)
f (Closure Static (ByteString -> a)
decoder ByteString
env) =
Static (ByteString -> b) -> ByteString -> Closure b
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure (Static (a -> b)
f Static (a -> b)
-> Static (ByteString -> a) -> Static (ByteString -> b)
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (ByteString -> a)
decoder) ByteString
env
decodeEnvPairStatic :: Static (ByteString -> (ByteString, ByteString))
decodeEnvPairStatic :: Static (ByteString -> (ByteString, ByteString))
decodeEnvPairStatic = String -> Static (ByteString -> (ByteString, ByteString))
forall a. String -> Static a
staticLabel String
"$decodeEnvPair"
closureApply :: forall a b .
Closure (a -> b) -> Closure a -> Closure b
closureApply :: forall a b. Closure (a -> b) -> Closure a -> Closure b
closureApply (Closure Static (ByteString -> a -> b)
fdec ByteString
fenv) (Closure Static (ByteString -> a)
xdec ByteString
xenv) =
Static (ByteString -> b) -> ByteString -> Closure b
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure Static (ByteString -> b)
decoder ((ByteString, ByteString) -> ByteString
forall a. Binary a => a -> ByteString
encode (ByteString
fenv, ByteString
xenv))
where
decoder :: Static (ByteString -> b)
decoder :: Static (ByteString -> b)
decoder = Static ((a -> b, a) -> b)
forall a b. Static ((a -> b, a) -> b)
appStatic
Static ((a -> b, a) -> b)
-> Static ((ByteString, ByteString) -> (a -> b, a))
-> Static ((ByteString, ByteString) -> b)
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose`
(Static (ByteString -> a -> b)
fdec Static (ByteString -> a -> b)
-> Static (ByteString -> a)
-> Static ((ByteString, ByteString) -> (a -> b, a))
forall a b a' b'.
Static (a -> b) -> Static (a' -> b') -> Static ((a, a') -> (b, b'))
`staticSplit` Static (ByteString -> a)
xdec)
Static ((ByteString, ByteString) -> b)
-> Static (ByteString -> (ByteString, ByteString))
-> Static (ByteString -> b)
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose`
Static (ByteString -> (ByteString, ByteString))
decodeEnvPairStatic
closureCompose :: Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
closureCompose :: forall b c a.
Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
closureCompose Closure (b -> c)
g Closure (a -> b)
f = Static ((b -> c) -> (a -> b) -> a -> c)
forall b c a. Static ((b -> c) -> (a -> b) -> a -> c)
composeStatic Static ((b -> c) -> (a -> b) -> a -> c)
-> Closure (b -> c) -> Closure ((a -> b) -> a -> c)
forall a b. Static (a -> b) -> Closure a -> Closure b
`closureApplyStatic` Closure (b -> c)
g Closure ((a -> b) -> a -> c)
-> Closure (a -> b) -> Closure (a -> c)
forall a b. Closure (a -> b) -> Closure a -> Closure b
`closureApply` Closure (a -> b)
f
closureSplit :: Closure (a -> b) -> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))
closureSplit :: forall a b a' b'.
Closure (a -> b)
-> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))
closureSplit Closure (a -> b)
f Closure (a' -> b')
g = Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
forall a b a' b'.
Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
splitStatic Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
-> Closure (a -> b) -> Closure ((a' -> b') -> (a, a') -> (b, b'))
forall a b. Static (a -> b) -> Closure a -> Closure b
`closureApplyStatic` Closure (a -> b)
f Closure ((a' -> b') -> (a, a') -> (b, b'))
-> Closure (a' -> b') -> Closure ((a, a') -> (b, b'))
forall a b. Closure (a -> b) -> Closure a -> Closure b
`closureApply` Closure (a' -> b')
g