{-# 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
dt forall a. Ord a => a -> a -> Bool
< Double
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error [Char]
"Time period dt < 0: holdProcess"
let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont ProcessId m
pid
t :: Double
t = forall (m :: * -> *). Point m -> Double
pointTime Point m
p forall a. Num a => a -> a -> a
+ Double
dt
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams m ()
c
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ProcessId m -> Ref m Bool
processInterruptRef ProcessId m
pid) Bool
False
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ProcessId m -> Ref m Double
processInterruptTime ProcessId m
pid) Double
t
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptPriority ProcessId m
pid) (forall (m :: * -> *). Point m -> Int
pointPriority Point m
p)
Int
v <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptVersion ProcessId m
pid)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Int
v' <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptVersion ProcessId m
pid)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v forall a. Eq a => a -> a -> Bool
== Int
v') forall a b. (a -> b) -> a -> b
$
do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a. Maybe a
Nothing
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams m ()
c ->
do Int
priority <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptPriority ProcessId m
pid)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a. Maybe a
Nothing
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ProcessId m -> Ref m Bool
processInterruptRef ProcessId m
pid) Bool
True
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptVersion ProcessId m
pid) forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+) Int
1
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority forall a b. (a -> b) -> a -> b
$
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 =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (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 =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Double
processInterruptTime ProcessId m
pid)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Double
t)
Maybe (ContParams m ())
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processInterruptCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptPriority ProcessId m
pid)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a. Maybe a
Nothing
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ProcessId m -> Ref m Bool
processInterruptRef ProcessId m
pid) Bool
True
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processInterruptVersion ProcessId m
pid) forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+) Int
1
Double
t <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Double
processInterruptTime ProcessId m
pid)
let dt :: Double
dt = Double
t forall a. Num a => a -> a -> a
- forall (m :: * -> *). Point m -> Double
pointTime Point m
p
c' :: ContParams m ()
c' = forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> (a -> Event m ()) -> ContParams m a
substituteCont ContParams m ()
c forall a b. (a -> b) -> a -> b
$ \()
a ->
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m ()
c forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). MonadDES m => Int -> Process m ()
processWithPriority Int
priority forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). MonadDES m => Double -> Process m ()
holdProcess Double
dt
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
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 = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams m ()
c ->
do let c' :: ContParams m ()
c' = forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> (a -> Event m ()) -> ContParams m a
substituteCont ContParams m ()
c forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m ()
c
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams m ()
c'
passivateProcess :: MonadDES m => Process m ()
{-# INLINABLE passivateProcess #-}
passivateProcess :: forall (m :: * -> *). MonadDES m => Process m ()
passivateProcess =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams m ()
c
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processReactPriority ProcessId m
pid) (forall (m :: * -> *). Point m -> Int
pointPriority Point m
p)
Just ContParams 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams m ()
c
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processReactPriority ProcessId m
pid) (forall (m :: * -> *). Point m -> Int
pointPriority Point m
p)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
m
Just ContParams 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 =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m ()))
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust Maybe (ContParams m ())
a
reactivateProcess :: MonadDES m => ProcessId m -> Event m ()
{-# INLINABLE reactivateProcess #-}
reactivateProcess :: forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
reactivateProcess ProcessId m
pid =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams m ()
c ->
do Int
priority <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processReactPriority ProcessId m
pid)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a. Maybe a
Nothing
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority forall a b. (a -> b) -> a -> b
$
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 =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let x :: Ref m (Maybe (ContParams m ()))
x = forall (m :: * -> *).
ProcessId m -> Ref m (Maybe (ContParams m ()))
processReactCont ProcessId m
pid
Maybe (ContParams m ())
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ 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 ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams m ()
c ->
do Int
priority <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Int
processReactPriority ProcessId m
pid)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m ()))
x forall a. Maybe a
Nothing
if Int
priority forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). Point m -> Int
pointPriority Point m
p
then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority forall a b. (a -> b) -> a -> b
$
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 =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
y <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ProcessId m -> Ref m Bool
processStarted ProcessId m
pid)
if Bool
y
then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"Another process with the specified identifier " forall a. [a] -> [a] -> [a]
++
[Char]
"has been started already: processIdPrepare"
else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ProcessId m -> Ref m Bool
processStarted ProcessId m
pid) Bool
True
let signal :: Signal m ContEvent
signal = forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Event m ()
handleSignal_ Signal m ContEvent
signal forall a b. (a -> b) -> a -> b
$ \ContEvent
e ->
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
case ContEvent
e of
ContEvent
ContCancellationInitiating ->
do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contCancellationActivated forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$
do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
interruptProcess ProcessId m
pid
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
reactivateProcess ProcessId m
pid
ContEvent
ContPreemptionBeginning ->
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreempted ProcessId m
pid
ContEvent
ContPreemptionEnding ->
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
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 forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processIdPrepare ProcessId m
pid
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 forall {a}. a -> Event m a
cont forall {a}. SomeException -> Event m a
econt forall {a}. a -> Event m a
ccont (forall (m :: * -> *). ProcessId m -> ContId m
processContId ProcessId m
pid) Bool
False
where cont :: a -> Event m a
cont = forall (m :: * -> *) a. Monad m => a -> m a
return
econt :: SomeException -> Event m a
econt = forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent
ccont :: a -> Event m a
ccont = forall (m :: * -> *) a. Monad m => a -> m a
return
m :: Cont m ()
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 = forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStartTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStartTime forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall (m :: * -> *) a. MonadDES m => Event m a -> Simulation m a
runEventInStopTime forall a b. (a -> b) -> a -> b
$ 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 =
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ 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 =
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process 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 =
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do Ref m (Maybe (ContParams m ()))
x <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
Ref m Bool
y <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
ContId m
c <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => Simulation m (ContId m)
newContId
Ref m Bool
i <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
Ref m (Maybe (ContParams m ()))
z <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
Ref m Double
t <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Double
0
Ref m Int
v <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
Ref m Int
priority1 <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
Ref m Int
priority2 <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
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 = forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate (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 <- forall (m :: * -> *). MonadDES m => Process m (ProcessId m)
processId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
cancelProcessWithId ProcessId m
pid
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess forall a b. (a -> b) -> a -> b
$
(forall a. HasCallStack => [Char] -> a
error [Char]
"The process must be cancelled already: cancelProcess." :: SomeException)
processCancelled :: MonadDES m => ProcessId m -> Event m Bool
{-# INLINABLE processCancelled #-}
processCancelled :: forall (m :: * -> *). MonadDES m => ProcessId m -> Event m Bool
processCancelled ProcessId m
pid = forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contCancellationInitiated (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 = forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating (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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Event m ()
handleSignal_ (forall (m :: * -> *). MonadDES m => ProcessId m -> Signal m ()
processCancelling ProcessId m
pid) 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 = forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contPreemptionBegin (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 = forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contPreemptionEnd (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 = forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contPreemptionBeginning (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 = forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contPreemptionEnding (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 = forall (m :: * -> *). ProcessId m -> Ref m Bool
processStarted ProcessId m
x forall a. Eq a => a -> a -> 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process 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 = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f 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 = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> ProcessId m -> Cont m (a -> b)
x ProcessId m
pid 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 = 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 = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> a
id
instance MonadDES m => MC.MonadThrow (Process m) where
{-# INLINE throwM #-}
throwM :: forall e a. Exception e => e -> Process m a
throwM = 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.
Exception e =>
Process m a -> (e -> Process m a) -> Process m a
catch = 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
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) 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') =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if Int
priority forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). Point m -> Int
pointPriority Point m
p
then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority forall a b. (a -> b) -> a -> b
$
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 =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (forall (m :: * -> *) a.
MonadDES m =>
[Process m a] -> Simulation m [(ProcessId m, Process m a)]
processParallelCreateIds [Process m a]
xs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
[(ProcessId m, Process m a)] -> Event m ()
processParallelPrepare [(ProcessId m, Process m a)]
xs
forall (m :: * -> *) a.
MonadDES m =>
[(Cont m a, ContId m)] -> Cont m [a]
contParallel forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId m, Process m a)]
xs forall a b. (a -> b) -> a -> b
$ \(ProcessId m
pid, Process m a
m) ->
(forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m a
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 =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation (forall (m :: * -> *) a.
MonadDES m =>
[Process m a] -> Simulation m [(ProcessId m, Process m a)]
processParallelCreateIds [Process m a]
xs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
[(ProcessId m, Process m a)] -> Event m ()
processParallelPrepare [(ProcessId m, Process m a)]
xs
forall (m :: * -> *) a.
MonadDES m =>
[(Cont m a, ContId m)] -> Cont m ()
contParallel_ forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId m, Process m a)]
xs forall a b. (a -> b) -> a -> b
$ \(ProcessId m
pid, Process m a
m) ->
(forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m a
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Process m a]
xs forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [ProcessId 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 =
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ProcessId m, Process m a)]
xs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processIdPrepare forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid' ->
do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processIdPrepare ProcessId m
pid
forall (m :: * -> *) a.
MonadDES m =>
Cont m a -> ContId m -> Cont m a
rerunCont (forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m a
x) (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 = 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 = 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid' ->
do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processIdPrepare ProcessId m
pid
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> Cont m () -> ContId m -> Cont m ()
spawnCont ContCancellation
cancellation (forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m ()
x) (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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> 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 =
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do Ref m Bool
started <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
SignalSource m ()
computed <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
Ref m (Maybe (MemoResult a))
value <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
let result :: Process m a
result =
do Just MemoResult a
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
MemoError IOException
e -> forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess IOException
e
MemoResult a
MemoCancelled -> forall (m :: * -> *) a. MonadDES m => Process m a
cancelProcess
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
do Maybe (MemoResult a)
v <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Bool
started
case Bool
f of
Bool
True ->
do forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal SignalSource m ()
computed
Process m a
result
Bool
False ->
do forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m Bool
started Bool
True
Ref m (MemoResult a)
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. MemoResult a
MemoCancelled
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess
(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
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (MemoResult a)
r (forall a. a -> MemoResult a
MemoComputed a
a))
(\IOException
e ->
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (MemoResult a)
r (forall a. IOException -> MemoResult a
MemoError IOException
e)))
(forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$
do MemoResult a
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (MemoResult a)
r
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (MemoResult a))
value (forall a. a -> Maybe a
Just MemoResult a
x)
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] <- forall (m :: * -> *) a.
MonadDES m =>
[Process m a] -> Process m [a]
processParallel [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left Process m a
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right Process m b
y]
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)] <-
forall (m :: * -> *) a.
MonadDES m =>
[Process m a] -> Process m [a]
processParallel [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left Process m a
x,
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) Process m b
y,
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) Process m c
z]
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' <- forall (m :: * -> *) a.
MonadDES m =>
Process m a -> Simulation m (Process m a)
memoProcess Process m (a, b)
xy
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Process m (a, b)
xy', forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
ProcessId m
timeoutPid <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall (m :: * -> *). MonadDES m => Simulation m (ProcessId m)
newProcessId
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> ProcessId m -> Process m () -> Process m ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId m
timeoutPid forall a b. (a -> b) -> a -> b
$
do forall (m :: * -> *). MonadDES m => Double -> Process m ()
holdProcess Double
timeout
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
cancelProcessWithId ProcessId m
pid
forall (m :: * -> *).
MonadDES m =>
ContCancellation -> ProcessId m -> Process m () -> Process m ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId m
pid forall a b. (a -> b) -> a -> b
$
do Ref m (Maybe (Either SomeException a))
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SimulationLift t m =>
Simulation m a -> t m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess
(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
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (Either SomeException a))
r forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right a
a))
(\SomeException
e ->
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (Either SomeException a))
r forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left SomeException
e)))
(forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall a b. (a -> b) -> a -> b
$
do forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
cancelProcessWithId ProcessId m
timeoutPid
Maybe (Either SomeException a)
x <- forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (Either SomeException a))
r
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 <- forall (m :: * -> *) a. MonadDES m => Signal m a -> Process m a
processAwait forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just (Right a
a) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
Just (Left (SomeException e
e)) -> forall (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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a b. (a -> b) -> a -> b
$
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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
let signal :: Signal m ()
signal = forall (m :: * -> *). MonadDES m => ProcessId m -> Signal m ()
processCancelling ProcessId m
pid
in forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Event m ()
handleSignal_ Signal m ()
signal forall a b. (a -> b) -> a -> b
$ \()
_ ->
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid -> 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 =
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
forall (m :: * -> *) a.
MonadDES m =>
[Char] -> Cont m a -> Cont m a
traceCont [Char]
message forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid Process m a
m