module Simulation.Aivika.Dynamics.LIFO
(LIFO,
lifoQueue,
lifoNull,
lifoFull,
lifoMaxCount,
lifoCount,
lifoLostCount,
lifoEnqueue,
lifoDequeue,
lifoEnqueueLost,
newLIFO,
dequeueLIFO,
tryDequeueLIFO,
enqueueLIFO,
tryEnqueueLIFO,
enqueueLIFOOrLost) where
import Data.IORef
import Data.Array
import Data.Array.IO.Safe
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
import Simulation.Aivika.Dynamics.Internal.Signal
import Simulation.Aivika.Dynamics.Signal
data LIFO a =
LIFO { lifoQueue :: EventQueue,
lifoMaxCount :: Int,
lifoReadRes :: Resource,
lifoWriteRes :: Resource,
lifoCountRef :: IORef Int,
lifoLostCountRef :: IORef Int,
lifoArray :: IOArray Int a,
lifoEnqueueSource :: SignalSource a,
lifoEnqueueLostSource :: SignalSource a,
lifoDequeueSource :: SignalSource a,
lifoUpdatedSource :: SignalSource 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
s1 <- newSignalSourceUnsafe
s2 <- newSignalSourceUnsafe
s3 <- newSignalSourceUnsafe
s4 <- newSignalSource q
return LIFO { lifoQueue = q,
lifoMaxCount = count,
lifoReadRes = r,
lifoWriteRes = w,
lifoCountRef = i,
lifoLostCountRef = l,
lifoArray = a,
lifoEnqueueSource = s1,
lifoEnqueueLostSource = s2,
lifoDequeueSource = s3,
lifoUpdatedSource = s4 }
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)
liftDynamics $ triggerSignal (lifoDequeueSource lifo) a
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)
triggerSignal (lifoDequeueSource lifo) a
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)
liftDynamics $ triggerSignal (lifoEnqueueSource lifo) a
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)
triggerSignal (lifoEnqueueSource lifo) a
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)
triggerSignal (lifoEnqueueSource lifo) a
else do liftIO $ modifyIORef (lifoLostCountRef lifo) $ (+) 1
triggerSignal (lifoEnqueueLostSource lifo) a
lifoEnqueue :: LIFO a -> Signal a
lifoEnqueue lifo = merge2Signals m1 m2
where m1 = publishSignal (lifoUpdatedSource lifo)
m2 = publishSignal (lifoEnqueueSource lifo)
lifoEnqueueLost :: LIFO a -> Signal a
lifoEnqueueLost lifo = merge2Signals m1 m2
where m1 = publishSignal (lifoUpdatedSource lifo)
m2 = publishSignal (lifoEnqueueLostSource lifo)
lifoDequeue :: LIFO a -> Signal a
lifoDequeue lifo = merge2Signals m1 m2
where m1 = publishSignal (lifoUpdatedSource lifo)
m2 = publishSignal (lifoDequeueSource lifo)
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