module Simulation.Aivika.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 Data.IORef
import Control.Monad
import Control.Monad.Trans
import Control.Exception
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 Simulation.Aivika.QueueStrategy
import qualified Simulation.Aivika.DoubleLinkedList as DLL
import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.PriorityQueue as PQ
type FCFSResource = Resource FCFS
type LCFSResource = Resource LCFS
type SIROResource = Resource SIRO
type PriorityResource = Resource StaticPriorities
data Resource s =
Resource { forall s. Resource s -> s
resourceStrategy :: s,
forall s. Resource s -> Maybe Int
resourceMaxCount :: Maybe Int,
forall s. Resource s -> IORef Int
resourceCountRef :: IORef Int,
forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList :: StrategyQueue s (FrozenCont ()) }
instance Eq (Resource s) where
Resource s
x == :: Resource s -> Resource s -> Bool
== Resource s
y = forall s. Resource s -> IORef Int
resourceCountRef Resource s
x forall a. Eq a => a -> a -> Bool
== forall s. Resource s -> IORef Int
resourceCountRef Resource s
y
newFCFSResource :: Int
-> Simulation FCFSResource
newFCFSResource :: Int -> Simulation FCFSResource
newFCFSResource = forall s. QueueStrategy s => s -> Int -> Simulation (Resource s)
newResource FCFS
FCFS
newFCFSResourceWithMaxCount :: Int
-> Maybe Int
-> Simulation FCFSResource
newFCFSResourceWithMaxCount :: Int -> Maybe Int -> Simulation FCFSResource
newFCFSResourceWithMaxCount = forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount FCFS
FCFS
newLCFSResource :: Int
-> Simulation LCFSResource
newLCFSResource :: Int -> Simulation LCFSResource
newLCFSResource = forall s. QueueStrategy s => s -> Int -> Simulation (Resource s)
newResource LCFS
LCFS
newLCFSResourceWithMaxCount :: Int
-> Maybe Int
-> Simulation LCFSResource
newLCFSResourceWithMaxCount :: Int -> Maybe Int -> Simulation LCFSResource
newLCFSResourceWithMaxCount = forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount LCFS
LCFS
newSIROResource :: Int
-> Simulation SIROResource
newSIROResource :: Int -> Simulation SIROResource
newSIROResource = forall s. QueueStrategy s => s -> Int -> Simulation (Resource s)
newResource SIRO
SIRO
newSIROResourceWithMaxCount :: Int
-> Maybe Int
-> Simulation SIROResource
newSIROResourceWithMaxCount :: Int -> Maybe Int -> Simulation SIROResource
newSIROResourceWithMaxCount = forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount SIRO
SIRO
newPriorityResource :: Int
-> Simulation PriorityResource
newPriorityResource :: Int -> Simulation PriorityResource
newPriorityResource = forall s. QueueStrategy s => s -> Int -> Simulation (Resource s)
newResource StaticPriorities
StaticPriorities
newPriorityResourceWithMaxCount :: Int
-> Maybe Int
-> Simulation PriorityResource
newPriorityResourceWithMaxCount :: Int -> Maybe Int -> Simulation PriorityResource
newPriorityResourceWithMaxCount = forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount StaticPriorities
StaticPriorities
newResource :: QueueStrategy s
=> s
-> Int
-> Simulation (Resource s)
newResource :: forall s. QueueStrategy s => s -> Int -> Simulation (Resource s)
newResource s
s Int
count =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count 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 forall a b. (a -> b) -> a -> b
$
String
"The resource count cannot be negative: " forall a. [a] -> [a] -> [a]
++
String
"newResource."
IORef Int
countRef <- forall a. a -> IO (IORef a)
newIORef Int
count
StrategyQueue s (FrozenCont ())
waitList <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a b. (a -> b) -> a -> b
$ forall s i. QueueStrategy s => s -> Simulation (StrategyQueue s i)
newStrategyQueue s
s
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceStrategy :: s
resourceStrategy = s
s,
resourceMaxCount :: Maybe Int
resourceMaxCount = forall a. a -> Maybe a
Just Int
count,
resourceCountRef :: IORef Int
resourceCountRef = IORef Int
countRef,
resourceWaitList :: StrategyQueue s (FrozenCont ())
resourceWaitList = StrategyQueue s (FrozenCont ())
waitList }
newResourceWithMaxCount :: QueueStrategy s
=> s
-> Int
-> Maybe Int
-> Simulation (Resource s)
newResourceWithMaxCount :: forall s.
QueueStrategy s =>
s -> Int -> Maybe Int -> Simulation (Resource s)
newResourceWithMaxCount s
s Int
count Maybe Int
maxCount =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count 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 forall a b. (a -> b) -> a -> b
$
String
"The resource count cannot be negative: " forall a. [a] -> [a] -> [a]
++
String
"newResourceWithMaxCount."
case Maybe Int
maxCount of
Just Int
maxCount | Int
count forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
String -> SimulationRetry
SimulationRetry forall a b. (a -> b) -> a -> b
$
String
"The resource count cannot be greater than " forall a. [a] -> [a] -> [a]
++
String
"its maximum value: newResourceWithMaxCount."
Maybe Int
_ ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IORef Int
countRef <- forall a. a -> IO (IORef a)
newIORef Int
count
StrategyQueue s (FrozenCont ())
waitList <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a b. (a -> b) -> a -> b
$ forall s i. QueueStrategy s => s -> Simulation (StrategyQueue s i)
newStrategyQueue s
s
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceStrategy :: s
resourceStrategy = s
s,
resourceMaxCount :: Maybe Int
resourceMaxCount = Maybe Int
maxCount,
resourceCountRef :: IORef Int
resourceCountRef = IORef Int
countRef,
resourceWaitList :: StrategyQueue s (FrozenCont ())
resourceWaitList = StrategyQueue s (FrozenCont ())
waitList }
resourceCount :: Resource s -> Event Int
resourceCount :: forall s. Resource s -> Event Int
resourceCount Resource s
r =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. IORef a -> IO a
readIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
requestResource :: EnqueueStrategy s
=> Resource s
-> Process ()
requestResource :: forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource s
r =
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 Int
a <- forall a. IORef a -> IO a
readIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
if Int
a forall a. Eq a => a -> a -> Bool
== Int
0
then do 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 s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource s
r
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall s i. EnqueueStrategy s => StrategyQueue s i -> i -> Event ()
strategyEnqueue (forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList Resource s
r) FrozenCont ()
c
else do let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
- Int
1
Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r) Int
a'
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 ()
requestResourceWithPriority :: PriorityQueueStrategy s p
=> Resource s
-> p
-> Process ()
requestResourceWithPriority :: forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority Resource s
r p
priority =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Int
a <- forall a. IORef a -> IO a
readIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
if Int
a forall a. Eq a => a -> a -> Bool
== Int
0
then do 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 s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority Resource s
r p
priority
forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall s p i.
PriorityQueueStrategy s p =>
StrategyQueue s i -> p -> i -> Event ()
strategyEnqueueWithPriority (forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList Resource s
r) p
priority FrozenCont ()
c
else do let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
- Int
1
Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r) Int
a'
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 ()
releaseResource :: DequeueStrategy s
=> Resource s
-> Process ()
releaseResource :: forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource s
r =
forall a. (ProcessId -> Cont a) -> Process a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId
_ ->
forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent Resource s
r
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 ()
releaseResourceWithinEvent :: DequeueStrategy s
=> Resource s
-> Event ()
releaseResourceWithinEvent :: forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent Resource s
r =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Int
a <- forall a. IORef a -> IO a
readIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
1
case forall s. Resource s -> Maybe Int
resourceMaxCount Resource s
r of
Just Int
maxCount | Int
a' forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$
String -> SimulationRetry
SimulationRetry forall a b. (a -> b) -> a -> b
$
String
"The resource count cannot be greater than " forall a. [a] -> [a] -> [a]
++
String
"its maximum value: releaseResourceWithinEvent."
Maybe Int
_ ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
f <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall s i. QueueStrategy s => StrategyQueue s i -> Event Bool
strategyQueueNull (forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList Resource s
r)
if Bool
f
then Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r) Int
a'
else do FrozenCont ()
c <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
forall s i. DequeueStrategy s => StrategyQueue s i -> Event i
strategyDequeue (forall s. Resource s -> StrategyQueue s (FrozenCont ())
resourceWaitList Resource s
r)
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 a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent Resource s
r
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 ()
tryRequestResourceWithinEvent :: Resource s
-> Event Bool
tryRequestResourceWithinEvent :: forall s. Resource s -> Event Bool
tryRequestResourceWithinEvent Resource s
r =
forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
do Int
a <- forall a. IORef a -> IO a
readIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r)
if Int
a forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
- Int
1
Int
a' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (forall s. Resource s -> IORef Int
resourceCountRef Resource s
r) Int
a'
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
usingResource :: EnqueueStrategy s
=> Resource s
-> Process a
-> Process a
usingResource :: forall s a.
EnqueueStrategy s =>
Resource s -> Process a -> Process a
usingResource Resource s
r Process a
m =
do forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource s
r
forall a b. Process a -> Process b -> Process a
finallyProcess Process a
m forall a b. (a -> b) -> a -> b
$ forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource s
r
usingResourceWithPriority :: PriorityQueueStrategy s p
=> Resource s
-> p
-> Process a
-> Process a
usingResourceWithPriority :: forall s p a.
PriorityQueueStrategy s p =>
Resource s -> p -> Process a -> Process a
usingResourceWithPriority Resource s
r p
priority Process a
m =
do forall s p.
PriorityQueueStrategy s p =>
Resource s -> p -> Process ()
requestResourceWithPriority Resource s
r p
priority
forall a b. Process a -> Process b -> Process a
finallyProcess Process a
m forall a b. (a -> b) -> a -> b
$ forall s. DequeueStrategy s => Resource s -> Process ()
releaseResource Resource s
r
incResourceCount :: DequeueStrategy s
=> Resource s
-> Int
-> Event ()
incResourceCount :: forall s. DequeueStrategy s => Resource s -> Int -> Event ()
incResourceCount Resource s
r Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall e a. Exception e => e -> Event a
throwEvent forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The increment cannot be negative: incResourceCount"
| Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise =
do forall s. DequeueStrategy s => Resource s -> Event ()
releaseResourceWithinEvent Resource s
r
forall s. DequeueStrategy s => Resource s -> Int -> Event ()
incResourceCount Resource s
r (Int
n forall a. Num a => a -> a -> a
- Int
1)
decResourceCount :: EnqueueStrategy s
=> Resource s
-> Int
-> Process ()
decResourceCount :: forall s. EnqueueStrategy s => Resource s -> Int -> Process ()
decResourceCount Resource s
r Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall e a. Exception e => e -> Process a
throwProcess forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The decrement cannot be negative: decResourceCount"
| Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise =
do forall s. EnqueueStrategy s => Resource s -> Process ()
requestResource Resource s
r
forall s. EnqueueStrategy s => Resource s -> Int -> Process ()
decResourceCount Resource s
r (Int
n forall a. Num a => a -> a -> a
- Int
1)