{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE RankNTypes  #-}
module Control.Distributed.Process.Internal.Closure.BuiltIn
  ( -- * Remote table
    remoteTable
    -- * Static dictionaries and associated operations
  , staticDecode
  , sdictUnit
  , sdictProcessId
  , sdictSendPort
  , sdictStatic
  , sdictClosure
    -- * Some static values
  , sndStatic
    -- * The CP type and associated combinators
  , CP
  , idCP
  , splitCP
  , returnCP
  , bindCP
  , seqCP
    -- * CP versions of Cloud Haskell primitives
  , decodeProcessIdStatic
  , cpLink
  , cpUnlink
  , cpRelay
  , cpSend
  , cpExpect
  , cpNewChan
    -- * Support for some CH operations
  , cpDelayed
  , cpEnableTraceRemote
  ) where

import Data.ByteString.Lazy (ByteString)
import Data.Binary (decode, encode)
import Data.Rank1Typeable (Typeable, ANY, ANY1, ANY2, ANY3, ANY4)
import Data.Rank1Dynamic (toDynamic)
import Control.Distributed.Static
  ( RemoteTable
  , registerStatic
  , Static
  , staticLabel
  , staticApply
  , Closure
  , closure
  , closureApplyStatic
  , closureApply
  , staticCompose
  , staticClosure
  )
import Control.Distributed.Process.Serializable
  ( SerializableDict(..)
  , Serializable
  , TypeableDict(..)
  )
import Control.Distributed.Process.Internal.Types
  ( Process
  , ProcessId
  , SendPort
  , ReceivePort
  , ProcessMonitorNotification(ProcessMonitorNotification)
  )
import Control.Distributed.Process.Internal.Primitives
  ( link
  , unlink
  , relay
  , send
  , expect
  , newChan
  , monitor
  , unmonitor
  , match
  , matchIf
  , receiveWait
  )

--------------------------------------------------------------------------------
-- Remote table                                                               --
--------------------------------------------------------------------------------

remoteTable :: RemoteTable -> RemoteTable
remoteTable :: RemoteTable -> RemoteTable
remoteTable =
      String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$decodeDict"      ((SerializableDict ANY -> ByteString -> ANY) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (SerializableDict ANY -> ByteString -> ANY
forall a. SerializableDict a -> ByteString -> a
decodeDict       :: SerializableDict ANY -> ByteString -> ANY))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$sdictUnit"       (SerializableDict () -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (SerializableDict ()
forall a. Serializable a => SerializableDict a
SerializableDict :: SerializableDict ()))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$sdictProcessId"  (SerializableDict ProcessId -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (SerializableDict ProcessId
forall a. Serializable a => SerializableDict a
SerializableDict :: SerializableDict ProcessId))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$sdictSendPort_"  ((SerializableDict ANY -> SerializableDict (SendPort ANY))
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (SerializableDict ANY -> SerializableDict (SendPort ANY)
forall a. SerializableDict a -> SerializableDict (SendPort a)
sdictSendPort_   :: SerializableDict ANY -> SerializableDict (SendPort ANY)))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$sdictStatic"     ((TypeableDict ANY -> SerializableDict (Static ANY)) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (TypeableDict ANY -> SerializableDict (Static ANY)
forall a. TypeableDict a -> SerializableDict (Static a)
sdictStatic_     :: TypeableDict ANY -> SerializableDict (Static ANY)))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$sdictClosure"    ((TypeableDict ANY -> SerializableDict (Closure ANY)) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (TypeableDict ANY -> SerializableDict (Closure ANY)
forall a. TypeableDict a -> SerializableDict (Closure a)
sdictClosure_    :: TypeableDict ANY -> SerializableDict (Closure ANY)))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$returnProcess"   ((ANY -> Process ANY) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (ANY -> Process ANY
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return           :: ANY -> Process ANY))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$seqProcess"      ((Process ANY1 -> Process ANY2 -> Process ANY2) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (Process ANY1 -> Process ANY2 -> Process ANY2
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)             :: Process ANY1 -> Process ANY2 -> Process ANY2))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$bindProcess"     ((Process ANY1 -> (ANY1 -> Process ANY2) -> Process ANY2) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (Process ANY1 -> (ANY1 -> Process ANY2) -> Process ANY2
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)            :: Process ANY1 -> (ANY1 -> Process ANY2) -> Process ANY2))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$decodeProcessId" ((ByteString -> ProcessId) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (ByteString -> ProcessId
forall a. Binary a => ByteString -> a
decode           :: ByteString -> ProcessId))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$link"            ((ProcessId -> Process ()) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ProcessId -> Process ()
link)
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$unlink"          ((ProcessId -> Process ()) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ProcessId -> Process ()
unlink)
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$relay"           ((ProcessId -> Process ()) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ProcessId -> Process ()
relay)
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$sendDict"        ((SerializableDict ANY -> ProcessId -> ANY -> Process ()) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (SerializableDict ANY -> ProcessId -> ANY -> Process ()
forall a. SerializableDict a -> ProcessId -> a -> Process ()
sendDict         :: SerializableDict ANY -> ProcessId -> ANY -> Process ()))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$expectDict"      ((SerializableDict ANY -> Process ANY) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (SerializableDict ANY -> Process ANY
forall a. SerializableDict a -> Process a
expectDict       :: SerializableDict ANY -> Process ANY))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$newChanDict"     ((SerializableDict ANY -> Process (SendPort ANY, ReceivePort ANY))
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic (SerializableDict ANY -> Process (SendPort ANY, ReceivePort ANY)
forall a. SerializableDict a -> Process (SendPort a, ReceivePort a)
newChanDict      :: SerializableDict ANY -> Process (SendPort ANY, ReceivePort ANY)))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$cpSplit"         (((ANY1 -> Process ANY3)
 -> (ANY2 -> Process ANY4) -> (ANY1, ANY2) -> Process (ANY3, ANY4))
-> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY1 -> Process ANY3)
-> (ANY2 -> Process ANY4) -> (ANY1, ANY2) -> Process (ANY3, ANY4)
forall a b c d.
(a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d)
cpSplit          :: (ANY1 -> Process ANY3) -> (ANY2 -> Process ANY4) -> (ANY1, ANY2) -> Process (ANY3, ANY4)))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$snd"             (((ANY1, ANY2) -> ANY2) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ((ANY1, ANY2) -> ANY2
forall a b. (a, b) -> b
snd              :: (ANY1, ANY2) -> ANY2))
    (RemoteTable -> RemoteTable)
-> (RemoteTable -> RemoteTable) -> RemoteTable -> RemoteTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$delay"           ((ProcessId -> Process () -> Process ()) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ProcessId -> Process () -> Process ()
delay)
  where
    decodeDict :: forall a. SerializableDict a -> ByteString -> a
    decodeDict :: forall a. SerializableDict a -> ByteString -> a
decodeDict SerializableDict a
SerializableDict = ByteString -> a
forall a. Binary a => ByteString -> a
decode

    sdictSendPort_ :: forall a. SerializableDict a -> SerializableDict (SendPort a)
    sdictSendPort_ :: forall a. SerializableDict a -> SerializableDict (SendPort a)
sdictSendPort_ SerializableDict a
SerializableDict = SerializableDict (SendPort a)
forall a. Serializable a => SerializableDict a
SerializableDict

    sdictStatic_ :: forall a. TypeableDict a -> SerializableDict (Static a)
    sdictStatic_ :: forall a. TypeableDict a -> SerializableDict (Static a)
sdictStatic_ TypeableDict a
TypeableDict = SerializableDict (Static a)
forall a. Serializable a => SerializableDict a
SerializableDict

    sdictClosure_ :: forall a. TypeableDict a -> SerializableDict (Closure a)
    sdictClosure_ :: forall a. TypeableDict a -> SerializableDict (Closure a)
sdictClosure_ TypeableDict a
TypeableDict = SerializableDict (Closure a)
forall a. Serializable a => SerializableDict a
SerializableDict

    sendDict :: forall a. SerializableDict a -> ProcessId -> a -> Process ()
    sendDict :: forall a. SerializableDict a -> ProcessId -> a -> Process ()
sendDict SerializableDict a
SerializableDict = ProcessId -> a -> Process ()
forall a. Serializable a => ProcessId -> a -> Process ()
send

    expectDict :: forall a. SerializableDict a -> Process a
    expectDict :: forall a. SerializableDict a -> Process a
expectDict SerializableDict a
SerializableDict = Process a
forall a. Serializable a => Process a
expect

    newChanDict :: forall a. SerializableDict a -> Process (SendPort a, ReceivePort a)
    newChanDict :: forall a. SerializableDict a -> Process (SendPort a, ReceivePort a)
newChanDict SerializableDict a
SerializableDict = Process (SendPort a, ReceivePort a)
forall a. Serializable a => Process (SendPort a, ReceivePort a)
newChan

    cpSplit :: forall a b c d. (a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d)
    cpSplit :: forall a b c d.
(a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d)
cpSplit a -> Process c
f b -> Process d
g (a
a, b
b) = do
      c
c <- a -> Process c
f a
a
      d
d <- b -> Process d
g b
b
      (c, d) -> Process (c, d)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, d
d)

--------------------------------------------------------------------------------
-- Static dictionaries and associated operations                              --
--------------------------------------------------------------------------------

-- | Static decoder, given a static serialization dictionary.
--
-- See module documentation of "Control.Distributed.Process.Closure" for an
-- example.
staticDecode :: Typeable a => Static (SerializableDict a) -> Static (ByteString -> a)
staticDecode :: forall a.
Typeable a =>
Static (SerializableDict a) -> Static (ByteString -> a)
staticDecode Static (SerializableDict a)
dict = Static (SerializableDict a -> ByteString -> a)
forall a.
Typeable a =>
Static (SerializableDict a -> ByteString -> a)
decodeDictStatic Static (SerializableDict a -> ByteString -> a)
-> Static (SerializableDict a) -> Static (ByteString -> a)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (SerializableDict a)
dict
  where
    decodeDictStatic :: Typeable a => Static (SerializableDict a -> ByteString -> a)
    decodeDictStatic :: forall a.
Typeable a =>
Static (SerializableDict a -> ByteString -> a)
decodeDictStatic = String -> Static (SerializableDict a -> ByteString -> a)
forall a. String -> Static a
staticLabel String
"$decodeDict"

-- | Serialization dictionary for '()'
sdictUnit :: Static (SerializableDict ())
sdictUnit :: Static (SerializableDict ())
sdictUnit = String -> Static (SerializableDict ())
forall a. String -> Static a
staticLabel String
"$sdictUnit"

-- | Serialization dictionary for 'ProcessId'
sdictProcessId :: Static (SerializableDict ProcessId)
sdictProcessId :: Static (SerializableDict ProcessId)
sdictProcessId = String -> Static (SerializableDict ProcessId)
forall a. String -> Static a
staticLabel String
"$sdictProcessId"

-- | Serialization dictionary for 'SendPort'
sdictSendPort :: Typeable a
              => Static (SerializableDict a) -> Static (SerializableDict (SendPort a))
sdictSendPort :: forall a.
Typeable a =>
Static (SerializableDict a)
-> Static (SerializableDict (SendPort a))
sdictSendPort = Static (SerializableDict a -> SerializableDict (SendPort a))
-> Static (SerializableDict a)
-> Static (SerializableDict (SendPort a))
forall a b. Static (a -> b) -> Static a -> Static b
staticApply (String
-> Static (SerializableDict a -> SerializableDict (SendPort a))
forall a. String -> Static a
staticLabel String
"$sdictSendPort_")

-- | Serialization dictionary for 'Static'.
sdictStatic :: Typeable a => Static (TypeableDict a) -> Static (SerializableDict (Static a))
sdictStatic :: forall a.
Typeable a =>
Static (TypeableDict a) -> Static (SerializableDict (Static a))
sdictStatic = Static (TypeableDict a -> SerializableDict (Static a))
-> Static (TypeableDict a) -> Static (SerializableDict (Static a))
forall a b. Static (a -> b) -> Static a -> Static b
staticApply (String -> Static (TypeableDict a -> SerializableDict (Static a))
forall a. String -> Static a
staticLabel String
"$sdictStatic")

-- | Serialization dictionary for 'Closure'.
sdictClosure :: Typeable a => Static (TypeableDict a) -> Static (SerializableDict (Closure a))
sdictClosure :: forall a.
Typeable a =>
Static (TypeableDict a) -> Static (SerializableDict (Closure a))
sdictClosure = Static (TypeableDict a -> SerializableDict (Closure a))
-> Static (TypeableDict a) -> Static (SerializableDict (Closure a))
forall a b. Static (a -> b) -> Static a -> Static b
staticApply (String -> Static (TypeableDict a -> SerializableDict (Closure a))
forall a. String -> Static a
staticLabel String
"$sdictClosure")

--------------------------------------------------------------------------------
-- Static values                                                              --
--------------------------------------------------------------------------------

sndStatic :: Static ((a, b) -> b)
sndStatic :: forall a b. Static ((a, b) -> b)
sndStatic = String -> Static ((a, b) -> b)
forall a. String -> Static a
staticLabel String
"$snd"

--------------------------------------------------------------------------------
-- The CP type and associated combinators                                     --
--------------------------------------------------------------------------------

-- | @CP a b@ is a process with input of type @a@ and output of type @b@
type CP a b = Closure (a -> Process b)

returnProcessStatic :: Typeable a => Static (a -> Process a)
returnProcessStatic :: forall a. Typeable a => Static (a -> Process a)
returnProcessStatic = String -> Static (a -> Process a)
forall a. String -> Static a
staticLabel String
"$returnProcess"

-- | 'CP' version of 'Control.Category.id'
idCP :: Typeable a => CP a a
idCP :: forall a. Typeable a => CP a a
idCP = Static (a -> Process a) -> Closure (a -> Process a)
forall a. Static a -> Closure a
staticClosure Static (a -> Process a)
forall a. Typeable a => Static (a -> Process a)
returnProcessStatic

-- | 'CP' version of ('Control.Arrow.***')
splitCP :: (Typeable a, Typeable b, Typeable c, Typeable d)
        => CP a c -> CP b d -> CP (a, b) (c, d)
splitCP :: forall a b c d.
(Typeable a, Typeable b, Typeable c, Typeable d) =>
CP a c -> CP b d -> CP (a, b) (c, d)
splitCP CP a c
p CP b d
q = Static
  ((a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d))
forall a c b d.
Static
  ((a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d))
cpSplitStatic Static
  ((a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d))
-> CP a c -> Closure ((b -> Process d) -> (a, b) -> Process (c, d))
forall a b. Static (a -> b) -> Closure a -> Closure b
`closureApplyStatic` CP a c
p Closure ((b -> Process d) -> (a, b) -> Process (c, d))
-> CP b d -> Closure ((a, b) -> Process (c, d))
forall a b. Closure (a -> b) -> Closure a -> Closure b
`closureApply` CP b d
q
  where
    cpSplitStatic :: Static ((a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d))
    cpSplitStatic :: forall a c b d.
Static
  ((a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d))
cpSplitStatic = String
-> Static
     ((a -> Process c) -> (b -> Process d) -> (a, b) -> Process (c, d))
forall a. String -> Static a
staticLabel String
"$cpSplit"

-- | 'CP' version of 'Control.Monad.return'
returnCP :: forall a. Serializable a
         => Static (SerializableDict a) -> a -> Closure (Process a)
returnCP :: forall a.
Serializable a =>
Static (SerializableDict a) -> a -> Closure (Process a)
returnCP Static (SerializableDict a)
dict a
x = Static (ByteString -> Process a)
-> ByteString -> Closure (Process a)
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure Static (ByteString -> Process a)
decoder (a -> ByteString
forall a. Binary a => a -> ByteString
encode a
x)
  where
    decoder :: Static (ByteString -> Process a)
    decoder :: Static (ByteString -> Process a)
decoder = Static (a -> Process a)
forall a. Typeable a => Static (a -> Process a)
returnProcessStatic
            Static (a -> Process a)
-> Static (ByteString -> a) -> Static (ByteString -> Process a)
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 Static (SerializableDict a)
dict

-- | 'CP' version of ('Control.Monad.>>')
seqCP :: (Typeable a, Typeable b)
      => Closure (Process a) -> Closure (Process b) -> Closure (Process b)
seqCP :: forall a b.
(Typeable a, Typeable b) =>
Closure (Process a) -> Closure (Process b) -> Closure (Process b)
seqCP Closure (Process a)
p Closure (Process b)
q = Static (Process a -> Process b -> Process b)
forall a b.
(Typeable a, Typeable b) =>
Static (Process a -> Process b -> Process b)
seqProcessStatic Static (Process a -> Process b -> Process b)
-> Closure (Process a) -> Closure (Process b -> Process b)
forall a b. Static (a -> b) -> Closure a -> Closure b
`closureApplyStatic` Closure (Process a)
p Closure (Process b -> Process b)
-> Closure (Process b) -> Closure (Process b)
forall a b. Closure (a -> b) -> Closure a -> Closure b
`closureApply` Closure (Process b)
q
  where
    seqProcessStatic :: (Typeable a, Typeable b)
                     => Static (Process a -> Process b -> Process b)
    seqProcessStatic :: forall a b.
(Typeable a, Typeable b) =>
Static (Process a -> Process b -> Process b)
seqProcessStatic = String -> Static (Process a -> Process b -> Process b)
forall a. String -> Static a
staticLabel String
"$seqProcess"

-- | (Not quite the) 'CP' version of ('Control.Monad.>>=')
bindCP :: forall a b. (Typeable a, Typeable b)
       => Closure (Process a) -> CP a b -> Closure (Process b)
bindCP :: forall a b.
(Typeable a, Typeable b) =>
Closure (Process a) -> CP a b -> Closure (Process b)
bindCP Closure (Process a)
x CP a b
f = Static (Process a -> (a -> Process b) -> Process b)
(Typeable a, Typeable b) =>
Static (Process a -> (a -> Process b) -> Process b)
bindProcessStatic Static (Process a -> (a -> Process b) -> Process b)
-> Closure (Process a) -> Closure ((a -> Process b) -> Process b)
forall a b. Static (a -> b) -> Closure a -> Closure b
`closureApplyStatic` Closure (Process a)
x Closure ((a -> Process b) -> Process b)
-> CP a b -> Closure (Process b)
forall a b. Closure (a -> b) -> Closure a -> Closure b
`closureApply` CP a b
f
  where
    bindProcessStatic :: (Typeable a, Typeable b)
                      => Static (Process a -> (a -> Process b) -> Process b)
    bindProcessStatic :: (Typeable a, Typeable b) =>
Static (Process a -> (a -> Process b) -> Process b)
bindProcessStatic = String -> Static (Process a -> (a -> Process b) -> Process b)
forall a. String -> Static a
staticLabel String
"$bindProcess"

--------------------------------------------------------------------------------
-- CP versions of Cloud Haskell primitives                                    --
--------------------------------------------------------------------------------

decodeProcessIdStatic :: Static (ByteString -> ProcessId)
decodeProcessIdStatic :: Static (ByteString -> ProcessId)
decodeProcessIdStatic = String -> Static (ByteString -> ProcessId)
forall a. String -> Static a
staticLabel String
"$decodeProcessId"

-- | 'CP' version of 'link'
cpLink :: ProcessId -> Closure (Process ())
cpLink :: ProcessId -> Closure (Process ())
cpLink = Static (ByteString -> Process ())
-> ByteString -> Closure (Process ())
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure (Static (ProcessId -> Process ())
linkStatic Static (ProcessId -> Process ())
-> Static (ByteString -> ProcessId)
-> Static (ByteString -> Process ())
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (ByteString -> ProcessId)
decodeProcessIdStatic) (ByteString -> Closure (Process ()))
-> (ProcessId -> ByteString) -> ProcessId -> Closure (Process ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> ByteString
forall a. Binary a => a -> ByteString
encode
  where
    linkStatic :: Static (ProcessId -> Process ())
    linkStatic :: Static (ProcessId -> Process ())
linkStatic = String -> Static (ProcessId -> Process ())
forall a. String -> Static a
staticLabel String
"$link"

-- | 'CP' version of 'unlink'
cpUnlink :: ProcessId -> Closure (Process ())
cpUnlink :: ProcessId -> Closure (Process ())
cpUnlink = Static (ByteString -> Process ())
-> ByteString -> Closure (Process ())
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure (Static (ProcessId -> Process ())
unlinkStatic Static (ProcessId -> Process ())
-> Static (ByteString -> ProcessId)
-> Static (ByteString -> Process ())
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (ByteString -> ProcessId)
decodeProcessIdStatic) (ByteString -> Closure (Process ()))
-> (ProcessId -> ByteString) -> ProcessId -> Closure (Process ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> ByteString
forall a. Binary a => a -> ByteString
encode
  where
    unlinkStatic :: Static (ProcessId -> Process ())
    unlinkStatic :: Static (ProcessId -> Process ())
unlinkStatic = String -> Static (ProcessId -> Process ())
forall a. String -> Static a
staticLabel String
"$unlink"

-- | 'CP' version of 'send'
cpSend :: forall a. Typeable a
       => Static (SerializableDict a) -> ProcessId -> CP a ()
cpSend :: forall a.
Typeable a =>
Static (SerializableDict a) -> ProcessId -> CP a ()
cpSend Static (SerializableDict a)
dict ProcessId
pid = Static (ByteString -> a -> Process ())
-> ByteString -> Closure (a -> Process ())
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure Static (ByteString -> a -> Process ())
decoder (ProcessId -> ByteString
forall a. Binary a => a -> ByteString
encode ProcessId
pid)
  where
    decoder :: Static (ByteString -> a -> Process ())
    decoder :: Static (ByteString -> a -> Process ())
decoder = (Static (SerializableDict a -> ProcessId -> a -> Process ())
Typeable a =>
Static (SerializableDict a -> ProcessId -> a -> Process ())
sendDictStatic Static (SerializableDict a -> ProcessId -> a -> Process ())
-> Static (SerializableDict a)
-> Static (ProcessId -> a -> Process ())
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (SerializableDict a)
dict)
            Static (ProcessId -> a -> Process ())
-> Static (ByteString -> ProcessId)
-> Static (ByteString -> a -> Process ())
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose`
              Static (ByteString -> ProcessId)
decodeProcessIdStatic

    sendDictStatic :: Typeable a
                   => Static (SerializableDict a -> ProcessId -> a -> Process ())
    sendDictStatic :: Typeable a =>
Static (SerializableDict a -> ProcessId -> a -> Process ())
sendDictStatic = String
-> Static (SerializableDict a -> ProcessId -> a -> Process ())
forall a. String -> Static a
staticLabel String
"$sendDict"

-- | 'CP' version of 'expect'
cpExpect :: Typeable a => Static (SerializableDict a) -> Closure (Process a)
cpExpect :: forall a.
Typeable a =>
Static (SerializableDict a) -> Closure (Process a)
cpExpect Static (SerializableDict a)
dict = Static (Process a) -> Closure (Process a)
forall a. Static a -> Closure a
staticClosure (Static (SerializableDict a -> Process a)
forall a. Typeable a => Static (SerializableDict a -> Process a)
expectDictStatic Static (SerializableDict a -> Process a)
-> Static (SerializableDict a) -> Static (Process a)
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (SerializableDict a)
dict)
  where
    expectDictStatic :: Typeable a => Static (SerializableDict a -> Process a)
    expectDictStatic :: forall a. Typeable a => Static (SerializableDict a -> Process a)
expectDictStatic = String -> Static (SerializableDict a -> Process a)
forall a. String -> Static a
staticLabel String
"$expectDict"

-- | 'CP' version of 'newChan'
cpNewChan :: Typeable a
          => Static (SerializableDict a)
          -> Closure (Process (SendPort a, ReceivePort a))
cpNewChan :: forall a.
Typeable a =>
Static (SerializableDict a)
-> Closure (Process (SendPort a, ReceivePort a))
cpNewChan Static (SerializableDict a)
dict = Static (Process (SendPort a, ReceivePort a))
-> Closure (Process (SendPort a, ReceivePort a))
forall a. Static a -> Closure a
staticClosure (Static (SerializableDict a -> Process (SendPort a, ReceivePort a))
forall a.
Typeable a =>
Static (SerializableDict a -> Process (SendPort a, ReceivePort a))
newChanDictStatic Static (SerializableDict a -> Process (SendPort a, ReceivePort a))
-> Static (SerializableDict a)
-> Static (Process (SendPort a, ReceivePort a))
forall a b. Static (a -> b) -> Static a -> Static b
`staticApply` Static (SerializableDict a)
dict)
  where
    newChanDictStatic :: Typeable a
                      => Static (SerializableDict a -> Process (SendPort a, ReceivePort a))
    newChanDictStatic :: forall a.
Typeable a =>
Static (SerializableDict a -> Process (SendPort a, ReceivePort a))
newChanDictStatic = String
-> Static
     (SerializableDict a -> Process (SendPort a, ReceivePort a))
forall a. String -> Static a
staticLabel String
"$newChanDict"

-- | 'CP' version of 'relay'
cpRelay :: ProcessId -> Closure (Process ())
cpRelay :: ProcessId -> Closure (Process ())
cpRelay = Static (ByteString -> Process ())
-> ByteString -> Closure (Process ())
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure (Static (ProcessId -> Process ())
relayStatic Static (ProcessId -> Process ())
-> Static (ByteString -> ProcessId)
-> Static (ByteString -> Process ())
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (ByteString -> ProcessId)
decodeProcessIdStatic) (ByteString -> Closure (Process ()))
-> (ProcessId -> ByteString) -> ProcessId -> Closure (Process ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> ByteString
forall a. Binary a => a -> ByteString
encode
  where
    relayStatic :: Static (ProcessId -> Process ())
    relayStatic :: Static (ProcessId -> Process ())
relayStatic = String -> Static (ProcessId -> Process ())
forall a. String -> Static a
staticLabel String
"$relay"

-- TODO: move cpEnableTraceRemote into Trace/Primitives.hs

cpEnableTraceRemote :: ProcessId -> Closure (Process ())
cpEnableTraceRemote :: ProcessId -> Closure (Process ())
cpEnableTraceRemote =
    Static (ByteString -> Process ())
-> ByteString -> Closure (Process ())
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure (Static (ProcessId -> Process ())
enableTraceStatic Static (ProcessId -> Process ())
-> Static (ByteString -> ProcessId)
-> Static (ByteString -> Process ())
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (ByteString -> ProcessId)
decodeProcessIdStatic) (ByteString -> Closure (Process ()))
-> (ProcessId -> ByteString) -> ProcessId -> Closure (Process ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> ByteString
forall a. Binary a => a -> ByteString
encode
  where
    enableTraceStatic :: Static (ProcessId -> Process ())
    enableTraceStatic :: Static (ProcessId -> Process ())
enableTraceStatic = String -> Static (ProcessId -> Process ())
forall a. String -> Static a
staticLabel String
"$enableTraceRemote"

--------------------------------------------------------------------------------
-- Support for spawn                                                          --
--------------------------------------------------------------------------------

-- | @delay them p@ is a process that waits for a signal (a message of type @()@)
-- from 'them' (origin is not verified) before proceeding as @p@. In order to
-- avoid waiting forever, @delay them p@ monitors 'them'. If it receives a
-- monitor message instead, it proceeds as @p@ too.
delay :: ProcessId -> Process () -> Process ()
delay :: ProcessId -> Process () -> Process ()
delay ProcessId
them Process ()
p = do
  MonitorRef
ref <- ProcessId -> Process MonitorRef
monitor ProcessId
them
  let sameRef :: ProcessMonitorNotification -> Bool
sameRef (ProcessMonitorNotification MonitorRef
ref' ProcessId
_ DiedReason
_) = MonitorRef
ref MonitorRef -> MonitorRef -> Bool
forall a. Eq a => a -> a -> Bool
== MonitorRef
ref'
  [Match ()] -> Process ()
forall b. [Match b] -> Process b
receiveWait [
      (() -> Process ()) -> Match ()
forall a b. Serializable a => (a -> Process b) -> Match b
match           ((() -> Process ()) -> Match ()) -> (() -> Process ()) -> Match ()
forall a b. (a -> b) -> a -> b
$ \() -> MonitorRef -> Process ()
unmonitor MonitorRef
ref
    , (ProcessMonitorNotification -> Bool)
-> (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b.
Serializable a =>
(a -> Bool) -> (a -> Process b) -> Match b
matchIf ProcessMonitorNotification -> Bool
sameRef ((ProcessMonitorNotification -> Process ()) -> Match ())
-> (ProcessMonitorNotification -> Process ()) -> Match ()
forall a b. (a -> b) -> a -> b
$ \ProcessMonitorNotification
_  -> () -> Process ()
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ]
  Process ()
p

-- | 'CP' version of 'delay'
cpDelayed :: ProcessId -> Closure (Process ()) -> Closure (Process ())
cpDelayed :: ProcessId -> Closure (Process ()) -> Closure (Process ())
cpDelayed = Closure (Process () -> Process ())
-> Closure (Process ()) -> Closure (Process ())
forall a b. Closure (a -> b) -> Closure a -> Closure b
closureApply (Closure (Process () -> Process ())
 -> Closure (Process ()) -> Closure (Process ()))
-> (ProcessId -> Closure (Process () -> Process ()))
-> ProcessId
-> Closure (Process ())
-> Closure (Process ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> Closure (Process () -> Process ())
cpDelay'
  where
    cpDelay' :: ProcessId -> Closure (Process () -> Process ())
    cpDelay' :: ProcessId -> Closure (Process () -> Process ())
cpDelay' ProcessId
pid = Static (ByteString -> Process () -> Process ())
-> ByteString -> Closure (Process () -> Process ())
forall a. Static (ByteString -> a) -> ByteString -> Closure a
closure Static (ByteString -> Process () -> Process ())
decoder (ProcessId -> ByteString
forall a. Binary a => a -> ByteString
encode ProcessId
pid)

    decoder :: Static (ByteString -> Process () -> Process ())
    decoder :: Static (ByteString -> Process () -> Process ())
decoder = Static (ProcessId -> Process () -> Process ())
delayStatic Static (ProcessId -> Process () -> Process ())
-> Static (ByteString -> ProcessId)
-> Static (ByteString -> Process () -> Process ())
forall b c a. Static (b -> c) -> Static (a -> b) -> Static (a -> c)
`staticCompose` Static (ByteString -> ProcessId)
decodeProcessIdStatic

    delayStatic :: Static (ProcessId -> Process () -> Process ())
    delayStatic :: Static (ProcessId -> Process () -> Process ())
delayStatic = String -> Static (ProcessId -> Process () -> Process ())
forall a. String -> Static a
staticLabel String
"$delay"