{-# LANGUAGE FlexibleContexts #-}
module Simulation.Aivika.Trans.Resource.Base
(
FCFSResource,
LCFSResource,
SIROResource,
PriorityResource,
Resource,
newFCFSResource,
newFCFSResourceWithMaxCount,
newLCFSResource,
newLCFSResourceWithMaxCount,
newSIROResource,
newSIROResourceWithMaxCount,
newPriorityResource,
newPriorityResourceWithMaxCount,
newResource,
newResourceWithMaxCount,
resourceStrategy,
resourceMaxCount,
resourceCount,
requestResource,
requestResourceWithPriority,
tryRequestResourceWithinEvent,
releaseResource,
releaseResourceWithinEvent,
usingResource,
usingResourceWithPriority,
incResourceCount,
decResourceCount) where
import Control.Monad
import Control.Monad.Trans
import Control.Exception
import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
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 Simulation.Aivika.Trans.QueueStrategy
type FCFSResource m = Resource m FCFS
type LCFSResource m = Resource m LCFS
type SIROResource m = Resource m SIRO
type PriorityResource m = Resource m StaticPriorities
data Resource m s =
Resource { forall (m :: * -> *) s. Resource m s -> s
resourceStrategy :: s,
forall (m :: * -> *) s. Resource m s -> Maybe Int
resourceMaxCount :: Maybe Int,
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef :: Ref m Int,
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList :: StrategyQueue m s (FrozenCont m ()) }
newFCFSResource :: MonadDES m
=> Int
-> Simulation m (FCFSResource m)
{-# INLINABLE newFCFSResource #-}
newFCFSResource :: forall (m :: * -> *).
MonadDES m =>
Int -> Simulation m (FCFSResource m)
newFCFSResource = FCFS -> Int -> Simulation m (Resource m FCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource FCFS
FCFS
newFCFSResourceWithMaxCount :: MonadDES m
=> Int
-> Maybe Int
-> Simulation m (FCFSResource m)
{-# INLINABLE newFCFSResourceWithMaxCount #-}
newFCFSResourceWithMaxCount :: forall (m :: * -> *).
MonadDES m =>
Int -> Maybe Int -> Simulation m (FCFSResource m)
newFCFSResourceWithMaxCount = FCFS -> Int -> Maybe Int -> Simulation m (Resource m FCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount FCFS
FCFS
newLCFSResource :: MonadDES m
=> Int
-> Simulation m (LCFSResource m)
{-# INLINABLE newLCFSResource #-}
newLCFSResource :: forall (m :: * -> *).
MonadDES m =>
Int -> Simulation m (LCFSResource m)
newLCFSResource = LCFS -> Int -> Simulation m (Resource m LCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource LCFS
LCFS
newLCFSResourceWithMaxCount :: MonadDES m
=> Int
-> Maybe Int
-> Simulation m (LCFSResource m)
{-# INLINABLE newLCFSResourceWithMaxCount #-}
newLCFSResourceWithMaxCount :: forall (m :: * -> *).
MonadDES m =>
Int -> Maybe Int -> Simulation m (LCFSResource m)
newLCFSResourceWithMaxCount = LCFS -> Int -> Maybe Int -> Simulation m (Resource m LCFS)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount LCFS
LCFS
newSIROResource :: (MonadDES m, QueueStrategy m SIRO)
=> Int
-> Simulation m (SIROResource m)
{-# INLINABLE newSIROResource #-}
newSIROResource :: forall (m :: * -> *).
(MonadDES m, QueueStrategy m SIRO) =>
Int -> Simulation m (SIROResource m)
newSIROResource = SIRO -> Int -> Simulation m (Resource m SIRO)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource SIRO
SIRO
newSIROResourceWithMaxCount :: (MonadDES m, QueueStrategy m SIRO)
=> Int
-> Maybe Int
-> Simulation m (SIROResource m)
{-# INLINABLE newSIROResourceWithMaxCount #-}
newSIROResourceWithMaxCount :: forall (m :: * -> *).
(MonadDES m, QueueStrategy m SIRO) =>
Int -> Maybe Int -> Simulation m (SIROResource m)
newSIROResourceWithMaxCount = SIRO -> Int -> Maybe Int -> Simulation m (Resource m SIRO)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount SIRO
SIRO
newPriorityResource :: (MonadDES m, QueueStrategy m StaticPriorities)
=> Int
-> Simulation m (PriorityResource m)
{-# INLINABLE newPriorityResource #-}
newPriorityResource :: forall (m :: * -> *).
(MonadDES m, QueueStrategy m StaticPriorities) =>
Int -> Simulation m (PriorityResource m)
newPriorityResource = StaticPriorities
-> Int -> Simulation m (Resource m StaticPriorities)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource StaticPriorities
StaticPriorities
newPriorityResourceWithMaxCount :: (MonadDES m, QueueStrategy m StaticPriorities)
=> Int
-> Maybe Int
-> Simulation m (PriorityResource m)
{-# INLINABLE newPriorityResourceWithMaxCount #-}
newPriorityResourceWithMaxCount :: forall (m :: * -> *).
(MonadDES m, QueueStrategy m StaticPriorities) =>
Int -> Maybe Int -> Simulation m (PriorityResource m)
newPriorityResourceWithMaxCount = StaticPriorities
-> Int -> Maybe Int -> Simulation m (Resource m StaticPriorities)
forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount StaticPriorities
StaticPriorities
newResource :: (MonadDES m, QueueStrategy m s)
=> s
-> Int
-> Simulation m (Resource m s)
{-# INLINABLE newResource #-}
newResource :: forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Simulation m (Resource m s)
newResource s
s Int
count =
(Run m -> m (Resource m s)) -> Simulation m (Resource m s)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Resource m s)) -> Simulation m (Resource m s))
-> (Run m -> m (Resource m s)) -> Simulation m (Resource m s)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count 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 e a. Exception e => e -> m a
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 -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
String
"The resource count cannot be negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"newResource."
Ref m Int
countRef <- 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 a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
count
StrategyQueue m s (FrozenCont m ())
waitList <- Run m
-> Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ()))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ())))
-> Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ()))
forall a b. (a -> b) -> a -> b
$ s -> Simulation m (StrategyQueue m s (FrozenCont m ()))
forall a. s -> Simulation m (StrategyQueue m s a)
forall (m :: * -> *) s a.
QueueStrategy m s =>
s -> Simulation m (StrategyQueue m s a)
newStrategyQueue s
s
Resource m s -> m (Resource m s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceStrategy :: s
resourceStrategy = s
s,
resourceMaxCount :: Maybe Int
resourceMaxCount = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count,
resourceCountRef :: Ref m Int
resourceCountRef = Ref m Int
countRef,
resourceWaitList :: StrategyQueue m s (FrozenCont m ())
resourceWaitList = StrategyQueue m s (FrozenCont m ())
waitList }
newResourceWithMaxCount :: (MonadDES m, QueueStrategy m s)
=> s
-> Int
-> Maybe Int
-> Simulation m (Resource m s)
{-# INLINABLE newResourceWithMaxCount #-}
newResourceWithMaxCount :: forall (m :: * -> *) s.
(MonadDES m, QueueStrategy m s) =>
s -> Int -> Maybe Int -> Simulation m (Resource m s)
newResourceWithMaxCount s
s Int
count Maybe Int
maxCount =
(Run m -> m (Resource m s)) -> Simulation m (Resource m s)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (Resource m s)) -> Simulation m (Resource m s))
-> (Run m -> m (Resource m s)) -> Simulation m (Resource m s)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count 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 e a. Exception e => e -> m a
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 -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
String
"The resource count cannot be negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"newResourceWithMaxCount."
case Maybe Int
maxCount of
Just Int
maxCount | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
SimulationRetry -> m ()
forall e a. Exception e => e -> m a
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 -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
String
"The resource count cannot be greater than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"its maximum value: newResourceWithMaxCount."
Maybe Int
_ ->
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Ref m Int
countRef <- 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 a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
count
StrategyQueue m s (FrozenCont m ())
waitList <- Run m
-> Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ()))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ())))
-> Simulation m (StrategyQueue m s (FrozenCont m ()))
-> m (StrategyQueue m s (FrozenCont m ()))
forall a b. (a -> b) -> a -> b
$ s -> Simulation m (StrategyQueue m s (FrozenCont m ()))
forall a. s -> Simulation m (StrategyQueue m s a)
forall (m :: * -> *) s a.
QueueStrategy m s =>
s -> Simulation m (StrategyQueue m s a)
newStrategyQueue s
s
Resource m s -> m (Resource m s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceStrategy :: s
resourceStrategy = s
s,
resourceMaxCount :: Maybe Int
resourceMaxCount = Maybe Int
maxCount,
resourceCountRef :: Ref m Int
resourceCountRef = Ref m Int
countRef,
resourceWaitList :: StrategyQueue m s (FrozenCont m ())
resourceWaitList = StrategyQueue m s (FrozenCont m ())
waitList }
resourceCount :: MonadDES m => Resource m s -> Event m Int
{-# INLINABLE resourceCount #-}
resourceCount :: forall (m :: * -> *) s. MonadDES m => Resource m s -> Event m Int
resourceCount Resource m s
r =
(Point m -> m Int) -> Event m Int
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m Int) -> Event m Int)
-> (Point m -> m Int) -> Event m Int
forall a b. (a -> b) -> a -> b
$ \Point m
p -> 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 a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
requestResource :: (MonadDES m, EnqueueStrategy m s)
=> Resource m s
-> Process m ()
{-# INLINABLE requestResource #-}
requestResource :: forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m s
r =
(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 Int
a <- 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 a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then 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
$
Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m s
r
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
$
StrategyQueue m s (FrozenCont m ())
-> FrozenCont m () -> Event m ()
forall a. StrategyQueue m s a -> a -> Event m ()
forall (m :: * -> *) s a.
EnqueueStrategy m s =>
StrategyQueue m s a -> a -> Event m ()
strategyEnqueue (Resource m s -> StrategyQueue m s (FrozenCont m ())
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList Resource m s
r) FrozenCont m ()
c
else do let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Int
a' Int -> m () -> m ()
forall a b. a -> b -> b
`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 a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r) Int
a'
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 ()
requestResourceWithPriority :: (MonadDES m, PriorityQueueStrategy m s p)
=> Resource m s
-> p
-> Process m ()
{-# INLINABLE requestResourceWithPriority #-}
requestResourceWithPriority :: forall (m :: * -> *) s p.
(MonadDES m, PriorityQueueStrategy m s p) =>
Resource m s -> p -> Process m ()
requestResourceWithPriority Resource m s
r p
priority =
(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 Int
a <- 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 a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then 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
$
Resource m s -> p -> Process m ()
forall (m :: * -> *) s p.
(MonadDES m, PriorityQueueStrategy m s p) =>
Resource m s -> p -> Process m ()
requestResourceWithPriority Resource m s
r p
priority
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
$
StrategyQueue m s (FrozenCont m ())
-> p -> FrozenCont m () -> Event m ()
forall a. StrategyQueue m s a -> p -> a -> Event m ()
forall (m :: * -> *) s p a.
PriorityQueueStrategy m s p =>
StrategyQueue m s a -> p -> a -> Event m ()
strategyEnqueueWithPriority (Resource m s -> StrategyQueue m s (FrozenCont m ())
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList Resource m s
r) p
priority FrozenCont m ()
c
else do let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Int
a' Int -> m () -> m ()
forall a b. a -> b -> b
`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 a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r) Int
a'
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 ()
releaseResource :: (MonadDES m, DequeueStrategy m s)
=> Resource m s
-> Process m ()
{-# INLINABLE releaseResource #-}
releaseResource :: forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m s
r =
(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
_ ->
(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 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
$ Resource m s -> Event m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Event m ()
releaseResourceWithinEvent Resource m s
r
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 ()
releaseResourceWithinEvent :: (MonadDES m, DequeueStrategy m s)
=> Resource m s
-> Event m ()
{-# INLINABLE releaseResourceWithinEvent #-}
releaseResourceWithinEvent :: forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Event m ()
releaseResourceWithinEvent Resource m s
r =
(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
a <- 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 a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
case Resource m s -> Maybe Int
forall (m :: * -> *) s. Resource m s -> Maybe Int
resourceMaxCount Resource m s
r of
Just Int
maxCount | Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
SimulationRetry -> m ()
forall e a. Exception e => e -> m a
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 -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
String
"The resource count cannot be greater than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"its maximum value: releaseResourceWithinEvent."
Maybe Int
_ ->
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
StrategyQueue m s (FrozenCont m ()) -> Event m Bool
forall a. StrategyQueue m s a -> Event m Bool
forall (m :: * -> *) s a.
QueueStrategy m s =>
StrategyQueue m s a -> Event m Bool
strategyQueueNull (Resource m s -> StrategyQueue m s (FrozenCont m ())
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList Resource m s
r)
if Bool
f
then Int
a' Int -> m () -> m ()
forall a b. a -> b -> b
`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 a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r) Int
a'
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
$
StrategyQueue m s (FrozenCont m ()) -> Event m (FrozenCont m ())
forall a. StrategyQueue m s a -> Event m a
forall (m :: * -> *) s a.
DequeueStrategy m s =>
StrategyQueue m s a -> Event m a
strategyDequeue (Resource m s -> StrategyQueue m s (FrozenCont m ())
forall (m :: * -> *) s.
Resource m s -> StrategyQueue m s (FrozenCont m ())
resourceWaitList Resource m s
r)
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 ->
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
$ Resource m s -> Event m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Event m ()
releaseResourceWithinEvent Resource m s
r
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 ()
tryRequestResourceWithinEvent :: MonadDES m
=> Resource m s
-> Event m Bool
{-# INLINABLE tryRequestResourceWithinEvent #-}
tryRequestResourceWithinEvent :: forall (m :: * -> *) s. MonadDES m => Resource m s -> Event m Bool
tryRequestResourceWithinEvent Resource m s
r =
(Point m -> m Bool) -> Event m Bool
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m Bool) -> Event m Bool)
-> (Point m -> m Bool) -> Event m Bool
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Int
a <- 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 a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r)
if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Int
a' Int -> m () -> m ()
forall a b. a -> b -> b
`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 a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Resource m s -> Ref m Int
forall (m :: * -> *) s. Resource m s -> Ref m Int
resourceCountRef Resource m s
r) Int
a'
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
usingResource :: (MonadDES m, EnqueueStrategy m s)
=> Resource m s
-> Process m a
-> Process m a
{-# INLINABLE usingResource #-}
usingResource :: forall (m :: * -> *) s a.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m a -> Process m a
usingResource Resource m s
r Process m a
m =
do Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m s
r
Process m a -> Process m () -> Process m a
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess Process m a
m (Process m () -> Process m a) -> Process m () -> Process m a
forall a b. (a -> b) -> a -> b
$ Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m s
r
usingResourceWithPriority :: (MonadDES m, PriorityQueueStrategy m s p)
=> Resource m s
-> p
-> Process m a
-> Process m a
{-# INLINABLE usingResourceWithPriority #-}
usingResourceWithPriority :: forall (m :: * -> *) s p a.
(MonadDES m, PriorityQueueStrategy m s p) =>
Resource m s -> p -> Process m a -> Process m a
usingResourceWithPriority Resource m s
r p
priority Process m a
m =
do Resource m s -> p -> Process m ()
forall (m :: * -> *) s p.
(MonadDES m, PriorityQueueStrategy m s p) =>
Resource m s -> p -> Process m ()
requestResourceWithPriority Resource m s
r p
priority
Process m a -> Process m () -> Process m a
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess Process m a
m (Process m () -> Process m a) -> Process m () -> Process m a
forall a b. (a -> b) -> a -> b
$ Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Process m ()
releaseResource Resource m s
r
incResourceCount :: (MonadDES m, DequeueStrategy m s)
=> Resource m s
-> Int
-> Event m ()
{-# INLINABLE incResourceCount #-}
incResourceCount :: forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Int -> Event m ()
incResourceCount Resource m s
r Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = SimulationRetry -> Event m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent (SimulationRetry -> Event m ()) -> SimulationRetry -> Event m ()
forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The increment cannot be negative: incResourceCount"
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise =
do Resource m s -> Event m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Event m ()
releaseResourceWithinEvent Resource m s
r
Resource m s -> Int -> Event m ()
forall (m :: * -> *) s.
(MonadDES m, DequeueStrategy m s) =>
Resource m s -> Int -> Event m ()
incResourceCount Resource m s
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
decResourceCount :: (MonadDES m, EnqueueStrategy m s)
=> Resource m s
-> Int
-> Process m ()
{-# INLINABLE decResourceCount #-}
decResourceCount :: forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Int -> Process m ()
decResourceCount Resource m s
r Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = SimulationRetry -> Process m ()
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Process m a
throwProcess (SimulationRetry -> Process m ())
-> SimulationRetry -> Process m ()
forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The decrement cannot be negative: decResourceCount"
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> Process m ()
forall a. a -> Process m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise =
do Resource m s -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Process m ()
requestResource Resource m s
r
Resource m s -> Int -> Process m ()
forall (m :: * -> *) s.
(MonadDES m, EnqueueStrategy m s) =>
Resource m s -> Int -> Process m ()
decResourceCount Resource m s
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)