{-# 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 =
    forall (m :: * -> *).
MonadResource m =>
Int -> Maybe Int -> Event m (Resource m)
newResourceWithMaxCount Int
count (forall a. a -> Maybe a
Just Int
count)

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

  {-# INLINABLE resourceWaitTimeChanged_ #-}
  resourceWaitTimeChanged_ :: Resource IO -> Signal IO ()
resourceWaitTimeChanged_ Resource IO
r =
    forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal 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 =
    forall (m :: * -> *). MonadResource m => Resource m -> Signal m ()
resourceCountChanged_ Resource IO
r forall a. Semigroup a => a -> a -> a
<>
    forall (m :: * -> *). MonadResource m => Resource m -> Signal m ()
resourceUtilisationCountChanged_ Resource IO
r forall a. Semigroup a => a -> a -> a
<>
    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 =
    forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId IO
pid ->
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams IO ()
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
    do let t :: Double
t = forall (m :: * -> *). Point m -> Double
pointTime Point IO
p
       Int
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
       if Int
a forall a. Eq a => a -> a -> Bool
== Int
0
         then do Bool
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$
                                forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams IO ()
c () forall a b. (a -> b) -> a -> b
$
                                forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams IO ()
c forall a b. (a -> b) -> a -> b
$
                                forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId IO
pid forall a b. (a -> b) -> a -> b
$
                                forall (m :: * -> *).
MonadResource m =>
Resource m -> Double -> Process m ()
requestResourceWithPriority Resource IO
r Double
priority
                           forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
priority (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Double
-> Double
-> ProcessId m
-> FrozenCont m ()
-> ResourceRequestingItem m
ResourceRequestingItem Double
priority Double
t ProcessId IO
pid FrozenCont IO ()
c)
                           forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p 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) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
item0
                           if Double
priority forall a. Ord a => a -> a -> Bool
< Double
p0
                             then do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
                                     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (- Double
priority) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Double -> ProcessId m -> ResourceActingItem m
ResourceActingItem Double
priority ProcessId IO
pid
                                     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
p0 (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Double -> Double -> ProcessId m -> ResourcePreemptedItem m
ResourcePreemptedItem Double
p0 Double
t ProcessId IO
pid0)
                                     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r Double
0
                                     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r Int
1
                                     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionBegin ProcessId IO
pid0
                                     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams IO ()
c ()
                             else do FrozenCont IO ()
c <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$
                                          forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams IO ()
c () forall a b. (a -> b) -> a -> b
$
                                          forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams IO ()
c forall a b. (a -> b) -> a -> b
$
                                          forall (m :: * -> *) a. ProcessId m -> Process m a -> Cont m a
invokeProcess ProcessId IO
pid forall a b. (a -> b) -> a -> b
$
                                          forall (m :: * -> *).
MonadResource m =>
Resource m -> Double -> Process m ()
requestResourceWithPriority Resource IO
r Double
priority
                                     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
priority (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Double
-> Double
-> ProcessId m
-> FrozenCont m ()
-> ResourceRequestingItem m
ResourceRequestingItem Double
priority Double
t ProcessId IO
pid FrozenCont IO ()
c)
                                     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r Int
1
         else do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (- Double
priority) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Double -> ProcessId m -> ResourceActingItem m
ResourceActingItem Double
priority ProcessId IO
pid
                 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r Double
0
                 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceCount Resource IO
r (-Int
1)
                 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r Int
1
                 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ 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 = 
    forall (m :: * -> *) a. (ProcessId m -> Cont m a) -> Process m a
Process forall a b. (a -> b) -> a -> b
$ \ProcessId IO
pid ->
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams IO ()
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
    do Bool
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueDeleteBy (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (\ResourceActingItem IO
item -> forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
item forall a. Eq a => a -> a -> Bool
== ProcessId IO
pid)
       if Bool
f
         then do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r (-Int
1)
                 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Event IO ()
releaseResource' Resource IO
r
                 forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams IO ()
c ()
         else forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp forall a b. (a -> b) -> a -> b
$
              String -> SimulationRetry
SimulationRetry
              String
"The resource was not acquired by this process: releaseResource"

  {-# INLINABLE usingResourceWithPriority #-}
  usingResourceWithPriority :: forall a. Resource IO -> Double -> Process IO a -> Process IO a
usingResourceWithPriority Resource IO
r Double
priority Process IO a
m =
    do forall (m :: * -> *).
MonadResource m =>
Resource m -> Double -> Process m ()
requestResourceWithPriority Resource IO
r Double
priority
       forall (m :: * -> *) a b.
MonadDES m =>
Process m a -> Process m b -> Process m a
finallyProcess Process IO a
m forall a b. (a -> b) -> a -> b
$ 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 forall a. Ord a => a -> a -> Bool
< Int
0     = forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The increment cannot be negative: incResourceCount"
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
0    = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
      do Resource IO -> Event IO ()
releaseResource' Resource IO
r
         forall (m :: * -> *).
MonadResource m =>
Resource m -> Int -> Event m ()
incResourceCount Resource IO
r (Int
n 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 forall a. Ord a => a -> a -> Bool
< Int
0     = forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent forall a b. (a -> b) -> a -> b
$ String -> SimulationRetry
SimulationRetry String
"The decrement cannot be negative: decResourceCount"
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
0    = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
      do Resource IO -> Event IO ()
decResourceCount' Resource IO
r
         forall (m :: * -> *).
MonadResource m =>
Resource m -> Int -> Event m ()
decResourceCount Resource IO
r (Int
n 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 forall a. Ord a => a -> a -> Bool
< Int
0  = forall (m :: * -> *).
MonadResource m =>
Resource m -> Int -> Event m ()
decResourceCount Resource IO
r (- Int
n)
    | Int
n forall a. Ord a => a -> a -> Bool
> Int
0  = forall (m :: * -> *).
MonadResource m =>
Resource m -> Int -> Event m ()
incResourceCount Resource IO
r Int
n
    | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()

  {-# INLINABLE resetResource #-}
  resetResource :: Resource IO -> Event IO ()
resetResource Resource IO
r =
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
    do let t :: Double
t = forall (m :: * -> *). Point m -> Double
pointTime Point IO
p
       Int
count <- forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
       forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef (TimingStats Int)
resourceCountStatsRef Resource IO
r) forall a b. (a -> b) -> a -> b
$
         forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
count
       Int
utilCount <- forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceUtilisationCountRef Resource IO
r)
       forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef (TimingStats Int)
resourceUtilisationCountStatsRef Resource IO
r) forall a b. (a -> b) -> a -> b
$
         forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
utilCount
       Int
queueCount <- forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceQueueCountRef Resource IO
r)
       forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef (TimingStats Int)
resourceQueueCountStatsRef Resource IO
r) forall a b. (a -> b) -> a -> b
$
         forall a. TimingData a => Double -> a -> TimingStats a
returnTimingStats Double
t Int
queueCount
       forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Double
resourceTotalWaitTimeRef Resource IO
r) Double
0
       forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef (SamplingStats Double)
resourceWaitTimeRef Resource IO
r) forall a. SamplingData a => SamplingStats a
emptySamplingStats
       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$
         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 { forall (m :: * -> *). ResourceActingItem m -> Double
actingItemPriority :: Double,
                       forall (m :: * -> *). 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 { forall (m :: * -> *). ResourceRequestingItem m -> Double
requestingItemPriority :: Double,
                           forall (m :: * -> *). ResourceRequestingItem m -> Double
requestingItemTime :: Double,
                           forall (m :: * -> *). ResourceRequestingItem m -> ProcessId m
requestingItemId :: ProcessId m,
                           forall (m :: * -> *). ResourceRequestingItem m -> FrozenCont m ()
requestingItemCont :: FrozenCont m () }

-- | Idenitifies an item that was preempted.
data ResourcePreemptedItem m =
  ResourcePreemptedItem { forall (m :: * -> *). ResourcePreemptedItem m -> Double
preemptedItemPriority :: Double,
                          forall (m :: * -> *). ResourcePreemptedItem m -> Double
preemptedItemTime :: Double,
                          forall (m :: * -> *). 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 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 = forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
x forall a. Eq a => a -> a -> Bool
== 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 =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
1
     case forall (m :: * -> *). MonadResource m => Resource m -> Maybe Int
resourceMaxCount Resource IO
r of
       Just Int
maxCount | Int
a' forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
         forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry forall a b. (a -> b) -> a -> b
$
         String
"The resource count cannot be greater than " forall a. [a] -> [a] -> [a]
++
         String
"its maximum value: releaseResource'."
       Maybe Int
_ ->
         forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Bool
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r)
     if Bool
f 
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p 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) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r)
               forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r)
               forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p 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 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ 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 ->
                          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Event IO ()
releaseResource' Resource IO
r
                        Just ContParams IO ()
c ->
                          do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (- Double
priority) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Double -> ProcessId m -> ResourceActingItem m
ResourceActingItem Double
priority ProcessId IO
pid
                             forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r (forall (m :: * -> *). Point m -> Double
pointTime Point IO
p forall a. Num a => a -> a -> a
- Double
t)
                             forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r Int
1
                             forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point IO
p) forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m Bool
processCancelled ProcessId IO
pid
                      case Bool
f of
                        Bool
True ->
                          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Event IO ()
releaseResource' Resource IO
r
                        Bool
False ->
                          do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r) (- Double
priority) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Double -> ProcessId m -> ResourceActingItem m
ResourceActingItem Double
priority ProcessId IO
pid
                             forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Double -> Event IO ()
updateResourceWaitTime Resource IO
r (forall (m :: * -> *). Point m -> Double
pointTime Point IO
p forall a. Num a => a -> a -> a
- Double
t)
                             forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r Int
1
                             forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ 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 =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do let t :: Double
t = forall (m :: * -> *). Point m -> Double
pointTime Point IO
p
     Int
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
a forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
       forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp forall a b. (a -> b) -> a -> b
$
       String -> SimulationRetry
SimulationRetry
       String
"The resource exceeded and its count is zero: decResourceCount'"
     Bool
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do (Double
p0', ResourceActingItem IO
item0) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
item0
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
p0 (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Double -> Double -> ProcessId m -> ResourcePreemptedItem m
ResourcePreemptedItem Double
p0 Double
t ProcessId IO
pid0)
          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionBegin ProcessId IO
pid0
          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceUtilisationCount Resource IO
r (-Int
1)
          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$ Resource IO -> Int -> Event IO ()
updateResourceQueueCount Resource IO
r Int
1
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p 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 =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r) Int
a'
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
       forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource IO -> IORef (TimingStats Int)
resourceCountStatsRef Resource IO
r) forall a b. (a -> b) -> a -> b
$
       forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (forall (m :: * -> *). Point m -> Double
pointTime Point IO
p) Int
a'
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$
       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 =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceQueueCountRef Resource IO
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Int
resourceQueueCountRef Resource IO
r) Int
a'
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
       forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource IO -> IORef (TimingStats Int)
resourceQueueCountStatsRef Resource IO
r) forall a b. (a -> b) -> a -> b
$
       forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (forall (m :: * -> *). Point m -> Double
pointTime Point IO
p) Int
a'
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$
       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 =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceUtilisationCountRef Resource IO
r)
     let a' :: Int
a' = Int
a forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Int
resourceUtilisationCountRef Resource IO
r) Int
a'
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
       forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource IO -> IORef (TimingStats Int)
resourceUtilisationCountStatsRef Resource IO
r) forall a b. (a -> b) -> a -> b
$
       forall a.
TimingData a =>
Double -> a -> TimingStats a -> TimingStats a
addTimingStats (forall (m :: * -> *). Point m -> Double
pointTime Point IO
p) Int
a'
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$
       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 =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Double
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Double
resourceTotalWaitTimeRef Resource IO
r)
     let a' :: Double
a' = Double
a forall a. Num a => a -> a -> a
+ Double
delta
     Double
a' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Double
resourceTotalWaitTimeRef Resource IO
r) Double
a'
     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
       forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource IO -> IORef (SamplingStats Double)
resourceWaitTimeRef Resource IO
r) forall a b. (a -> b) -> a -> b
$
       forall a. SamplingData a => a -> SamplingStats a -> SamplingStats a
addSamplingStats Double
delta
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p forall a b. (a -> b) -> a -> b
$
       forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Resource IO -> SignalSource IO ()
resourceWaitTimeSource Resource IO
r) ()