-- |
-- 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,
        -- * 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 -> 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 Int
processInterruptVersion :: 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 :: Process a -> Process a
liftProcess = Process a -> Process a
forall a. a -> a
id

-- | Invoke the process computation.
invokeProcess :: ProcessId -> Process a -> Cont a
{-# INLINE invokeProcess #-}
invokeProcess :: 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 =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
dt Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       [Char] -> IO ()
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt
     IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x (Maybe (ContParams ()) -> IO ()) -> Maybe (ContParams ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> Maybe (ContParams ())
forall a. a -> Maybe a
Just ContParams ()
c
     IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
False
     IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid) Double
t
     Int
v <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Int
processInterruptVersion ProcessId
pid)
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Event () -> Event ()
enqueueEvent Double
t (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$
       (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
       do Int
v' <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Int
processInterruptVersion ProcessId
pid)
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
v') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ 
            do IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x Maybe (ContParams ())
forall a. Maybe a
Nothing
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
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 =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> 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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams ()
c ->
         do IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x Maybe (ContParams ())
forall a. Maybe a
Nothing
            IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
True
            IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ProcessId -> IORef Int
processInterruptVersion ProcessId
pid) ((Int -> Int) -> IO ()) -> (Int -> Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1
            Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
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 =
  (Point -> IO Bool) -> Event Bool
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Bool) -> Event Bool)
-> (Point -> IO Bool) -> Event Bool
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  IORef Bool -> IO Bool
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 =
  (Point -> IO (Maybe Double)) -> Event (Maybe Double)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (Maybe Double)) -> Event (Maybe Double))
-> (Point -> IO (Maybe Double)) -> Event (Maybe Double)
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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Just ContParams ()
c  ->
         do Double
t <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid)
            Maybe Double -> IO (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t)
       Maybe (ContParams ())
Nothing ->
         Maybe Double -> IO (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
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 =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> 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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Just ContParams ()
c ->
         do IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x Maybe (ContParams ())
forall a. Maybe a
Nothing
            IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processInterruptRef ProcessId
pid) Bool
True
            IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (ProcessId -> IORef Int
processInterruptVersion ProcessId
pid) ((Int -> Int) -> IO ()) -> (Int -> Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1
            Double
t <- IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Double
processInterruptTime ProcessId
pid)
            let dt :: Double
dt = Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Point -> Double
pointTime Point
p
                c' :: ContParams ()
c' = ContParams () -> (() -> Event ()) -> ContParams ()
forall a. ContParams a -> (a -> Event ()) -> ContParams a
substituteCont ContParams ()
c ((() -> Event ()) -> ContParams ())
-> (() -> Event ()) -> ContParams ()
forall a b. (a -> b) -> a -> b
$ \()
a ->
                  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
                  Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  ContParams () -> Cont () -> Event ()
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c (Cont () -> Event ()) -> Cont () -> Event ()
forall a b. (a -> b) -> a -> b
$
                  ProcessId -> Process () -> Cont ()
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process () -> Cont ()) -> Process () -> Cont ()
forall a b. (a -> b) -> a -> b
$
                  Double -> Process ()
holdProcess Double
dt
            Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
              ContParams () -> () -> Event ()
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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
            case Maybe (ContParams ())
a of
              Maybe (ContParams ())
Nothing ->
                () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just ContParams ()
c ->
                do let c' :: ContParams ()
c' = ContParams () -> (() -> Event ()) -> ContParams ()
forall a. ContParams a -> (a -> Event ()) -> ContParams a
substituteCont ContParams ()
c ((() -> Event ()) -> ContParams ())
-> (() -> Event ()) -> ContParams ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
reenterCont ContParams ()
c
                   IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x (Maybe (ContParams ()) -> IO ()) -> Maybe (ContParams ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> Maybe (ContParams ())
forall a. a -> Maybe a
Just ContParams ()
c'

-- | Passivate the process.
passivateProcess :: Process ()
passivateProcess :: Process ()
passivateProcess =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> 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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing -> IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x (Maybe (ContParams ()) -> IO ()) -> Maybe (ContParams ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> Maybe (ContParams ())
forall a. a -> Maybe a
Just ContParams ()
c
       Just ContParams ()
_  -> [Char] -> IO ()
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 =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> 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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing ->
         do IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x (Maybe (ContParams ()) -> IO ()) -> Maybe (ContParams ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> Maybe (ContParams ())
forall a. a -> Maybe a
Just ContParams ()
c
            Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
m
       Just ContParams ()
_  -> [Char] -> IO ()
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 =
  (Point -> IO Bool) -> Event Bool
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Bool) -> Event Bool)
-> (Point -> IO Bool) -> Event Bool
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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe (ContParams ()) -> Bool
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 =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> 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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing -> 
         () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams ()
c ->
         do IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x Maybe (ContParams ())
forall a. Maybe a
Nothing
            Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
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 =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> 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 <- IORef (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams ()))
x
     case Maybe (ContParams ())
a of
       Maybe (ContParams ())
Nothing -> 
         () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ContParams ()
c ->
         do IORef (Maybe (ContParams ())) -> Maybe (ContParams ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams ()))
x Maybe (ContParams ())
forall a. Maybe a
Nothing
            Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | Prepare the processes identifier for running.
processIdPrepare :: ProcessId -> Event ()
processIdPrepare :: ProcessId -> Event ()
processIdPrepare ProcessId
pid =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool
y <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (ProcessId -> IORef Bool
processStarted ProcessId
pid)
     if Bool
y
       then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char]
"Another process with the specified identifier " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            [Char]
"has been started already: processIdPrepare"
       else IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ProcessId -> IORef Bool
processStarted ProcessId
pid) Bool
True
     let signal :: Signal ContEvent
signal = ContId -> Signal ContEvent
contSignal (ContId -> Signal ContEvent) -> ContId -> Signal ContEvent
forall a b. (a -> b) -> a -> b
$ ProcessId -> ContId
processContId ProcessId
pid
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       Signal ContEvent -> (ContEvent -> Event ()) -> Event ()
forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ Signal ContEvent
signal ((ContEvent -> Event ()) -> Event ())
-> (ContEvent -> Event ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \ContEvent
e ->
       (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
       case ContEvent
e of
         ContEvent
ContCancellationInitiating ->
           do Bool
z <- ContId -> IO Bool
contCancellationActivated (ContId -> IO Bool) -> ContId -> IO Bool
forall a b. (a -> b) -> a -> b
$ ProcessId -> ContId
processContId ProcessId
pid
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
interruptProcess ProcessId
pid
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
reactivateProcess ProcessId
pid
         ContEvent
ContPreemptionBeginning ->
           Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processPreempted ProcessId
pid
         ContEvent
ContPreemptionEnding ->
           () -> IO ()
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 <- Simulation ProcessId -> Event ProcessId
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
     Cont ()
-> (() -> Event ())
-> (SomeException -> Event ())
-> (() -> Event ())
-> ContId
-> Bool
-> Event ()
forall a.
Cont a
-> (a -> Event ())
-> (SomeException -> Event ())
-> (() -> Event ())
-> ContId
-> Bool
-> Event ()
runCont Cont ()
m () -> Event ()
forall a. a -> Event a
cont SomeException -> Event ()
forall a. SomeException -> Event a
econt () -> Event ()
forall a. a -> Event a
ccont (ProcessId -> ContId
processContId ProcessId
pid) Bool
False
       where cont :: a -> Event a
cont  = a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return
             econt :: SomeException -> Event a
econt = SomeException -> Event a
forall e a. Exception e => e -> Event a
throwEvent
             ccont :: a -> Event a
ccont = a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return
             m :: Cont ()
m = ProcessId -> Process () -> Cont ()
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 = Event () -> Simulation ()
forall a. Event a -> Simulation a
runEventInStartTime (Event () -> Simulation ())
-> (Process () -> Event ()) -> Process () -> Simulation ()
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 =
  Event () -> Simulation ()
forall a. Event a -> Simulation a
runEventInStartTime (Event () -> Simulation ()) -> Event () -> Simulation ()
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 = Event () -> Simulation ()
forall a. Event a -> Simulation a
runEventInStopTime (Event () -> Simulation ())
-> (Process () -> Event ()) -> Process () -> Simulation ()
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 =
  Event () -> Simulation ()
forall a. Event a -> Simulation a
runEventInStopTime (Event () -> Simulation ()) -> Event () -> Simulation ()
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 (Event () -> Event ()) -> Event () -> Event ()
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 (Event () -> Event ()) -> Event () -> Event ()
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 = (ProcessId -> Cont ProcessId) -> Process ProcessId
forall a. (ProcessId -> Cont a) -> Process a
Process ProcessId -> Cont ProcessId
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 <- IO (IORef (Maybe (ContParams ())))
-> Simulation (IORef (Maybe (ContParams ())))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (ContParams ())))
 -> Simulation (IORef (Maybe (ContParams ()))))
-> IO (IORef (Maybe (ContParams ())))
-> Simulation (IORef (Maybe (ContParams ())))
forall a b. (a -> b) -> a -> b
$ Maybe (ContParams ()) -> IO (IORef (Maybe (ContParams ())))
forall a. a -> IO (IORef a)
newIORef Maybe (ContParams ())
forall a. Maybe a
Nothing
     IORef Bool
y <- IO (IORef Bool) -> Simulation (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> Simulation (IORef Bool))
-> IO (IORef Bool) -> Simulation (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
     ContId
c <- Simulation ContId
newContId
     IORef Bool
i <- IO (IORef Bool) -> Simulation (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> Simulation (IORef Bool))
-> IO (IORef Bool) -> Simulation (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
     IORef (Maybe (ContParams ()))
z <- IO (IORef (Maybe (ContParams ())))
-> Simulation (IORef (Maybe (ContParams ())))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (ContParams ())))
 -> Simulation (IORef (Maybe (ContParams ()))))
-> IO (IORef (Maybe (ContParams ())))
-> Simulation (IORef (Maybe (ContParams ())))
forall a b. (a -> b) -> a -> b
$ Maybe (ContParams ()) -> IO (IORef (Maybe (ContParams ())))
forall a. a -> IO (IORef a)
newIORef Maybe (ContParams ())
forall a. Maybe a
Nothing
     IORef Double
t <- IO (IORef Double) -> Simulation (IORef Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Double) -> Simulation (IORef Double))
-> IO (IORef Double) -> Simulation (IORef Double)
forall a b. (a -> b) -> a -> b
$ Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
     IORef Int
v <- IO (IORef Int) -> Simulation (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> Simulation (IORef Int))
-> IO (IORef Int) -> Simulation (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     ProcessId -> Simulation ProcessId
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessId :: IORef Bool
-> IORef (Maybe (ContParams ()))
-> ContId
-> IORef Bool
-> IORef (Maybe (ContParams ()))
-> IORef Double
-> IORef Int
-> ProcessId
ProcessId { processStarted :: IORef Bool
processStarted = IORef Bool
y,
                        processReactCont :: IORef (Maybe (ContParams ()))
processReactCont     = IORef (Maybe (ContParams ()))
x, 
                        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 Int
processInterruptVersion = IORef Int
v }

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

-- | 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 =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  Event () -> Cont ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Cont ()) -> Event () -> Cont ()
forall a b. (a -> b) -> a -> b
$
  Signal () -> (() -> Event ()) -> Event ()
forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ (ProcessId -> Signal ()
processCancelling ProcessId
pid) ((() -> Event ()) -> Event ()) -> (() -> Event ()) -> Event ()
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 IORef (Maybe (ContParams ()))
-> IORef (Maybe (ContParams ())) -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId -> IORef (Maybe (ContParams ()))
processReactCont ProcessId
y    -- for the references are unique

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

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

instance Applicative Process where
  pure :: a -> Process a
pure = a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: Process (a -> b) -> Process a -> Process 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 :: [Char] -> Process a
fail = [Char] -> Process a
forall a. HasCallStack => [Char] -> a
error

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

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

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

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

bindP :: Process a -> (a -> Process b) -> Process b
{-# INLINE bindP #-}
bindP :: Process a -> (a -> Process b) -> Process b
bindP (Process ProcessId -> Cont a
m) a -> Process b
k = 
  (ProcessId -> Cont b) -> Process b
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont b) -> Process b)
-> (ProcessId -> Cont b) -> Process b
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 :: Parameter a -> Process a
liftPP Parameter a
m = (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> Parameter a -> Cont a
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter a
m

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

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

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

liftIOP :: IO a -> Process a
{-# INLINE liftIOP #-}
liftIOP :: IO a -> Process a
liftIOP IO a
m = (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> IO a -> Cont a
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 :: Process a -> (e -> Process a) -> Process a
catchProcess (Process ProcessId -> Cont a
m) e -> Process a
h =
  (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  Cont a -> (e -> Cont a) -> Cont a
forall e a. Exception e => Cont a -> (e -> Cont a) -> Cont a
catchCont (ProcessId -> Cont a
m ProcessId
pid) ((e -> Cont a) -> Cont a) -> (e -> Cont a) -> Cont a
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 :: Process a -> Process b -> Process a
finallyProcess (Process ProcessId -> Cont a
m) (Process ProcessId -> Cont b
m') =
  (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  Cont a -> Cont b -> Cont a
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 :: e -> Process a
throwProcess = IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Process a) -> (e -> IO a) -> e -> Process a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall a e. Exception e => e -> a
throw

-- | 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 :: [Process a] -> Process [a]
processParallel [Process a]
xs =
  Simulation [(ProcessId, Process a)]
-> Process [(ProcessId, Process a)]
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation ([Process a] -> Simulation [(ProcessId, Process a)]
forall a. [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs) Process [(ProcessId, Process a)]
-> ([(ProcessId, Process a)] -> Process [a]) -> Process [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(ProcessId, Process a)] -> Process [a]
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 :: [(ProcessId, Process a)] -> Process [a]
processParallelUsingIds [(ProcessId, Process a)]
xs =
  (ProcessId -> Cont [a]) -> Process [a]
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont [a]) -> Process [a])
-> (ProcessId -> Cont [a]) -> Process [a]
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  do Event () -> Cont ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Cont ()) -> Event () -> Cont ()
forall a b. (a -> b) -> a -> b
$ [(ProcessId, Process a)] -> Event ()
forall a. [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs
     [(Cont a, ContId)] -> Cont [a]
forall a. [(Cont a, ContId)] -> Cont [a]
contParallel ([(Cont a, ContId)] -> Cont [a]) -> [(Cont a, ContId)] -> Cont [a]
forall a b. (a -> b) -> a -> b
$
       (((ProcessId, Process a) -> (Cont a, ContId))
 -> [(ProcessId, Process a)] -> [(Cont a, ContId)])
-> [(ProcessId, Process a)]
-> ((ProcessId, Process a) -> (Cont a, ContId))
-> [(Cont a, ContId)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ProcessId, Process a) -> (Cont a, ContId))
-> [(ProcessId, Process a)] -> [(Cont a, ContId)]
forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId, Process a)]
xs (((ProcessId, Process a) -> (Cont a, ContId))
 -> [(Cont a, ContId)])
-> ((ProcessId, Process a) -> (Cont a, ContId))
-> [(Cont a, ContId)]
forall a b. (a -> b) -> a -> b
$ \(ProcessId
pid, Process a
m) ->
       (ProcessId -> Process a -> Cont a
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_ :: [Process a] -> Process ()
processParallel_ [Process a]
xs =
  Simulation [(ProcessId, Process a)]
-> Process [(ProcessId, Process a)]
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation ([Process a] -> Simulation [(ProcessId, Process a)]
forall a. [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs) Process [(ProcessId, Process a)]
-> ([(ProcessId, Process a)] -> Process ()) -> Process ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(ProcessId, Process a)] -> Process ()
forall a. [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_ 

-- | Like 'processParallelUsingIds' but ignores the result.
processParallelUsingIds_ :: [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_ :: [(ProcessId, Process a)] -> Process ()
processParallelUsingIds_ [(ProcessId, Process a)]
xs =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  do Event () -> Cont ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Cont ()) -> Event () -> Cont ()
forall a b. (a -> b) -> a -> b
$ [(ProcessId, Process a)] -> Event ()
forall a. [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs
     [(Cont a, ContId)] -> Cont ()
forall a. [(Cont a, ContId)] -> Cont ()
contParallel_ ([(Cont a, ContId)] -> Cont ()) -> [(Cont a, ContId)] -> Cont ()
forall a b. (a -> b) -> a -> b
$
       (((ProcessId, Process a) -> (Cont a, ContId))
 -> [(ProcessId, Process a)] -> [(Cont a, ContId)])
-> [(ProcessId, Process a)]
-> ((ProcessId, Process a) -> (Cont a, ContId))
-> [(Cont a, ContId)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ProcessId, Process a) -> (Cont a, ContId))
-> [(ProcessId, Process a)] -> [(Cont a, ContId)]
forall a b. (a -> b) -> [a] -> [b]
map [(ProcessId, Process a)]
xs (((ProcessId, Process a) -> (Cont a, ContId))
 -> [(Cont a, ContId)])
-> ((ProcessId, Process a) -> (Cont a, ContId))
-> [(Cont a, ContId)]
forall a b. (a -> b) -> a -> b
$ \(ProcessId
pid, Process a
m) ->
       (ProcessId -> Process a -> Cont a
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 :: [Process a] -> Simulation [(ProcessId, Process a)]
processParallelCreateIds [Process a]
xs =
  do [ProcessId]
pids <- Simulation [ProcessId] -> Simulation [ProcessId]
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation (Simulation [ProcessId] -> Simulation [ProcessId])
-> Simulation [ProcessId] -> Simulation [ProcessId]
forall a b. (a -> b) -> a -> b
$ [Process a]
-> (Process a -> Simulation ProcessId) -> Simulation [ProcessId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Process a]
xs ((Process a -> Simulation ProcessId) -> Simulation [ProcessId])
-> (Process a -> Simulation ProcessId) -> Simulation [ProcessId]
forall a b. (a -> b) -> a -> b
$ Simulation ProcessId -> Process a -> Simulation ProcessId
forall a b. a -> b -> a
const Simulation ProcessId
newProcessId
     [(ProcessId, Process a)] -> Simulation [(ProcessId, Process a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ProcessId, Process a)] -> Simulation [(ProcessId, Process a)])
-> [(ProcessId, Process a)] -> Simulation [(ProcessId, Process a)]
forall a b. (a -> b) -> a -> b
$ [ProcessId] -> [Process a] -> [(ProcessId, Process a)]
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 :: [(ProcessId, Process a)] -> Event ()
processParallelPrepare [(ProcessId, Process a)]
xs =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  [(ProcessId, Process a)]
-> ((ProcessId, Process a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ProcessId, Process a)]
xs (((ProcessId, Process a) -> IO ()) -> IO ())
-> ((ProcessId, Process a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ())
-> ((ProcessId, Process a) -> Event ())
-> (ProcessId, Process a)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessId -> Event ()
processIdPrepare (ProcessId -> Event ())
-> ((ProcessId, Process a) -> ProcessId)
-> (ProcessId, Process a)
-> Event ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessId, Process a) -> ProcessId
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 :: ProcessId -> Process a -> Process a
processUsingId ProcessId
pid Process a
x =
  (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid' ->
  do Event () -> Cont ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Cont ()) -> Event () -> Cont ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processIdPrepare ProcessId
pid
     Cont a -> ContId -> Cont a
forall a. Cont a -> ContId -> Cont a
rerunCont (ProcessId -> Process a -> Cont a
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 <- Simulation ProcessId -> Process ProcessId
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 =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid' ->
  do Event () -> Cont ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Cont ()) -> Event () -> Cont ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processIdPrepare ProcessId
pid
     ContCancellation -> Cont () -> ContId -> Cont ()
spawnCont ContCancellation
cancellation (ProcessId -> Process () -> Cont ()
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 :: Signal a -> Process a
processAwait Signal a
signal =
  (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> Signal a -> Cont a
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 :: Process a -> Simulation (Process a)
memoProcess Process a
x =
  do IORef Bool
started  <- IO (IORef Bool) -> Simulation (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> Simulation (IORef Bool))
-> IO (IORef Bool) -> Simulation (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
     SignalSource ()
computed <- Simulation (SignalSource ())
forall a. Simulation (SignalSource a)
newSignalSource
     IORef (Maybe (MemoResult a))
value    <- IO (IORef (Maybe (MemoResult a)))
-> Simulation (IORef (Maybe (MemoResult a)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (MemoResult a)))
 -> Simulation (IORef (Maybe (MemoResult a))))
-> IO (IORef (Maybe (MemoResult a)))
-> Simulation (IORef (Maybe (MemoResult a)))
forall a b. (a -> b) -> a -> b
$ Maybe (MemoResult a) -> IO (IORef (Maybe (MemoResult a)))
forall a. a -> IO (IORef a)
newIORef Maybe (MemoResult a)
forall a. Maybe a
Nothing
     let result :: Process a
result =
           do Just MemoResult a
x <- IO (Maybe (MemoResult a)) -> Process (Maybe (MemoResult a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (MemoResult a)) -> Process (Maybe (MemoResult a)))
-> IO (Maybe (MemoResult a)) -> Process (Maybe (MemoResult a))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (MemoResult a)) -> IO (Maybe (MemoResult a))
forall a. IORef a -> IO a
readIORef IORef (Maybe (MemoResult a))
value
              case MemoResult a
x of
                MemoComputed a -> a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                MemoError e    -> IOException -> Process a
forall e a. Exception e => e -> Process a
throwProcess IOException
e
                MemoResult a
MemoCancelled  -> Process a
forall a. Process a
cancelProcess
     Process a -> Simulation (Process a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Process a -> Simulation (Process a))
-> Process a -> Simulation (Process a)
forall a b. (a -> b) -> a -> b
$
       do Maybe (MemoResult a)
v <- IO (Maybe (MemoResult a)) -> Process (Maybe (MemoResult a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (MemoResult a)) -> Process (Maybe (MemoResult a)))
-> IO (Maybe (MemoResult a)) -> Process (Maybe (MemoResult a))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (MemoResult a)) -> IO (Maybe (MemoResult a))
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 <- IO Bool -> Process Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Process Bool) -> IO Bool -> Process Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
started
                 case Bool
f of
                   Bool
True ->
                     do Signal () -> Process ()
forall a. Signal a -> Process a
processAwait (Signal () -> Process ()) -> Signal () -> Process ()
forall a b. (a -> b) -> a -> b
$ SignalSource () -> Signal ()
forall a. SignalSource a -> Signal a
publishSignal SignalSource ()
computed
                        Process a
result
                   Bool
False ->
                     do IO () -> Process ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
started Bool
True
                        IORef (MemoResult a)
r <- IO (IORef (MemoResult a)) -> Process (IORef (MemoResult a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (MemoResult a)) -> Process (IORef (MemoResult a)))
-> IO (IORef (MemoResult a)) -> Process (IORef (MemoResult a))
forall a b. (a -> b) -> a -> b
$ MemoResult a -> IO (IORef (MemoResult a))
forall a. a -> IO (IORef a)
newIORef MemoResult a
forall a. MemoResult a
MemoCancelled
                        Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process a
finallyProcess
                          (Process () -> (IOException -> Process ()) -> Process ()
forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess
                           (do a
a <- Process a
x    -- compute only once!
                               IO () -> Process ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef (MemoResult a) -> MemoResult a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MemoResult a)
r (a -> MemoResult a
forall a. a -> MemoResult a
MemoComputed a
a))
                           (\IOException
e ->
                             IO () -> Process ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef (MemoResult a) -> MemoResult a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MemoResult a)
r (IOException -> MemoResult a
forall a. IOException -> MemoResult a
MemoError IOException
e)))
                          (Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
                           do IO () -> Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Event ()) -> IO () -> Event ()
forall a b. (a -> b) -> a -> b
$
                                do MemoResult a
x <- IORef (MemoResult a) -> IO (MemoResult a)
forall a. IORef a -> IO a
readIORef IORef (MemoResult a)
r
                                   IORef (Maybe (MemoResult a)) -> Maybe (MemoResult a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (MemoResult a))
value (MemoResult a -> Maybe (MemoResult a)
forall a. a -> Maybe a
Just MemoResult a
x)
                              SignalSource () -> () -> Event ()
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 :: Process a -> Process b -> Process (a, b)
zipProcessParallel Process a
x Process b
y =
  do [Left a
a, Right b
b] <- [Process (Either a b)] -> Process [Either a b]
forall a. [Process a] -> Process [a]
processParallel [(a -> Either a b) -> Process a -> Process (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left Process a
x, (b -> Either a b) -> Process b -> Process (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right Process b
y]
     (a, b) -> Process (a, b)
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 :: 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)] <-
       [Process (Either a (Either b c))]
-> Process [Either a (Either b c)]
forall a. [Process a] -> Process [a]
processParallel [(a -> Either a (Either b c))
-> Process a -> Process (Either a (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a (Either b c)
forall a b. a -> Either a b
Left Process a
x,
                        (b -> Either a (Either b c))
-> Process b -> Process (Either a (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either b c -> Either a (Either b c)
forall a b. b -> Either a b
Right (Either b c -> Either a (Either b c))
-> (b -> Either b c) -> b -> Either a (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b c
forall a b. a -> Either a b
Left) Process b
y,
                        (c -> Either a (Either b c))
-> Process c -> Process (Either a (Either b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either b c -> Either a (Either b c)
forall a b. b -> Either a b
Right (Either b c -> Either a (Either b c))
-> (c -> Either b c) -> c -> Either a (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right) Process c
z]
     (a, b, c) -> Process (a, b, c)
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 :: Process (a, b) -> Simulation (Process a, Process b)
unzipProcess Process (a, b)
xy =
  do Process (a, b)
xy' <- Process (a, b) -> Simulation (Process (a, b))
forall a. Process a -> Simulation (Process a)
memoProcess Process (a, b)
xy
     (Process a, Process b) -> Simulation (Process a, Process b)
forall (m :: * -> *) a. Monad m => a -> m a
return (((a, b) -> a) -> Process (a, b) -> Process a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst Process (a, b)
xy', ((a, b) -> b) -> Process (a, b) -> Process b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd Process (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 :: Double -> Process a -> Process (Maybe a)
timeoutProcess Double
timeout Process a
p =
  do ProcessId
pid <- Simulation ProcessId -> Process ProcessId
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
     Double -> ProcessId -> Process a -> Process (Maybe a)
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 :: Double -> ProcessId -> Process a -> Process (Maybe a)
timeoutProcessUsingId Double
timeout ProcessId
pid Process a
p =
  do SignalSource (Maybe (Either SomeException a))
s <- Simulation (SignalSource (Maybe (Either SomeException a)))
-> Process (SignalSource (Maybe (Either SomeException a)))
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation (SignalSource (Maybe (Either SomeException a)))
forall a. Simulation (SignalSource a)
newSignalSource
     ProcessId
timeoutPid <- Simulation ProcessId -> Process ProcessId
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation ProcessId
newProcessId
     ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId
timeoutPid (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$
       do Double -> Process ()
holdProcess Double
timeout
          Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
            ProcessId -> Event ()
cancelProcessWithId ProcessId
pid
     ContCancellation -> ProcessId -> Process () -> Process ()
spawnProcessUsingIdWith ContCancellation
CancelChildAfterParent ProcessId
pid (Process () -> Process ()) -> Process () -> Process ()
forall a b. (a -> b) -> a -> b
$
       do IORef (Maybe (Either SomeException a))
r <- IO (IORef (Maybe (Either SomeException a)))
-> Process (IORef (Maybe (Either SomeException a)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (Either SomeException a)))
 -> Process (IORef (Maybe (Either SomeException a))))
-> IO (IORef (Maybe (Either SomeException a)))
-> Process (IORef (Maybe (Either SomeException a)))
forall a b. (a -> b) -> a -> b
$ Maybe (Either SomeException a)
-> IO (IORef (Maybe (Either SomeException a)))
forall a. a -> IO (IORef a)
newIORef Maybe (Either SomeException a)
forall a. Maybe a
Nothing
          Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process a
finallyProcess
            (Process () -> (SomeException -> Process ()) -> Process ()
forall e a.
Exception e =>
Process a -> (e -> Process a) -> Process a
catchProcess
             (do a
a <- Process a
p
                 IO () -> Process ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (Either SomeException a))
-> Maybe (Either SomeException a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Either SomeException a))
r (Maybe (Either SomeException a) -> IO ())
-> Maybe (Either SomeException a) -> IO ()
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a))
             (\SomeException
e ->
               IO () -> Process ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Process ()) -> IO () -> Process ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (Either SomeException a))
-> Maybe (Either SomeException a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Either SomeException a))
r (Maybe (Either SomeException a) -> IO ())
-> Maybe (Either SomeException a) -> IO ()
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
e)))
            (Event () -> Process ()
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event () -> Process ()) -> Event () -> Process ()
forall a b. (a -> b) -> a -> b
$
             do ProcessId -> Event ()
cancelProcessWithId ProcessId
timeoutPid
                Maybe (Either SomeException a)
x <- IO (Maybe (Either SomeException a))
-> Event (Maybe (Either SomeException a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either SomeException a))
 -> Event (Maybe (Either SomeException a)))
-> IO (Maybe (Either SomeException a))
-> Event (Maybe (Either SomeException a))
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (Either SomeException a))
-> IO (Maybe (Either SomeException a))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Either SomeException a))
r
                SignalSource (Maybe (Either SomeException a))
-> Maybe (Either SomeException a) -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal SignalSource (Maybe (Either SomeException a))
s Maybe (Either SomeException a)
x)
     Maybe (Either SomeException a)
x <- Signal (Maybe (Either SomeException a))
-> Process (Maybe (Either SomeException a))
forall a. Signal a -> Process a
processAwait (Signal (Maybe (Either SomeException a))
 -> Process (Maybe (Either SomeException a)))
-> Signal (Maybe (Either SomeException a))
-> Process (Maybe (Either SomeException a))
forall a b. (a -> b) -> a -> b
$ SignalSource (Maybe (Either SomeException a))
-> Signal (Maybe (Either SomeException a))
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 -> Maybe a -> Process (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
       Just (Right a
a) -> Maybe a -> Process (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
       Just (Left (SomeException e
e)) -> e -> Process (Maybe a)
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 =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
  Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$
  ContParams () -> () -> Event ()
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 :: Process a
neverProcess =
  (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams a -> Event ()) -> Cont a
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams a -> Event ()) -> Cont a)
-> (ContParams a -> Event ()) -> Cont a
forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  let signal :: Signal ()
signal = ProcessId -> Signal ()
processCancelling ProcessId
pid
  in Signal () -> (() -> Event ()) -> Event ()
forall a. Signal a -> (a -> Event ()) -> Event ()
handleSignal_ Signal ()
signal ((() -> Event ()) -> Event ()) -> (() -> Event ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \()
_ ->
     ContParams a -> a -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams a
c (a -> Event ()) -> a -> Event ()
forall a b. (a -> b) -> a -> b
$ [Char] -> a
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 :: [Char] -> Process a
retryProcess = Event a -> Process a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent (Event a -> Process a)
-> ([Char] -> Event a) -> [Char] -> Process a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Event a
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 :: Process () -> Process a
transferProcess (Process ProcessId -> Cont ()
m) =
  (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid -> Cont () -> Cont a
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 :: [Char] -> Process a -> Process a
traceProcess [Char]
message Process a
m =
  (ProcessId -> Cont a) -> Process a
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont a) -> Process a)
-> (ProcessId -> Cont a) -> Process a
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  [Char] -> Cont a -> Cont a
forall a. [Char] -> Cont a -> Cont a
traceCont [Char]
message (Cont a -> Cont a) -> Cont a -> Cont a
forall a b. (a -> b) -> a -> b
$
  ProcessId -> Process a -> Cont a
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid Process a
m