module Simulation.Aivika.Internal.Process
(
ProcessId,
Process(..),
ProcessLift(..),
invokeProcess,
runProcess,
runProcessUsingId,
runProcessInStartTime,
runProcessInStartTimeUsingId,
runProcessInStopTime,
runProcessInStopTimeUsingId,
spawnProcess,
spawnProcessUsingId,
spawnProcessWith,
spawnProcessUsingIdWith,
enqueueProcess,
enqueueProcessUsingId,
newProcessId,
processId,
processUsingId,
holdProcess,
interruptProcess,
processInterrupted,
processInterruptionTime,
passivateProcess,
passivateProcessBefore,
processPassive,
reactivateProcess,
reactivateProcessImmediately,
cancelProcessWithId,
cancelProcess,
processCancelled,
processCancelling,
whenCancellingProcess,
processAwait,
processPreemptionBegin,
processPreemptionEnd,
processPreemptionBeginning,
processPreemptionEnding,
processYield,
timeoutProcess,
timeoutProcessUsingId,
processParallel,
processParallelUsingIds,
processParallel_,
processParallelUsingIds_,
catchProcess,
finallyProcess,
throwProcess,
processWithPriority,
zipProcessParallel,
zip3ProcessParallel,
unzipProcess,
memoProcess,
neverProcess,
retryProcess,
transferProcess,
traceProcess) where
import Data.Maybe
import Data.IORef
import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fail
import qualified Control.Monad.Catch as MC
import Control.Applicative
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Parameter
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Cont
import Simulation.Aivika.Signal
data ProcessId =
ProcessId { ProcessId -> IORef Bool
processStarted :: IORef Bool,
ProcessId -> IORef (Maybe (ContParams ()))
processReactCont :: IORef (Maybe (ContParams ())),
ProcessId -> IORef EventPriority
processReactPriority :: IORef Int,
ProcessId -> ContId
processContId :: ContId,
ProcessId -> IORef Bool
processInterruptRef :: IORef Bool,
ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont :: IORef (Maybe (ContParams ())),
ProcessId -> IORef Double
processInterruptTime :: IORef Double,
ProcessId -> IORef EventPriority
processInterruptVersion :: IORef Int,
ProcessId -> IORef EventPriority
processInterruptPriority :: IORef Int }
newtype Process a = Process (ProcessId -> Cont a)
class ProcessLift m where
liftProcess :: Process a -> m a
instance ProcessLift Process where
liftProcess :: forall a. Process a -> Process a
liftProcess = forall a. a -> a
id
invokeProcess :: ProcessId -> Process a -> Cont a
{-# INLINE invokeProcess #-}
invokeProcess :: forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process ProcessId -> Cont a
m) = ProcessId -> Cont a
m ProcessId
pid
holdProcess :: Double -> Process ()
holdProcess :: Double -> Process ()
holdProcess Double
dt =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
dt forall a. Ord a => a -> a -> Bool
< Double
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error [Char]
"Time period dt < 0: holdProcess"
let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont ProcessId
pid
t :: Double
t = Point -> Double
pointTime Point
p forall a. Num a => a -> a -> a
+ Double
dt
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams ()
c
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
False
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid) Double
t
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef EventPriority
processInterruptPriority ProcessId
pid) (Point -> EventPriority
pointPriority Point
p)
EventPriority
v <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processInterruptVersion ProcessId
pid)
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do EventPriority
v' <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processInterruptVersion ProcessId
pid)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventPriority
v forall a. Eq a => a -> a -> Bool
== EventPriority
v') forall a b. (a -> b) -> a -> b
$
do forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
interruptProcess :: ProcessId -> Event ()
interruptProcess :: ProcessId -> Event ()
interruptProcess ProcessId
pid =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
case Maybe (ContParams ())
a of
Maybe (ContParams ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams ()
c ->
do EventPriority
priority <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processInterruptPriority ProcessId
pid)
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
True
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ProcessId -> IORef EventPriority
processInterruptVersion ProcessId
pid) forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+) EventPriority
1
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority (Point -> Double
pointTime Point
p) EventPriority
priority forall a b. (a -> b) -> a -> b
$
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
processInterrupted :: ProcessId -> Event Bool
processInterrupted :: ProcessId -> Event Bool
processInterrupted ProcessId
pid =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid)
processInterruptionTime :: ProcessId -> Event (Maybe Double)
processInterruptionTime :: ProcessId -> Event (Maybe Double)
processInterruptionTime ProcessId
pid =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
case Maybe (ContParams ())
a of
Just ContParams ()
c ->
do Double
t <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Double
t)
Maybe (ContParams ())
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
processPreempted :: ProcessId -> Event ()
processPreempted :: ProcessId -> Event ()
processPreempted ProcessId
pid =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
case Maybe (ContParams ())
a of
Just ContParams ()
c ->
do EventPriority
priority <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processInterruptPriority ProcessId
pid)
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
True
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ProcessId -> IORef EventPriority
processInterruptVersion ProcessId
pid) forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+) EventPriority
1
Double
t <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid)
let dt :: Double
dt = Double
t forall a. Num a => a -> a -> a
- Point -> Double
pointTime Point
p
c' :: ContParams ()
c' = forall a. ContParams a -> (a -> Event ()) -> ContParams a
substituteCont ContParams ()
c forall a b. (a -> b) -> a -> b
$ \()
a ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c forall a b. (a -> b) -> a -> b
$
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid forall a b. (a -> b) -> a -> b
$
EventPriority -> Process ()
processWithPriority EventPriority
priority forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Process ()
holdProcess Double
dt
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall a. ContParams a -> a -> Event ()
reenterCont ContParams ()
c' ()
Maybe (ContParams ())
Nothing ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
case Maybe (ContParams ())
a of
Maybe (ContParams ())
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams ()
c ->
do let c' :: ContParams ()
c' = forall a. ContParams a -> (a -> Event ()) -> ContParams a
substituteCont ContParams ()
c forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
reenterCont ContParams ()
c
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams ()
c'
passivateProcess :: Process ()
passivateProcess :: Process ()
passivateProcess =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
case Maybe (ContParams ())
a of
Maybe (ContParams ())
Nothing ->
do forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams ()
c
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef EventPriority
processReactPriority ProcessId
pid) (Point -> EventPriority
pointPriority Point
p)
Just ContParams ()
_ ->
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot passivate the process twice: passivateProcess"
passivateProcessBefore :: Event () -> Process ()
passivateProcessBefore :: Event () -> Process ()
passivateProcessBefore Event ()
m =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
case Maybe (ContParams ())
a of
Maybe (ContParams ())
Nothing ->
do forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams ()
c
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef EventPriority
processReactPriority ProcessId
pid) (Point -> EventPriority
pointPriority Point
p)
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
m
Just ContParams ()
_ ->
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot passivate the process twice: passivateProcessBefore"
processPassive :: ProcessId -> Event Bool
processPassive :: ProcessId -> Event Bool
processPassive ProcessId
pid =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust Maybe (ContParams ())
a
reactivateProcess :: ProcessId -> Event ()
reactivateProcess :: ProcessId -> Event ()
reactivateProcess ProcessId
pid =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
case Maybe (ContParams ())
a of
Maybe (ContParams ())
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams ()
c ->
do EventPriority
priority <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processReactPriority ProcessId
pid)
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority (Point -> Double
pointTime Point
p) EventPriority
priority forall a b. (a -> b) -> a -> b
$
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
reactivateProcessImmediately :: ProcessId -> Event ()
reactivateProcessImmediately :: ProcessId -> Event ()
reactivateProcessImmediately ProcessId
pid =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
case Maybe (ContParams ())
a of
Maybe (ContParams ())
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams ()
c ->
do EventPriority
priority <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processReactPriority ProcessId
pid)
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
if EventPriority
priority forall a. Eq a => a -> a -> Bool
== Point -> EventPriority
pointPriority Point
p
then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
else forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority (Point -> Double
pointTime Point
p) EventPriority
priority forall a b. (a -> b) -> a -> b
$
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
processIdPrepare :: ProcessId -> Event ()
processIdPrepare :: ProcessId -> Event ()
processIdPrepare ProcessId
pid =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Bool
y <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Bool
processStarted ProcessId
pid)
if Bool
y
then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"Another process with the specified identifier " forall a. [a] -> [a] -> [a]
++
[Char]
"has been started already: processIdPrepare"
else forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processStarted ProcessId
pid) Bool
True
let signal :: Signal ContEvent
signal = ContId -> Signal ContEvent
contSignal forall a b. (a -> b) -> a -> b
$ ProcessId -> ContId
processContId ProcessId
pid
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ Signal ContEvent
signal forall a b. (a -> b) -> a -> b
$ \ContEvent
e ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
case ContEvent
e of
ContEvent
ContCancellationInitiating ->
do Bool
z <- ContId -> IO Bool
contCancellationActivated forall a b. (a -> b) -> a -> b
$ ProcessId -> ContId
processContId ProcessId
pid
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$
do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
interruptProcess ProcessId
pid
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
reactivateProcess ProcessId
pid
ContEvent
ContPreemptionBeginning ->
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processPreempted ProcessId
pid
ContEvent
ContPreemptionEnding ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runProcess :: Process () -> Event ()
runProcess :: Process () -> Event ()
runProcess Process ()
p =
do ProcessId
pid <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p
runProcessUsingId :: ProcessId -> Process () -> Event ()
runProcessUsingId :: ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p =
do ProcessId -> Event ()
processIdPrepare ProcessId
pid
forall a.
Cont a
-> (a -> Event ())
-> (SomeException -> Event ())
-> (() -> Event ())
-> ContId
-> Bool
-> Event ()
runCont Cont ()
m forall {a}. a -> Event a
cont forall {a}. SomeException -> Event a
econt forall {a}. a -> Event a
ccont (ProcessId -> ContId
processContId ProcessId
pid) Bool
False
where cont :: a -> Event a
cont = forall (m :: * -> *) a. Monad m => a -> m a
return
econt :: SomeException -> Event a
econt = forall e a. Exception e => e -> Event a
throwEvent
ccont :: a -> Event a
ccont = forall (m :: * -> *) a. Monad m => a -> m a
return
m :: Cont ()
m = forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process ()
p
runProcessInStartTime :: Process () -> Simulation ()
runProcessInStartTime :: Process () -> Simulation ()
runProcessInStartTime = forall a. Event a -> Simulation a
runEventInStartTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process () -> Event ()
runProcess
runProcessInStartTimeUsingId :: ProcessId -> Process () -> Simulation ()
runProcessInStartTimeUsingId :: ProcessId -> Process () -> Simulation ()
runProcessInStartTimeUsingId ProcessId
pid Process ()
p =
forall a. Event a -> Simulation a
runEventInStartTime forall a b. (a -> b) -> a -> b
$ ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p
runProcessInStopTime :: Process () -> Simulation ()
runProcessInStopTime :: Process () -> Simulation ()
runProcessInStopTime = forall a. Event a -> Simulation a
runEventInStopTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process () -> Event ()
runProcess
runProcessInStopTimeUsingId :: ProcessId -> Process () -> Simulation ()
runProcessInStopTimeUsingId :: ProcessId -> Process () -> Simulation ()
runProcessInStopTimeUsingId ProcessId
pid Process ()
p =
forall a. Event a -> Simulation a
runEventInStopTime forall a b. (a -> b) -> a -> b
$ ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p
enqueueProcess :: Double -> Process () -> Event ()
enqueueProcess :: Double -> Process () -> Event ()
enqueueProcess Double
t Process ()
p =
Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ Process () -> Event ()
runProcess Process ()
p
enqueueProcessUsingId :: Double -> ProcessId -> Process () -> Event ()
enqueueProcessUsingId :: Double -> ProcessId -> Process () -> Event ()
enqueueProcessUsingId Double
t ProcessId
pid Process ()
p =
Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p
processId :: Process ProcessId
processId :: Process ProcessId
processId = forall a. (ProcessId -> Cont a) -> Process a
Process forall (m :: * -> *) a. Monad m => a -> m a
return
newProcessId :: Simulation ProcessId
newProcessId :: Simulation ProcessId
newProcessId =
do IORef (Maybe (ContParams ()))
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
IORef Bool
y <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
ContId
c <- Simulation ContId
newContId
IORef Bool
i <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
IORef (Maybe (ContParams ()))
z <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
IORef Double
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Double
0
IORef EventPriority
v <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef EventPriority
0
IORef EventPriority
priority1 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef EventPriority
0
IORef EventPriority
priority2 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef EventPriority
0
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessId { processStarted :: IORef Bool
processStarted = IORef Bool
y,
processReactCont :: IORef (Maybe (ContParams ()))
processReactCont = IORef (Maybe (ContParams ()))
x,
processReactPriority :: IORef EventPriority
processReactPriority = IORef EventPriority
priority1,
processContId :: ContId
processContId = ContId
c,
processInterruptRef :: IORef Bool
processInterruptRef = IORef Bool
i,
processInterruptCont :: IORef (Maybe (ContParams ()))
processInterruptCont = IORef (Maybe (ContParams ()))
z,
processInterruptTime :: IORef Double
processInterruptTime = IORef Double
t,
processInterruptVersion :: IORef EventPriority
processInterruptVersion = IORef EventPriority
v,
processInterruptPriority :: IORef EventPriority
processInterruptPriority = IORef EventPriority
priority2 }
cancelProcessWithId :: ProcessId -> Event ()
cancelProcessWithId :: ProcessId -> Event ()
cancelProcessWithId ProcessId
pid = ContId -> Event ()
contCancellationInitiate (ProcessId -> ContId
processContId ProcessId
pid)
cancelProcess :: Process a
cancelProcess :: forall a. Process a
cancelProcess =
do ProcessId
pid <- Process ProcessId
processId
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
cancelProcessWithId ProcessId
pid
forall e a. Exception e => e -> Process a
throwProcess forall a b. (a -> b) -> a -> b
$
(forall a. HasCallStack => [Char] -> a
error [Char]
"The process must be cancelled already: cancelProcess." :: SomeException)
processCancelled :: ProcessId -> Event Bool
processCancelled :: ProcessId -> Event Bool
processCancelled ProcessId
pid = ContId -> Event Bool
contCancellationInitiated (ProcessId -> ContId
processContId ProcessId
pid)
processCancelling :: ProcessId -> Signal ()
processCancelling :: ProcessId -> Signal ()
processCancelling ProcessId
pid = ContId -> Signal ()
contCancellationInitiating (ProcessId -> ContId
processContId ProcessId
pid)
whenCancellingProcess :: Event () -> Process ()
whenCancellingProcess :: Event () -> Process ()
whenCancellingProcess Event ()
h =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ (ProcessId -> Signal ()
processCancelling ProcessId
pid) forall a b. (a -> b) -> a -> b
$ \() -> Event ()
h
processPreemptionBegin :: ProcessId -> Event ()
processPreemptionBegin :: ProcessId -> Event ()
processPreemptionBegin ProcessId
pid = ContId -> Event ()
contPreemptionBegin (ProcessId -> ContId
processContId ProcessId
pid)
processPreemptionEnd :: ProcessId -> Event ()
processPreemptionEnd :: ProcessId -> Event ()
processPreemptionEnd ProcessId
pid = ContId -> Event ()
contPreemptionEnd (ProcessId -> ContId
processContId ProcessId
pid)
processPreemptionBeginning :: ProcessId -> Signal ()
processPreemptionBeginning :: ProcessId -> Signal ()
processPreemptionBeginning ProcessId
pid = ContId -> Signal ()
contPreemptionBeginning (ProcessId -> ContId
processContId ProcessId
pid)
processPreemptionEnding :: ProcessId -> Signal ()
processPreemptionEnding :: ProcessId -> Signal ()
processPreemptionEnding ProcessId
pid = ContId -> Signal ()
contPreemptionEnding (ProcessId -> ContId
processContId ProcessId
pid)
instance Eq ProcessId where
ProcessId
x == :: ProcessId -> ProcessId -> Bool
== ProcessId
y = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
x forall a. Eq a => a -> a -> Bool
== ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
y
instance Monad Process where
Process a
m >>= :: forall a b. Process a -> (a -> Process b) -> Process b
>>= a -> Process b
k = forall a b. Process a -> (a -> Process b) -> Process b
bindP Process a
m a -> Process b
k
instance Functor Process where
fmap :: forall a b. (a -> b) -> Process a -> Process b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative Process where
pure :: forall a. a -> Process a
pure = forall a. a -> Process a
returnP
<*> :: forall a b. Process (a -> b) -> Process a -> Process b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance MonadFail Process where
fail :: forall a. [Char] -> Process a
fail = forall a. HasCallStack => [Char] -> a
error
instance ParameterLift Process where
liftParameter :: forall a. Parameter a -> Process a
liftParameter = forall a. Parameter a -> Process a
liftPP
instance SimulationLift Process where
liftSimulation :: forall a. Simulation a -> Process a
liftSimulation = forall a. Simulation a -> Process a
liftSP
instance DynamicsLift Process where
liftDynamics :: forall a. Dynamics a -> Process a
liftDynamics = forall a. Dynamics a -> Process a
liftDP
instance EventLift Process where
liftEvent :: forall a. Event a -> Process a
liftEvent = forall a. Event a -> Process a
liftEP
instance MonadIO Process where
liftIO :: forall a. IO a -> Process a
liftIO = forall a. IO a -> Process a
liftIOP
instance MC.MonadThrow Process where
throwM :: forall e a. Exception e => e -> Process a
throwM = forall e a. Exception e => e -> Process a
throwProcess
instance MC.MonadCatch Process where
catch :: forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catch = forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess
returnP :: a -> Process a
{-# INLINE returnP #-}
returnP :: forall a. a -> Process a
returnP a
a = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
bindP :: Process a -> (a -> Process b) -> Process b
{-# INLINE bindP #-}
bindP :: forall a b. Process a -> (a -> Process b) -> Process b
bindP (Process ProcessId -> Cont a
m) a -> Process b
k =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
do a
a <- ProcessId -> Cont a
m ProcessId
pid
let Process ProcessId -> Cont b
m' = a -> Process b
k a
a
ProcessId -> Cont b
m' ProcessId
pid
liftPP :: Parameter a -> Process a
{-# INLINE liftPP #-}
liftPP :: forall a. Parameter a -> Process a
liftPP Parameter a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter a
m
liftSP :: Simulation a -> Process a
{-# INLINE liftSP #-}
liftSP :: forall a. Simulation a -> Process a
liftSP Simulation a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation a
m
liftDP :: Dynamics a -> Process a
{-# INLINE liftDP #-}
liftDP :: forall a. Dynamics a -> Process a
liftDP Dynamics a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics a
m
liftEP :: Event a -> Process a
{-# INLINE liftEP #-}
liftEP :: forall a. Event a -> Process a
liftEP Event a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent Event a
m
liftIOP :: IO a -> Process a
{-# INLINE liftIOP #-}
liftIOP :: forall a. IO a -> Process a
liftIOP IO a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
catchProcess :: Exception e => Process a -> (e -> Process a) -> Process a
catchProcess :: forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess (Process ProcessId -> Cont a
m) e -> Process a
h =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall e a. Exception e => Cont a -> (e -> Cont a) -> Cont a
catchCont (ProcessId -> Cont a
m ProcessId
pid) forall a b. (a -> b) -> a -> b
$ \e
e ->
let Process ProcessId -> Cont a
m' = e -> Process a
h e
e in ProcessId -> Cont a
m' ProcessId
pid
finallyProcess :: Process a -> Process b -> Process a
finallyProcess :: forall a b. Process a -> Process b -> Process a
finallyProcess (Process ProcessId -> Cont a
m) (Process ProcessId -> Cont b
m') =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a b. Cont a -> Cont b -> Cont a
finallyCont (ProcessId -> Cont a
m ProcessId
pid) (ProcessId -> Cont b
m' ProcessId
pid)
throwProcess :: Exception e => e -> Process a
throwProcess :: forall e a. Exception e => e -> Process a
throwProcess = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Exception e => e -> a
throw
processWithPriority :: EventPriority -> Process ()
processWithPriority :: EventPriority -> Process ()
processWithPriority EventPriority
priority =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
if EventPriority
priority forall a. Eq a => a -> a -> Bool
== Point -> EventPriority
pointPriority Point
p
then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
else forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority (Point -> Double
pointTime Point
p) EventPriority
priority forall a b. (a -> b) -> a -> b
$
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
processParallel :: [Process a] -> Process [a]
processParallel :: forall a. [Process a] -> Process [a]
processParallel [Process a]
xs =
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (forall a. [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [(ProcessId, Process a)] -> Process [a]
processParallelUsingIds
processParallelUsingIds :: [(ProcessId, Process a)] -> Process [a]
processParallelUsingIds :: forall a. [(ProcessId, Process a)] -> Process [a]
processParallelUsingIds [(ProcessId, Process a)]
xs =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
do forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall a. [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs
forall a. [(Cont a, ContId)] -> Cont [a]
contParallel forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId, Process a)]
xs forall a b. (a -> b) -> a -> b
$ \(ProcessId
pid, Process a
m) ->
(forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
m, ProcessId -> ContId
processContId ProcessId
pid)
processParallel_ :: [Process a] -> Process ()
processParallel_ :: forall a. [Process a] -> Process ()
processParallel_ [Process a]
xs =
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (forall a. [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_
processParallelUsingIds_ :: [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_ :: forall a. [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_ [(ProcessId, Process a)]
xs =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
do forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall a. [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs
forall a. [(Cont a, ContId)] -> Cont ()
contParallel_ forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId, Process a)]
xs forall a b. (a -> b) -> a -> b
$ \(ProcessId
pid, Process a
m) ->
(forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
m, ProcessId -> ContId
processContId ProcessId
pid)
processParallelCreateIds :: [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds :: forall a. [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs =
do [ProcessId]
pids <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Process a]
xs forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Simulation ProcessId
newProcessId
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [ProcessId]
pids [Process a]
xs
processParallelPrepare :: [(ProcessId, Process a)] -> Event ()
processParallelPrepare :: forall a. [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ProcessId, Process a)]
xs forall a b. (a -> b) -> a -> b
$ forall a. Point -> Event a -> IO a
invokeEvent Point
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> Event ()
processIdPrepare forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
processUsingId :: ProcessId -> Process a -> Process a
processUsingId :: forall a. ProcessId -> Process a -> Process a
processUsingId ProcessId
pid Process a
x =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid' ->
do forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processIdPrepare ProcessId
pid
forall a. Cont a -> ContId -> Cont a
rerunCont (forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
x) (ProcessId -> ContId
processContId ProcessId
pid)
spawnProcess :: Process () -> Process ()
spawnProcess :: Process () -> Process ()
spawnProcess = ContCancellation -> Process () -> Process ()
spawnProcessWith ContCancellation
CancelTogether
spawnProcessUsingId :: ProcessId -> Process () -> Process ()
spawnProcessUsingId :: ProcessId -> Process () -> Process ()
spawnProcessUsingId = ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
CancelTogether
spawnProcessWith :: ContCancellation -> Process () -> Process ()
spawnProcessWith :: ContCancellation -> Process () -> Process ()
spawnProcessWith ContCancellation
cancellation Process ()
x =
do ProcessId
pid <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
cancellation ProcessId
pid Process ()
x
spawnProcessUsingIdWith :: ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith :: ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
cancellation ProcessId
pid Process ()
x =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid' ->
do forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processIdPrepare ProcessId
pid
ContCancellation -> Cont () -> ContId -> Cont ()
spawnCont ContCancellation
cancellation (forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process ()
x) (ProcessId -> ContId
processContId ProcessId
pid)
processAwait :: Signal a -> Process a
processAwait :: forall a. Signal a -> Process a
processAwait Signal a
signal =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall a. Signal a -> Cont a
contAwait Signal a
signal
data MemoResult a = MemoComputed a
| MemoError IOException
| MemoCancelled
memoProcess :: Process a -> Simulation (Process a)
memoProcess :: forall a. Process a -> Simulation (Process a)
memoProcess Process a
x =
do IORef Bool
started <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
SignalSource ()
computed <- forall a. Simulation (SignalSource a)
newSignalSource
IORef (Maybe (MemoResult a))
value <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
let result :: Process a
result =
do Just MemoResult a
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe (MemoResult a))
value
case MemoResult a
x of
MemoComputed a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
MemoError IOException
e -> forall e a. Exception e => e -> Process a
throwProcess IOException
e
MemoResult a
MemoCancelled -> forall a. Process a
cancelProcess
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
do Maybe (MemoResult a)
v <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe (MemoResult a))
value
case Maybe (MemoResult a)
v of
Just MemoResult a
_ -> Process a
result
Maybe (MemoResult a)
Nothing ->
do Bool
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Bool
started
case Bool
f of
Bool
True ->
do forall a. Signal a -> Process a
processAwait forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource ()
computed
Process a
result
Bool
False ->
do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
started Bool
True
IORef (MemoResult a)
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. MemoResult a
MemoCancelled
forall a b. Process a -> Process b -> Process a
finallyProcess
(forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess
(do a
a <- Process a
x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (MemoResult a)
r (forall a. a -> MemoResult a
MemoComputed a
a))
(\IOException
e ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (MemoResult a)
r (forall a. IOException -> MemoResult a
MemoError IOException
e)))
(forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
do MemoResult a
x <- forall a. IORef a -> IO a
readIORef IORef (MemoResult a)
r
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (MemoResult a))
value (forall a. a -> Maybe a
Just MemoResult a
x)
forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource ()
computed ())
Process a
result
zipProcessParallel :: Process a -> Process b -> Process (a, b)
zipProcessParallel :: forall a b. Process a -> Process b -> Process (a, b)
zipProcessParallel Process a
x Process b
y =
do [Left a
a, Right b
b] <- forall a. [Process a] -> Process [a]
processParallel [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left Process a
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right Process b
y]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
zip3ProcessParallel :: Process a -> Process b -> Process c -> Process (a, b, c)
zip3ProcessParallel :: forall a b c.
Process a -> Process b -> Process c -> Process (a, b, c)
zip3ProcessParallel Process a
x Process b
y Process c
z =
do [Left a
a,
Right (Left b
b),
Right (Right c
c)] <-
forall a. [Process a] -> Process [a]
processParallel [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left Process a
x,
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) Process b
y,
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) Process c
z]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c)
unzipProcess :: Process (a, b) -> Simulation (Process a, Process b)
unzipProcess :: forall a b. Process (a, b) -> Simulation (Process a, Process b)
unzipProcess Process (a, b)
xy =
do Process (a, b)
xy' <- forall a. Process a -> Simulation (Process a)
memoProcess Process (a, b)
xy
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Process (a, b)
xy', forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Process (a, b)
xy')
timeoutProcess :: Double -> Process a -> Process (Maybe a)
timeoutProcess :: forall a. Double -> Process a -> Process (Maybe a)
timeoutProcess Double
timeout Process a
p =
do ProcessId
pid <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
forall a. Double -> ProcessId -> Process a -> Process (Maybe a)
timeoutProcessUsingId Double
timeout ProcessId
pid Process a
p
timeoutProcessUsingId :: Double -> ProcessId -> Process a -> Process (Maybe a)
timeoutProcessUsingId :: forall a. Double -> ProcessId -> Process a -> Process (Maybe a)
timeoutProcessUsingId Double
timeout ProcessId
pid Process a
p =
do SignalSource (Maybe (Either SomeException a))
s <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a. Simulation (SignalSource a)
newSignalSource
ProcessId
timeoutPid <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId
timeoutPid forall a b. (a -> b) -> a -> b
$
do Double -> Process ()
holdProcess Double
timeout
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
ProcessId -> Event ()
cancelProcessWithId ProcessId
pid
ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId
pid forall a b. (a -> b) -> a -> b
$
do IORef (Maybe (Either SomeException a))
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
forall a b. Process a -> Process b -> Process a
finallyProcess
(forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess
(do a
a <- Process a
p
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Either SomeException a))
r forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right a
a))
(\SomeException
e ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Either SomeException a))
r forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left SomeException
e)))
(forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
do ProcessId -> Event ()
cancelProcessWithId ProcessId
timeoutPid
Maybe (Either SomeException a)
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe (Either SomeException a))
r
forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource (Maybe (Either SomeException a))
s Maybe (Either SomeException a)
x)
Maybe (Either SomeException a)
x <- forall a. Signal a -> Process a
processAwait forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource (Maybe (Either SomeException a))
s
case Maybe (Either SomeException a)
x of
Maybe (Either SomeException a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (Right a
a) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
Just (Left (SomeException e
e)) -> forall e a. Exception e => e -> Process a
throwProcess e
e
processYield :: Process ()
processYield :: Process ()
processYield =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) forall a b. (a -> b) -> a -> b
$
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
neverProcess :: Process a
neverProcess :: forall a. Process a
neverProcess =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
let signal :: Signal ()
signal = ProcessId -> Signal ()
processCancelling ProcessId
pid
in forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ Signal ()
signal forall a b. (a -> b) -> a -> b
$ \()
_ ->
forall a. ContParams a -> a -> Event ()
resumeCont ContParams a
c forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"It must never be computed: neverProcess"
retryProcess :: String -> Process a
retryProcess :: forall a. [Char] -> Process a
retryProcess = forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> Event a
retryEvent
transferProcess :: Process () -> Process a
transferProcess :: forall a. Process () -> Process a
transferProcess (Process ProcessId -> Cont ()
m) =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall a. Cont () -> Cont a
transferCont (ProcessId -> Cont ()
m ProcessId
pid)
traceProcess :: String -> Process a -> Process a
traceProcess :: forall a. [Char] -> Process a -> Process a
traceProcess [Char]
message Process a
m =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a. [Char] -> Cont a -> Cont a
traceCont [Char]
message forall a b. (a -> b) -> a -> b
$
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
m