{-# LANGUAGE TypeFamilies, FlexibleInstances #-}

-- |
-- Module     : Simulation.Aivika.IO.Resource.Preemption
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- This module defines the preemptible resource, where
-- the 'IO' monad is an instance of 'MonadResource'.
--
module Simulation.Aivika.IO.Resource.Preemption () where

import Control.Monad
import Control.Monad.Trans

import Data.Maybe
import Data.IORef
import Data.Monoid

import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Internal.Cont
import Simulation.Aivika.Trans.Internal.Process
import Simulation.Aivika.Trans.Resource.Preemption
import Simulation.Aivika.Trans.Statistics
import Simulation.Aivika.Trans.Signal

import Simulation.Aivika.IO.DES

import qualified Simulation.Aivika.PriorityQueue as PQ

-- | The 'IO' monad is an instance of 'MonadResource'.
instance MonadResource IO where
-- instance (Monad m, MonadDES m, MonadIO m, MonadTemplate m) => MonadResource m where

  {-# SPECIALISE instance MonadResource IO #-}

  -- | A template-based implementation of the preemptible resource.
  data Resource IO = 
    Resource { Resource IO -> Maybe Int
resourceMaxCount0 :: Maybe Int,
               -- ^ Return the maximum count of the resource, where 'Nothing'
               -- means that the resource has no upper bound.
               Resource IO -> IORef Int
resourceCountRef :: IORef Int,
               Resource IO -> IORef (TimingStats Int)
resourceCountStatsRef :: IORef (TimingStats Int),
               Resource IO -> SignalSource IO Int
resourceCountSource :: SignalSource IO Int,
               Resource IO -> IORef Int
resourceUtilisationCountRef :: IORef Int,
               Resource IO -> IORef (TimingStats Int)
resourceUtilisationCountStatsRef :: IORef (TimingStats Int),
               Resource IO -> SignalSource IO Int
resourceUtilisationCountSource :: SignalSource IO Int,
               Resource IO -> IORef Int
resourceQueueCountRef :: IORef Int,
               Resource IO -> IORef (TimingStats Int)
resourceQueueCountStatsRef :: IORef (TimingStats Int),
               Resource IO -> SignalSource IO Int
resourceQueueCountSource :: SignalSource IO Int,
               Resource IO -> IORef Double
resourceTotalWaitTimeRef :: IORef Double,
               Resource IO -> IORef (SamplingStats Double)
resourceWaitTimeRef :: IORef (SamplingStats Double),
               Resource IO -> SignalSource IO ()
resourceWaitTimeSource :: SignalSource IO (),
               Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue :: PQ.PriorityQueue (ResourceActingItem IO),
               Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue :: PQ.PriorityQueue (ResourceAwaitingItem IO) }

  {-# INLINABLE newResource #-}
  newResource :: Int -> Event IO (Resource IO)
newResource Int
count =
    Int -> Maybe Int -> Event IO (Resource IO)
forall (m :: * -> *).
MonadResource m =>
Int -> Maybe Int -> Event m (Resource m)
newResourceWithMaxCount Int
count (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count)

  {-# INLINABLE newResourceWithMaxCount #-}
  newResourceWithMaxCount :: Int -> Maybe Int -> Event IO (Resource IO)
newResourceWithMaxCount Int
count Maybe Int
maxCount =
    (Point IO -> IO (Resource IO)) -> Event IO (Resource IO)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO (Resource IO)) -> Event IO (Resource IO))
-> (Point IO -> IO (Resource IO)) -> Event IO (Resource IO)
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
    do let r :: Run IO
r = Point IO -> Run IO
forall (m :: * -> *). Point m -> Run m
pointRun Point IO
p
           t :: Double
t = Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         SimulationRetry -> IO ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
         String
"The resource count cannot be negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"newResourceWithMaxCount."
       case Maybe Int
maxCount of
         Just Int
maxCount | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
           SimulationRetry -> IO ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
           String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
           String
"The resource count cannot be greater than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
"its maximum value: newResourceWithMaxCount."
         Maybe Int
_ ->
           () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       IORef Int
countRef <- IO (IORef Int) -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> IO (IORef Int))
-> IO (IORef Int) -> IO (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
count
       IORef (TimingStats Int)
countStatsRef <- IO (IORef (TimingStats Int)) -> IO (IORef (TimingStats Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (TimingStats Int)) -> IO (IORef (TimingStats Int)))
-> IO (IORef (TimingStats Int)) -> IO (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
count
       SignalSource IO Int
countSource <- Run IO
-> Simulation IO (SignalSource IO Int) -> IO (SignalSource IO Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run IO
r Simulation IO (SignalSource IO Int)
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
       IORef Int
utilCountRef <- IO (IORef Int) -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> IO (IORef Int))
-> IO (IORef Int) -> IO (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)
utilCountStatsRef <- IO (IORef (TimingStats Int)) -> IO (IORef (TimingStats Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (TimingStats Int)) -> IO (IORef (TimingStats Int)))
-> IO (IORef (TimingStats Int)) -> IO (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
       SignalSource IO Int
utilCountSource <- Run IO
-> Simulation IO (SignalSource IO Int) -> IO (SignalSource IO Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run IO
r Simulation IO (SignalSource IO Int)
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
       IORef Int
queueCountRef <- IO (IORef Int) -> IO (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> IO (IORef Int))
-> IO (IORef Int) -> IO (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)
queueCountStatsRef <- IO (IORef (TimingStats Int)) -> IO (IORef (TimingStats Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (TimingStats Int)) -> IO (IORef (TimingStats Int)))
-> IO (IORef (TimingStats Int)) -> IO (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
       SignalSource IO Int
queueCountSource <- Run IO
-> Simulation IO (SignalSource IO Int) -> IO (SignalSource IO Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run IO
r Simulation IO (SignalSource IO Int)
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
       IORef Double
totalWaitTimeRef <- IO (IORef Double) -> IO (IORef Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Double) -> IO (IORef Double))
-> IO (IORef Double) -> IO (IORef Double)
forall a b. (a -> b) -> a -> b
$ Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
       IORef (SamplingStats Double)
waitTimeRef <- IO (IORef (SamplingStats Double))
-> IO (IORef (SamplingStats Double))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SamplingStats Double))
 -> IO (IORef (SamplingStats Double)))
-> IO (IORef (SamplingStats Double))
-> IO (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. SamplingData a => SamplingStats a
emptySamplingStats
       SignalSource IO ()
waitTimeSource <- Run IO
-> Simulation IO (SignalSource IO ()) -> IO (SignalSource IO ())
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run IO
r Simulation IO (SignalSource IO ())
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
       PriorityQueue (ResourceActingItem IO)
actingQueue <- IO (PriorityQueue (ResourceActingItem IO))
-> IO (PriorityQueue (ResourceActingItem IO))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PriorityQueue (ResourceActingItem IO))
forall a. IO (PriorityQueue a)
PQ.newQueue
       PriorityQueue (ResourceAwaitingItem IO)
waitQueue <- IO (PriorityQueue (ResourceAwaitingItem IO))
-> IO (PriorityQueue (ResourceAwaitingItem IO))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PriorityQueue (ResourceAwaitingItem IO))
forall a. IO (PriorityQueue a)
PQ.newQueue
       Resource IO -> IO (Resource IO)
forall (m :: * -> *) a. Monad m => a -> m a
return Resource :: Maybe Int
-> IORef Int
-> IORef (TimingStats Int)
-> SignalSource IO Int
-> IORef Int
-> IORef (TimingStats Int)
-> SignalSource IO Int
-> IORef Int
-> IORef (TimingStats Int)
-> SignalSource IO Int
-> IORef Double
-> IORef (SamplingStats Double)
-> SignalSource IO ()
-> PriorityQueue (ResourceActingItem IO)
-> PriorityQueue (ResourceAwaitingItem IO)
-> Resource IO
Resource { resourceMaxCount0 :: Maybe Int
resourceMaxCount0 = Maybe Int
maxCount,
                         resourceCountRef :: IORef Int
resourceCountRef = IORef Int
countRef,
                         resourceCountStatsRef :: IORef (TimingStats Int)
resourceCountStatsRef = IORef (TimingStats Int)
countStatsRef,
                         resourceCountSource :: SignalSource IO Int
resourceCountSource = SignalSource IO Int
countSource,
                         resourceUtilisationCountRef :: IORef Int
resourceUtilisationCountRef = IORef Int
utilCountRef,
                         resourceUtilisationCountStatsRef :: IORef (TimingStats Int)
resourceUtilisationCountStatsRef = IORef (TimingStats Int)
utilCountStatsRef,
                         resourceUtilisationCountSource :: SignalSource IO Int
resourceUtilisationCountSource = SignalSource IO Int
utilCountSource,
                         resourceQueueCountRef :: IORef Int
resourceQueueCountRef = IORef Int
queueCountRef,
                         resourceQueueCountStatsRef :: IORef (TimingStats Int)
resourceQueueCountStatsRef = IORef (TimingStats Int)
queueCountStatsRef,
                         resourceQueueCountSource :: SignalSource IO Int
resourceQueueCountSource = SignalSource IO Int
queueCountSource,
                         resourceTotalWaitTimeRef :: IORef Double
resourceTotalWaitTimeRef = IORef Double
totalWaitTimeRef,
                         resourceWaitTimeRef :: IORef (SamplingStats Double)
resourceWaitTimeRef = IORef (SamplingStats Double)
waitTimeRef,
                         resourceWaitTimeSource :: SignalSource IO ()
resourceWaitTimeSource = SignalSource IO ()
waitTimeSource,
                         resourceActingQueue :: PriorityQueue (ResourceActingItem IO)
resourceActingQueue = PriorityQueue (ResourceActingItem IO)
actingQueue,
                         resourceWaitQueue :: PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue = PriorityQueue (ResourceAwaitingItem IO)
waitQueue }

  {-# INLINABLE resourceMaxCount #-}
  resourceMaxCount :: Resource IO -> Maybe Int
resourceMaxCount = Resource IO -> Maybe Int
resourceMaxCount0

  {-# INLINABLE resourceCount #-}
  resourceCount :: Resource IO -> Event IO Int
resourceCount Resource IO
r =
    (Point IO -> IO Int) -> Event IO Int
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO Int) -> Event IO Int)
-> (Point IO -> IO Int) -> Event IO Int
forall a b. (a -> b) -> a -> b
$ \Point IO
p -> IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)

  {-# INLINABLE resourceCountStats #-}
  resourceCountStats :: Resource IO -> Event IO (TimingStats Int)
resourceCountStats Resource IO
r =
    (Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int))
-> (Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point IO
p -> IO (TimingStats Int) -> IO (TimingStats Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TimingStats Int) -> IO (TimingStats Int))
-> IO (TimingStats Int) -> IO (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef (TimingStats Int)
resourceCountStatsRef Resource IO
r)

  {-# INLINABLE resourceCountChanged #-}
  resourceCountChanged :: Resource IO -> Signal IO Int
resourceCountChanged Resource IO
r =
    SignalSource IO Int -> Signal IO Int
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal (SignalSource IO Int -> Signal IO Int)
-> SignalSource IO Int -> Signal IO Int
forall a b. (a -> b) -> a -> b
$ Resource IO -> SignalSource IO Int
resourceCountSource Resource IO
r

  {-# INLINABLE resourceCountChanged_ #-}
  resourceCountChanged_ :: Resource IO -> Signal IO ()
resourceCountChanged_ Resource IO
r =
    (Int -> ()) -> Signal IO Int -> Signal IO ()
forall (m :: * -> *) a b.
MonadDES m =>
(a -> b) -> Signal m a -> Signal m b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal IO Int -> Signal IO ()) -> Signal IO Int -> Signal IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Signal IO Int
forall (m :: * -> *). MonadResource m => Resource m -> Signal m Int
resourceCountChanged Resource IO
r

  {-# INLINABLE resourceUtilisationCount #-}
  resourceUtilisationCount :: Resource IO -> Event IO Int
resourceUtilisationCount Resource IO
r =
    (Point IO -> IO Int) -> Event IO Int
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO Int) -> Event IO Int)
-> (Point IO -> IO Int) -> Event IO Int
forall a b. (a -> b) -> a -> b
$ \Point IO
p -> IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceUtilisationCountRef Resource IO
r)

  {-# INLINABLE resourceUtilisationCountStats #-}
  resourceUtilisationCountStats :: Resource IO -> Event IO (TimingStats Int)
resourceUtilisationCountStats Resource IO
r =
    (Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int))
-> (Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point IO
p -> IO (TimingStats Int) -> IO (TimingStats Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TimingStats Int) -> IO (TimingStats Int))
-> IO (TimingStats Int) -> IO (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef (TimingStats Int)
resourceUtilisationCountStatsRef Resource IO
r)

  {-# INLINABLE resourceUtilisationCountChanged #-}
  resourceUtilisationCountChanged :: Resource IO -> Signal IO Int
resourceUtilisationCountChanged Resource IO
r =
    SignalSource IO Int -> Signal IO Int
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal (SignalSource IO Int -> Signal IO Int)
-> SignalSource IO Int -> Signal IO Int
forall a b. (a -> b) -> a -> b
$ Resource IO -> SignalSource IO Int
resourceUtilisationCountSource Resource IO
r

  {-# INLINABLE resourceUtilisationCountChanged_ #-}
  resourceUtilisationCountChanged_ :: Resource IO -> Signal IO ()
resourceUtilisationCountChanged_ Resource IO
r =
    (Int -> ()) -> Signal IO Int -> Signal IO ()
forall (m :: * -> *) a b.
MonadDES m =>
(a -> b) -> Signal m a -> Signal m b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal IO Int -> Signal IO ()) -> Signal IO Int -> Signal IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Signal IO Int
forall (m :: * -> *). MonadResource m => Resource m -> Signal m Int
resourceUtilisationCountChanged Resource IO
r

  {-# INLINABLE resourceQueueCount #-}
  resourceQueueCount :: Resource IO -> Event IO Int
resourceQueueCount Resource IO
r =
    (Point IO -> IO Int) -> Event IO Int
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO Int) -> Event IO Int)
-> (Point IO -> IO Int) -> Event IO Int
forall a b. (a -> b) -> a -> b
$ \Point IO
p -> IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceQueueCountRef Resource IO
r)

  {-# INLINABLE resourceQueueCountStats #-}
  resourceQueueCountStats :: Resource IO -> Event IO (TimingStats Int)
resourceQueueCountStats Resource IO
r =
    (Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int))
-> (Point IO -> IO (TimingStats Int)) -> Event IO (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point IO
p -> IO (TimingStats Int) -> IO (TimingStats Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TimingStats Int) -> IO (TimingStats Int))
-> IO (TimingStats Int) -> IO (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef (TimingStats Int)
resourceQueueCountStatsRef Resource IO
r)

  {-# INLINABLE resourceQueueCountChanged #-}
  resourceQueueCountChanged :: Resource IO -> Signal IO Int
resourceQueueCountChanged Resource IO
r =
    SignalSource IO Int -> Signal IO Int
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal (SignalSource IO Int -> Signal IO Int)
-> SignalSource IO Int -> Signal IO Int
forall a b. (a -> b) -> a -> b
$ Resource IO -> SignalSource IO Int
resourceQueueCountSource Resource IO
r

  {-# INLINABLE resourceQueueCountChanged_ #-}
  resourceQueueCountChanged_ :: Resource IO -> Signal IO ()
resourceQueueCountChanged_ Resource IO
r =
    (Int -> ()) -> Signal IO Int -> Signal IO ()
forall (m :: * -> *) a b.
MonadDES m =>
(a -> b) -> Signal m a -> Signal m b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal IO Int -> Signal IO ()) -> Signal IO Int -> Signal IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Signal IO Int
forall (m :: * -> *). MonadResource m => Resource m -> Signal m Int
resourceQueueCountChanged Resource IO
r

  {-# INLINABLE resourceTotalWaitTime #-}
  resourceTotalWaitTime :: Resource IO -> Event IO Double
resourceTotalWaitTime Resource IO
r =
    (Point IO -> IO Double) -> Event IO Double
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO Double) -> Event IO Double)
-> (Point IO -> IO Double) -> Event IO Double
forall a b. (a -> b) -> a -> b
$ \Point IO
p -> IO Double -> IO Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> IO Double) -> IO Double -> IO Double
forall a b. (a -> b) -> a -> b
$ IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Double
resourceTotalWaitTimeRef Resource IO
r)

  {-# INLINABLE resourceWaitTime #-}
  resourceWaitTime :: Resource IO -> Event IO (SamplingStats Double)
resourceWaitTime Resource IO
r =
    (Point IO -> IO (SamplingStats Double))
-> Event IO (SamplingStats Double)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO (SamplingStats Double))
 -> Event IO (SamplingStats Double))
-> (Point IO -> IO (SamplingStats Double))
-> Event IO (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ \Point IO
p -> IO (SamplingStats Double) -> IO (SamplingStats Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SamplingStats Double) -> IO (SamplingStats Double))
-> IO (SamplingStats Double) -> IO (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef (SamplingStats Double)
resourceWaitTimeRef Resource IO
r)

  {-# INLINABLE resourceWaitTimeChanged #-}
  resourceWaitTimeChanged :: Resource IO -> Signal IO (SamplingStats Double)
resourceWaitTimeChanged Resource IO
r =
    (() -> Event IO (SamplingStats Double))
-> Signal IO () -> Signal IO (SamplingStats Double)
forall (m :: * -> *) a b.
MonadDES m =>
(a -> Event m b) -> Signal m a -> Signal m b
mapSignalM (\() -> Resource IO -> Event IO (SamplingStats Double)
forall (m :: * -> *).
MonadResource m =>
Resource m -> Event m (SamplingStats Double)
resourceWaitTime Resource IO
r) (Signal IO () -> Signal IO (SamplingStats Double))
-> Signal IO () -> Signal IO (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Resource IO -> Signal IO ()
forall (m :: * -> *). MonadResource m => Resource m -> Signal m ()
resourceWaitTimeChanged_ Resource IO
r

  {-# INLINABLE resourceWaitTimeChanged_ #-}
  resourceWaitTimeChanged_ :: Resource IO -> Signal IO ()
resourceWaitTimeChanged_ Resource IO
r =
    SignalSource IO () -> Signal IO ()
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal (SignalSource IO () -> Signal IO ())
-> SignalSource IO () -> Signal IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> SignalSource IO ()
resourceWaitTimeSource Resource IO
r

  {-# INLINABLE resourceChanged_ #-}
  resourceChanged_ :: Resource IO -> Signal IO ()
resourceChanged_ Resource IO
r =
    Resource IO -> Signal IO ()
forall (m :: * -> *). MonadResource m => Resource m -> Signal m ()
resourceCountChanged_ Resource IO
r Signal IO () -> Signal IO () -> Signal IO ()
forall a. Semigroup a => a -> a -> a
<>
    Resource IO -> Signal IO ()
forall (m :: * -> *). MonadResource m => Resource m -> Signal m ()
resourceUtilisationCountChanged_ Resource IO
r Signal IO () -> Signal IO () -> Signal IO ()
forall a. Semigroup a => a -> a -> a
<>
    Resource IO -> Signal IO ()
forall (m :: * -> *). MonadResource m => Resource m -> Signal m ()
resourceQueueCountChanged_ Resource IO
r

  {-# INLINABLE requestResourceWithPriority #-}
  requestResourceWithPriority :: Resource IO -> Double -> Process IO ()
requestResourceWithPriority Resource IO
r Double
priority =
    (ProcessId IO -> Cont IO ()) -> Process IO ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId IO -> Cont IO ()) -> Process IO ())
-> (ProcessId IO -> Cont IO ()) -> Process IO ()
forall a b. (a -> b) -> a -> b
$ \ProcessId IO
pid ->
    (ContParams IO () -> Event IO ()) -> Cont IO ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams IO () -> Event IO ()) -> Cont IO ())
-> (ContParams IO () -> Event IO ()) -> Cont IO ()
forall a b. (a -> b) -> a -> b
$ \ContParams IO ()
c ->
    (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
    do let t :: Double
t = Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p
       Int
a <- IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
       if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
         then do Bool
f <- IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO) -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
                 if Bool
f
                   then do FrozenCont IO ()
c <- Point IO -> Event IO (FrozenCont IO ()) -> IO (FrozenCont IO ())
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO (FrozenCont IO ()) -> IO (FrozenCont IO ()))
-> Event IO (FrozenCont IO ()) -> IO (FrozenCont IO ())
forall a b. (a -> b) -> a -> b
$
                                ContParams IO ()
-> () -> Event IO () -> Event IO (FrozenCont IO ())
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams IO ()
c () (Event IO () -> Event IO (FrozenCont IO ()))
-> Event IO () -> Event IO (FrozenCont IO ())
forall a b. (a -> b) -> a -> b
$
                                ContParams IO () -> Cont IO () -> Event IO ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams IO ()
c (Cont IO () -> Event IO ()) -> Cont IO () -> Event IO ()
forall a b. (a -> b) -> a -> b
$
                                ProcessId IO -> Process IO () -> Cont IO ()
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId IO
pid (Process IO () -> Cont IO ()) -> Process IO () -> Cont IO ()
forall a b. (a -> b) -> a -> b
$
                                Resource IO -> Double -> Process IO ()
forall (m :: * -> *).
MonadResource m =>
Resource m -> Double -> Process m ()
requestResourceWithPriority Resource IO
r Double
priority
                           IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceAwaitingItem IO)
-> Double -> ResourceAwaitingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
priority (ResourceRequestingItem IO -> ResourceAwaitingItem IO
forall a b. a -> Either a b
Left (ResourceRequestingItem IO -> ResourceAwaitingItem IO)
-> ResourceRequestingItem IO -> ResourceAwaitingItem IO
forall a b. (a -> b) -> a -> b
$ Double
-> Double
-> ProcessId IO
-> FrozenCont IO ()
-> ResourceRequestingItem IO
forall (m :: * -> *).
Double
-> Double
-> ProcessId m
-> FrozenCont m ()
-> ResourceRequestingItem m
ResourceRequestingItem Double
priority Double
t ProcessId IO
pid FrozenCont IO ()
c)
                           Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r Int
1
                   else do (Double
p0', ResourceActingItem IO
item0) <- IO (Double, ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, ResourceActingItem IO)
 -> IO (Double, ResourceActingItem IO))
-> IO (Double, ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
                           let p0 :: Double
p0 = - Double
p0'
                               pid0 :: ProcessId IO
pid0 = ResourceActingItem IO -> ProcessId IO
forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
item0
                           if Double
priority Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
p0
                             then do IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO) -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
                                     IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO)
-> Double -> ResourceActingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (- Double
priority) (ResourceActingItem IO -> IO ()) -> ResourceActingItem IO -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId IO -> ResourceActingItem IO
forall (m :: * -> *). Double -> ProcessId m -> ResourceActingItem m
ResourceActingItem Double
priority ProcessId IO
pid
                                     IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceAwaitingItem IO)
-> Double -> ResourceAwaitingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
p0 (ResourcePreemptedItem IO -> ResourceAwaitingItem IO
forall a b. b -> Either a b
Right (ResourcePreemptedItem IO -> ResourceAwaitingItem IO)
-> ResourcePreemptedItem IO -> ResourceAwaitingItem IO
forall a b. (a -> b) -> a -> b
$ Double -> Double -> ProcessId IO -> ResourcePreemptedItem IO
forall (m :: * -> *).
Double -> Double -> ProcessId m -> ResourcePreemptedItem m
ResourcePreemptedItem Double
p0 Double
t ProcessId IO
pid0)
                                     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r Double
0
                                     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r Int
1
                                     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId IO -> Event IO ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionBegin ProcessId IO
pid0
                                     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams IO () -> () -> Event IO ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams IO ()
c ()
                             else do FrozenCont IO ()
c <- Point IO -> Event IO (FrozenCont IO ()) -> IO (FrozenCont IO ())
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO (FrozenCont IO ()) -> IO (FrozenCont IO ()))
-> Event IO (FrozenCont IO ()) -> IO (FrozenCont IO ())
forall a b. (a -> b) -> a -> b
$
                                          ContParams IO ()
-> () -> Event IO () -> Event IO (FrozenCont IO ())
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams IO ()
c () (Event IO () -> Event IO (FrozenCont IO ()))
-> Event IO () -> Event IO (FrozenCont IO ())
forall a b. (a -> b) -> a -> b
$
                                          ContParams IO () -> Cont IO () -> Event IO ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams IO ()
c (Cont IO () -> Event IO ()) -> Cont IO () -> Event IO ()
forall a b. (a -> b) -> a -> b
$
                                          ProcessId IO -> Process IO () -> Cont IO ()
forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId IO
pid (Process IO () -> Cont IO ()) -> Process IO () -> Cont IO ()
forall a b. (a -> b) -> a -> b
$
                                          Resource IO -> Double -> Process IO ()
forall (m :: * -> *).
MonadResource m =>
Resource m -> Double -> Process m ()
requestResourceWithPriority Resource IO
r Double
priority
                                     IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceAwaitingItem IO)
-> Double -> ResourceAwaitingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
priority (ResourceRequestingItem IO -> ResourceAwaitingItem IO
forall a b. a -> Either a b
Left (ResourceRequestingItem IO -> ResourceAwaitingItem IO)
-> ResourceRequestingItem IO -> ResourceAwaitingItem IO
forall a b. (a -> b) -> a -> b
$ Double
-> Double
-> ProcessId IO
-> FrozenCont IO ()
-> ResourceRequestingItem IO
forall (m :: * -> *).
Double
-> Double
-> ProcessId m
-> FrozenCont m ()
-> ResourceRequestingItem m
ResourceRequestingItem Double
priority Double
t ProcessId IO
pid FrozenCont IO ()
c)
                                     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r Int
1
         else do IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO)
-> Double -> ResourceActingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (- Double
priority) (ResourceActingItem IO -> IO ()) -> ResourceActingItem IO -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId IO -> ResourceActingItem IO
forall (m :: * -> *). Double -> ProcessId m -> ResourceActingItem m
ResourceActingItem Double
priority ProcessId IO
pid
                 Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r Double
0
                 Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceCount Resource IO
r (-Int
1)
                 Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r Int
1
                 Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams IO () -> () -> Event IO ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams IO ()
c ()

  {-# INLINABLE releaseResource #-}
  releaseResource :: Resource IO -> Process IO ()
releaseResource Resource IO
r = 
    (ProcessId IO -> Cont IO ()) -> Process IO ()
forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process ((ProcessId IO -> Cont IO ()) -> Process IO ())
-> (ProcessId IO -> Cont IO ()) -> Process IO ()
forall a b. (a -> b) -> a -> b
$ \ProcessId IO
pid ->
    (ContParams IO () -> Event IO ()) -> Cont IO ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams IO () -> Event IO ()) -> Cont IO ())
-> (ContParams IO () -> Event IO ()) -> Cont IO ()
forall a b. (a -> b) -> a -> b
$ \ContParams IO ()
c ->
    (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
    do Bool
f <- IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Maybe (ResourceActingItem IO) -> Bool)
-> IO (Maybe (ResourceActingItem IO)) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (ResourceActingItem IO) -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe (ResourceActingItem IO)) -> IO Bool)
-> IO (Maybe (ResourceActingItem IO)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO)
-> (ResourceActingItem IO -> Bool)
-> IO (Maybe (ResourceActingItem IO))
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueDeleteBy (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (\ResourceActingItem IO
item -> ResourceActingItem IO -> ProcessId IO
forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
item ProcessId IO -> ProcessId IO -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId IO
pid)
       if Bool
f
         then do Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r (-Int
1)
                 Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Event IO ()
releaseResource' Resource IO
r
                 Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams IO () -> () -> Event IO ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams IO ()
c ()
         else SimulationRetry -> IO ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
              String -> SimulationRetry
SimulationRetry
              String
"The resource was not acquired by this process: releaseResource"

  {-# INLINABLE usingResourceWithPriority #-}
  usingResourceWithPriority :: Resource IO -> Double -> Process IO a -> Process IO a
usingResourceWithPriority Resource IO
r Double
priority Process IO a
m =
    do Resource IO -> Double -> Process IO ()
forall (m :: * -> *).
MonadResource m =>
Resource m -> Double -> Process m ()
requestResourceWithPriority Resource IO
r Double
priority
       Process IO a -> Process IO () -> Process IO a
forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess Process IO a
m (Process IO () -> Process IO a) -> Process IO () -> Process IO a
forall a b. (a -> b) -> a -> b
$ Resource IO -> Process IO ()
forall (m :: * -> *). MonadResource m => Resource m -> Process m ()
releaseResource Resource IO
r

  {-# INLINABLE incResourceCount #-}
  incResourceCount :: Resource IO -> Int -> Event IO ()
incResourceCount Resource IO
r Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = SimulationRetry -> Event IO ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent (SimulationRetry -> Event IO ()) -> SimulationRetry -> Event IO ()
forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The increment cannot be negative: incResourceCount"
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = () -> Event IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
      do Resource IO -> Event IO ()
releaseResource' Resource IO
r
         Resource IO -> Int -> Event IO ()
forall (m :: * -> *).
MonadResource m =>
Resource m -> Int -> Event m ()
incResourceCount Resource IO
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

  {-# INLINABLE decResourceCount #-}
  decResourceCount :: Resource IO -> Int -> Event IO ()
decResourceCount Resource IO
r Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = SimulationRetry -> Event IO ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent (SimulationRetry -> Event IO ()) -> SimulationRetry -> Event IO ()
forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The decrement cannot be negative: decResourceCount"
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = () -> Event IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
      do Resource IO -> Event IO ()
decResourceCount' Resource IO
r
         Resource IO -> Int -> Event IO ()
forall (m :: * -> *).
MonadResource m =>
Resource m -> Int -> Event m ()
decResourceCount Resource IO
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

  {-# INLINABLE alterResourceCount #-}
  alterResourceCount :: Resource IO -> Int -> Event IO ()
alterResourceCount Resource IO
r Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = Resource IO -> Int -> Event IO ()
forall (m :: * -> *).
MonadResource m =>
Resource m -> Int -> Event m ()
decResourceCount Resource IO
r (- Int
n)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0  = Resource IO -> Int -> Event IO ()
forall (m :: * -> *).
MonadResource m =>
Resource m -> Int -> Event m ()
incResourceCount Resource IO
r Int
n
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> Event IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  {-# INLINABLE resetResource #-}
  resetResource :: Resource IO -> Event IO ()
resetResource Resource IO
r =
    (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
    do let t :: Double
t = Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p
       Int
count <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
       IORef (TimingStats Int) -> TimingStats Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef (TimingStats Int)
resourceCountStatsRef Resource IO
r) (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
count
       Int
utilCount <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceUtilisationCountRef Resource IO
r)
       IORef (TimingStats Int) -> TimingStats Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef (TimingStats Int)
resourceUtilisationCountStatsRef Resource IO
r) (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
utilCount
       Int
queueCount <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceQueueCountRef Resource IO
r)
       IORef (TimingStats Int) -> TimingStats Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef (TimingStats Int)
resourceQueueCountStatsRef Resource IO
r) (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
queueCount
       IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Double
resourceTotalWaitTimeRef Resource IO
r) Double
0
       IORef (SamplingStats Double) -> SamplingStats Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef (SamplingStats Double)
resourceWaitTimeRef Resource IO
r) SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
       Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         SignalSource IO () -> () -> Event IO ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Resource IO -> SignalSource IO ()
resourceWaitTimeSource Resource IO
r) ()

-- | Identifies an acting item that acquired the resource.
data ResourceActingItem m =
  ResourceActingItem { ResourceActingItem m -> Double
actingItemPriority :: Double,
                       ResourceActingItem m -> ProcessId m
actingItemId :: ProcessId m }

-- | Idenitifies an awaiting item that waits for releasing of the resource to take it.
type ResourceAwaitingItem m = Either (ResourceRequestingItem m) (ResourcePreemptedItem m)

-- | Idenitifies an item that requests for the resource.
data ResourceRequestingItem m =
  ResourceRequestingItem { ResourceRequestingItem m -> Double
requestingItemPriority :: Double,
                           ResourceRequestingItem m -> Double
requestingItemTime :: Double,
                           ResourceRequestingItem m -> ProcessId m
requestingItemId :: ProcessId m,
                           ResourceRequestingItem m -> FrozenCont m ()
requestingItemCont :: FrozenCont m () }

-- | Idenitifies an item that was preempted.
data ResourcePreemptedItem m =
  ResourcePreemptedItem { ResourcePreemptedItem m -> Double
preemptedItemPriority :: Double,
                          ResourcePreemptedItem m -> Double
preemptedItemTime :: Double,
                          ResourcePreemptedItem m -> ProcessId m
preemptedItemId :: ProcessId m }

instance Eq (Resource IO) where
-- instance (MonadDES m, MonadIO m, MonadTemplate m) => Eq (Resource m) where

  {-# INLINABLE (==) #-}
  Resource IO
x == :: Resource IO -> Resource IO -> Bool
== Resource IO
y = Resource IO -> IORef Int
resourceCountRef Resource IO
x IORef Int -> IORef Int -> Bool
forall a. Eq a => a -> a -> Bool
== Resource IO -> IORef Int
resourceCountRef Resource IO
y  -- unique references

instance Eq (ResourceActingItem IO) where
-- instance (MonadDES m, MonadIO m, MonadTemplate m) => Eq (ResourceActingItem m) where

  {-# INLINABLE (==) #-}
  ResourceActingItem IO
x == :: ResourceActingItem IO -> ResourceActingItem IO -> Bool
== ResourceActingItem IO
y = ResourceActingItem IO -> ProcessId IO
forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
x ProcessId IO -> ProcessId IO -> Bool
forall a. Eq a => a -> a -> Bool
== ResourceActingItem IO -> ProcessId IO
forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
y

-- | Release the resource increasing its count and resuming one of the
-- previously suspended or preempted processes as possible.
releaseResource' :: Resource IO
                    -- ^ the resource to release
                    -> Event IO ()
-- releaseResource' :: (MonadDES m, MonadIO m, MonadTemplate m)
--                     => Resource m
--                     -- ^ the resource to release
--                     -> Event m ()
{-# INLINABLE releaseResource' #-}
releaseResource' :: Resource IO -> Event IO ()
releaseResource' Resource IO
r =
  (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     case Resource IO -> Maybe Int
forall (m :: * -> *). MonadResource m => Resource m -> Maybe Int
resourceMaxCount Resource IO
r of
       Just Int
maxCount | Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
         SimulationRetry -> IO ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
         String
"The resource count cannot be greater than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"its maximum value: releaseResource'."
       Maybe Int
_ ->
         () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Bool
f <- IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceAwaitingItem IO) -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r)
     if Bool
f 
       then Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceCount Resource IO
r Int
1
       else do (Double
priority', ResourceAwaitingItem IO
item) <- IO (Double, ResourceAwaitingItem IO)
-> IO (Double, ResourceAwaitingItem IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, ResourceAwaitingItem IO)
 -> IO (Double, ResourceAwaitingItem IO))
-> IO (Double, ResourceAwaitingItem IO)
-> IO (Double, ResourceAwaitingItem IO)
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceAwaitingItem IO)
-> IO (Double, ResourceAwaitingItem IO)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r)
               IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceAwaitingItem IO) -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r)
               Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r (-Int
1)
               case ResourceAwaitingItem IO
item of
                 Left (ResourceRequestingItem Double
priority Double
t ProcessId IO
pid FrozenCont IO ()
c) ->
                   do Maybe (ContParams IO ())
c <- Point IO
-> Event IO (Maybe (ContParams IO ()))
-> IO (Maybe (ContParams IO ()))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO (Maybe (ContParams IO ()))
 -> IO (Maybe (ContParams IO ())))
-> Event IO (Maybe (ContParams IO ()))
-> IO (Maybe (ContParams IO ()))
forall a b. (a -> b) -> a -> b
$ FrozenCont IO () -> Event IO (Maybe (ContParams IO ()))
forall (m :: * -> *) a.
FrozenCont m a -> Event m (Maybe (ContParams m a))
unfreezeCont FrozenCont IO ()
c
                      case Maybe (ContParams IO ())
c of
                        Maybe (ContParams IO ())
Nothing ->
                          Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Event IO ()
releaseResource' Resource IO
r
                        Just ContParams IO ()
c ->
                          do IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO)
-> Double -> ResourceActingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (- Double
priority) (ResourceActingItem IO -> IO ()) -> ResourceActingItem IO -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId IO -> ResourceActingItem IO
forall (m :: * -> *). Double -> ProcessId m -> ResourceActingItem m
ResourceActingItem Double
priority ProcessId IO
pid
                             Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r (Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t)
                             Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r Int
1
                             Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Event IO () -> Event IO ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p) (Event IO () -> Event IO ()) -> Event IO () -> Event IO ()
forall a b. (a -> b) -> a -> b
$ ContParams IO () -> () -> Event IO ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams IO ()
c ()
                 Right (ResourcePreemptedItem Double
priority Double
t ProcessId IO
pid) ->
                   do Bool
f <- Point IO -> Event IO Bool -> IO Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO Bool -> IO Bool) -> Event IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ProcessId IO -> Event IO Bool
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m Bool
processCancelled ProcessId IO
pid
                      case Bool
f of
                        Bool
True ->
                          Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Event IO ()
releaseResource' Resource IO
r
                        Bool
False ->
                          do IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO)
-> Double -> ResourceActingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (- Double
priority) (ResourceActingItem IO -> IO ()) -> ResourceActingItem IO -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId IO -> ResourceActingItem IO
forall (m :: * -> *). Double -> ProcessId m -> ResourceActingItem m
ResourceActingItem Double
priority ProcessId IO
pid
                             Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r (Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t)
                             Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r Int
1
                             Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId IO -> Event IO ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionEnd ProcessId IO
pid

-- | Preempt a process with the lowest priority that acquires yet the resource
-- and decrease the count of available resource by 1. 
decResourceCount' :: Resource IO -> Event IO ()
-- decResourceCount' :: (MonadDES m, MonadIO m, MonadTemplate m) => Resource m -> Event m ()
{-# INLINABLE decResourceCount' #-}
decResourceCount' :: Resource IO -> Event IO ()
decResourceCount' Resource IO
r =
  (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do let t :: Double
t = Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p
     Int
a <- IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SimulationRetry -> IO ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
       String -> SimulationRetry
SimulationRetry
       String
"The resource exceeded and its count is zero: decResourceCount'"
     Bool
f <- IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO) -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       do (Double
p0', ResourceActingItem IO
item0) <- IO (Double, ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, ResourceActingItem IO)
 -> IO (Double, ResourceActingItem IO))
-> IO (Double, ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
          let p0 :: Double
p0 = - Double
p0'
              pid0 :: ProcessId IO
pid0 = ResourceActingItem IO -> ProcessId IO
forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
item0
          IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO) -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
          IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceAwaitingItem IO)
-> Double -> ResourceAwaitingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
p0 (ResourcePreemptedItem IO -> ResourceAwaitingItem IO
forall a b. b -> Either a b
Right (ResourcePreemptedItem IO -> ResourceAwaitingItem IO)
-> ResourcePreemptedItem IO -> ResourceAwaitingItem IO
forall a b. (a -> b) -> a -> b
$ Double -> Double -> ProcessId IO -> ResourcePreemptedItem IO
forall (m :: * -> *).
Double -> Double -> ProcessId m -> ResourcePreemptedItem m
ResourcePreemptedItem Double
p0 Double
t ProcessId IO
pid0)
          Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId IO -> Event IO ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionBegin ProcessId IO
pid0
          Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r (-Int
1)
          Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r Int
1
     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceCount Resource IO
r (-Int
1)

-- | Update the resource count and its statistics.
updateResourceCount :: Resource IO -> Int -> Event IO ()
-- updateResourceCount :: (MonadDES m, MonadIO m, MonadTemplate m) => Resource m -> Int -> Event m ()
{-# INLINABLE updateResourceCount #-}
updateResourceCount :: Resource IO -> Int -> Event IO ()
updateResourceCount Resource IO
r Int
delta =
  (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
`seq` IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r) Int
a'
     IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource IO -> IORef (TimingStats Int)
resourceCountStatsRef Resource IO
r) ((TimingStats Int -> TimingStats Int) -> IO ())
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p) Int
a'
     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource IO Int -> Int -> Event IO ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Resource IO -> SignalSource IO Int
resourceCountSource Resource IO
r) Int
a'

-- | Update the resource queue length and its statistics.
updateResourceQueueCount :: Resource IO -> Int -> Event IO ()
-- updateResourceQueueCount :: (MonadDES m, MonadIO m, MonadTemplate m) => Resource m -> Int -> Event m ()
{-# INLINABLE updateResourceQueueCount #-}
updateResourceQueueCount :: Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r Int
delta =
  (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceQueueCountRef Resource IO
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
`seq` IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Int
resourceQueueCountRef Resource IO
r) Int
a'
     IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource IO -> IORef (TimingStats Int)
resourceQueueCountStatsRef Resource IO
r) ((TimingStats Int -> TimingStats Int) -> IO ())
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p) Int
a'
     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource IO Int -> Int -> Event IO ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Resource IO -> SignalSource IO Int
resourceQueueCountSource Resource IO
r) Int
a'

-- | Update the resource utilisation count and its statistics.
updateResourceUtilisationCount :: Resource IO -> Int -> Event IO ()
-- updateResourceUtilisationCount :: (MonadDES m, MonadIO m, MonadTemplate m) => Resource m -> Int -> Event m ()
{-# INLINABLE updateResourceUtilisationCount #-}
updateResourceUtilisationCount :: Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r Int
delta =
  (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceUtilisationCountRef Resource IO
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
`seq` IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Int
resourceUtilisationCountRef Resource IO
r) Int
a'
     IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource IO -> IORef (TimingStats Int)
resourceUtilisationCountStatsRef Resource IO
r) ((TimingStats Int -> TimingStats Int) -> IO ())
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a b. (a -> b) -> a -> b
$
       Double -> Int -> TimingStats Int -> TimingStats Int
forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p) Int
a'
     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource IO Int -> Int -> Event IO ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Resource IO -> SignalSource IO Int
resourceUtilisationCountSource Resource IO
r) Int
a'

-- | Update the resource wait time and its statistics.
updateResourceWaitTime :: Resource IO -> Double -> Event IO ()
-- updateResourceWaitTime :: (MonadDES m, MonadIO m, MonadTemplate m) => Resource m -> Double -> Event m ()
{-# INLINABLE updateResourceWaitTime #-}
updateResourceWaitTime :: Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r Double
delta =
  (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Double
a <- IO Double -> IO Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> IO Double) -> IO Double -> IO Double
forall a b. (a -> b) -> a -> b
$ IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Double
resourceTotalWaitTimeRef Resource IO
r)
     let a' :: Double
a' = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
delta
     Double
a' Double -> IO () -> IO ()
`seq` IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Double -> Double -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Double
resourceTotalWaitTimeRef Resource IO
r) Double
a'
     IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       IORef (SamplingStats Double)
-> (SamplingStats Double -> SamplingStats Double) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource IO -> IORef (SamplingStats Double)
resourceWaitTimeRef Resource IO
r) ((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
delta
     Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource IO () -> () -> Event IO ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Resource IO -> SignalSource IO ()
resourceWaitTimeSource Resource IO
r) ()