-- |
-- Module     : Simulation.Aivika.Internal.Process
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- This is an internal implementation module that should never be used directly.
--
-- A value in the 'Process' monad represents a discontinuous process that 
-- can suspend in any simulation time point and then resume later in the same 
-- or another time point. 
-- 
-- The process of this type can involve the 'Event', 'Dynamics' and 'Simulation'
-- computations. Moreover, a value in the @Process@ monad can be run within
-- the @Event@ computation.
--
-- A value of the 'ProcessId' type is just an identifier of such a process.
--
-- The characteristic property of the @Process@ type is function 'holdProcess'
-- that suspends the current process for the specified time interval.
--
module Simulation.Aivika.Internal.Process
       (-- * Process Monad
        ProcessId,
        Process(..),
        ProcessLift(..),
        invokeProcess,
        -- * Running Process
        runProcess,
        runProcessUsingId,
        runProcessInStartTime,
        runProcessInStartTimeUsingId,
        runProcessInStopTime,
        runProcessInStopTimeUsingId,
        -- * Spawning Processes
        spawnProcess,
        spawnProcessUsingId,
        spawnProcessWith,
        spawnProcessUsingIdWith,
        -- * Enqueuing Process
        enqueueProcess,
        enqueueProcessUsingId,
        -- * Creating Process Identifier
        newProcessId,
        processId,
        processUsingId,
        -- * Holding, Interrupting, Passivating and Canceling Process
        holdProcess,
        interruptProcess,
        processInterrupted,
        processInterruptionTime,
        passivateProcess,
        passivateProcessBefore,
        processPassive,
        reactivateProcess,
        reactivateProcessImmediately,
        cancelProcessWithId,
        cancelProcess,
        processCancelled,
        processCancelling,
        whenCancellingProcess,
        -- * Awaiting Signal
        processAwait,
        -- * Preemption
        processPreemptionBegin,
        processPreemptionEnd,
        processPreemptionBeginning,
        processPreemptionEnding,
        -- * Yield of Process
        processYield,
        -- * Process Timeout
        timeoutProcess,
        timeoutProcessUsingId,
        -- * Parallelizing Processes
        processParallel,
        processParallelUsingIds,
        processParallel_,
        processParallelUsingIds_,
        -- * Exception Handling
        catchProcess,
        finallyProcess,
        throwProcess,
        -- * Process Priority
        processWithPriority,
        -- * Utilities
        zipProcessParallel,
        zip3ProcessParallel,
        unzipProcess,
        -- * Memoizing Process
        memoProcess,
        -- * Never Ending Process
        neverProcess,
        -- * Retrying Computation
        retryProcess,
        -- * GoTo Statement
        transferProcess,
        -- * Debugging
        traceProcess) where

import Data.Maybe
import Data.IORef

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fail
import qualified Control.Monad.Catch as MC
import Control.Applicative

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Parameter
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Cont
import Simulation.Aivika.Signal

-- | Represents a process identifier.
data ProcessId = 
  ProcessId { ProcessId -> IORef Bool
processStarted :: IORef Bool,
              ProcessId -> IORef (Maybe (ContParams ()))
processReactCont     :: IORef (Maybe (ContParams ())),
              ProcessId -> IORef EventPriority
processReactPriority :: IORef Int,
              ProcessId -> ContId
processContId  :: ContId,
              ProcessId -> IORef Bool
processInterruptRef  :: IORef Bool, 
              ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont :: IORef (Maybe (ContParams ())),
              ProcessId -> IORef Double
processInterruptTime :: IORef Double,
              ProcessId -> IORef EventPriority
processInterruptVersion :: IORef Int,
              ProcessId -> IORef EventPriority
processInterruptPriority :: IORef Int }

-- | Specifies a discontinuous process that can suspend at any time
-- and then resume later.
newtype Process a = Process (ProcessId -> Cont a)

-- | A type class to lift the 'Process' computation to other computations.
class ProcessLift m where
  
  -- | Lift the specified 'Process' computation to another computation.
  liftProcess :: Process a -> m a

instance ProcessLift Process where
  liftProcess :: forall a. Process a -> Process a
liftProcess = forall a. a -> a
id

-- | Invoke the process computation.
invokeProcess :: ProcessId -> Process a -> Cont a
{-# INLINE invokeProcess #-}
invokeProcess :: forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process ProcessId -> Cont a
m) = ProcessId -> Cont a
m ProcessId
pid

-- | Hold the process for the specified time period.
holdProcess :: Double -> Process ()
holdProcess :: Double -> Process ()
holdProcess Double
dt =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
dt forall a. Ord a => a -> a -> Bool
< Double
0) forall a b. (a -> b) -> a -> b
$
       forall a. HasCallStack => [Char] -> a
error [Char]
"Time period dt < 0: holdProcess"
     let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont ProcessId
pid
         t :: Double
t = Point -> Double
pointTime Point
p forall a. Num a => a -> a -> a
+ Double
dt
     forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams ()
c
     forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
False
     forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid) Double
t
     forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef EventPriority
processInterruptPriority ProcessId
pid) (Point -> EventPriority
pointPriority Point
p)
     EventPriority
v <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processInterruptVersion ProcessId
pid)
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$
       forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
       do EventPriority
v' <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processInterruptVersion ProcessId
pid)
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventPriority
v forall a. Eq a => a -> a -> Bool
== EventPriority
v') forall a b. (a -> b) -> a -> b
$ 
            do forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | Interrupt a process with the specified identifier if the process
-- is held by computation 'holdProcess'.
interruptProcess :: ProcessId -> Event ()
interruptProcess :: ProcessId -> Event ()
interruptProcess ProcessId
pid =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont ProcessId
pid
     Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams ()
c ->
         do EventPriority
priority <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processInterruptPriority ProcessId
pid)
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
            forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
True
            forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ProcessId -> IORef EventPriority
processInterruptVersion ProcessId
pid) forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+) EventPriority
1
            forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
              Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority (Point -> Double
pointTime Point
p) EventPriority
priority forall a b. (a -> b) -> a -> b
$
              forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
            
-- | Test whether the process with the specified identifier was interrupted.
processInterrupted :: ProcessId -> Event Bool
processInterrupted :: ProcessId -> Event Bool
processInterrupted ProcessId
pid =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid)

-- | Return the expected interruption time after finishing the 'holdProcess' computation,
-- which value may change if the corresponding process is preempted.
processInterruptionTime :: ProcessId -> Event (Maybe Double)
processInterruptionTime :: ProcessId -> Event (Maybe Double)
processInterruptionTime ProcessId
pid =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont ProcessId
pid
     Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Just ContParams ()
c  ->
         do Double
t <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid)
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Double
t)
       Maybe (ContParams ())
Nothing ->
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Define a reaction when the process with the specified identifier is preempted.
processPreempted :: ProcessId -> Event ()
processPreempted :: ProcessId -> Event ()
processPreempted ProcessId
pid =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processInterruptCont ProcessId
pid
     Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Just ContParams ()
c ->
         do EventPriority
priority <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processInterruptPriority ProcessId
pid)
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
            forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
True
            forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ProcessId -> IORef EventPriority
processInterruptVersion ProcessId
pid) forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+) EventPriority
1
            Double
t <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid)
            let dt :: Double
dt = Double
t forall a. Num a => a -> a -> a
- Point -> Double
pointTime Point
p
                c' :: ContParams ()
c' = forall a. ContParams a -> (a -> Event ()) -> ContParams a
substituteCont ContParams ()
c forall a b. (a -> b) -> a -> b
$ \()
a ->
                  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
                  forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                  forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c forall a b. (a -> b) -> a -> b
$
                  forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid forall a b. (a -> b) -> a -> b
$
                  EventPriority -> Process ()
processWithPriority EventPriority
priority forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Process ()
holdProcess Double
dt
            forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
              forall a. ContParams a -> a -> Event ()
reenterCont ContParams ()
c' ()
       Maybe (ContParams ())
Nothing ->
         do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
            Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
            case Maybe (ContParams ())
a of
              Maybe (ContParams ())
Nothing ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just ContParams ()
c ->
                do let c' :: ContParams ()
c' = forall a. ContParams a -> (a -> Event ()) -> ContParams a
substituteCont ContParams ()
c forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
reenterCont ContParams ()
c
                   forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams ()
c'

-- | Passivate the process.
passivateProcess :: Process ()
passivateProcess :: Process ()
passivateProcess =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
     Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing ->
         do forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams ()
c
            forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef EventPriority
processReactPriority ProcessId
pid) (Point -> EventPriority
pointPriority Point
p)
       Just ContParams ()
_  ->
         forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot passivate the process twice: passivateProcess"

-- | Passivate the process before performing some action.
passivateProcessBefore :: Event () -> Process ()
passivateProcessBefore :: Event () -> Process ()
passivateProcessBefore Event ()
m =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
     Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing ->
         do forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ContParams ()
c
            forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef EventPriority
processReactPriority ProcessId
pid) (Point -> EventPriority
pointPriority Point
p)
            forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
m
       Just ContParams ()
_  ->
         forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot passivate the process twice: passivateProcessBefore"

-- | Test whether the process with the specified identifier is passivated.
processPassive :: ProcessId -> Event Bool
processPassive :: ProcessId -> Event Bool
processPassive ProcessId
pid =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
     Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust Maybe (ContParams ())
a

-- | Reactivate a process with the specified identifier.
reactivateProcess :: ProcessId -> Event ()
reactivateProcess :: ProcessId -> Event ()
reactivateProcess ProcessId
pid =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
     Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing -> 
         forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams ()
c ->
         do EventPriority
priority <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processReactPriority ProcessId
pid)
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
            forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
              Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority (Point -> Double
pointTime Point
p) EventPriority
priority forall a b. (a -> b) -> a -> b
$
              forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | Reactivate a process with the specified identifier immediately.
reactivateProcessImmediately :: ProcessId -> Event ()
reactivateProcessImmediately :: ProcessId -> Event ()
reactivateProcessImmediately ProcessId
pid =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let x :: IORef (Maybe (ContParams ()))
x = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
pid
     Maybe (ContParams ())
a <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing -> 
         forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams ()
c ->
         do EventPriority
priority <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef EventPriority
processReactPriority ProcessId
pid)
            forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x forall a. Maybe a
Nothing
            if EventPriority
priority forall a. Eq a => a -> a -> Bool
== Point -> EventPriority
pointPriority Point
p
              then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
              else forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                   Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority (Point -> Double
pointTime Point
p) EventPriority
priority forall a b. (a -> b) -> a -> b
$
                   forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | Prepare the processes identifier for running.
processIdPrepare :: ProcessId -> Event ()
processIdPrepare :: ProcessId -> Event ()
processIdPrepare ProcessId
pid =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool
y <- forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Bool
processStarted ProcessId
pid)
     if Bool
y
       then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
            [Char]
"Another process with the specified identifier " forall a. [a] -> [a] -> [a]
++
            [Char]
"has been started already: processIdPrepare"
       else forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processStarted ProcessId
pid) Bool
True
     let signal :: Signal ContEvent
signal = ContId -> Signal ContEvent
contSignal forall a b. (a -> b) -> a -> b
$ ProcessId -> ContId
processContId ProcessId
pid
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ Signal ContEvent
signal forall a b. (a -> b) -> a -> b
$ \ContEvent
e ->
       forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
       case ContEvent
e of
         ContEvent
ContCancellationInitiating ->
           do Bool
z <- ContId -> IO Bool
contCancellationActivated forall a b. (a -> b) -> a -> b
$ ProcessId -> ContId
processContId ProcessId
pid
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$
                do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
interruptProcess ProcessId
pid
                   forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
reactivateProcess ProcessId
pid
         ContEvent
ContPreemptionBeginning ->
           forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processPreempted ProcessId
pid
         ContEvent
ContPreemptionEnding ->
           forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Run immediately the process. A new 'ProcessId' identifier will be
-- assigned to the process.
--            
-- To run the process at the specified time, you can use
-- the 'enqueueProcess' function.
runProcess :: Process () -> Event ()
runProcess :: Process () -> Event ()
runProcess Process ()
p =
  do ProcessId
pid <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
     ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p
             
-- | Run immediately the process with the specified identifier.
-- It will be more efficient than as you would specify the process identifier
-- with help of the 'processUsingId' combinator and then would call 'runProcess'.
--            
-- To run the process at the specified time, you can use
-- the 'enqueueProcessUsingId' function.
runProcessUsingId :: ProcessId -> Process () -> Event ()
runProcessUsingId :: ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p =
  do ProcessId -> Event ()
processIdPrepare ProcessId
pid
     forall a.
Cont a
-> (a -> Event ())
-> (SomeException -> Event ())
-> (() -> Event ())
-> ContId
-> Bool
-> Event ()
runCont Cont ()
m forall {a}. a -> Event a
cont forall {a}. SomeException -> Event a
econt forall {a}. a -> Event a
ccont (ProcessId -> ContId
processContId ProcessId
pid) Bool
False
       where cont :: a -> Event a
cont  = forall (m :: * -> *) a. Monad m => a -> m a
return
             econt :: SomeException -> Event a
econt = forall e a. Exception e => e -> Event a
throwEvent
             ccont :: a -> Event a
ccont = forall (m :: * -> *) a. Monad m => a -> m a
return
             m :: Cont ()
m = forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process ()
p

-- | Run the process in the start time immediately involving all pending
-- 'CurrentEvents' in the computation too.
runProcessInStartTime :: Process () -> Simulation ()
runProcessInStartTime :: Process () -> Simulation ()
runProcessInStartTime = forall a. Event a -> Simulation a
runEventInStartTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process () -> Event ()
runProcess

-- | Run the process in the start time immediately using the specified identifier
-- and involving all pending 'CurrentEvents' in the computation too.
runProcessInStartTimeUsingId :: ProcessId -> Process () -> Simulation ()
runProcessInStartTimeUsingId :: ProcessId -> Process () -> Simulation ()
runProcessInStartTimeUsingId ProcessId
pid Process ()
p =
  forall a. Event a -> Simulation a
runEventInStartTime forall a b. (a -> b) -> a -> b
$ ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p

-- | Run the process in the final simulation time immediately involving all
-- pending 'CurrentEvents' in the computation too.
runProcessInStopTime :: Process () -> Simulation ()
runProcessInStopTime :: Process () -> Simulation ()
runProcessInStopTime = forall a. Event a -> Simulation a
runEventInStopTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process () -> Event ()
runProcess

-- | Run the process in the final simulation time immediately using 
-- the specified identifier and involving all pending 'CurrentEvents'
-- in the computation too.
runProcessInStopTimeUsingId :: ProcessId -> Process () -> Simulation ()
runProcessInStopTimeUsingId :: ProcessId -> Process () -> Simulation ()
runProcessInStopTimeUsingId ProcessId
pid Process ()
p =
  forall a. Event a -> Simulation a
runEventInStopTime forall a b. (a -> b) -> a -> b
$ ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p

-- | Enqueue the process that will be then started at the specified time
-- from the event queue.
enqueueProcess :: Double -> Process () -> Event ()
enqueueProcess :: Double -> Process () -> Event ()
enqueueProcess Double
t Process ()
p =
  Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ Process () -> Event ()
runProcess Process ()
p

-- | Enqueue the process that will be then started at the specified time
-- from the event queue.
enqueueProcessUsingId :: Double -> ProcessId -> Process () -> Event ()
enqueueProcessUsingId :: Double -> ProcessId -> Process () -> Event ()
enqueueProcessUsingId Double
t ProcessId
pid Process ()
p =
  Double -> Event () -> Event ()
enqueueEvent Double
t forall a b. (a -> b) -> a -> b
$ ProcessId -> Process () -> Event ()
runProcessUsingId ProcessId
pid Process ()
p

-- | Return the current process identifier.
processId :: Process ProcessId
processId :: Process ProcessId
processId = forall a. (ProcessId -> Cont a) -> Process a
Process forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Create a new process identifier.
newProcessId :: Simulation ProcessId
newProcessId :: Simulation ProcessId
newProcessId =
  do IORef (Maybe (ContParams ()))
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     IORef Bool
y <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
     ContId
c <- Simulation ContId
newContId
     IORef Bool
i <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
     IORef (Maybe (ContParams ()))
z <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     IORef Double
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Double
0
     IORef EventPriority
v <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef EventPriority
0
     IORef EventPriority
priority1 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef EventPriority
0
     IORef EventPriority
priority2 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef EventPriority
0
     forall (m :: * -> *) a. Monad m => a -> m a
return ProcessId { processStarted :: IORef Bool
processStarted = IORef Bool
y,
                        processReactCont :: IORef (Maybe (ContParams ()))
processReactCont     = IORef (Maybe (ContParams ()))
x,
                        processReactPriority :: IORef EventPriority
processReactPriority = IORef EventPriority
priority1,
                        processContId :: ContId
processContId  = ContId
c, 
                        processInterruptRef :: IORef Bool
processInterruptRef  = IORef Bool
i,
                        processInterruptCont :: IORef (Maybe (ContParams ()))
processInterruptCont = IORef (Maybe (ContParams ()))
z,
                        processInterruptTime :: IORef Double
processInterruptTime = IORef Double
t,
                        processInterruptVersion :: IORef EventPriority
processInterruptVersion = IORef EventPriority
v,
                        processInterruptPriority :: IORef EventPriority
processInterruptPriority = IORef EventPriority
priority2 }

-- | Cancel a process with the specified identifier, interrupting it if needed.
cancelProcessWithId :: ProcessId -> Event ()
cancelProcessWithId :: ProcessId -> Event ()
cancelProcessWithId ProcessId
pid = ContId -> Event ()
contCancellationInitiate (ProcessId -> ContId
processContId ProcessId
pid)

-- | The process cancels itself.
cancelProcess :: Process a
cancelProcess :: forall a. Process a
cancelProcess =
  do ProcessId
pid <- Process ProcessId
processId
     forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
cancelProcessWithId ProcessId
pid
     forall e a. Exception e => e -> Process a
throwProcess forall a b. (a -> b) -> a -> b
$
       (forall a. HasCallStack => [Char] -> a
error [Char]
"The process must be cancelled already: cancelProcess." :: SomeException)

-- | Test whether the process with the specified identifier was cancelled.
processCancelled :: ProcessId -> Event Bool
processCancelled :: ProcessId -> Event Bool
processCancelled ProcessId
pid = ContId -> Event Bool
contCancellationInitiated (ProcessId -> ContId
processContId ProcessId
pid)

-- | Return a signal that notifies about cancelling the process with 
-- the specified identifier.
processCancelling :: ProcessId -> Signal ()
processCancelling :: ProcessId -> Signal ()
processCancelling ProcessId
pid = ContId -> Signal ()
contCancellationInitiating (ProcessId -> ContId
processContId ProcessId
pid)

-- | Register a handler that will be invoked in case of cancelling the current process.
whenCancellingProcess :: Event () -> Process ()
whenCancellingProcess :: Event () -> Process ()
whenCancellingProcess Event ()
h =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
  forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ (ProcessId -> Signal ()
processCancelling ProcessId
pid) forall a b. (a -> b) -> a -> b
$ \() -> Event ()
h

-- | Preempt a process with the specified identifier.
processPreemptionBegin :: ProcessId -> Event ()
processPreemptionBegin :: ProcessId -> Event ()
processPreemptionBegin ProcessId
pid = ContId -> Event ()
contPreemptionBegin (ProcessId -> ContId
processContId ProcessId
pid)

-- | Proceed with the process with the specified identifier after it was preempted with help of 'preemptProcessBegin'.
processPreemptionEnd :: ProcessId -> Event ()
processPreemptionEnd :: ProcessId -> Event ()
processPreemptionEnd ProcessId
pid = ContId -> Event ()
contPreemptionEnd (ProcessId -> ContId
processContId ProcessId
pid)

-- | Return a signal when the process is preempted.
processPreemptionBeginning :: ProcessId -> Signal ()
processPreemptionBeginning :: ProcessId -> Signal ()
processPreemptionBeginning ProcessId
pid = ContId -> Signal ()
contPreemptionBeginning (ProcessId -> ContId
processContId ProcessId
pid)

-- | Return a signal when the process is proceeded after it was preempted earlier.
processPreemptionEnding :: ProcessId -> Signal ()
processPreemptionEnding :: ProcessId -> Signal ()
processPreemptionEnding ProcessId
pid = ContId -> Signal ()
contPreemptionEnding (ProcessId -> ContId
processContId ProcessId
pid)

instance Eq ProcessId where
  ProcessId
x == :: ProcessId -> ProcessId -> Bool
== ProcessId
y = ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
x forall a. Eq a => a -> a -> Bool
== ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
y    -- for the references are unique

instance Monad Process where
  Process a
m >>= :: forall a b. Process a -> (a -> Process b) -> Process b
>>= a -> Process b
k = forall a b. Process a -> (a -> Process b) -> Process b
bindP Process a
m a -> Process b
k

instance Functor Process where
  fmap :: forall a b. (a -> b) -> Process a -> Process b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative Process where
  pure :: forall a. a -> Process a
pure = forall a. a -> Process a
returnP
  <*> :: forall a b. Process (a -> b) -> Process a -> Process b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance MonadFail Process where
  fail :: forall a. [Char] -> Process a
fail = forall a. HasCallStack => [Char] -> a
error

instance ParameterLift Process where
  liftParameter :: forall a. Parameter a -> Process a
liftParameter = forall a. Parameter a -> Process a
liftPP

instance SimulationLift Process where
  liftSimulation :: forall a. Simulation a -> Process a
liftSimulation = forall a. Simulation a -> Process a
liftSP
  
instance DynamicsLift Process where
  liftDynamics :: forall a. Dynamics a -> Process a
liftDynamics = forall a. Dynamics a -> Process a
liftDP
  
instance EventLift Process where
  liftEvent :: forall a. Event a -> Process a
liftEvent = forall a. Event a -> Process a
liftEP
  
instance MonadIO Process where
  liftIO :: forall a. IO a -> Process a
liftIO = forall a. IO a -> Process a
liftIOP
  
instance MC.MonadThrow Process where
  throwM :: forall e a. Exception e => e -> Process a
throwM = forall e a. Exception e => e -> Process a
throwProcess

instance MC.MonadCatch Process where
  catch :: forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catch = forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess

returnP :: a -> Process a
{-# INLINE returnP #-}
returnP :: forall a. a -> Process a
returnP a
a = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a

bindP :: Process a -> (a -> Process b) -> Process b
{-# INLINE bindP #-}
bindP :: forall a b. Process a -> (a -> Process b) -> Process b
bindP (Process ProcessId -> Cont a
m) a -> Process b
k = 
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> 
  do a
a <- ProcessId -> Cont a
m ProcessId
pid
     let Process ProcessId -> Cont b
m' = a -> Process b
k a
a
     ProcessId -> Cont b
m' ProcessId
pid

liftPP :: Parameter a -> Process a
{-# INLINE liftPP #-}
liftPP :: forall a. Parameter a -> Process a
liftPP Parameter a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter a
m

liftSP :: Simulation a -> Process a
{-# INLINE liftSP #-}
liftSP :: forall a. Simulation a -> Process a
liftSP Simulation a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation a
m

liftDP :: Dynamics a -> Process a
{-# INLINE liftDP #-}
liftDP :: forall a. Dynamics a -> Process a
liftDP Dynamics a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics a
m

liftEP :: Event a -> Process a
{-# INLINE liftEP #-}
liftEP :: forall a. Event a -> Process a
liftEP Event a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent Event a
m

liftIOP :: IO a -> Process a
{-# INLINE liftIOP #-}
liftIOP :: forall a. IO a -> Process a
liftIOP IO a
m = forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m

-- | Exception handling within 'Process' computations.
catchProcess :: Exception e => Process a -> (e -> Process a) -> Process a
catchProcess :: forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess (Process ProcessId -> Cont a
m) e -> Process a
h =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall e a. Exception e => Cont a -> (e -> Cont a) -> Cont a
catchCont (ProcessId -> Cont a
m ProcessId
pid) forall a b. (a -> b) -> a -> b
$ \e
e ->
  let Process ProcessId -> Cont a
m' = e -> Process a
h e
e in ProcessId -> Cont a
m' ProcessId
pid
                           
-- | A computation with finalization part.
finallyProcess :: Process a -> Process b -> Process a
finallyProcess :: forall a b. Process a -> Process b -> Process a
finallyProcess (Process ProcessId -> Cont a
m) (Process ProcessId -> Cont b
m') =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a b. Cont a -> Cont b -> Cont a
finallyCont (ProcessId -> Cont a
m ProcessId
pid) (ProcessId -> Cont b
m' ProcessId
pid)

-- | Throw the exception with the further exception handling.
--
-- By some reason, an exception raised with help of the standard 'throw' function
-- is not handled properly within 'Process' computation, altough it will be still handled 
-- if it will be wrapped in the 'IO' monad. Therefore, you should use specialised
-- functions like the stated one that use the 'throw' function but within the 'IO' computation,
-- which allows already handling the exception.
throwProcess :: Exception e => e -> Process a
throwProcess :: forall e a. Exception e => e -> Process a
throwProcess = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Exception e => e -> a
throw

-- | Proceed with the process that would use the specified event priority.
processWithPriority :: EventPriority -> Process ()
processWithPriority :: EventPriority -> Process ()
processWithPriority EventPriority
priority =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  if EventPriority
priority forall a. Eq a => a -> a -> Bool
== Point -> EventPriority
pointPriority Point
p
  then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
  else forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
       Double -> EventPriority -> Event () -> Event ()
enqueueEventWithPriority (Point -> Double
pointTime Point
p) EventPriority
priority forall a b. (a -> b) -> a -> b
$
       forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | Execute the specified computations in parallel within
-- the current computation and return their results. The cancellation
-- of any of the nested computations affects the current computation.
-- The exception raised in any of the nested computations is propagated
-- to the current computation as well.
--
-- Here word @parallel@ literally means that the computations are
-- actually executed on a single operating system thread but
-- they are processed simultaneously by the event queue.
--
-- New 'ProcessId' identifiers will be assigned to the started processes.
processParallel :: [Process a] -> Process [a]
processParallel :: forall a. [Process a] -> Process [a]
processParallel [Process a]
xs =
  forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (forall a. [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [(ProcessId, Process a)] -> Process [a]
processParallelUsingIds 

-- | Like 'processParallel' but allows specifying the process identifiers.
-- It will be more efficient than as you would specify the process identifiers
-- with help of the 'processUsingId' combinator and then would call 'processParallel'.
processParallelUsingIds :: [(ProcessId, Process a)] -> Process [a]
processParallelUsingIds :: forall a. [(ProcessId, Process a)] -> Process [a]
processParallelUsingIds [(ProcessId, Process a)]
xs =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  do forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall a. [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs
     forall a. [(Cont a, ContId)] -> Cont [a]
contParallel forall a b. (a -> b) -> a -> b
$
       forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId, Process a)]
xs forall a b. (a -> b) -> a -> b
$ \(ProcessId
pid, Process a
m) ->
       (forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
m, ProcessId -> ContId
processContId ProcessId
pid)

-- | Like 'processParallel' but ignores the result.
processParallel_ :: [Process a] -> Process ()
processParallel_ :: forall a. [Process a] -> Process ()
processParallel_ [Process a]
xs =
  forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (forall a. [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_ 

-- | Like 'processParallelUsingIds' but ignores the result.
processParallelUsingIds_ :: [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_ :: forall a. [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_ [(ProcessId, Process a)]
xs =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  do forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ forall a. [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs
     forall a. [(Cont a, ContId)] -> Cont ()
contParallel_ forall a b. (a -> b) -> a -> b
$
       forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId, Process a)]
xs forall a b. (a -> b) -> a -> b
$ \(ProcessId
pid, Process a
m) ->
       (forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
m, ProcessId -> ContId
processContId ProcessId
pid)

-- | Create the new process identifiers.
processParallelCreateIds :: [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds :: forall a. [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs =
  do [ProcessId]
pids <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Process a]
xs forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Simulation ProcessId
newProcessId
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [ProcessId]
pids [Process a]
xs

-- | Prepare the processes for parallel execution.
processParallelPrepare :: [(ProcessId, Process a)] -> Event ()
processParallelPrepare :: forall a. [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ProcessId, Process a)]
xs forall a b. (a -> b) -> a -> b
$ forall a. Point -> Event a -> IO a
invokeEvent Point
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> Event ()
processIdPrepare forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst

-- | Allow calling the process with the specified identifier.
-- It creates a nested process when canceling any of two, or raising an
-- @IO@ exception in any of the both, affects the 'Process' computation.
--
-- At the same time, the interruption has no such effect as it requires
-- explicit specifying the 'ProcessId' identifier of the nested process itself,
-- that is the nested process cannot be interrupted using only the parent
-- process identifier.
processUsingId :: ProcessId -> Process a -> Process a
processUsingId :: forall a. ProcessId -> Process a -> Process a
processUsingId ProcessId
pid Process a
x =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid' ->
  do forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processIdPrepare ProcessId
pid
     forall a. Cont a -> ContId -> Cont a
rerunCont (forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
x) (ProcessId -> ContId
processContId ProcessId
pid)

-- | Spawn the child process. In case of cancelling one of the processes,
-- other process will be cancelled too.
spawnProcess :: Process () -> Process ()
spawnProcess :: Process () -> Process ()
spawnProcess = ContCancellation -> Process () -> Process ()
spawnProcessWith ContCancellation
CancelTogether

-- | Spawn the child process with the specified process identifier.
-- In case of cancelling one of the processes, other process will
-- be cancelled too.
spawnProcessUsingId :: ProcessId -> Process () -> Process ()
spawnProcessUsingId :: ProcessId -> Process () -> Process ()
spawnProcessUsingId = ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
CancelTogether

-- | Spawn the child process specifying how the child and parent processes
-- should be cancelled in case of need.
spawnProcessWith :: ContCancellation -> Process () -> Process ()
spawnProcessWith :: ContCancellation -> Process () -> Process ()
spawnProcessWith ContCancellation
cancellation Process ()
x =
  do ProcessId
pid <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
     ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
cancellation ProcessId
pid Process ()
x

-- | Spawn the child process specifying how the child and parent processes
-- should be cancelled in case of need.
spawnProcessUsingIdWith :: ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith :: ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
cancellation ProcessId
pid Process ()
x =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid' ->
  do forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processIdPrepare ProcessId
pid
     ContCancellation -> Cont () -> ContId -> Cont ()
spawnCont ContCancellation
cancellation (forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process ()
x) (ProcessId -> ContId
processContId ProcessId
pid)

-- | Await the signal.
processAwait :: Signal a -> Process a
processAwait :: forall a. Signal a -> Process a
processAwait Signal a
signal =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall a. Signal a -> Cont a
contAwait Signal a
signal

-- | The result of memoization.
data MemoResult a = MemoComputed a
                  | MemoError IOException
                  | MemoCancelled

-- | Memoize the process so that it would always return the same value
-- within the simulation run.
memoProcess :: Process a -> Simulation (Process a)
memoProcess :: forall a. Process a -> Simulation (Process a)
memoProcess Process a
x =
  do IORef Bool
started  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
     SignalSource ()
computed <- forall a. Simulation (SignalSource a)
newSignalSource
     IORef (Maybe (MemoResult a))
value    <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     let result :: Process a
result =
           do Just MemoResult a
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe (MemoResult a))
value
              case MemoResult a
x of
                MemoComputed a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                MemoError IOException
e    -> forall e a. Exception e => e -> Process a
throwProcess IOException
e
                MemoResult a
MemoCancelled  -> forall a. Process a
cancelProcess
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
       do Maybe (MemoResult a)
v <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe (MemoResult a))
value
          case Maybe (MemoResult a)
v of
            Just MemoResult a
_ -> Process a
result
            Maybe (MemoResult a)
Nothing ->
              do Bool
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Bool
started
                 case Bool
f of
                   Bool
True ->
                     do forall a. Signal a -> Process a
processAwait forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource ()
computed
                        Process a
result
                   Bool
False ->
                     do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
started Bool
True
                        IORef (MemoResult a)
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. MemoResult a
MemoCancelled
                        forall a b. Process a -> Process b -> Process a
finallyProcess
                          (forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess
                           (do a
a <- Process a
x    -- compute only once!
                               forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (MemoResult a)
r (forall a. a -> MemoResult a
MemoComputed a
a))
                           (\IOException
e ->
                             forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (MemoResult a)
r (forall a. IOException -> MemoResult a
MemoError IOException
e)))
                          (forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
                           do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                                do MemoResult a
x <- forall a. IORef a -> IO a
readIORef IORef (MemoResult a)
r
                                   forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (MemoResult a))
value (forall a. a -> Maybe a
Just MemoResult a
x)
                              forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource ()
computed ())
                        Process a
result

-- | Zip two parallel processes waiting for the both.
zipProcessParallel :: Process a -> Process b -> Process (a, b)
zipProcessParallel :: forall a b. Process a -> Process b -> Process (a, b)
zipProcessParallel Process a
x Process b
y =
  do [Left a
a, Right b
b] <- forall a. [Process a] -> Process [a]
processParallel [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left Process a
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right Process b
y]
     forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)

-- | Zip three parallel processes waiting for their results.
zip3ProcessParallel :: Process a -> Process b -> Process c -> Process (a, b, c)
zip3ProcessParallel :: forall a b c.
Process a -> Process b -> Process c -> Process (a, b, c)
zip3ProcessParallel Process a
x Process b
y Process c
z =
  do [Left a
a,
      Right (Left b
b),
      Right (Right c
c)] <-
       forall a. [Process a] -> Process [a]
processParallel [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left Process a
x,
                        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) Process b
y,
                        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) Process c
z]
     forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c)

-- | Unzip the process using memoization so that the both returned
-- processes could be applied independently, although they will refer
-- to the same pair of values.
unzipProcess :: Process (a, b) -> Simulation (Process a, Process b)
unzipProcess :: forall a b. Process (a, b) -> Simulation (Process a, Process b)
unzipProcess Process (a, b)
xy =
  do Process (a, b)
xy' <- forall a. Process a -> Simulation (Process a)
memoProcess Process (a, b)
xy
     forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Process (a, b)
xy', forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd Process (a, b)
xy')

-- | Try to run the child process within the specified timeout.
-- If the process will finish successfully within this time interval then
-- the result wrapped in 'Just' will be returned; otherwise, the child process
-- will be cancelled and 'Nothing' will be returned.
--
-- If an exception is raised in the child process then it is propagated to
-- the parent computation as well.
--
-- A cancellation of the child process doesn't lead to cancelling the parent process.
-- Then 'Nothing' is returned within the computation.
--
-- This is a heavy-weight operation destined for working with arbitrary discontinuous
-- processes. Please consider using a more light-weight function 'interruptProcess' or else
-- 'cancelProcessWithId' whenever possible.
timeoutProcess :: Double -> Process a -> Process (Maybe a)
timeoutProcess :: forall a. Double -> Process a -> Process (Maybe a)
timeoutProcess Double
timeout Process a
p =
  do ProcessId
pid <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
     forall a. Double -> ProcessId -> Process a -> Process (Maybe a)
timeoutProcessUsingId Double
timeout ProcessId
pid Process a
p

-- | Try to run the child process with the given identifier within the specified timeout.
-- If the process will finish successfully within this time interval then
-- the result wrapped in 'Just' will be returned; otherwise, the child process
-- will be cancelled and 'Nothing' will be returned.
--
-- If an exception is raised in the child process then it is propagated to
-- the parent computation as well.
--
-- A cancellation of the child process doesn't lead to cancelling the parent process.
-- Then 'Nothing' is returned within the computation.
--
-- This is a heavy-weight operation destined for working with arbitrary discontinuous
-- processes. Please consider using a more light-weight function 'interruptProcess' or else
-- 'cancelProcessWithId' whenever possible.
timeoutProcessUsingId :: Double -> ProcessId -> Process a -> Process (Maybe a)
timeoutProcessUsingId :: forall a. Double -> ProcessId -> Process a -> Process (Maybe a)
timeoutProcessUsingId Double
timeout ProcessId
pid Process a
p =
  do SignalSource (Maybe (Either SomeException a))
s <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation forall a. Simulation (SignalSource a)
newSignalSource
     ProcessId
timeoutPid <- forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
     ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId
timeoutPid forall a b. (a -> b) -> a -> b
$
       do Double -> Process ()
holdProcess Double
timeout
          forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
            ProcessId -> Event ()
cancelProcessWithId ProcessId
pid
     ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId
pid forall a b. (a -> b) -> a -> b
$
       do IORef (Maybe (Either SomeException a))
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
          forall a b. Process a -> Process b -> Process a
finallyProcess
            (forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess
             (do a
a <- Process a
p
                 forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Either SomeException a))
r forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right a
a))
             (\SomeException
e ->
               forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Either SomeException a))
r forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left SomeException
e)))
            (forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall a b. (a -> b) -> a -> b
$
             do ProcessId -> Event ()
cancelProcessWithId ProcessId
timeoutPid
                Maybe (Either SomeException a)
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (Maybe (Either SomeException a))
r
                forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource (Maybe (Either SomeException a))
s Maybe (Either SomeException a)
x)
     Maybe (Either SomeException a)
x <- forall a. Signal a -> Process a
processAwait forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> Signal a
publishSignal SignalSource (Maybe (Either SomeException a))
s
     case Maybe (Either SomeException a)
x of
       Maybe (Either SomeException a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
       Just (Right a
a) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
       Just (Left (SomeException e
e)) -> forall e a. Exception e => e -> Process a
throwProcess e
e

-- | Yield to allow other 'Process' and 'Event' computations to run
-- at the current simulation time point.
processYield :: Process ()
processYield :: Process ()
processYield =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
  Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) forall a b. (a -> b) -> a -> b
$
  forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | A computation that never computes the result. It behaves like a black hole for
-- the discontinuous process, although such a process can still be canceled outside
-- (see 'cancelProcessWithId'), but then only its finalization parts (see 'finallyProcess')
-- will be called, usually, to release the resources acquired before.
neverProcess :: Process a
neverProcess :: forall a. Process a
neverProcess =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  let signal :: Signal ()
signal = ProcessId -> Signal ()
processCancelling ProcessId
pid
  in forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ Signal ()
signal forall a b. (a -> b) -> a -> b
$ \()
_ ->
     forall a. ContParams a -> a -> Event ()
resumeCont ContParams a
c forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"It must never be computed: neverProcess"

-- | Retry the current computation as possible, using the specified argument
-- as a 'SimulationRetry' exception message in case of failure.
retryProcess :: String -> Process a
retryProcess :: forall a. [Char] -> Process a
retryProcess = forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> Event a
retryEvent

-- | Like the GoTo statement it transfers the direction of computation,
-- but raises an exception when used within 'catchProcess' or 'finallyProcess'.
transferProcess :: Process () -> Process a
transferProcess :: forall a. Process () -> Process a
transferProcess (Process ProcessId -> Cont ()
m) =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> forall a. Cont () -> Cont a
transferCont (ProcessId -> Cont ()
m ProcessId
pid)

-- | Show the debug message with the current simulation time.
traceProcess :: String -> Process a -> Process a
traceProcess :: forall a. [Char] -> Process a -> Process a
traceProcess [Char]
message Process a
m =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. [Char] -> Cont a -> Cont a
traceCont [Char]
message forall a b. (a -> b) -> a -> b
$
  forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
m