module Simulation.Aivika.GPSS.Queue
(
Queue,
QueueEntry(..),
newQueue,
queueNull,
queueContent,
queueContentStats,
enqueueCount,
enqueueZeroEntryCount,
queueWaitTime,
queueNonZeroEntryWaitTime,
queueRate,
enqueue,
dequeue,
resetQueue,
queueNullChanged,
queueNullChanged_,
queueContentChanged,
queueContentChanged_,
enqueueCountChanged,
enqueueCountChanged_,
enqueueZeroEntryCountChanged,
enqueueZeroEntryCountChanged_,
queueWaitTimeChanged,
queueWaitTimeChanged_,
queueNonZeroEntryWaitTimeChanged,
queueNonZeroEntryWaitTimeChanged_,
queueRateChanged,
queueRateChanged_,
enqueued,
dequeued,
queueChanged_) where
import Data.IORef
import Data.Monoid
import Data.Maybe
import Data.Hashable
import Control.Monad
import Control.Monad.Trans
import Simulation.Aivika
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Process
import Simulation.Aivika.Signal
import Simulation.Aivika.Statistics
import Simulation.Aivika.GPSS.Transact
data Queue =
Queue { queueSequenceNo :: Int,
queueContentRef :: IORef Int,
queueContentStatsRef :: IORef (TimingStats Int),
enqueueCountRef :: IORef Int,
enqueueZeroEntryCountRef :: IORef Int,
queueWaitTimeRef :: IORef (SamplingStats Double),
queueNonZeroEntryWaitTimeRef :: IORef (SamplingStats Double),
enqueuedSource :: SignalSource (),
dequeuedSource :: SignalSource ()
}
data QueueEntry =
QueueEntry { entryQueue :: Queue,
entryEnqueueTime :: Double
} deriving Eq
instance Eq Queue where
x == y = (queueContentRef x) == (queueContentRef y)
instance Hashable Queue where
hashWithSalt salt x = hashWithSalt salt (queueSequenceNo x)
newQueue :: Event Queue
newQueue =
do t <- liftDynamics time
g <- liftParameter generatorParameter
no <- liftIO $ generateSequenceNo g
i <- liftIO $ newIORef 0
is <- liftIO $ newIORef $ returnTimingStats t 0
e <- liftIO $ newIORef 0
z <- liftIO $ newIORef 0
w <- liftIO $ newIORef mempty
w2 <- liftIO $ newIORef mempty
s1 <- liftSimulation $ newSignalSource
s2 <- liftSimulation $ newSignalSource
return Queue { queueSequenceNo = no,
queueContentRef = i,
queueContentStatsRef = is,
enqueueCountRef = e,
enqueueZeroEntryCountRef = z,
queueWaitTimeRef = w,
queueNonZeroEntryWaitTimeRef = w2,
enqueuedSource = s1,
dequeuedSource = s2 }
queueNull :: Queue -> Event Bool
queueNull q =
Event $ \p ->
do n <- readIORef (queueContentRef q)
return (n == 0)
queueNullChanged :: Queue -> Signal Bool
queueNullChanged q =
mapSignalM (const $ queueNull q) (queueNullChanged_ q)
queueNullChanged_ :: Queue -> Signal ()
queueNullChanged_ = queueContentChanged_
queueContent :: Queue -> Event Int
queueContent q =
Event $ \p -> readIORef (queueContentRef q)
queueContentStats :: Queue -> Event (TimingStats Int)
queueContentStats q =
Event $ \p -> readIORef (queueContentStatsRef q)
queueContentChanged :: Queue -> Signal Int
queueContentChanged q =
mapSignalM (const $ queueContent q) (queueContentChanged_ q)
queueContentChanged_ :: Queue -> Signal ()
queueContentChanged_ q =
mapSignal (const ()) (enqueued q) <>
mapSignal (const ()) (dequeued q)
enqueueCount :: Queue -> Event Int
enqueueCount q =
Event $ \p -> readIORef (enqueueCountRef q)
enqueueCountChanged :: Queue -> Signal Int
enqueueCountChanged q =
mapSignalM (const $ enqueueCount q) (enqueueCountChanged_ q)
enqueueCountChanged_ :: Queue -> Signal ()
enqueueCountChanged_ q =
mapSignal (const ()) (enqueued q)
enqueueZeroEntryCount :: Queue -> Event Int
enqueueZeroEntryCount q =
Event $ \p -> readIORef (enqueueZeroEntryCountRef q)
enqueueZeroEntryCountChanged :: Queue -> Signal Int
enqueueZeroEntryCountChanged q =
mapSignalM (const $ enqueueZeroEntryCount q) (enqueueZeroEntryCountChanged_ q)
enqueueZeroEntryCountChanged_ :: Queue -> Signal ()
enqueueZeroEntryCountChanged_ q =
mapSignal (const ()) (dequeued q)
queueWaitTime :: Queue -> Event (SamplingStats Double)
queueWaitTime q =
Event $ \p -> readIORef (queueWaitTimeRef q)
queueWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueWaitTimeChanged q =
mapSignalM (const $ queueWaitTime q) (queueWaitTimeChanged_ q)
queueWaitTimeChanged_ :: Queue -> Signal ()
queueWaitTimeChanged_ q =
mapSignal (const ()) (dequeued q)
queueNonZeroEntryWaitTime :: Queue -> Event (SamplingStats Double)
queueNonZeroEntryWaitTime q =
Event $ \p -> readIORef (queueNonZeroEntryWaitTimeRef q)
queueNonZeroEntryWaitTimeChanged :: Queue -> Signal (SamplingStats Double)
queueNonZeroEntryWaitTimeChanged q =
mapSignalM (const $ queueNonZeroEntryWaitTime q) (queueNonZeroEntryWaitTimeChanged_ q)
queueNonZeroEntryWaitTimeChanged_ :: Queue -> Signal ()
queueNonZeroEntryWaitTimeChanged_ q =
mapSignal (const ()) (dequeued q)
queueRate :: Queue -> Event Double
queueRate q =
Event $ \p ->
do x <- readIORef (queueContentStatsRef q)
y <- readIORef (queueWaitTimeRef q)
return (timingStatsMean x / samplingStatsMean y)
queueRateChanged :: Queue -> Signal Double
queueRateChanged q =
mapSignalM (const $ queueRate q) (queueRateChanged_ q)
queueRateChanged_ :: Queue -> Signal ()
queueRateChanged_ q =
mapSignal (const ()) (enqueued q) <>
mapSignal (const ()) (dequeued q)
enqueued:: Queue -> Signal ()
enqueued q = publishSignal (enqueuedSource q)
dequeued :: Queue -> Signal ()
dequeued q = publishSignal (dequeuedSource q)
enqueue :: Queue
-> Transact a
-> Int
-> Event ()
enqueue q transact increment =
Event $ \p ->
do let t = pointTime p
e = QueueEntry { entryQueue = q,
entryEnqueueTime = t }
n <- readIORef (enqueueCountRef q)
let n' = n + 1
n' `seq` writeIORef (enqueueCountRef q) n'
c <- readIORef (queueContentRef q)
let c' = c + increment
c' `seq` writeIORef (queueContentRef q) c'
modifyIORef' (queueContentStatsRef q) (addTimingStats t c')
invokeEvent p $
registerTransactQueueEntry transact e
invokeEvent p $
triggerSignal (enqueuedSource q) ()
dequeue :: Queue
-> Transact a
-> Int
-> Event ()
dequeue q transact decrement =
Event $ \p ->
do e <- invokeEvent p $
unregisterTransactQueueEntry transact q
let t = pointTime p
t0 = entryEnqueueTime e
dt = t t0
c <- readIORef (queueContentRef q)
let c' = c decrement
c' `seq` writeIORef (queueContentRef q) c'
modifyIORef' (queueContentStatsRef q) (addTimingStats t c')
modifyIORef' (queueWaitTimeRef q) $
addSamplingStats dt
if t == t0
then modifyIORef' (enqueueZeroEntryCountRef q) (+ 1)
else modifyIORef' (queueNonZeroEntryWaitTimeRef q) $
addSamplingStats dt
invokeEvent p $
triggerSignal (dequeuedSource q) ()
queueChanged_ :: Queue -> Signal ()
queueChanged_ q =
mapSignal (const ()) (enqueued q) <>
mapSignal (const ()) (dequeued q)
resetQueue :: Queue -> Event ()
resetQueue q =
do t <- liftDynamics time
content <- liftIO $ readIORef (queueContentRef q)
liftIO $ writeIORef (queueContentStatsRef q) $
returnTimingStats t content
liftIO $ writeIORef (enqueueCountRef q) 0
liftIO $ writeIORef (enqueueZeroEntryCountRef q) 0
liftIO $ writeIORef (queueWaitTimeRef q) mempty
liftIO $ writeIORef (queueNonZeroEntryWaitTimeRef q) mempty