{-# LANGUAGE TypeFamilies, FlexibleInstances #-}

-- |
-- Module     : Simulation.Aivika.IO.Resource.Preemption.Base
-- 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 an optimised preemptible resource, where
-- the 'IO' monad is an instance of 'MonadResource'.
--
module Simulation.Aivika.IO.Resource.Preemption.Base () where

import Control.Monad
import Control.Monad.Trans

import Data.Maybe
import Data.IORef

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.Base

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,
               Resource IO -> IORef Int
resourceCountRef :: IORef Int,
               Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue :: PQ.PriorityQueue (ResourceActingItem IO),
               Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue :: PQ.PriorityQueue (ResourceAwaitingItem IO) }

  {-# INLINABLE newResource #-}
  newResource :: Int -> Simulation IO (Resource IO)
newResource Int
count =
    (Run IO -> IO (Resource IO)) -> Simulation IO (Resource IO)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run IO -> IO (Resource IO)) -> Simulation IO (Resource IO))
-> (Run IO -> IO (Resource IO)) -> Simulation IO (Resource IO)
forall a b. (a -> b) -> a -> b
$ \Run IO
r ->
    do 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
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
         String
"The resource count cannot be negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"newResource."
       IORef Int
countRef <- IO (IORef Int) -> IO (IORef Int)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> IO (IORef Int))
-> IO (IORef Int) -> IO (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
count
       PriorityQueue (ResourceActingItem IO)
actingQueue <- IO (PriorityQueue (ResourceActingItem IO))
-> IO (PriorityQueue (ResourceActingItem IO))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PriorityQueue (ResourceActingItem IO))
forall a. IO (PriorityQueue a)
PQ.newQueue
       PriorityQueue (ResourceAwaitingItem IO)
waitQueue <- IO (PriorityQueue (ResourceAwaitingItem IO))
-> IO (PriorityQueue (ResourceAwaitingItem IO))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PriorityQueue (ResourceAwaitingItem IO))
forall a. IO (PriorityQueue a)
PQ.newQueue
       Resource IO -> IO (Resource IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceMaxCount0 :: Maybe Int
resourceMaxCount0 = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
count,
                         resourceCountRef :: IORef Int
resourceCountRef = IORef Int
countRef,
                         resourceActingQueue :: PriorityQueue (ResourceActingItem IO)
resourceActingQueue = PriorityQueue (ResourceActingItem IO)
actingQueue,
                         resourceWaitQueue :: PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue = PriorityQueue (ResourceAwaitingItem IO)
waitQueue }

  {-# INLINABLE newResourceWithMaxCount #-}
  newResourceWithMaxCount :: Int -> Maybe Int -> Simulation IO (Resource IO)
newResourceWithMaxCount Int
count Maybe Int
maxCount =
    (Run IO -> IO (Resource IO)) -> Simulation IO (Resource IO)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run IO -> IO (Resource IO)) -> Simulation IO (Resource IO))
-> (Run IO -> IO (Resource IO)) -> Simulation IO (Resource IO)
forall a b. (a -> b) -> a -> b
$ \Run IO
r ->
    do 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
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
         String
"The resource count cannot be negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"newResourceWithMaxCount."
       case Maybe Int
maxCount of
         Just Int
maxCount | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxCount ->
           SimulationRetry -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
           String -> SimulationRetry
SimulationRetry (String -> SimulationRetry) -> String -> SimulationRetry
forall a b. (a -> b) -> a -> b
$
           String
"The resource count cannot be greater than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
           String
"its maximum value: newResourceWithMaxCount."
         Maybe Int
_ ->
           () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       IORef Int
countRef <- IO (IORef Int) -> IO (IORef Int)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> IO (IORef Int))
-> IO (IORef Int) -> IO (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
count
       PriorityQueue (ResourceActingItem IO)
actingQueue <- IO (PriorityQueue (ResourceActingItem IO))
-> IO (PriorityQueue (ResourceActingItem IO))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PriorityQueue (ResourceActingItem IO))
forall a. IO (PriorityQueue a)
PQ.newQueue
       PriorityQueue (ResourceAwaitingItem IO)
waitQueue <- IO (PriorityQueue (ResourceAwaitingItem IO))
-> IO (PriorityQueue (ResourceAwaitingItem IO))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (PriorityQueue (ResourceAwaitingItem IO))
forall a. IO (PriorityQueue a)
PQ.newQueue
       Resource IO -> IO (Resource IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Resource { resourceMaxCount0 :: Maybe Int
resourceMaxCount0 = Maybe Int
maxCount,
                         resourceCountRef :: IORef Int
resourceCountRef = IORef Int
countRef,
                         resourceActingQueue :: PriorityQueue (ResourceActingItem IO)
resourceActingQueue = PriorityQueue (ResourceActingItem IO)
actingQueue,
                         resourceWaitQueue :: PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue = PriorityQueue (ResourceAwaitingItem IO)
waitQueue }

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

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

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

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

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

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

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

-- | 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 item that requests for the resource.
data ResourceRequestingItem m =
  ResourceRequestingItem { forall (m :: * -> *). ResourceRequestingItem m -> Double
requestingItemPriority :: 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 -> ProcessId m
preemptedItemId :: ProcessId m }

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

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

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

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

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

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

decResourceCount' :: Resource IO -> Event IO ()
-- decResourceCount' :: (MonadDES m, MonadIO m, MonadTemplate m) => Resource m -> Event m ()
{-# INLINABLE decResourceCount' #-}
decResourceCount' :: Resource IO -> Event IO ()
decResourceCount' Resource IO
r =
  (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  do Int
a <- IO Int -> IO Int
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r)
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       SimulationRetry -> IO ()
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp (SimulationRetry -> IO ()) -> SimulationRetry -> IO ()
forall a b. (a -> b) -> a -> b
$
       String -> SimulationRetry
SimulationRetry
       String
"The resource exceeded and its count is zero: decResourceCount'"
     Bool
f <- IO Bool -> IO Bool
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO) -> IO Bool
forall a. PriorityQueue a -> IO Bool
PQ.queueNull (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       do (Double
p0', ResourceActingItem IO
item0) <- IO (Double, ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, ResourceActingItem IO)
 -> IO (Double, ResourceActingItem IO))
-> IO (Double, ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO)
-> IO (Double, ResourceActingItem IO)
forall a. PriorityQueue a -> IO (Double, a)
PQ.queueFront (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
          let p0 :: Double
p0 = - Double
p0'
              pid0 :: ProcessId IO
pid0 = ResourceActingItem IO -> ProcessId IO
forall (m :: * -> *). ResourceActingItem m -> ProcessId m
actingItemId ResourceActingItem IO
item0
          IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceActingItem IO) -> IO ()
forall a. PriorityQueue a -> IO ()
PQ.dequeue (Resource IO -> PriorityQueue (ResourceActingItem IO)
resourceActingQueue Resource IO
r)
          IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PriorityQueue (ResourceAwaitingItem IO)
-> Double -> ResourceAwaitingItem IO -> IO ()
forall a. PriorityQueue a -> Double -> a -> IO ()
PQ.enqueue (Resource IO -> PriorityQueue (ResourceAwaitingItem IO)
resourceWaitQueue Resource IO
r) Double
p0 (ResourcePreemptedItem IO -> ResourceAwaitingItem IO
forall a b. b -> Either a b
Right (ResourcePreemptedItem IO -> ResourceAwaitingItem IO)
-> ResourcePreemptedItem IO -> ResourceAwaitingItem IO
forall a b. (a -> b) -> a -> b
$ Double -> ProcessId IO -> ResourcePreemptedItem IO
forall (m :: * -> *).
Double -> ProcessId m -> ResourcePreemptedItem m
ResourcePreemptedItem Double
p0 ProcessId IO
pid0)
          Point IO -> Event IO () -> IO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point IO
p (Event IO () -> IO ()) -> Event IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessId IO -> Event IO ()
forall (m :: * -> *). MonadDES m => ProcessId m -> Event m ()
processPreemptionBegin ProcessId IO
pid0
     let a' :: Int
a' = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     Int
a' Int -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Resource IO -> IORef Int
resourceCountRef Resource IO
r) Int
a'