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