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