-- |
-- Module     : Simulation.Aivika.Trans.GPSS.Transact
-- Copyright  : Copyright (c) 2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.2
--
-- This module defines a GPSS transact.
--
module Simulation.Aivika.Trans.GPSS.Transact
       (Transact,
        transactValue,
        transactArrivalDelay,
        transactArrivalTime,
        transactPriority,
        transactAssemblySet,
        newTransact,
        splitTransact,
        assignTransactValue,
        assignTransactValueM,
        assignTransactPriority,
        takeTransact,
        releaseTransact,
        transactPreemptionBegin,
        transactPreemptionEnd,
        requireTransactProcessId,
        transferTransact,
        reactivateTransacts,
        registerTransactQueueEntry,
        unregisterTransactQueueEntry) where

import Control.Monad
import Control.Monad.Trans
import Control.Exception

import qualified Data.HashMap.Lazy as HM

import Simulation.Aivika.Trans
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Internal.Cont
import Simulation.Aivika.Trans.Internal.Process

import {-# SOURCE #-} Simulation.Aivika.Trans.GPSS.Queue
import {-# SOURCE #-} Simulation.Aivika.Trans.GPSS.AssemblySet

-- | Represents a GPSS transact.
data Transact m a =
  Transact { Transact m a -> a
transactValue :: a,
             -- ^ The data of the transact.
             Transact m a -> Maybe Double
transactArrivalDelay :: Maybe Double,
             -- ^ The delay between the transacts generated.
             Transact m a -> Double
transactArrivalTime :: Double,
             -- ^ The time at which the transact was generated.
             Transact m a -> Int
transactPriority :: Int,
             -- ^ The transact priority.
             Transact m a -> Ref m (Maybe (AssemblySet m))
transactAssemblySetRef :: Ref m (Maybe (AssemblySet m)),
             -- ^ The assembly set.
             Transact m a -> Ref m Int
transactPreemptionCountRef :: Ref m Int,
             -- ^ How many times the transact is preempted.
             Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef :: Ref m (Maybe (ProcessId m)),
             -- ^ An identifier of the process that handles the transact at present
             Transact m a -> Ref m (Maybe (FrozenCont m ()))
transactProcessContRef :: Ref m (Maybe (FrozenCont m ())),
             -- ^ A continuation of the process that tried to handle the transact.
             Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
transactQueueEntryRef :: Ref m (HM.HashMap (Queue m) (QueueEntry m))
             -- ^ The queue entries registered by the the transact.
           }

instance MonadDES m => Eq (Transact m a) where

  {-# INLINABLE (==) #-}
  Transact m a
x == :: Transact m a -> Transact m a -> Bool
== Transact m a
y = (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
x) Ref m (Maybe (ProcessId m)) -> Ref m (Maybe (ProcessId m)) -> Bool
forall a. Eq a => a -> a -> Bool
== (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
y)

-- | Create a new transact.
newTransact :: MonadDES m
               => Arrival a
               -- ^ the arrival data
               -> Int
               -- ^ the transact priority
               -> Simulation m (Transact m a)
{-# INLINABLE newTransact #-}
newTransact :: Arrival a -> Int -> Simulation m (Transact m a)
newTransact Arrival a
a Int
priority =
  (Run m -> m (Transact m a)) -> Simulation m (Transact m a)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Transact m a)) -> Simulation m (Transact m a))
-> (Run m -> m (Transact m a)) -> Simulation m (Transact m a)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Ref m Int
r0 <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Int
0
     Ref m (Maybe (ProcessId m))
r1 <- Run m
-> Simulation m (Ref m (Maybe (ProcessId m)))
-> m (Ref m (Maybe (ProcessId m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (ProcessId m)))
 -> m (Ref m (Maybe (ProcessId m))))
-> Simulation m (Ref m (Maybe (ProcessId m)))
-> m (Ref m (Maybe (ProcessId m)))
forall a b. (a -> b) -> a -> b
$ Maybe (ProcessId m) -> Simulation m (Ref m (Maybe (ProcessId m)))
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Maybe (ProcessId m)
forall a. Maybe a
Nothing
     Ref m (Maybe (FrozenCont m ()))
r2 <- Run m
-> Simulation m (Ref m (Maybe (FrozenCont m ())))
-> m (Ref m (Maybe (FrozenCont m ())))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (FrozenCont m ())))
 -> m (Ref m (Maybe (FrozenCont m ()))))
-> Simulation m (Ref m (Maybe (FrozenCont m ())))
-> m (Ref m (Maybe (FrozenCont m ())))
forall a b. (a -> b) -> a -> b
$ Maybe (FrozenCont m ())
-> Simulation m (Ref m (Maybe (FrozenCont m ())))
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Maybe (FrozenCont m ())
forall a. Maybe a
Nothing
     Ref m (HashMap (Queue m) (QueueEntry m))
r3 <- Run m
-> Simulation m (Ref m (HashMap (Queue m) (QueueEntry m)))
-> m (Ref m (HashMap (Queue m) (QueueEntry m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (HashMap (Queue m) (QueueEntry m)))
 -> m (Ref m (HashMap (Queue m) (QueueEntry m))))
-> Simulation m (Ref m (HashMap (Queue m) (QueueEntry m)))
-> m (Ref m (HashMap (Queue m) (QueueEntry m)))
forall a b. (a -> b) -> a -> b
$ HashMap (Queue m) (QueueEntry m)
-> Simulation m (Ref m (HashMap (Queue m) (QueueEntry m)))
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef HashMap (Queue m) (QueueEntry m)
forall k v. HashMap k v
HM.empty
     Ref m (Maybe (AssemblySet m))
r4 <- Run m
-> Simulation m (Ref m (Maybe (AssemblySet m)))
-> m (Ref m (Maybe (AssemblySet m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (AssemblySet m)))
 -> m (Ref m (Maybe (AssemblySet m))))
-> Simulation m (Ref m (Maybe (AssemblySet m)))
-> m (Ref m (Maybe (AssemblySet m)))
forall a b. (a -> b) -> a -> b
$ Maybe (AssemblySet m)
-> Simulation m (Ref m (Maybe (AssemblySet m)))
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Maybe (AssemblySet m)
forall a. Maybe a
Nothing
     Transact m a -> m (Transact m a)
forall (m :: * -> *) a. Monad m => a -> m a
return Transact :: forall (m :: * -> *) a.
a
-> Maybe Double
-> Double
-> Int
-> Ref m (Maybe (AssemblySet m))
-> Ref m Int
-> Ref m (Maybe (ProcessId m))
-> Ref m (Maybe (FrozenCont m ()))
-> Ref m (HashMap (Queue m) (QueueEntry m))
-> Transact m a
Transact { transactValue :: a
transactValue = Arrival a -> a
forall a. Arrival a -> a
arrivalValue Arrival a
a,
                       transactArrivalDelay :: Maybe Double
transactArrivalDelay = Arrival a -> Maybe Double
forall a. Arrival a -> Maybe Double
arrivalDelay Arrival a
a,
                       transactArrivalTime :: Double
transactArrivalTime = Arrival a -> Double
forall a. Arrival a -> Double
arrivalTime Arrival a
a,
                       transactPriority :: Int
transactPriority = Int
priority,
                       transactAssemblySetRef :: Ref m (Maybe (AssemblySet m))
transactAssemblySetRef = Ref m (Maybe (AssemblySet m))
r4,
                       transactPreemptionCountRef :: Ref m Int
transactPreemptionCountRef = Ref m Int
r0,
                       transactProcessIdRef :: Ref m (Maybe (ProcessId m))
transactProcessIdRef = Ref m (Maybe (ProcessId m))
r1,
                       transactProcessContRef :: Ref m (Maybe (FrozenCont m ()))
transactProcessContRef = Ref m (Maybe (FrozenCont m ()))
r2,
                       transactQueueEntryRef :: Ref m (HashMap (Queue m) (QueueEntry m))
transactQueueEntryRef = Ref m (HashMap (Queue m) (QueueEntry m))
r3
                     }

-- | Split the transact.
splitTransact :: MonadDES m => Transact m a -> Simulation m (Transact m a)
{-# INLINABLE splitTransact #-}
splitTransact :: Transact m a -> Simulation m (Transact m a)
splitTransact Transact m a
t =
  (Run m -> m (Transact m a)) -> Simulation m (Transact m a)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Transact m a)) -> Simulation m (Transact m a))
-> (Run m -> m (Transact m a)) -> Simulation m (Transact m a)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Ref m Int
r0 <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Int
0
     Ref m (Maybe (ProcessId m))
r1 <- Run m
-> Simulation m (Ref m (Maybe (ProcessId m)))
-> m (Ref m (Maybe (ProcessId m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (ProcessId m)))
 -> m (Ref m (Maybe (ProcessId m))))
-> Simulation m (Ref m (Maybe (ProcessId m)))
-> m (Ref m (Maybe (ProcessId m)))
forall a b. (a -> b) -> a -> b
$ Maybe (ProcessId m) -> Simulation m (Ref m (Maybe (ProcessId m)))
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Maybe (ProcessId m)
forall a. Maybe a
Nothing
     Ref m (Maybe (FrozenCont m ()))
r2 <- Run m
-> Simulation m (Ref m (Maybe (FrozenCont m ())))
-> m (Ref m (Maybe (FrozenCont m ())))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (FrozenCont m ())))
 -> m (Ref m (Maybe (FrozenCont m ()))))
-> Simulation m (Ref m (Maybe (FrozenCont m ())))
-> m (Ref m (Maybe (FrozenCont m ())))
forall a b. (a -> b) -> a -> b
$ Maybe (FrozenCont m ())
-> Simulation m (Ref m (Maybe (FrozenCont m ())))
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef Maybe (FrozenCont m ())
forall a. Maybe a
Nothing
     Ref m (HashMap (Queue m) (QueueEntry m))
r3 <- Run m
-> Simulation m (Ref m (HashMap (Queue m) (QueueEntry m)))
-> m (Ref m (HashMap (Queue m) (QueueEntry m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (HashMap (Queue m) (QueueEntry m)))
 -> m (Ref m (HashMap (Queue m) (QueueEntry m))))
-> Simulation m (Ref m (HashMap (Queue m) (QueueEntry m)))
-> m (Ref m (HashMap (Queue m) (QueueEntry m)))
forall a b. (a -> b) -> a -> b
$ HashMap (Queue m) (QueueEntry m)
-> Simulation m (Ref m (HashMap (Queue m) (QueueEntry m)))
forall (m :: * -> *) a. MonadDES m => a -> Simulation m (Ref m a)
newRef HashMap (Queue m) (QueueEntry m)
forall k v. HashMap k v
HM.empty
     Transact m a -> m (Transact m a)
forall (m :: * -> *) a. Monad m => a -> m a
return Transact :: forall (m :: * -> *) a.
a
-> Maybe Double
-> Double
-> Int
-> Ref m (Maybe (AssemblySet m))
-> Ref m Int
-> Ref m (Maybe (ProcessId m))
-> Ref m (Maybe (FrozenCont m ()))
-> Ref m (HashMap (Queue m) (QueueEntry m))
-> Transact m a
Transact { transactValue :: a
transactValue = Transact m a -> a
forall (m :: * -> *) a. Transact m a -> a
transactValue Transact m a
t,
                       transactArrivalDelay :: Maybe Double
transactArrivalDelay = Transact m a -> Maybe Double
forall (m :: * -> *) a. Transact m a -> Maybe Double
transactArrivalDelay Transact m a
t,
                       transactArrivalTime :: Double
transactArrivalTime = Transact m a -> Double
forall (m :: * -> *) a. Transact m a -> Double
transactArrivalTime Transact m a
t,
                       transactPriority :: Int
transactPriority = Transact m a -> Int
forall (m :: * -> *) a. Transact m a -> Int
transactPriority Transact m a
t,
                       transactAssemblySetRef :: Ref m (Maybe (AssemblySet m))
transactAssemblySetRef = Transact m a -> Ref m (Maybe (AssemblySet m))
forall (m :: * -> *) a.
Transact m a -> Ref m (Maybe (AssemblySet m))
transactAssemblySetRef Transact m a
t,
                       transactPreemptionCountRef :: Ref m Int
transactPreemptionCountRef = Ref m Int
r0,
                       transactProcessIdRef :: Ref m (Maybe (ProcessId m))
transactProcessIdRef = Ref m (Maybe (ProcessId m))
r1,
                       transactProcessContRef :: Ref m (Maybe (FrozenCont m ()))
transactProcessContRef = Ref m (Maybe (FrozenCont m ()))
r2,
                       transactQueueEntryRef :: Ref m (HashMap (Queue m) (QueueEntry m))
transactQueueEntryRef = Ref m (HashMap (Queue m) (QueueEntry m))
r3
                     }

-- | Return the transact assembly set.
transactAssemblySet :: MonadDES m => Transact m a -> Event m (AssemblySet m)
{-# INLINABLE transactAssemblySet #-}
transactAssemblySet :: Transact m a -> Event m (AssemblySet m)
transactAssemblySet Transact m a
t =
  (Point m -> m (AssemblySet m)) -> Event m (AssemblySet m)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (AssemblySet m)) -> Event m (AssemblySet m))
-> (Point m -> m (AssemblySet m)) -> Event m (AssemblySet m)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
     Maybe (AssemblySet m)
x <- Point m
-> Event m (Maybe (AssemblySet m)) -> m (Maybe (AssemblySet m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (AssemblySet m)) -> m (Maybe (AssemblySet m)))
-> Event m (Maybe (AssemblySet m)) -> m (Maybe (AssemblySet m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (AssemblySet m)) -> Event m (Maybe (AssemblySet m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (Maybe (AssemblySet m))
forall (m :: * -> *) a.
Transact m a -> Ref m (Maybe (AssemblySet m))
transactAssemblySetRef Transact m a
t)
     case Maybe (AssemblySet m)
x of
       Just AssemblySet m
a  -> AssemblySet m -> m (AssemblySet m)
forall (m :: * -> *) a. Monad m => a -> m a
return AssemblySet m
a
       Maybe (AssemblySet m)
Nothing ->
         do AssemblySet m
a <- Run m -> Simulation m (AssemblySet m) -> m (AssemblySet m)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r Simulation m (AssemblySet m)
forall (m :: * -> *). MonadDES m => Simulation m (AssemblySet m)
newAssemblySet
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (AssemblySet m))
-> Maybe (AssemblySet m) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (Maybe (AssemblySet m))
forall (m :: * -> *) a.
Transact m a -> Ref m (Maybe (AssemblySet m))
transactAssemblySetRef Transact m a
t) (AssemblySet m -> Maybe (AssemblySet m)
forall a. a -> Maybe a
Just AssemblySet m
a)
            AssemblySet m -> m (AssemblySet m)
forall (m :: * -> *) a. Monad m => a -> m a
return AssemblySet m
a

-- | Take the transact.
takeTransact :: MonadDES m => Transact m a -> Process m ()
{-# INLINABLE takeTransact #-}
takeTransact :: Transact m a -> Process m ()
takeTransact Transact m a
t =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Maybe (ProcessId m)
pid0 <- Point m -> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m)))
-> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Event m (Maybe (ProcessId m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t)
     case Maybe (ProcessId m)
pid0 of
       Just ProcessId m
pid0 ->
         SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"The transact is acquired by another process: takeTransact"
       Maybe (ProcessId m)
Nothing   ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Maybe (ProcessId m) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t) (ProcessId m -> Maybe (ProcessId m)
forall a. a -> Maybe a
Just ProcessId m
pid)
            Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m Int
forall (m :: * -> *) a. Transact m a -> Ref m Int
transactPreemptionCountRef Transact m a
t)
            if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
              then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
              else do FrozenCont m ()
c <- Point m -> Event m (FrozenCont m ()) -> m (FrozenCont m ())
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (FrozenCont m ()) -> m (FrozenCont m ()))
-> Event m (FrozenCont m ()) -> m (FrozenCont m ())
forall a b. (a -> b) -> a -> b
$
                           ContParams m () -> () -> Event m () -> Event m (FrozenCont m ())
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams m ()
c () (Event m () -> Event m (FrozenCont m ()))
-> Event m () -> Event m (FrozenCont m ())
forall a b. (a -> b) -> a -> b
$
                           ContParams m () -> Cont m () -> Event m ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m ()
c (Cont m () -> Event m ()) -> Cont m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
                           ProcessId m -> Process m () -> Cont m ()
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId m
pid (Process m () -> Cont m ()) -> Process m () -> Cont m ()
forall a b. (a -> b) -> a -> b
$
                           Transact m a -> Process m ()
forall (m :: * -> *) a. MonadDES m => Transact m a -> Process m ()
takeTransact Transact m a
t
                      Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
                        Ref m (Maybe (FrozenCont m ()))
-> Maybe (FrozenCont m ()) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (Maybe (FrozenCont m ()))
forall (m :: * -> *) a.
Transact m a -> Ref m (Maybe (FrozenCont m ()))
transactProcessContRef Transact m a
t) (FrozenCont m () -> Maybe (FrozenCont m ())
forall a. a -> Maybe a
Just FrozenCont m ()
c)
                      [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
n] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
_ ->
                        Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
                        ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionBegin ProcessId m
pid

-- | Release the transact.
releaseTransact :: MonadDES m => Transact m a -> Process m ()
{-# INLINABLE releaseTransact #-}
releaseTransact :: Transact m a -> Process m ()
releaseTransact Transact m a
t =
  (ProcessId m -> Cont m ()) -> Process m ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId m -> Cont m ()) -> Process m ())
-> (ProcessId m -> Cont m ()) -> Process m ()
forall a b. (a -> b) -> a -> b
$ \ProcessId m
pid ->
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Maybe (ProcessId m)
pid0 <- Point m -> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m)))
-> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Event m (Maybe (ProcessId m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t)
     case Maybe (ProcessId m)
pid0 of
       Maybe (ProcessId m)
Nothing ->
         SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"The transact is not acquired by any process: releaseTransact"
       Just ProcessId m
pid0 | ProcessId m
pid0 ProcessId m -> ProcessId m -> Bool
forall a. Eq a => a -> a -> Bool
/= ProcessId m
pid ->
         SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"The transact is acquired by another process: releaseTransact"
       Just ProcessId m
pid0 ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Maybe (ProcessId m) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t) Maybe (ProcessId m)
forall a. Maybe a
Nothing
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (FrozenCont m ()))
-> Maybe (FrozenCont m ()) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (Maybe (FrozenCont m ()))
forall (m :: * -> *) a.
Transact m a -> Ref m (Maybe (FrozenCont m ()))
transactProcessContRef Transact m a
t) Maybe (FrozenCont m ())
forall a. Maybe a
Nothing
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Preempt the computation that handles the transact.
transactPreemptionBegin :: MonadDES m => Transact m a -> Event m ()
{-# INLINABLE transactPreemptionBegin #-}
transactPreemptionBegin :: Transact m a -> Event m ()
transactPreemptionBegin Transact m a
t =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m Int
forall (m :: * -> *) a. Transact m a -> Ref m Int
transactPreemptionCountRef Transact m a
t)
     let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     Int
n' Int -> m () -> m ()
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m Int
forall (m :: * -> *) a. Transact m a -> Ref m Int
transactPreemptionCountRef Transact m a
t) Int
n'
     Maybe (ProcessId m)
pid <- Point m -> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m)))
-> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Event m (Maybe (ProcessId m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t)
     case Maybe (ProcessId m)
pid of
       Maybe (ProcessId m)
Nothing  -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ProcessId m
pid -> Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionBegin ProcessId m
pid

-- | Proceed with the computation after the transact was preempted earlier.
transactPreemptionEnd :: MonadDES m => Transact m a -> Event m ()
{-# INLINABLE transactPreemptionEnd #-}
transactPreemptionEnd :: Transact m a -> Event m ()
transactPreemptionEnd Transact m a
t =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m Int
forall (m :: * -> *) a. Transact m a -> Ref m Int
transactPreemptionCountRef Transact m a
t)
     let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
       SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
       String -> SimulationRetry
SimulationRetry
       String
"The transact preemption count cannot be negative: transactPreemptionEnd"
     Int
n' Int -> m () -> m ()
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m Int
forall (m :: * -> *) a. Transact m a -> Ref m Int
transactPreemptionCountRef Transact m a
t) Int
n'
     Maybe (ProcessId m)
pid <- Point m -> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m)))
-> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Event m (Maybe (ProcessId m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t)
     case Maybe (ProcessId m)
pid of
       Maybe (ProcessId m)
Nothing  -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ProcessId m
pid ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionEnd ProcessId m
pid
            Maybe (FrozenCont m ())
c <- Point m
-> Event m (Maybe (FrozenCont m ())) -> m (Maybe (FrozenCont m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (FrozenCont m ())) -> m (Maybe (FrozenCont m ())))
-> Event m (Maybe (FrozenCont m ())) -> m (Maybe (FrozenCont m ()))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (FrozenCont m ()))
-> Event m (Maybe (FrozenCont m ()))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (Maybe (FrozenCont m ()))
forall (m :: * -> *) a.
Transact m a -> Ref m (Maybe (FrozenCont m ()))
transactProcessContRef Transact m a
t)
            case Maybe (FrozenCont m ())
c of
              Maybe (FrozenCont m ())
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just FrozenCont m ()
c  ->
                do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (FrozenCont m ()))
-> Maybe (FrozenCont m ()) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (Maybe (FrozenCont m ()))
forall (m :: * -> *) a.
Transact m a -> Ref m (Maybe (FrozenCont m ()))
transactProcessContRef Transact m a
t) Maybe (FrozenCont m ())
forall a. Maybe a
Nothing
                   Maybe (ContParams m ())
c <- Point m
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ())))
-> Event m (Maybe (ContParams m ())) -> m (Maybe (ContParams m ()))
forall a b. (a -> b) -> a -> b
$ FrozenCont m () -> Event m (Maybe (ContParams m ()))
forall (m :: * -> *) a.
FrozenCont m a -> Event m (Maybe (ContParams m a))
unfreezeCont FrozenCont m ()
c
                   case Maybe (ContParams m ())
c of
                     Maybe (ContParams m ())
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     Just ContParams m ()
c  -> Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()

-- | Require to return an identifier of the process associated with the transact.
requireTransactProcessId :: MonadDES m => Transact m a -> Event m (ProcessId m)
{-# INLINABLE requireTransactProcessId #-}
requireTransactProcessId :: Transact m a -> Event m (ProcessId m)
requireTransactProcessId Transact m a
t =
  (Point m -> m (ProcessId m)) -> Event m (ProcessId m)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (ProcessId m)) -> Event m (ProcessId m))
-> (Point m -> m (ProcessId m)) -> Event m (ProcessId m)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Maybe (ProcessId m)
a <- Point m -> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m)))
-> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Event m (Maybe (ProcessId m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t)
     case Maybe (ProcessId m)
a of
       Maybe (ProcessId m)
Nothing ->
         SimulationRetry -> m (ProcessId m)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m (ProcessId m))
-> SimulationRetry -> m (ProcessId m)
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"The transact must be associated with any process: requireTransactProcessId"
       Just ProcessId m
pid ->
         ProcessId m -> m (ProcessId m)
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessId m
pid

-- | Like the GoTo statement, it associates the transact with another process.
transferTransact :: MonadDES m => Transact m a -> Process m () -> Event m ()
{-# INLINABLE transferTransact #-}
transferTransact :: Transact m a -> Process m () -> Event m ()
transferTransact Transact m a
t Process m ()
transfer =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Maybe (ProcessId m)
a <- Point m -> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m)))
-> Event m (Maybe (ProcessId m)) -> m (Maybe (ProcessId m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Event m (Maybe (ProcessId m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t)
     case Maybe (ProcessId m)
a of
       Maybe (ProcessId m)
Nothing  -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just ProcessId m
pid ->
         Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
cancelProcessWithId ProcessId m
pid
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ProcessId m)) -> Maybe (ProcessId m) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (Maybe (ProcessId m))
forall (m :: * -> *) a. Transact m a -> Ref m (Maybe (ProcessId m))
transactProcessIdRef Transact m a
t) Maybe (ProcessId m)
forall a. Maybe a
Nothing
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (FrozenCont m ()))
-> Maybe (FrozenCont m ()) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (Maybe (FrozenCont m ()))
forall (m :: * -> *) a.
Transact m a -> Ref m (Maybe (FrozenCont m ()))
transactProcessContRef Transact m a
t) Maybe (FrozenCont m ())
forall a. Maybe a
Nothing
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
       Process m () -> Event m ()
forall (m :: * -> *). MonadDES m => Process m () -> Event m ()
runProcess (Process m () -> Event m ()) -> Process m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
       do Transact m a -> Process m ()
forall (m :: * -> *) a. MonadDES m => Transact m a -> Process m ()
takeTransact Transact m a
t
          Process m () -> Process m ()
forall (m :: * -> *) a. MonadDES m => Process m () -> Process m a
transferProcess Process m ()
transfer

-- | Register the queue entry in the transact.
registerTransactQueueEntry :: MonadDES m => Transact m a -> QueueEntry m -> Event m ()
{-# INLINABLE registerTransactQueueEntry #-}
registerTransactQueueEntry :: Transact m a -> QueueEntry m -> Event m ()
registerTransactQueueEntry Transact m a
t QueueEntry m
e =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let q :: Queue m
q = QueueEntry m -> Queue m
forall (m :: * -> *). QueueEntry m -> Queue m
entryQueue QueueEntry m
e
     HashMap (Queue m) (QueueEntry m)
m <- Point m
-> Event m (HashMap (Queue m) (QueueEntry m))
-> m (HashMap (Queue m) (QueueEntry m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (HashMap (Queue m) (QueueEntry m))
 -> m (HashMap (Queue m) (QueueEntry m)))
-> Event m (HashMap (Queue m) (QueueEntry m))
-> m (HashMap (Queue m) (QueueEntry m))
forall a b. (a -> b) -> a -> b
$ Ref m (HashMap (Queue m) (QueueEntry m))
-> Event m (HashMap (Queue m) (QueueEntry m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
forall (m :: * -> *) a.
Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
transactQueueEntryRef Transact m a
t)
     case Queue m -> HashMap (Queue m) (QueueEntry m) -> Maybe (QueueEntry m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Queue m
q HashMap (Queue m) (QueueEntry m)
m of
       Just QueueEntry m
e0 ->
         SimulationRetry -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m ()) -> SimulationRetry -> m ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"There is already another queue entry for the specified queue: registerTransactQueueEntry"
       Maybe (QueueEntry m)
Nothing ->
         Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (HashMap (Queue m) (QueueEntry m))
-> HashMap (Queue m) (QueueEntry m) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
forall (m :: * -> *) a.
Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
transactQueueEntryRef Transact m a
t) (Queue m
-> QueueEntry m
-> HashMap (Queue m) (QueueEntry m)
-> HashMap (Queue m) (QueueEntry m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Queue m
q QueueEntry m
e HashMap (Queue m) (QueueEntry m)
m)

-- | Unregister the queue entry from the transact.
unregisterTransactQueueEntry :: MonadDES m => Transact m a -> Queue m -> Event m (QueueEntry m)
{-# INLINABLE unregisterTransactQueueEntry #-}
unregisterTransactQueueEntry :: Transact m a -> Queue m -> Event m (QueueEntry m)
unregisterTransactQueueEntry Transact m a
t Queue m
q =
  (Point m -> m (QueueEntry m)) -> Event m (QueueEntry m)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (QueueEntry m)) -> Event m (QueueEntry m))
-> (Point m -> m (QueueEntry m)) -> Event m (QueueEntry m)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do HashMap (Queue m) (QueueEntry m)
m <- Point m
-> Event m (HashMap (Queue m) (QueueEntry m))
-> m (HashMap (Queue m) (QueueEntry m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (HashMap (Queue m) (QueueEntry m))
 -> m (HashMap (Queue m) (QueueEntry m)))
-> Event m (HashMap (Queue m) (QueueEntry m))
-> m (HashMap (Queue m) (QueueEntry m))
forall a b. (a -> b) -> a -> b
$ Ref m (HashMap (Queue m) (QueueEntry m))
-> Event m (HashMap (Queue m) (QueueEntry m))
forall (m :: * -> *) a. MonadDES m => Ref m a -> Event m a
readRef (Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
forall (m :: * -> *) a.
Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
transactQueueEntryRef Transact m a
t)
     case Queue m -> HashMap (Queue m) (QueueEntry m) -> Maybe (QueueEntry m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Queue m
q HashMap (Queue m) (QueueEntry m)
m of
       Maybe (QueueEntry m)
Nothing ->
         SimulationRetry -> m (QueueEntry m)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> m (QueueEntry m))
-> SimulationRetry -> m (QueueEntry m)
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"There is no queue entry for the specified queue: unregisterTransactQueueEntry"
       Just QueueEntry m
e  ->
         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (HashMap (Queue m) (QueueEntry m))
-> HashMap (Queue m) (QueueEntry m) -> Event m ()
forall (m :: * -> *) a. MonadDES m => Ref m a -> a -> Event m ()
writeRef (Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
forall (m :: * -> *) a.
Transact m a -> Ref m (HashMap (Queue m) (QueueEntry m))
transactQueueEntryRef Transact m a
t) (Queue m
-> HashMap (Queue m) (QueueEntry m)
-> HashMap (Queue m) (QueueEntry m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Queue m
q HashMap (Queue m) (QueueEntry m)
m)
            QueueEntry m -> m (QueueEntry m)
forall (m :: * -> *) a. Monad m => a -> m a
return QueueEntry m
e

-- | Assign the transact value and return a new version of the same transact.
assignTransactValue :: Transact m a -> (a -> b) -> Transact m b
assignTransactValue :: Transact m a -> (a -> b) -> Transact m b
assignTransactValue Transact m a
t a -> b
f =
  let b :: b
b = a -> b
f (Transact m a -> a
forall (m :: * -> *) a. Transact m a -> a
transactValue Transact m a
t)
  in Transact m a
t { transactValue :: b
transactValue = b
b }

-- | Assign the transact value and return a new version of the same transact.
assignTransactValueM :: Monad c => Transact m a -> (a -> c b) -> c (Transact m b)
{-# INLINABLE assignTransactValue #-}
assignTransactValueM :: Transact m a -> (a -> c b) -> c (Transact m b)
assignTransactValueM Transact m a
t a -> c b
f =
  do b
b <- a -> c b
f (Transact m a -> a
forall (m :: * -> *) a. Transact m a -> a
transactValue Transact m a
t)
     Transact m b -> c (Transact m b)
forall (m :: * -> *) a. Monad m => a -> m a
return Transact m a
t { transactValue :: b
transactValue = b
b }

-- | Assign the priority and return a new version of the same transact.
assignTransactPriority :: Transact m a -> Int -> Transact m a
assignTransactPriority :: Transact m a -> Int -> Transact m a
assignTransactPriority Transact m a
t Int
priority =
  Transact m a
t { transactPriority :: Int
transactPriority = Int
priority }

-- | Reactivate the transacts or transfer them to the specified computations.
reactivateTransacts :: MonadDES m => [(Transact m a, Maybe (Process m ()))] -> Event m ()
{-# INLINABLE reactivateTransacts #-}
reactivateTransacts :: [(Transact m a, Maybe (Process m ()))] -> Event m ()
reactivateTransacts [] = () -> Event m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reactivateTransacts ((Transact m a
t, Maybe (Process m ())
Nothing): [(Transact m a, Maybe (Process m ()))]
xs) =
  do ProcessId m
pid <- Transact m a -> Event m (ProcessId m)
forall (m :: * -> *) a.
MonadDES m =>
Transact m a -> Event m (ProcessId m)
requireTransactProcessId Transact m a
t
     ProcessId m -> Event m ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
reactivateProcess ProcessId m
pid
     [(Transact m a, Maybe (Process m ()))] -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
[(Transact m a, Maybe (Process m ()))] -> Event m ()
reactivateTransacts [(Transact m a, Maybe (Process m ()))]
xs
reactivateTransacts ((Transact m a
t, Just Process m ()
transfer): [(Transact m a, Maybe (Process m ()))]
xs) =
  do Transact m a -> Process m () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Transact m a -> Process m () -> Event m ()
transferTransact Transact m a
t Process m ()
transfer
     [(Transact m a, Maybe (Process m ()))] -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
[(Transact m a, Maybe (Process m ()))] -> Event m ()
reactivateTransacts [(Transact m a, Maybe (Process m ()))]
xs