-- |
-- Module     : Simulation.Aivika.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.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 Data.IORef
import Data.Functor

import qualified Data.HashMap.Lazy as HM

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

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

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

instance Eq (Transact a) where
  Transact a
x == :: Transact a -> Transact a -> Bool
== Transact a
y = (forall a. Transact a -> IORef (Maybe ProcessId)
transactProcessIdRef Transact a
x) forall a. Eq a => a -> a -> Bool
== (forall a. Transact a -> IORef (Maybe ProcessId)
transactProcessIdRef Transact a
y)

instance Functor Transact where
  fmap :: forall a b. (a -> b) -> Transact a -> Transact b
fmap a -> b
f Transact a
t = Transact a
t { transactValue :: b
transactValue = a -> b
f (forall a. Transact a -> a
transactValue Transact a
t) }

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

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

-- | Return the transact assembly set.
transactAssemblySet :: Transact a -> Event AssemblySet
transactAssemblySet :: forall a. Transact a -> Event AssemblySet
transactAssemblySet Transact a
t =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let r :: Run
r = Point -> Run
pointRun Point
p
     Maybe AssemblySet
x <- forall a. IORef a -> IO a
readIORef (forall a. Transact a -> IORef (Maybe AssemblySet)
transactAssemblySetRef Transact a
t)
     case Maybe AssemblySet
x of
       Just AssemblySet
a  -> forall (m :: * -> *) a. Monad m => a -> m a
return AssemblySet
a
       Maybe AssemblySet
Nothing ->
         do AssemblySet
a <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation AssemblySet
newAssemblySet
            forall a. IORef a -> a -> IO ()
writeIORef (forall a. Transact a -> IORef (Maybe AssemblySet)
transactAssemblySetRef Transact a
t) (forall a. a -> Maybe a
Just AssemblySet
a)
            forall (m :: * -> *) a. Monad m => a -> m a
return AssemblySet
a

-- | Take the transact.
takeTransact :: Transact a -> Process ()
takeTransact :: forall a. Transact a -> Process ()
takeTransact Transact a
t =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c0 ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Maybe ProcessId
pid0 <- forall a. IORef a -> IO a
readIORef (forall a. Transact a -> IORef (Maybe ProcessId)
transactProcessIdRef Transact a
t)
     case Maybe ProcessId
pid0 of
       Just ProcessId
pid0 ->
         forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"The transact is acquired by another process: takeTransact"
       Maybe ProcessId
Nothing   ->
         do let priority :: Int
priority = forall a. Transact a -> Int
transactPriority Transact a
t
            forall a. IORef a -> a -> IO ()
writeIORef (forall a. Transact a -> IORef (Maybe ProcessId)
transactProcessIdRef Transact a
t) (forall a. a -> Maybe a
Just ProcessId
pid)
            Int
n <- forall a. IORef a -> IO a
readIORef (forall a. Transact a -> IORef Int
transactPreemptionCountRef Transact a
t)
            if Int
n forall a. Eq a => a -> a -> Bool
== Int
0
              then if Int
priority forall a. Eq a => a -> a -> Bool
== Point -> Int
pointPriority Point
p
                   then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                        forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c0 ()
                   else forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                        forall a. ContParams a -> a -> Event ()
resumeCont (forall a. ContParams a -> Int -> ContParams a
substituteContPriority ContParams ()
c0 Int
priority) ()
              else do let c :: ContParams ()
c = forall a. ContParams a -> Int -> ContParams a
substituteContPriority ContParams ()
c0 Int
priority
                      FrozenCont ()
c <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                           forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () forall a b. (a -> b) -> a -> b
$
                           forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c forall a b. (a -> b) -> a -> b
$
                           forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid forall a b. (a -> b) -> a -> b
$
                           forall a. Transact a -> Process ()
takeTransact Transact a
t
                      forall a. IORef a -> a -> IO ()
writeIORef (forall a. Transact a -> IORef (Maybe (FrozenCont ()))
transactProcessContRef Transact a
t) (forall a. a -> Maybe a
Just FrozenCont ()
c)
                      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
n] forall a b. (a -> b) -> a -> b
$ \Int
_ ->
                        forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                        ProcessId -> Event ()
processPreemptionBegin ProcessId
pid

-- | Release the transact.
releaseTransact :: Transact a -> Process ()
releaseTransact :: forall a. Transact a -> Process ()
releaseTransact Transact a
t =
  forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Maybe ProcessId
pid0 <- forall a. IORef a -> IO a
readIORef (forall a. Transact a -> IORef (Maybe ProcessId)
transactProcessIdRef Transact a
t)
     case Maybe ProcessId
pid0 of
       Maybe ProcessId
Nothing ->
         forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"The transact is not acquired by any process: releaseTransact"
       Just ProcessId
pid0 | ProcessId
pid0 forall a. Eq a => a -> a -> Bool
/= ProcessId
pid ->
         forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"The transact is acquired by another process: releaseTransact"
       Just ProcessId
pid0 ->
         do forall a. IORef a -> a -> IO ()
writeIORef (forall a. Transact a -> IORef (Maybe ProcessId)
transactProcessIdRef Transact a
t) forall a. Maybe a
Nothing
            forall a. IORef a -> a -> IO ()
writeIORef (forall a. Transact a -> IORef (Maybe (FrozenCont ()))
transactProcessContRef Transact a
t) forall a. Maybe a
Nothing
            forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

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

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

-- | Require to return an identifier of the process associated with the transact.
requireTransactProcessId :: Transact a -> Event ProcessId
requireTransactProcessId :: forall a. Transact a -> Event ProcessId
requireTransactProcessId Transact a
t =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Maybe ProcessId
a <- forall a. IORef a -> IO a
readIORef (forall a. Transact a -> IORef (Maybe ProcessId)
transactProcessIdRef Transact a
t)
     case Maybe ProcessId
a of
       Maybe ProcessId
Nothing ->
         forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"The transact must be associated with any process: requireTransactProcessId"
       Just ProcessId
pid ->
         forall (m :: * -> *) a. Monad m => a -> m a
return ProcessId
pid

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

-- | Register the queue entry in the transact.
registerTransactQueueEntry :: Transact a -> QueueEntry -> Event ()
registerTransactQueueEntry :: forall a. Transact a -> QueueEntry -> Event ()
registerTransactQueueEntry Transact a
t QueueEntry
e =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let q :: Queue
q = QueueEntry -> Queue
entryQueue QueueEntry
e
     HashMap Queue QueueEntry
m <- forall a. IORef a -> IO a
readIORef (forall a. Transact a -> IORef (HashMap Queue QueueEntry)
transactQueueEntryRef Transact a
t)
     case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Queue
q HashMap Queue QueueEntry
m of
       Just QueueEntry
e0 ->
         forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"There is already another queue entry for the specified queue: registerTransactQueueEntry"
       Maybe QueueEntry
Nothing ->
         forall a. IORef a -> a -> IO ()
writeIORef (forall a. Transact a -> IORef (HashMap Queue QueueEntry)
transactQueueEntryRef Transact a
t) (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Queue
q QueueEntry
e HashMap Queue QueueEntry
m)

-- | Unregister the queue entry from the transact.
unregisterTransactQueueEntry :: Transact a -> Queue -> Event QueueEntry
unregisterTransactQueueEntry :: forall a. Transact a -> Queue -> Event QueueEntry
unregisterTransactQueueEntry Transact a
t Queue
q =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do HashMap Queue QueueEntry
m <- forall a. IORef a -> IO a
readIORef (forall a. Transact a -> IORef (HashMap Queue QueueEntry)
transactQueueEntryRef Transact a
t)
     case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Queue
q HashMap Queue QueueEntry
m of
       Maybe QueueEntry
Nothing ->
         forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry
         String
"There is no queue entry for the specified queue: unregisterTransactQueueEntry"
       Just QueueEntry
e  ->
         do forall a. IORef a -> a -> IO ()
writeIORef (forall a. Transact a -> IORef (HashMap Queue QueueEntry)
transactQueueEntryRef Transact a
t) (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Queue
q HashMap Queue QueueEntry
m)
            forall (m :: * -> *) a. Monad m => a -> m a
return QueueEntry
e

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

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

-- | Assign the priority and return a new version of the same transact.
assignTransactPriority :: Transact a -> Int -> Process (Transact a)
assignTransactPriority :: forall a. Transact a -> Int -> Process (Transact a)
assignTransactPriority Transact a
t Int
priority =
  do Int -> Process ()
processWithPriority Int
priority
     forall (m :: * -> *) a. Monad m => a -> m a
return Transact a
t { transactPriority :: Int
transactPriority = Int
priority }

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