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

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

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

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

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

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

-- | 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 forall a. Eq a => a -> a -> Bool
== Resource IO -> IORef Int
resourceCountRef Resource IO
y  -- unique references

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

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

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