module Simulation.Aivika.Dynamics.Resource
(Resource,
newResource,
resourceQueue,
resourceInitCount,
resourceCount,
requestResource,
releaseResource) where
import Data.IORef
import Control.Monad
import Simulation.Aivika.Dynamics.Internal.Simulation
import Simulation.Aivika.Dynamics.Internal.Dynamics
import Simulation.Aivika.Dynamics.Internal.Cont
import Simulation.Aivika.Dynamics.Internal.Process
import Simulation.Aivika.Dynamics.EventQueue
import qualified Simulation.Aivika.Queue as Q
data Resource =
Resource { resourceQueue :: EventQueue,
resourceInitCount :: Int,
resourceCountRef :: IORef Int,
resourceWaitQueue :: Q.Queue (() -> Dynamics ())}
instance Eq Resource where
x == y = resourceCountRef x == resourceCountRef y
newResource :: EventQueue -> Int -> Simulation Resource
newResource q initCount =
Simulation $ \r ->
do countRef <- newIORef initCount
waitQueue <- Q.newQueue
return Resource { resourceQueue = q,
resourceInitCount = initCount,
resourceCountRef = countRef,
resourceWaitQueue = waitQueue }
resourceCount :: Resource -> Dynamics Int
resourceCount r =
Dynamics $ \p ->
do let Dynamics m = queueRun (resourceQueue r)
m p
readIORef (resourceCountRef r)
requestResource :: Resource -> Process ()
requestResource r =
Process $ \_ ->
Cont $ \c ->
Dynamics $ \p ->
do a <- readIORef (resourceCountRef r)
if a == 0
then Q.enqueue (resourceWaitQueue r) c
else do let a' = a 1
a' `seq` writeIORef (resourceCountRef r) a'
let Dynamics m = c ()
m p
releaseResource :: Resource -> Process ()
releaseResource r =
Process $ \_ ->
Cont $ \c ->
Dynamics $ \p ->
do a <- readIORef (resourceCountRef r)
let a' = a + 1
when (a' > resourceInitCount r) $
error $
"The resource count cannot be greater than " ++
"its initial value: releaseResource."
f <- Q.queueNull (resourceWaitQueue r)
if f
then a' `seq` writeIORef (resourceCountRef r) a'
else do c2 <- Q.queueFront (resourceWaitQueue r)
Q.dequeue (resourceWaitQueue r)
let Dynamics m = enqueueCont (resourceQueue r) (pointTime p) c2
m p
let Dynamics m' = c ()
m' p