-- |
-- Module     : Simulation.Aivika.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.
--
module Simulation.Aivika.Resource.Preemption
       (-- * Resource Type
        Resource,
        -- * Creating Resource
        newResource,
        newResourceWithMaxCount,
        -- * Resource Properties
        resourceMaxCount,
        resourceCount,
        resourceCountStats,
        resourceUtilisationCount,
        resourceUtilisationCountStats,
        resourceQueueCount,
        resourceQueueCountStats,
        resourceTotalWaitTime,
        resourceWaitTime,
        -- * Requesting for and Releasing Resource
        requestResourceWithPriority,
        releaseResource,
        usingResourceWithPriority,
        -- * Altering Resource 
        incResourceCount,
        decResourceCount,
        alterResourceCount,
        -- * Statistics Reset
        resetResource,
        -- * Signals
        resourceCountChanged,
        resourceCountChanged_,
        resourceUtilisationCountChanged,
        resourceUtilisationCountChanged_,
        resourceQueueCountChanged,
        resourceQueueCountChanged_,
        resourceWaitTimeChanged,
        resourceWaitTimeChanged_,
        resourceChanged_) where

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

import Control.Monad
import Control.Monad.Trans
import Control.Exception

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Cont
import Simulation.Aivika.Internal.Process
import Simulation.Aivika.QueueStrategy
import Simulation.Aivika.Statistics
import Simulation.Aivika.Signal

import qualified Simulation.Aivika.PriorityQueue as PQ

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

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

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

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

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

instance Eq Resource where
  Resource
x == :: Resource -> Resource -> Bool
== Resource
y = Resource -> IORef Int
resourceCountRef Resource
x IORef Int -> IORef Int -> Bool
forall a. Eq a => a -> a -> Bool
== Resource -> IORef Int
resourceCountRef Resource
y  -- unique references

instance Eq ResourceActingItem where
  ResourceActingItem
x == :: ResourceActingItem -> ResourceActingItem -> Bool
== ResourceActingItem
y = ResourceActingItem -> ProcessId
actingItemId ResourceActingItem
x ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ResourceActingItem -> ProcessId
actingItemId ResourceActingItem
y

-- | Create a new resource with the specified initial count that becomes the upper bound as well.
newResource :: Int
               -- ^ the initial count (and maximal count too) of the resource
               -> Event Resource
newResource :: Int -> Event Resource
newResource Int
count =
  Int -> Maybe Int -> Event Resource
newResourceWithMaxCount Int
count (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count)

-- | Create a new resource with the specified initial and maximum counts,
-- where 'Nothing' means that the resource has no upper bound.
newResourceWithMaxCount :: Int
                           -- ^ the initial count of the resource
                           -> Maybe Int
                           -- ^ the maximum count of the resource, which can be indefinite
                           -> Event Resource
newResourceWithMaxCount :: Int -> Maybe Int -> Event Resource
newResourceWithMaxCount Int
count Maybe Int
maxCount =
  (Point -> IO Resource) -> Event Resource
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Resource) -> Event Resource)
-> (Point -> IO Resource) -> Event Resource
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let r :: Run
r = Point -> Run
pointRun Point
p
         t :: Double
t = Point -> Double
pointTime Point
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 e a. Exception e => e -> IO a
throwIO (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 e a. Exception e => e -> IO a
throwIO (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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef Int
countRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
count
     IORef (TimingStats Int)
countStatsRef <- 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 Int
countSource <- Run -> Simulation (SignalSource Int) -> IO (SignalSource Int)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
utilCountRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     IORef (TimingStats Int)
utilCountStatsRef <- 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 Int
utilCountSource <- Run -> Simulation (SignalSource Int) -> IO (SignalSource Int)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     IORef Int
queueCountRef <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     IORef (TimingStats Int)
queueCountStatsRef <- 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 Int
queueCountSource <- Run -> Simulation (SignalSource Int) -> IO (SignalSource Int)
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource Int)
forall a. Simulation (SignalSource a)
newSignalSource
     IORef Double
totalWaitTimeRef <- Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
newIORef Double
0
     IORef (SamplingStats Double)
waitTimeRef <- SamplingStats Double -> IO (IORef (SamplingStats Double))
forall a. a -> IO (IORef a)
newIORef SamplingStats Double
forall a. SamplingData a => SamplingStats a
emptySamplingStats
     SignalSource ()
waitTimeSource <- Run -> Simulation (SignalSource ()) -> IO (SignalSource ())
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource ())
forall a. Simulation (SignalSource a)
newSignalSource
     PriorityQueue ResourceActingItem
actingQueue <- IO (PriorityQueue ResourceActingItem)
forall a. IO (PriorityQueue a)
PQ.newQueue
     PriorityQueue ResourceAwaitingItem
waitQueue <- IO (PriorityQueue ResourceAwaitingItem)
forall a. IO (PriorityQueue a)
PQ.newQueue
     Resource -> IO Resource
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceMaxCount :: Maybe Int
resourceMaxCount = Maybe Int
maxCount,
                       resourceCountRef :: IORef Int
resourceCountRef = IORef Int
countRef,
                       resourceCountStatsRef :: IORef (TimingStats Int)
resourceCountStatsRef = IORef (TimingStats Int)
countStatsRef,
                       resourceCountSource :: SignalSource Int
resourceCountSource = SignalSource Int
countSource,
                       resourceUtilisationCountRef :: IORef Int
resourceUtilisationCountRef = IORef Int
utilCountRef,
                       resourceUtilisationCountStatsRef :: IORef (TimingStats Int)
resourceUtilisationCountStatsRef = IORef (TimingStats Int)
utilCountStatsRef,
                       resourceUtilisationCountSource :: SignalSource Int
resourceUtilisationCountSource = SignalSource Int
utilCountSource,
                       resourceQueueCountRef :: IORef Int
resourceQueueCountRef = IORef Int
queueCountRef,
                       resourceQueueCountStatsRef :: IORef (TimingStats Int)
resourceQueueCountStatsRef = IORef (TimingStats Int)
queueCountStatsRef,
                       resourceQueueCountSource :: SignalSource Int
resourceQueueCountSource = SignalSource Int
queueCountSource,
                       resourceTotalWaitTimeRef :: IORef Double
resourceTotalWaitTimeRef = IORef Double
totalWaitTimeRef,
                       resourceWaitTimeRef :: IORef (SamplingStats Double)
resourceWaitTimeRef = IORef (SamplingStats Double)
waitTimeRef,
                       resourceWaitTimeSource :: SignalSource ()
resourceWaitTimeSource = SignalSource ()
waitTimeSource,
                       resourceActingQueue :: PriorityQueue ResourceActingItem
resourceActingQueue = PriorityQueue ResourceActingItem
actingQueue,
                       resourceWaitQueue :: PriorityQueue ResourceAwaitingItem
resourceWaitQueue = PriorityQueue ResourceAwaitingItem
waitQueue }

-- | Return the current available count of the resource.
resourceCount :: Resource -> Event Int
resourceCount :: Resource -> Event Int
resourceCount Resource
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceCountRef Resource
r)

-- | Return the statistics for the available count of the resource.
resourceCountStats :: Resource -> Event (TimingStats Int)
resourceCountStats :: Resource -> Event (TimingStats Int)
resourceCountStats Resource
r =
  (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (TimingStats Int)) -> Event (TimingStats Int))
-> (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Resource -> IORef (TimingStats Int)
resourceCountStatsRef Resource
r)

-- | Signal triggered when the 'resourceCount' property changes.
resourceCountChanged :: Resource -> Signal Int
resourceCountChanged :: Resource -> Signal Int
resourceCountChanged Resource
r =
  SignalSource Int -> Signal Int
forall a. SignalSource a -> Signal a
publishSignal (SignalSource Int -> Signal Int) -> SignalSource Int -> Signal Int
forall a b. (a -> b) -> a -> b
$ Resource -> SignalSource Int
resourceCountSource Resource
r

-- | Signal triggered when the 'resourceCount' property changes.
resourceCountChanged_ :: Resource -> Signal ()
resourceCountChanged_ :: Resource -> Signal ()
resourceCountChanged_ Resource
r =
  (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal Int -> Signal ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ Resource -> Signal Int
resourceCountChanged Resource
r

-- | Return the current utilisation count of the resource.
resourceUtilisationCount :: Resource -> Event Int
resourceUtilisationCount :: Resource -> Event Int
resourceUtilisationCount Resource
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceUtilisationCountRef Resource
r)

-- | Return the statistics for the utilisation count of the resource.
resourceUtilisationCountStats :: Resource -> Event (TimingStats Int)
resourceUtilisationCountStats :: Resource -> Event (TimingStats Int)
resourceUtilisationCountStats Resource
r =
  (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (TimingStats Int)) -> Event (TimingStats Int))
-> (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Resource -> IORef (TimingStats Int)
resourceUtilisationCountStatsRef Resource
r)

-- | Signal triggered when the 'resourceUtilisationCount' property changes.
resourceUtilisationCountChanged :: Resource -> Signal Int
resourceUtilisationCountChanged :: Resource -> Signal Int
resourceUtilisationCountChanged Resource
r =
  SignalSource Int -> Signal Int
forall a. SignalSource a -> Signal a
publishSignal (SignalSource Int -> Signal Int) -> SignalSource Int -> Signal Int
forall a b. (a -> b) -> a -> b
$ Resource -> SignalSource Int
resourceUtilisationCountSource Resource
r

-- | Signal triggered when the 'resourceUtilisationCount' property changes.
resourceUtilisationCountChanged_ :: Resource -> Signal ()
resourceUtilisationCountChanged_ :: Resource -> Signal ()
resourceUtilisationCountChanged_ Resource
r =
  (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal Int -> Signal ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ Resource -> Signal Int
resourceUtilisationCountChanged Resource
r

-- | Return the current queue length of the resource.
resourceQueueCount :: Resource -> Event Int
resourceQueueCount :: Resource -> Event Int
resourceQueueCount Resource
r =
  (Point -> IO Int) -> Event Int
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Int) -> Event Int) -> (Point -> IO Int) -> Event Int
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceQueueCountRef Resource
r)

-- | Return the statistics for the queue length of the resource.
resourceQueueCountStats :: Resource -> Event (TimingStats Int)
resourceQueueCountStats :: Resource -> Event (TimingStats Int)
resourceQueueCountStats Resource
r =
  (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (TimingStats Int)) -> Event (TimingStats Int))
-> (Point -> IO (TimingStats Int)) -> Event (TimingStats Int)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (TimingStats Int) -> IO (TimingStats Int)
forall a. IORef a -> IO a
readIORef (Resource -> IORef (TimingStats Int)
resourceQueueCountStatsRef Resource
r)

-- | Signal triggered when the 'resourceQueueCount' property changes.
resourceQueueCountChanged :: Resource -> Signal Int
resourceQueueCountChanged :: Resource -> Signal Int
resourceQueueCountChanged Resource
r =
  SignalSource Int -> Signal Int
forall a. SignalSource a -> Signal a
publishSignal (SignalSource Int -> Signal Int) -> SignalSource Int -> Signal Int
forall a b. (a -> b) -> a -> b
$ Resource -> SignalSource Int
resourceQueueCountSource Resource
r

-- | Signal triggered when the 'resourceQueueCount' property changes.
resourceQueueCountChanged_ :: Resource -> Signal ()
resourceQueueCountChanged_ :: Resource -> Signal ()
resourceQueueCountChanged_ Resource
r =
  (Int -> ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Int -> ()
forall a b. a -> b -> a
const ()) (Signal Int -> Signal ()) -> Signal Int -> Signal ()
forall a b. (a -> b) -> a -> b
$ Resource -> Signal Int
resourceQueueCountChanged Resource
r

-- | Return the total wait time of the resource.
resourceTotalWaitTime :: Resource -> Event Double
resourceTotalWaitTime :: Resource -> Event Double
resourceTotalWaitTime Resource
r =
  (Point -> IO Double) -> Event Double
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO Double) -> Event Double)
-> (Point -> IO Double) -> Event Double
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef Double -> IO Double
forall a. IORef a -> IO a
readIORef (Resource -> IORef Double
resourceTotalWaitTimeRef Resource
r)

-- | Return the statistics for the wait time of the resource.
resourceWaitTime :: Resource -> Event (SamplingStats Double)
resourceWaitTime :: Resource -> Event (SamplingStats Double)
resourceWaitTime Resource
r =
  (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (SamplingStats Double))
 -> Event (SamplingStats Double))
-> (Point -> IO (SamplingStats Double))
-> Event (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (SamplingStats Double) -> IO (SamplingStats Double)
forall a. IORef a -> IO a
readIORef (Resource -> IORef (SamplingStats Double)
resourceWaitTimeRef Resource
r)

-- | Signal triggered when the 'resourceTotalWaitTime' and 'resourceWaitTime' properties change.
resourceWaitTimeChanged :: Resource -> Signal (SamplingStats Double)
resourceWaitTimeChanged :: Resource -> Signal (SamplingStats Double)
resourceWaitTimeChanged Resource
r =
  (() -> Event (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> Event b) -> Signal a -> Signal b
mapSignalM (\() -> Resource -> Event (SamplingStats Double)
resourceWaitTime Resource
r) (Signal () -> Signal (SamplingStats Double))
-> Signal () -> Signal (SamplingStats Double)
forall a b. (a -> b) -> a -> b
$ Resource -> Signal ()
resourceWaitTimeChanged_ Resource
r

-- | Signal triggered when the 'resourceTotalWaitTime' and 'resourceWaitTime' properties change.
resourceWaitTimeChanged_ :: Resource -> Signal ()
resourceWaitTimeChanged_ :: Resource -> Signal ()
resourceWaitTimeChanged_ Resource
r =
  SignalSource () -> Signal ()
forall a. SignalSource a -> Signal a
publishSignal (SignalSource () -> Signal ()) -> SignalSource () -> Signal ()
forall a b. (a -> b) -> a -> b
$ Resource -> SignalSource ()
resourceWaitTimeSource Resource
r

-- | Request with the priority for the resource decreasing its count
-- in case of success, otherwise suspending the discontinuous process
-- until some other process releases the resource.
--
-- It may preempt another process if the latter aquired the resource before
-- but had a lower priority. Then the current process takes an ownership of
-- the resource.
requestResourceWithPriority :: Resource
                               -- ^ the requested resource
                               -> Double
                               -- ^ the priority (the less value has a higher priority)
                               -> Process ()
requestResourceWithPriority :: Resource -> Double -> Process ()
requestResourceWithPriority Resource
r Double
priority =
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceCountRef Resource
r)
     if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
       then do Bool
f <- PriorityQueue ResourceActingItem -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r)
               if Bool
f
                 then do FrozenCont ()
c <- Point -> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (FrozenCont ()) -> IO (FrozenCont ()))
-> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                              ContParams () -> () -> Event () -> Event (FrozenCont ())
forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () (Event () -> Event (FrozenCont ()))
-> Event () -> Event (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                              ContParams () -> Cont () -> Event ()
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c (Cont () -> Event ()) -> Cont () -> Event ()
forall a b. (a -> b) -> a -> b
$
                              ProcessId -> Process () -> Cont ()
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process () -> Cont ()) -> Process () -> Cont ()
forall a b. (a -> b) -> a -> b
$
                              Resource -> Double -> Process ()
requestResourceWithPriority Resource
r Double
priority
                         PriorityQueue ResourceAwaitingItem
-> Double -> ResourceAwaitingItem -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource -> PriorityQueue ResourceAwaitingItem
resourceWaitQueue Resource
r) Double
priority (ResourceRequestingItem -> ResourceAwaitingItem
forall a b. a -> Either a b
Left (ResourceRequestingItem -> ResourceAwaitingItem)
-> ResourceRequestingItem -> ResourceAwaitingItem
forall a b. (a -> b) -> a -> b
$ Double
-> Double -> ProcessId -> FrozenCont () -> ResourceRequestingItem
ResourceRequestingItem Double
priority Double
t ProcessId
pid FrozenCont ()
c)
                         Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceQueueCount Resource
r Int
1
                 else do (Double
p0', ResourceActingItem
item0) <- PriorityQueue ResourceActingItem -> IO (Double, ResourceActingItem)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r)
                         let p0 :: Double
p0 = - Double
p0'
                             pid0 :: ProcessId
pid0 = ResourceActingItem -> ProcessId
actingItemId ResourceActingItem
item0
                         if Double
priority Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
p0
                           then do PriorityQueue ResourceActingItem -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r)
                                   PriorityQueue ResourceActingItem
-> Double -> ResourceActingItem -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r) (- Double
priority) (ResourceActingItem -> IO ()) -> ResourceActingItem -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId -> ResourceActingItem
ResourceActingItem Double
priority ProcessId
pid
                                   PriorityQueue ResourceAwaitingItem
-> Double -> ResourceAwaitingItem -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource -> PriorityQueue ResourceAwaitingItem
resourceWaitQueue Resource
r) Double
p0 (ResourcePreemptedItem -> ResourceAwaitingItem
forall a b. b -> Either a b
Right (ResourcePreemptedItem -> ResourceAwaitingItem)
-> ResourcePreemptedItem -> ResourceAwaitingItem
forall a b. (a -> b) -> a -> b
$ Double -> Double -> ProcessId -> ResourcePreemptedItem
ResourcePreemptedItem Double
p0 Double
t ProcessId
pid0)
                                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Double -> Event ()
updateResourceWaitTime Resource
r Double
0
                                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceQueueCount Resource
r Int
1
                                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processPreemptionBegin ProcessId
pid0
                                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
                           else do FrozenCont ()
c <- Point -> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (FrozenCont ()) -> IO (FrozenCont ()))
-> Event (FrozenCont ()) -> IO (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                                        ContParams () -> () -> Event () -> Event (FrozenCont ())
forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams ()
c () (Event () -> Event (FrozenCont ()))
-> Event () -> Event (FrozenCont ())
forall a b. (a -> b) -> a -> b
$
                                        ContParams () -> Cont () -> Event ()
forall a. ContParams a -> Cont a -> Event ()
invokeCont ContParams ()
c (Cont () -> Event ()) -> Cont () -> Event ()
forall a b. (a -> b) -> a -> b
$
                                        ProcessId -> Process () -> Cont ()
forall a. ProcessId -> Process a -> Cont a
invokeProcess ProcessId
pid (Process () -> Cont ()) -> Process () -> Cont ()
forall a b. (a -> b) -> a -> b
$
                                        Resource -> Double -> Process ()
requestResourceWithPriority Resource
r Double
priority
                                   PriorityQueue ResourceAwaitingItem
-> Double -> ResourceAwaitingItem -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource -> PriorityQueue ResourceAwaitingItem
resourceWaitQueue Resource
r) Double
priority (ResourceRequestingItem -> ResourceAwaitingItem
forall a b. a -> Either a b
Left (ResourceRequestingItem -> ResourceAwaitingItem)
-> ResourceRequestingItem -> ResourceAwaitingItem
forall a b. (a -> b) -> a -> b
$ Double
-> Double -> ProcessId -> FrozenCont () -> ResourceRequestingItem
ResourceRequestingItem Double
priority Double
t ProcessId
pid FrozenCont ()
c)
                                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceQueueCount Resource
r Int
1
       else do PriorityQueue ResourceActingItem
-> Double -> ResourceActingItem -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r) (- Double
priority) (ResourceActingItem -> IO ()) -> ResourceActingItem -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId -> ResourceActingItem
ResourceActingItem Double
priority ProcessId
pid
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Double -> Event ()
updateResourceWaitTime Resource
r Double
0
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceCount Resource
r (-Int
1)
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceUtilisationCount Resource
r Int
1
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()

-- | Release the resource increasing its count and resuming one of the
-- previously suspended or preempted processes as possible.
releaseResource :: Resource
                   -- ^ the resource to release
                   -> Process ()
releaseResource :: Resource -> Process ()
releaseResource Resource
r = 
  (ProcessId -> Cont ()) -> Process ()
forall a. (ProcessId -> Cont a) -> Process a
Process ((ProcessId -> Cont ()) -> Process ())
-> (ProcessId -> Cont ()) -> Process ()
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
  (ContParams () -> Event ()) -> Cont ()
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams () -> Event ()) -> Cont ())
-> (ContParams () -> Event ()) -> Cont ()
forall a b. (a -> b) -> a -> b
$ \ContParams ()
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool
f <- (Maybe ResourceActingItem -> Bool)
-> IO (Maybe ResourceActingItem) -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ResourceActingItem -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe ResourceActingItem) -> IO Bool)
-> IO (Maybe ResourceActingItem) -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue ResourceActingItem
-> (ResourceActingItem -> Bool) -> IO (Maybe ResourceActingItem)
forall a. PriorityQueue a -> (a -> Bool) -> IO (Maybe a)
PQ.queueDeleteBy (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r) (\ResourceActingItem
item -> ResourceActingItem -> ProcessId
actingItemId ResourceActingItem
item ProcessId -> ProcessId -> Bool
forall a. Eq a => a -> a -> Bool
== ProcessId
pid)
     if Bool
f
       then do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceUtilisationCount Resource
r (-Int
1)
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Event ()
releaseResource' Resource
r
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams ()
c ()
       else SimulationRetry -> IO ()
forall e a. Exception e => e -> IO a
throwIO (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> SimulationRetry
SimulationRetry
            String
"The resource was not acquired by this process: releaseResource"

-- | Release the resource increasing its count and resuming one of the
-- previously suspended or preempted processes as possible.
releaseResource' :: Resource
                    -- ^ the resource to release
                    -> Event ()
releaseResource' :: Resource -> Event ()
releaseResource' Resource
r =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceCountRef Resource
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     case Resource -> Maybe Int
resourceMaxCount Resource
r of
       Just Int
maxCount | Int
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
         SimulationRetry -> IO ()
forall e a. Exception e => e -> IO a
throwIO (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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Bool
f <- PriorityQueue ResourceAwaitingItem -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource -> PriorityQueue ResourceAwaitingItem
resourceWaitQueue Resource
r)
     if Bool
f 
       then Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceCount Resource
r Int
1
       else do (Double
priority', ResourceAwaitingItem
item) <- PriorityQueue ResourceAwaitingItem
-> IO (Double, ResourceAwaitingItem)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront (Resource -> PriorityQueue ResourceAwaitingItem
resourceWaitQueue Resource
r)
               PriorityQueue ResourceAwaitingItem -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource -> PriorityQueue ResourceAwaitingItem
resourceWaitQueue Resource
r)
               Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceQueueCount Resource
r (-Int
1)
               case ResourceAwaitingItem
item of
                 Left (ResourceRequestingItem Double
priority Double
t ProcessId
pid FrozenCont ()
c) ->
                   do Maybe (ContParams ())
c <- Point
-> Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ())))
-> Event (Maybe (ContParams ())) -> IO (Maybe (ContParams ()))
forall a b. (a -> b) -> a -> b
$ FrozenCont () -> Event (Maybe (ContParams ()))
forall a. FrozenCont a -> Event (Maybe (ContParams a))
unfreezeCont FrozenCont ()
c
                      case Maybe (ContParams ())
c of
                        Maybe (ContParams ())
Nothing ->
                          Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Event ()
releaseResource' Resource
r
                        Just ContParams ()
c ->
                          do PriorityQueue ResourceActingItem
-> Double -> ResourceActingItem -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r) (- Double
priority) (ResourceActingItem -> IO ()) -> ResourceActingItem -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId -> ResourceActingItem
ResourceActingItem Double
priority ProcessId
pid
                             Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Double -> Event ()
updateResourceWaitTime Resource
r (Point -> Double
pointTime Point
p Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t)
                             Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceUtilisationCount Resource
r Int
1
                             Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$ ContParams () -> () -> Event ()
forall a. ContParams a -> a -> Event ()
reenterCont ContParams ()
c ()
                 Right (ResourcePreemptedItem Double
priority Double
t ProcessId
pid) ->
                   do Bool
f <- Point -> Event Bool -> IO Bool
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event Bool -> IO Bool) -> Event Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event Bool
processCancelled ProcessId
pid
                      case Bool
f of
                        Bool
True ->
                          Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Event ()
releaseResource' Resource
r
                        Bool
False ->
                          do PriorityQueue ResourceActingItem
-> Double -> ResourceActingItem -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r) (- Double
priority) (ResourceActingItem -> IO ()) -> ResourceActingItem -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId -> ResourceActingItem
ResourceActingItem Double
priority ProcessId
pid
                             Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Double -> Event ()
updateResourceWaitTime Resource
r (Point -> Double
pointTime Point
p Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t)
                             Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceUtilisationCount Resource
r Int
1
                             Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processPreemptionEnd ProcessId
pid
               
-- | Acquire the resource with the specified priority, perform some action and
-- safely release the resource in the end, even if the 'IOException' was raised
-- within the action.
usingResourceWithPriority :: Resource
                             -- ^ the resource we are going to request for and then
                             -- release in the end
                             -> Double
                             -- ^ the priority (the less value has a higher priority)
                             -> Process a
                             -- ^ the action we are going to apply having the resource
                             -> Process a
                             -- ^ the result of the action
usingResourceWithPriority :: forall a. Resource -> Double -> Process a -> Process a
usingResourceWithPriority Resource
r Double
priority Process a
m =
  do Resource -> Double -> Process ()
requestResourceWithPriority Resource
r Double
priority
     Process a -> Process () -> Process a
forall a b. Process a -> Process b -> Process a
finallyProcess Process a
m (Process () -> Process a) -> Process () -> Process a
forall a b. (a -> b) -> a -> b
$ Resource -> Process ()
releaseResource Resource
r

-- | Preempt a process with the lowest priority that acquires yet the resource
-- and decrease the count of available resource by 1. 
decResourceCount' :: Resource -> Event ()
decResourceCount' :: Resource -> Event ()
decResourceCount' Resource
r =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let t :: Double
t = Point -> Double
pointTime Point
p
     Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceCountRef Resource
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 e a. Exception e => e -> IO a
throwIO (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 <- PriorityQueue ResourceActingItem -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
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
item0) <- PriorityQueue ResourceActingItem -> IO (Double, ResourceActingItem)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r)
          let p0 :: Double
p0 = - Double
p0'
              pid0 :: ProcessId
pid0 = ResourceActingItem -> ProcessId
actingItemId ResourceActingItem
item0
          PriorityQueue ResourceActingItem -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource -> PriorityQueue ResourceActingItem
resourceActingQueue Resource
r)
          PriorityQueue ResourceAwaitingItem
-> Double -> ResourceAwaitingItem -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource -> PriorityQueue ResourceAwaitingItem
resourceWaitQueue Resource
r) Double
p0 (ResourcePreemptedItem -> ResourceAwaitingItem
forall a b. b -> Either a b
Right (ResourcePreemptedItem -> ResourceAwaitingItem)
-> ResourcePreemptedItem -> ResourceAwaitingItem
forall a b. (a -> b) -> a -> b
$ Double -> Double -> ProcessId -> ResourcePreemptedItem
ResourcePreemptedItem Double
p0 Double
t ProcessId
pid0)
          Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId -> Event ()
processPreemptionBegin ProcessId
pid0
          Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceUtilisationCount Resource
r (-Int
1)
          Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceQueueCount Resource
r Int
1
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Resource -> Int -> Event ()
updateResourceCount Resource
r (-Int
1)

-- | Increase the count of available resource by the specified number,
-- invoking the awaiting and preempted processes according to their priorities
-- as needed.
incResourceCount :: Resource
                    -- ^ the resource
                    -> Int
                    -- ^ the increment for the resource count
                    -> Event ()
incResourceCount :: Resource -> Int -> Event ()
incResourceCount Resource
r Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = SimulationRetry -> Event ()
forall e a. Exception e => e -> Event a
throwEvent (SimulationRetry -> Event ()) -> SimulationRetry -> Event ()
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 ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
    do Resource -> Event ()
releaseResource' Resource
r
       Resource -> Int -> Event ()
incResourceCount Resource
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Decrease the count of available resource by the specified number,
-- preempting the processes according to their priorities as needed.
decResourceCount :: Resource
                    -- ^ the resource
                    -> Int
                    -- ^ the decrement for the resource count
                    -> Event ()
decResourceCount :: Resource -> Int -> Event ()
decResourceCount Resource
r Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = SimulationRetry -> Event ()
forall e a. Exception e => e -> Event a
throwEvent (SimulationRetry -> Event ()) -> SimulationRetry -> Event ()
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 ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
    do Resource -> Event ()
decResourceCount' Resource
r
       Resource -> Int -> Event ()
decResourceCount Resource
r (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Alter the resource count either increasing or decreasing it by calling
-- 'incResourceCount' or 'decResourceCount' respectively.
alterResourceCount :: Resource
                      -- ^ the resource
                      -> Int
                      -- ^ a change of the resource count
                      -> Event ()
alterResourceCount :: Resource -> Int -> Event ()
alterResourceCount Resource
r Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = Resource -> Int -> Event ()
decResourceCount Resource
r (- Int
n)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0  = Resource -> Int -> Event ()
incResourceCount Resource
r Int
n
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> Event ()
forall a. a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Signal triggered when one of the resource counters changes.
resourceChanged_ :: Resource -> Signal ()
resourceChanged_ :: Resource -> Signal ()
resourceChanged_ Resource
r =
  Resource -> Signal ()
resourceCountChanged_ Resource
r Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  Resource -> Signal ()
resourceUtilisationCountChanged_ Resource
r Signal () -> Signal () -> Signal ()
forall a. Semigroup a => a -> a -> a
<>
  Resource -> Signal ()
resourceQueueCountChanged_ Resource
r

-- | Update the resource count and its statistics.
updateResourceCount :: Resource -> Int -> Event ()
updateResourceCount :: Resource -> Int -> Event ()
updateResourceCount Resource
r Int
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceCountRef Resource
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource -> IORef Int
resourceCountRef Resource
r) Int
a'
     IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource -> IORef (TimingStats Int)
resourceCountStatsRef Resource
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 -> Double
pointTime Point
p) Int
a'
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Resource -> SignalSource Int
resourceCountSource Resource
r) Int
a'

-- | Update the resource queue length and its statistics.
updateResourceQueueCount :: Resource -> Int -> Event ()
updateResourceQueueCount :: Resource -> Int -> Event ()
updateResourceQueueCount Resource
r Int
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceQueueCountRef Resource
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource -> IORef Int
resourceQueueCountRef Resource
r) Int
a'
     IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource -> IORef (TimingStats Int)
resourceQueueCountStatsRef Resource
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 -> Double
pointTime Point
p) Int
a'
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Resource -> SignalSource Int
resourceQueueCountSource Resource
r) Int
a'

-- | Update the resource utilisation count and its statistics.
updateResourceUtilisationCount :: Resource -> Int -> Event ()
updateResourceUtilisationCount :: Resource -> Int -> Event ()
updateResourceUtilisationCount Resource
r Int
delta =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
a <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource -> IORef Int
resourceUtilisationCountRef Resource
r)
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
     Int
a' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource -> IORef Int
resourceUtilisationCountRef Resource
r) Int
a'
     IORef (TimingStats Int)
-> (TimingStats Int -> TimingStats Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (Resource -> IORef (TimingStats Int)
resourceUtilisationCountStatsRef Resource
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 -> Double
pointTime Point
p) Int
a'
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SignalSource Int -> Int -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Resource -> SignalSource Int
resourceUtilisationCountSource Resource
r) Int
a'

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

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