module Simulation.Aivika.Dynamics.FIFO
(FIFO,
fifoQueue,
fifoNull,
fifoFull,
fifoMaxCount,
fifoCount,
fifoLostCount,
fifoEnqueue,
fifoDequeue,
fifoEnqueueLost,
newFIFO,
dequeueFIFO,
tryDequeueFIFO,
enqueueFIFO,
tryEnqueueFIFO,
enqueueFIFOOrLost) 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
data FIFO a =
FIFO { fifoQueue :: EventQueue,
fifoMaxCount :: Int,
fifoReadRes :: Resource,
fifoWriteRes :: Resource,
fifoCountRef :: IORef Int,
fifoLostCountRef :: IORef Int,
fifoStartRef :: IORef Int,
fifoEndRef :: IORef Int,
fifoArray :: IOArray Int a,
fifoEnqueueSource :: SignalSource a,
fifoEnqueueLostSource :: SignalSource a,
fifoDequeueSource :: SignalSource a,
fifoUpdatedSource :: SignalSource a }
newFIFO :: EventQueue -> Int -> Simulation (FIFO a)
newFIFO q count =
do i <- liftIO $ newIORef 0
l <- liftIO $ newIORef 0
s <- liftIO $ newIORef 0
e <- 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 <- newSignalSourceWithUpdate (runQueue q)
return FIFO { fifoQueue = q,
fifoMaxCount = count,
fifoReadRes = r,
fifoWriteRes = w,
fifoCountRef = i,
fifoLostCountRef = l,
fifoStartRef = s,
fifoEndRef = e,
fifoArray = a,
fifoEnqueueSource = s1,
fifoEnqueueLostSource = s2,
fifoDequeueSource = s3,
fifoUpdatedSource = s4 }
fifoNull :: FIFO a -> Dynamics Bool
fifoNull fifo =
do a <- fifoCount fifo
return (a == 0)
fifoFull :: FIFO a -> Dynamics Bool
fifoFull fifo =
do a <- fifoCount fifo
return (a == fifoMaxCount fifo)
fifoCount :: FIFO a -> Dynamics Int
fifoCount fifo =
liftIO $ readIORef (fifoCountRef fifo)
fifoLostCount :: FIFO a -> Dynamics Int
fifoLostCount fifo =
liftIO $ readIORef (fifoLostCountRef fifo)
dequeueFIFO :: FIFO a -> Process a
dequeueFIFO fifo =
do requestResource (fifoReadRes fifo)
a <- liftIO $ dequeueImpl fifo
releaseResource (fifoWriteRes fifo)
liftDynamics $ triggerSignal (fifoDequeueSource fifo) a
return a
tryDequeueFIFO :: FIFO a -> Dynamics (Maybe a)
tryDequeueFIFO fifo =
do x <- tryRequestResourceInDynamics (fifoReadRes fifo)
if x
then do a <- liftIO $ dequeueImpl fifo
releaseResourceInDynamics (fifoWriteRes fifo)
triggerSignal (fifoDequeueSource fifo) a
return $ Just a
else return Nothing
enqueueFIFO :: FIFO a -> a -> Process ()
enqueueFIFO fifo a =
do requestResource (fifoWriteRes fifo)
liftIO $ enqueueImpl fifo a
releaseResource (fifoReadRes fifo)
liftDynamics $ triggerSignal (fifoEnqueueSource fifo) a
tryEnqueueFIFO :: FIFO a -> a -> Dynamics Bool
tryEnqueueFIFO fifo a =
do x <- tryRequestResourceInDynamics (fifoWriteRes fifo)
if x
then do liftIO $ enqueueImpl fifo a
releaseResourceInDynamics (fifoReadRes fifo)
triggerSignal (fifoEnqueueSource fifo) a
return True
else return False
enqueueFIFOOrLost :: FIFO a -> a -> Dynamics ()
enqueueFIFOOrLost fifo a =
do x <- tryRequestResourceInDynamics (fifoWriteRes fifo)
if x
then do liftIO $ enqueueImpl fifo a
releaseResourceInDynamics (fifoReadRes fifo)
triggerSignal (fifoEnqueueSource fifo) a
else do liftIO $ modifyIORef (fifoLostCountRef fifo) $ (+) 1
triggerSignal (fifoEnqueueLostSource fifo) a
fifoEnqueue :: FIFO a -> Signal a
fifoEnqueue fifo = merge2Signals m1 m2
where m1 = publishSignal (fifoUpdatedSource fifo)
m2 = publishSignal (fifoEnqueueSource fifo)
fifoEnqueueLost :: FIFO a -> Signal a
fifoEnqueueLost fifo = merge2Signals m1 m2
where m1 = publishSignal (fifoUpdatedSource fifo)
m2 = publishSignal (fifoEnqueueLostSource fifo)
fifoDequeue :: FIFO a -> Signal a
fifoDequeue fifo = merge2Signals m1 m2
where m1 = publishSignal (fifoUpdatedSource fifo)
m2 = publishSignal (fifoDequeueSource fifo)
dequeueImpl :: FIFO a -> IO a
dequeueImpl fifo =
do i <- readIORef (fifoCountRef fifo)
s <- readIORef (fifoStartRef fifo)
let i' = i 1
s' = (s + 1) `mod` fifoMaxCount fifo
a <- readArray (fifoArray fifo) s
writeArray (fifoArray fifo) s undefined
i' `seq` writeIORef (fifoCountRef fifo) i'
s' `seq` writeIORef (fifoStartRef fifo) s'
return a
enqueueImpl :: FIFO a -> a -> IO ()
enqueueImpl fifo a =
do i <- readIORef (fifoCountRef fifo)
e <- readIORef (fifoEndRef fifo)
let i' = i + 1
e' = (e + 1) `mod` fifoMaxCount fifo
a `seq` writeArray (fifoArray fifo) e a
i' `seq` writeIORef (fifoCountRef fifo) i'
e' `seq` writeIORef (fifoEndRef fifo) e'