module Simulation.Aivika.Dynamics.LIFO
(LIFO,
lifoQueue,
lifoNull,
lifoFull,
lifoMaxCount,
lifoCount,
lifoLostCount,
newLIFO,
dequeueLIFO,
tryDequeueLIFO,
enqueueLIFO,
tryEnqueueLIFO,
enqueueLIFOOrLost) where
import Data.IORef
import Data.Array
import Data.Array.IO
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Dynamics.Simulation
import Simulation.Aivika.Dynamics.EventQueue
import Simulation.Aivika.Dynamics.Process
import Simulation.Aivika.Dynamics.Resource
data LIFO a =
LIFO { lifoQueue :: EventQueue,
lifoMaxCount :: Int,
lifoReadRes :: Resource,
lifoWriteRes :: Resource,
lifoCountRef :: IORef Int,
lifoLostCountRef :: IORef Int,
lifoArray :: IOArray Int a }
newLIFO :: EventQueue -> Int -> Simulation (LIFO a)
newLIFO q count =
do i <- liftIO $ newIORef 0
l <- liftIO $ newIORef 0
a <- liftIO $ newArray_ (0, count 1)
r <- newResourceWithCount q count 0
w <- newResourceWithCount q count count
return LIFO { lifoQueue = q,
lifoMaxCount = count,
lifoReadRes = r,
lifoWriteRes = w,
lifoCountRef = i,
lifoLostCountRef = l,
lifoArray = a }
lifoNull :: LIFO a -> Dynamics Bool
lifoNull lifo =
do a <- lifoCount lifo
return (a == 0)
lifoFull :: LIFO a -> Dynamics Bool
lifoFull lifo =
do a <- lifoCount lifo
return (a == lifoMaxCount lifo)
lifoCount :: LIFO a -> Dynamics Int
lifoCount lifo =
liftIO $ readIORef (lifoCountRef lifo)
lifoLostCount :: LIFO a -> Dynamics Int
lifoLostCount lifo =
liftIO $ readIORef (lifoLostCountRef lifo)
dequeueLIFO :: LIFO a -> Process a
dequeueLIFO lifo =
do requestResource (lifoReadRes lifo)
a <- liftIO $ dequeueImpl lifo
releaseResource (lifoWriteRes lifo)
return a
tryDequeueLIFO :: LIFO a -> Dynamics (Maybe a)
tryDequeueLIFO lifo =
do x <- tryRequestResourceInDynamics (lifoReadRes lifo)
if x
then do a <- liftIO $ dequeueImpl lifo
releaseResourceInDynamics (lifoWriteRes lifo)
return $ Just a
else return Nothing
enqueueLIFO :: LIFO a -> a -> Process ()
enqueueLIFO lifo a =
do requestResource (lifoWriteRes lifo)
liftIO $ enqueueImpl lifo a
releaseResource (lifoReadRes lifo)
tryEnqueueLIFO :: LIFO a -> a -> Dynamics Bool
tryEnqueueLIFO lifo a =
do x <- tryRequestResourceInDynamics (lifoWriteRes lifo)
if x
then do liftIO $ enqueueImpl lifo a
releaseResourceInDynamics (lifoReadRes lifo)
return True
else return False
enqueueLIFOOrLost :: LIFO a -> a -> Dynamics ()
enqueueLIFOOrLost lifo a =
do x <- tryRequestResourceInDynamics (lifoWriteRes lifo)
if x
then do liftIO $ enqueueImpl lifo a
releaseResourceInDynamics (lifoReadRes lifo)
else liftIO $ modifyIORef (lifoLostCountRef lifo) $ (+) 1
dequeueImpl :: LIFO a -> IO a
dequeueImpl lifo =
do i <- readIORef (lifoCountRef lifo)
let j = i 1
a <- j `seq` readArray (lifoArray lifo) j
writeArray (lifoArray lifo) j undefined
writeIORef (lifoCountRef lifo) j
return a
enqueueImpl :: LIFO a -> a -> IO ()
enqueueImpl lifo a =
do i <- readIORef (lifoCountRef lifo)
let j = i + 1
a `seq` writeArray (lifoArray lifo) i a
j `seq` writeIORef (lifoCountRef lifo) j