{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Simulation.Aivika.Trans.Internal.Cont
(ContParams,
ContCancellation(..),
Cont(..),
ContId,
ContEvent(..),
FrozenCont,
newContId,
contSignal,
contCancellationInitiated,
contCancellationInitiate,
contCancellationInitiating,
contCancellationActivated,
contCancellationBind,
contCancellationConnect,
contPreemptionBegun,
contPreemptionBegin,
contPreemptionBeginning,
contPreemptionEnd,
contPreemptionEnding,
invokeCont,
runCont,
rerunCont,
spawnCont,
contParallel,
contParallel_,
catchCont,
finallyCont,
throwCont,
resumeCont,
resumeECont,
reenterCont,
freezeCont,
freezeContReentering,
unfreezeCont,
substituteCont,
substituteContPriority,
contCanceled,
contAwait,
transferCont,
traceCont) where
import Data.Array
import Data.Monoid
import Control.Exception
import Control.Monad
import Control.Monad.Trans
import qualified Control.Monad.Catch as MC
import Control.Applicative
import Debug.Trace (trace)
import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Signal
data ContCancellation = CancelTogether
| CancelChildAfterParent
| CancelParentAfterChild
| CancelInIsolation
data ContId m =
ContId { forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef :: Ref m Bool,
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef :: Ref m Bool,
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef :: Ref m Int,
forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource :: SignalSource m ContEvent
}
instance MonadDES m => Eq (ContId m) where
ContId m
x == :: ContId m -> ContId m -> Bool
== ContId m
y = ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x Ref m Bool -> Ref m Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
y
data ContEvent = ContCancellationInitiating
| ContPreemptionBeginning
| ContPreemptionEnding
deriving (ContEvent -> ContEvent -> Bool
(ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> Bool) -> Eq ContEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContEvent -> ContEvent -> Bool
== :: ContEvent -> ContEvent -> Bool
$c/= :: ContEvent -> ContEvent -> Bool
/= :: ContEvent -> ContEvent -> Bool
Eq, Eq ContEvent
Eq ContEvent =>
(ContEvent -> ContEvent -> Ordering)
-> (ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> ContEvent)
-> (ContEvent -> ContEvent -> ContEvent)
-> Ord ContEvent
ContEvent -> ContEvent -> Bool
ContEvent -> ContEvent -> Ordering
ContEvent -> ContEvent -> ContEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ContEvent -> ContEvent -> Ordering
compare :: ContEvent -> ContEvent -> Ordering
$c< :: ContEvent -> ContEvent -> Bool
< :: ContEvent -> ContEvent -> Bool
$c<= :: ContEvent -> ContEvent -> Bool
<= :: ContEvent -> ContEvent -> Bool
$c> :: ContEvent -> ContEvent -> Bool
> :: ContEvent -> ContEvent -> Bool
$c>= :: ContEvent -> ContEvent -> Bool
>= :: ContEvent -> ContEvent -> Bool
$cmax :: ContEvent -> ContEvent -> ContEvent
max :: ContEvent -> ContEvent -> ContEvent
$cmin :: ContEvent -> ContEvent -> ContEvent
min :: ContEvent -> ContEvent -> ContEvent
Ord, Int -> ContEvent -> ShowS
[ContEvent] -> ShowS
ContEvent -> String
(Int -> ContEvent -> ShowS)
-> (ContEvent -> String)
-> ([ContEvent] -> ShowS)
-> Show ContEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContEvent -> ShowS
showsPrec :: Int -> ContEvent -> ShowS
$cshow :: ContEvent -> String
show :: ContEvent -> String
$cshowList :: [ContEvent] -> ShowS
showList :: [ContEvent] -> ShowS
Show)
newContId :: MonadDES m => Simulation m (ContId m)
{-# INLINABLE newContId #-}
newContId :: forall (m :: * -> *). MonadDES m => Simulation m (ContId m)
newContId =
(Run m -> m (ContId m)) -> Simulation m (ContId m)
forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation ((Run m -> m (ContId m)) -> Simulation m (ContId m))
-> (Run m -> m (ContId m)) -> Simulation m (ContId m)
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do Ref m Bool
r1 <- Run m -> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Bool) -> m (Ref m Bool))
-> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Simulation m (Ref m Bool)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
Ref m Bool
r2 <- Run m -> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Bool) -> m (Ref m Bool))
-> Simulation m (Ref m Bool) -> m (Ref m Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Simulation m (Ref m Bool)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
Ref m Int
r3 <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
SignalSource m ContEvent
s <- Run m
-> Simulation m (SignalSource m ContEvent)
-> m (SignalSource m ContEvent)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r Simulation m (SignalSource m ContEvent)
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
ContId m -> m (ContId m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ContId { contCancellationInitiatedRef :: Ref m Bool
contCancellationInitiatedRef = Ref m Bool
r1,
contCancellationActivatedRef :: Ref m Bool
contCancellationActivatedRef = Ref m Bool
r2,
contPreemptionCountRef :: Ref m Int
contPreemptionCountRef = Ref m Int
r3,
contSignalSource :: SignalSource m ContEvent
contSignalSource = SignalSource m ContEvent
s
}
contSignal :: ContId m -> Signal m ContEvent
{-# INLINABLE contSignal #-}
contSignal :: forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal = SignalSource m ContEvent -> Signal m ContEvent
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal (SignalSource m ContEvent -> Signal m ContEvent)
-> (ContId m -> SignalSource m ContEvent)
-> ContId m
-> Signal m ContEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> SignalSource m ContEvent
forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource
contCancellationInitiating :: MonadDES m => ContId m -> Signal m ()
{-# INLINABLE contCancellationInitiating #-}
contCancellationInitiating :: forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating =
(ContEvent -> Bool) -> Signal m ContEvent -> Signal m ()
forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContCancellationInitiating ContEvent -> ContEvent -> Bool
forall a. Eq a => a -> a -> Bool
==) (Signal m ContEvent -> Signal m ())
-> (ContId m -> Signal m ContEvent) -> ContId m -> Signal m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Signal m ContEvent
forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal
contCancellationInitiated :: MonadDES m => ContId m -> Event m Bool
{-# INLINABLE contCancellationInitiated #-}
contCancellationInitiated :: forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contCancellationInitiated =
Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Ref m Bool -> Event m Bool)
-> (ContId m -> Ref m Bool) -> ContId m -> Event m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef
contCancellationActivated :: MonadDES m => ContId m -> Event m Bool
{-# INLINABLE contCancellationActivated #-}
contCancellationActivated :: forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contCancellationActivated =
Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Ref m Bool -> Event m Bool)
-> (ContId m -> Ref m Bool) -> ContId m -> Event m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef
contCancellationDeactivate :: MonadDES m => ContId m -> Event m ()
{-# INLINABLE contCancellationDeactivate #-}
contCancellationDeactivate :: forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationDeactivate ContId m
x =
Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
x) Bool
False
contCancellationBind :: MonadDES m => ContId m -> [ContId m] -> Event m (DisposableEvent m)
{-# INLINABLE contCancellationBind #-}
contCancellationBind :: forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind ContId m
x [ContId m]
ys =
(Point m -> m (DisposableEvent m)) -> Event m (DisposableEvent m)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (DisposableEvent m)) -> Event m (DisposableEvent m))
-> (Point m -> m (DisposableEvent m))
-> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do [DisposableEvent m]
hs1 <- [ContId m]
-> (ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ContId m]
ys ((ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m])
-> (ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m]
forall a b. (a -> b) -> a -> b
$ \ContId m
y ->
Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
x) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
y
[DisposableEvent m]
hs2 <- [ContId m]
-> (ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ContId m]
ys ((ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m])
-> (ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m]
forall a b. (a -> b) -> a -> b
$ \ContId m
y ->
Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
y) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
x
DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent m -> m (DisposableEvent m))
-> DisposableEvent m -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ [DisposableEvent m] -> DisposableEvent m
forall a. Monoid a => [a] -> a
mconcat [DisposableEvent m]
hs1 DisposableEvent m -> DisposableEvent m -> DisposableEvent m
forall a. Semigroup a => a -> a -> a
<> [DisposableEvent m] -> DisposableEvent m
forall a. Monoid a => [a] -> a
mconcat [DisposableEvent m]
hs2
contCancellationConnect :: MonadDES m
=> ContId m
-> ContCancellation
-> ContId m
-> Event m (DisposableEvent m)
{-# INLINABLE contCancellationConnect #-}
contCancellationConnect :: forall (m :: * -> *).
MonadDES m =>
ContId m
-> ContCancellation -> ContId m -> Event m (DisposableEvent m)
contCancellationConnect ContId m
parent ContCancellation
cancellation ContId m
child =
(Point m -> m (DisposableEvent m)) -> Event m (DisposableEvent m)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (DisposableEvent m)) -> Event m (DisposableEvent m))
-> (Point m -> m (DisposableEvent m))
-> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let m1 :: Event m (DisposableEvent m)
m1 =
Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
parent) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
child
m2 :: Event m (DisposableEvent m)
m2 =
Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
child) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
parent
DisposableEvent m
h1 <-
case ContCancellation
cancellation of
ContCancellation
CancelTogether -> Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m1
ContCancellation
CancelChildAfterParent -> Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m1
ContCancellation
CancelParentAfterChild -> DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent m
forall a. Monoid a => a
mempty
ContCancellation
CancelInIsolation -> DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent m
forall a. Monoid a => a
mempty
DisposableEvent m
h2 <-
case ContCancellation
cancellation of
ContCancellation
CancelTogether -> Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m2
ContCancellation
CancelChildAfterParent -> DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent m
forall a. Monoid a => a
mempty
ContCancellation
CancelParentAfterChild -> Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m2
ContCancellation
CancelInIsolation -> DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent m
forall a. Monoid a => a
mempty
DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent m -> m (DisposableEvent m))
-> DisposableEvent m -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ DisposableEvent m
h1 DisposableEvent m -> DisposableEvent m -> DisposableEvent m
forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
h2
contCancellationInitiate :: MonadDES m => ContId m -> Event m ()
{-# INLINABLE contCancellationInitiate #-}
contCancellationInitiate :: forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
x =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x) Bool
True
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
x) Bool
True
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ SignalSource m ContEvent -> ContEvent -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (ContId m -> SignalSource m ContEvent
forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContCancellationInitiating
contPreemptionBegin :: MonadDES m => ContId m -> Event m ()
{-# INLINABLE contPreemptionBegin #-}
contPreemptionBegin :: forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contPreemptionBegin ContId m
x =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
do Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Int
n' Int -> m () -> m ()
forall a b. a -> b -> b
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x) Int
n'
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
SignalSource m ContEvent -> ContEvent -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (ContId m -> SignalSource m ContEvent
forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContPreemptionBeginning
contPreemptionEnd :: MonadDES m => ContId m -> Event m ()
{-# INLINABLE contPreemptionEnd #-}
contPreemptionEnd :: forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contPreemptionEnd ContId m
x =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
do Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Int
n' Int -> m () -> m ()
forall a b. a -> b -> b
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x) Int
n'
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
SignalSource m ContEvent -> ContEvent -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (ContId m -> SignalSource m ContEvent
forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContPreemptionEnding
contPreemptionBeginning :: MonadDES m => ContId m -> Signal m ()
{-# INLINABLE contPreemptionBeginning #-}
contPreemptionBeginning :: forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contPreemptionBeginning =
(ContEvent -> Bool) -> Signal m ContEvent -> Signal m ()
forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContPreemptionBeginning ContEvent -> ContEvent -> Bool
forall a. Eq a => a -> a -> Bool
==) (Signal m ContEvent -> Signal m ())
-> (ContId m -> Signal m ContEvent) -> ContId m -> Signal m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Signal m ContEvent
forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal
contPreemptionEnding :: MonadDES m => ContId m -> Signal m ()
{-# INLINABLE contPreemptionEnding #-}
contPreemptionEnding :: forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contPreemptionEnding =
(ContEvent -> Bool) -> Signal m ContEvent -> Signal m ()
forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContPreemptionEnding ContEvent -> ContEvent -> Bool
forall a. Eq a => a -> a -> Bool
==) (Signal m ContEvent -> Signal m ())
-> (ContId m -> Signal m ContEvent) -> ContId m -> Signal m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Signal m ContEvent
forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal
contPreemptionBegun :: MonadDES m => ContId m -> Event m Bool
{-# INLINABLE contPreemptionBegun #-}
contPreemptionBegun :: forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contPreemptionBegun ContId m
x =
(Point m -> m Bool) -> Event m Bool
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m Bool) -> Event m Bool)
-> (Point m -> m Bool) -> Event m Bool
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
newtype Cont m a = Cont (ContParams m a -> Event m ())
data ContParams m a =
ContParams { forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont :: a -> Event m (),
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux :: ContParamsAux m }
data ContParamsAux m =
ContParamsAux { forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont :: SomeException -> Event m (),
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont :: () -> Event m (),
forall (m :: * -> *). ContParamsAux m -> ContId m
contId :: ContId m,
forall (m :: * -> *). ContParamsAux m -> Ref m Bool
contCancelRef :: Ref m Bool,
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag :: Bool }
instance MonadDES m => Monad (Cont m) where
{-# INLINE (>>=) #-}
(Cont ContParams m a -> Event m ()
m) >>= :: forall a b. Cont m a -> (a -> Cont m b) -> Cont m b
>>= a -> Cont m b
k =
(ContParams m b -> Event m ()) -> Cont m b
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m b -> Event m ()) -> Cont m b)
-> (ContParams m b -> Event m ()) -> Cont m b
forall a b. (a -> b) -> a -> b
$ \ContParams m b
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m b
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m b
c
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m (ContParams m a -> Event m ()) -> ContParams m a -> Event m ()
forall a b. (a -> b) -> a -> b
$
let cont :: a -> Event m ()
cont a
a = ContParams m b -> Cont m b -> Event m ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m b
c (a -> Cont m b
k a
a)
in ContParams m b
c { contCont = cont }
instance MonadDES m => MonadCompTrans Cont m where
{-# INLINE liftComp #-}
liftComp :: forall a. m a -> Cont m a
liftComp m a
m =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool)
-> (ContParams m a -> ContParamsAux m) -> ContParams m a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> Bool) -> ContParams m a -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a
c
then m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching m a
m Point m
p ContParams m a
c
else m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching m a
m Point m
p ContParams m a
c
instance MonadDES m => ParameterLift Cont m where
{-# INLINE liftParameter #-}
liftParameter :: forall a. Parameter m a -> Cont m a
liftParameter (Parameter Run m -> m a
m) =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool)
-> (ContParams m a -> ContParamsAux m) -> ContParams m a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> Bool) -> ContParams m a -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a
c
then m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (Run m -> m a
m (Run m -> m a) -> Run m -> m a
forall a b. (a -> b) -> a -> b
$ Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) Point m
p ContParams m a
c
else m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (Run m -> m a
m (Run m -> m a) -> Run m -> m a
forall a b. (a -> b) -> a -> b
$ Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) Point m
p ContParams m a
c
instance MonadDES m => SimulationLift Cont m where
{-# INLINE liftSimulation #-}
liftSimulation :: forall a. Simulation m a -> Cont m a
liftSimulation (Simulation Run m -> m a
m) =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool)
-> (ContParams m a -> ContParamsAux m) -> ContParams m a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> Bool) -> ContParams m a -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a
c
then m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (Run m -> m a
m (Run m -> m a) -> Run m -> m a
forall a b. (a -> b) -> a -> b
$ Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) Point m
p ContParams m a
c
else m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (Run m -> m a
m (Run m -> m a) -> Run m -> m a
forall a b. (a -> b) -> a -> b
$ Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) Point m
p ContParams m a
c
instance MonadDES m => DynamicsLift Cont m where
{-# INLINE liftDynamics #-}
liftDynamics :: forall a. Dynamics m a -> Cont m a
liftDynamics (Dynamics Point m -> m a
m) =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool)
-> (ContParams m a -> ContParamsAux m) -> ContParams m a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> Bool) -> ContParams m a -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a
c
then m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (Point m -> m a
m Point m
p) Point m
p ContParams m a
c
else m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (Point m -> m a
m Point m
p) Point m
p ContParams m a
c
instance MonadDES m => EventLift Cont m where
{-# INLINE liftEvent #-}
liftEvent :: forall a. Event m a -> Cont m a
liftEvent (Event Point m -> m a
m) =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool)
-> (ContParams m a -> ContParamsAux m) -> ContParams m a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> Bool) -> ContParams m a -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a
c
then m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (Point m -> m a
m Point m
p) Point m
p ContParams m a
c
else m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (Point m -> m a
m Point m
p) Point m
p ContParams m a
c
instance (MonadDES m, MonadIO m) => MonadIO (Cont m) where
{-# INLINE liftIO #-}
liftIO :: forall a. IO a -> Cont m a
liftIO IO a
m =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool)
-> (ContParams m a -> ContParamsAux m) -> ContParams m a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> Bool) -> ContParams m a -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a
c
then m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m) Point m
p ContParams m a
c
else m a -> Point m -> ContParams m a -> m ()
forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m) Point m
p ContParams m a
c
instance MonadDES m => Functor (Cont m) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Cont m a -> Cont m b
fmap = (a -> b) -> Cont m a -> Cont m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance MonadDES m => Applicative (Cont m) where
{-# INLINE pure #-}
pure :: forall a. a -> Cont m a
pure a
a =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
{-# INLINE (<*>) #-}
<*> :: forall a b. Cont m (a -> b) -> Cont m a -> Cont m b
(<*>) = Cont m (a -> b) -> Cont m a -> Cont m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance MonadDES m => MC.MonadThrow (Cont m) where
{-# INLINE throwM #-}
throwM :: forall e a. (HasCallStack, Exception e) => e -> Cont m a
throwM = e -> Cont m a
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Cont m a
throwCont
instance MonadDES m => MC.MonadCatch (Cont m) where
{-# INLINE catch #-}
catch :: forall e a.
(HasCallStack, Exception e) =>
Cont m a -> (e -> Cont m a) -> Cont m a
catch = Cont m a -> (e -> Cont m a) -> Cont m a
forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Cont m a -> (e -> Cont m a) -> Cont m a
catchCont
invokeCont :: ContParams m a -> Cont m a -> Event m ()
{-# INLINE invokeCont #-}
invokeCont :: forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m a
p (Cont ContParams m a -> Event m ()
m) = ContParams m a -> Event m ()
m ContParams m a
p
cancelCont :: MonadDES m => ContParams m a -> Event m ()
{-# NOINLINE cancelCont #-}
cancelCont :: forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationDeactivate (ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c)
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ (ContParamsAux m -> () -> Event m ()
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (ContParamsAux m -> () -> Event m ())
-> ContParamsAux m -> () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ()
callCont :: MonadDES m => (a -> Cont m b) -> a -> ContParams m b -> Event m ()
{-# INLINABLE callCont #-}
callCont :: forall (m :: * -> *) a b.
MonadDES m =>
(a -> Cont m b) -> a -> ContParams m b -> Event m ()
callCont a -> Cont m b
k a
a ContParams m b
c =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m b
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m b
c
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Cont m b -> Event m ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m b
c (a -> Cont m b
k a
a)
catchCont :: (MonadDES m, Exception e) => Cont m a -> (e -> Cont m a) -> Cont m a
{-# INLINABLE catchCont #-}
catchCont :: forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Cont m a -> (e -> Cont m a) -> Cont m a
catchCont (Cont ContParams m a -> Event m ()
m) e -> Cont m a
h =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c0 ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let c :: ContParams m a
c = ContParams m a
c0 { contAux = (contAux c0) { contCatchFlag = True } }
Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m (ContParams m a -> Event m ()) -> ContParams m a -> Event m ()
forall a b. (a -> b) -> a -> b
$
let econt :: SomeException -> Event m ()
econt SomeException
e0 =
case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e0 of
Just e
e -> (e -> Cont m a) -> e -> ContParams m a -> Event m ()
forall (m :: * -> *) a b.
MonadDES m =>
(a -> Cont m b) -> a -> ContParams m b -> Event m ()
callCont e -> Cont m a
h e
e ContParams m a
c
Maybe e
Nothing -> (ContParamsAux m -> SomeException -> Event m ()
forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (ContParamsAux m -> SomeException -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> SomeException
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> SomeException -> Event m ())
-> ContParams m a -> SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a
c) SomeException
e0
in ContParams m a
c { contAux = (contAux c) { contECont = econt } }
finallyCont :: MonadDES m => Cont m a -> Cont m b -> Cont m a
{-# INLINABLE finallyCont #-}
finallyCont :: forall (m :: * -> *) a b.
MonadDES m =>
Cont m a -> Cont m b -> Cont m a
finallyCont (Cont ContParams m a -> Event m ()
m) (Cont ContParams m b -> Event m ()
m') =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c0 ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let c :: ContParams m a
c = ContParams m a
c0 { contAux = (contAux c0) { contCatchFlag = True } }
Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m (ContParams m a -> Event m ()) -> ContParams m a -> Event m ()
forall a b. (a -> b) -> a -> b
$
let cont :: a -> Event m ()
cont a
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' (ContParams m b -> Event m ()) -> ContParams m b -> Event m ()
forall a b. (a -> b) -> a -> b
$
let cont :: p -> Event m ()
cont p
b = ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
in ContParams m a
c { contCont = cont }
econt :: SomeException -> Event m ()
econt SomeException
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' (ContParams m b -> Event m ()) -> ContParams m b -> Event m ()
forall a b. (a -> b) -> a -> b
$
let cont :: p -> Event m ()
cont p
b = (ContParamsAux m -> SomeException -> Event m ()
forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (ContParamsAux m -> SomeException -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> SomeException
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> SomeException -> Event m ())
-> ContParams m a -> SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a
c) SomeException
e
in ContParams m a
c { contCont = cont }
ccont :: () -> Event m ()
ccont () =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' (ContParams m b -> Event m ()) -> ContParams m b -> Event m ()
forall a b. (a -> b) -> a -> b
$
let cont :: p -> Event m ()
cont p
b = (ContParamsAux m -> () -> Event m ()
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (ContParamsAux m -> () -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> ()
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> () -> Event m ())
-> ContParams m a -> () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a
c) ()
econt :: p -> Event m ()
econt p
e = (ContParamsAux m -> () -> Event m ()
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (ContParamsAux m -> () -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> ()
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> () -> Event m ())
-> ContParams m a -> () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a
c) ()
in ContParams m a
c { contCont = cont,
contAux = (contAux c) { contECont = econt } }
in ContParams m a
c { contCont = cont,
contAux = (contAux c) { contECont = econt,
contCCont = ccont } }
throwCont :: (MonadDES m, Exception e) => e -> Cont m a
{-# INLINABLE throwCont #-}
throwCont :: forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Cont m a
throwCont = Event m a -> Cont m a
forall a. Event m a -> Cont m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m a -> Cont m a) -> (e -> Event m a) -> e -> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent
runCont :: MonadDES m
=> Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
{-# INLINABLE runCont #-}
runCont :: forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont (Cont ContParams m a -> Event m ()
m) a -> Event m ()
cont SomeException -> Event m ()
econt () -> Event m ()
ccont ContId m
cid Bool
catchFlag =
ContParams m a -> Event m ()
m ContParams { contCont :: a -> Event m ()
contCont = a -> Event m ()
cont,
contAux :: ContParamsAux m
contAux =
ContParamsAux { contECont :: SomeException -> Event m ()
contECont = SomeException -> Event m ()
econt,
contCCont :: () -> Event m ()
contCCont = () -> Event m ()
ccont,
contId :: ContId m
contId = ContId m
cid,
contCancelRef :: Ref m Bool
contCancelRef = ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
cid,
contCatchFlag :: Bool
contCatchFlag = Bool
catchFlag } }
liftWithoutCatching :: MonadDES m => m a -> Point m -> ContParams m a -> m ()
{-# INLINE liftWithoutCatching #-}
liftWithoutCatching :: forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching m a
m Point m
p ContParams m a
c =
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else do a
a <- m a
m
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
liftWithCatching :: MonadDES m => m a -> Point m -> ContParams m a -> m ()
{-# NOINLINE liftWithCatching #-}
liftWithCatching :: forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching m a
m Point m
p ContParams m a
c =
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else do let r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
Ref m a
aref <- Run m -> Simulation m (Ref m a) -> m (Ref m a)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m a) -> m (Ref m a))
-> Simulation m (Ref m a) -> m (Ref m a)
forall a b. (a -> b) -> a -> b
$ a -> Simulation m (Ref m a)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef a
forall a. HasCallStack => a
undefined
Ref m (Maybe SomeException)
eref <- Run m
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException)))
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> Simulation m (Ref m (Maybe SomeException))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe SomeException
forall a. Maybe a
Nothing
m () -> (SomeException -> m ()) -> m ()
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp
(m a
m m a -> (a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> (a -> Event m ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> a -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m a
aref)
(Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ())
-> (SomeException -> Event m ()) -> SomeException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m (Maybe SomeException) -> Maybe SomeException -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe SomeException)
eref (Maybe SomeException -> Event m ())
-> (SomeException -> Maybe SomeException)
-> SomeException
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just)
Maybe SomeException
e <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
eref
case Maybe SomeException
e of
Maybe SomeException
Nothing ->
do a
a <- Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m a -> m a) -> Event m a -> m a
forall a b. (a -> b) -> a -> b
$ Ref m a -> Event m a
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m a
aref
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
Just SomeException
e ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ (ContParamsAux m -> SomeException -> Event m ()
forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (ContParamsAux m -> SomeException -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> SomeException
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux) ContParams m a
c SomeException
e
resumeCont :: MonadDES m => ContParams m a -> a -> Event m ()
{-# INLINE resumeCont #-}
resumeCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c a
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
resumeECont :: MonadDES m => ContParams m a -> SomeException -> Event m ()
{-# INLINE resumeECont #-}
resumeECont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m a
c SomeException
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ (ContParamsAux m -> SomeException -> Event m ()
forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (ContParamsAux m -> SomeException -> Event m ())
-> ContParamsAux m -> SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) SomeException
e
contCanceled :: MonadDES m => ContParams m a -> Event m Bool
{-# INLINE contCanceled #-}
contCanceled :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c = Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Ref m Bool -> Event m Bool) -> Ref m Bool -> Event m Bool
forall a b. (a -> b) -> a -> b
$ ContParamsAux m -> Ref m Bool
forall (m :: * -> *). ContParamsAux m -> Ref m Bool
contCancelRef (ContParamsAux m -> Ref m Bool) -> ContParamsAux m -> Ref m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
contParallel :: MonadDES m
=> [(Cont m a, ContId m)]
-> Cont m [a]
{-# INLINABLE contParallel #-}
contParallel :: forall (m :: * -> *) a.
MonadDES m =>
[(Cont m a, ContId m)] -> Cont m [a]
contParallel [(Cont m a, ContId m)]
xs =
(ContParams m [a] -> Event m ()) -> Cont m [a]
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m [a] -> Event m ()) -> Cont m [a])
-> (ContParams m [a] -> Event m ()) -> Cont m [a]
forall a b. (a -> b) -> a -> b
$ \ContParams m [a]
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let n :: Int
n = [(Cont m a, ContId m)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Cont m a, ContId m)]
xs
r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
worker :: m ()
worker =
do [Ref m a]
results <- [Int] -> (Int -> m (Ref m a)) -> m [Ref m a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1..Int
n] ((Int -> m (Ref m a)) -> m [Ref m a])
-> (Int -> m (Ref m a)) -> m [Ref m a]
forall a b. (a -> b) -> a -> b
$ \Int
i -> Run m -> Simulation m (Ref m a) -> m (Ref m a)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m a) -> m (Ref m a))
-> Simulation m (Ref m a) -> m (Ref m a)
forall a b. (a -> b) -> a -> b
$ a -> Simulation m (Ref m a)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef a
forall a. HasCallStack => a
undefined
Ref m Int
counter <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
Ref m (Maybe SomeException)
catchRef <- Run m
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException)))
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> Simulation m (Ref m (Maybe SomeException))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe SomeException
forall a. Maybe a
Nothing
DisposableEvent m
hs <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
ContId m -> [ContId m] -> Event m (DisposableEvent m)
forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind (ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m [a]
c) ([ContId m] -> Event m (DisposableEvent m))
-> [ContId m] -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
((Cont m a, ContId m) -> ContId m)
-> [(Cont m a, ContId m)] -> [ContId m]
forall a b. (a -> b) -> [a] -> [b]
map (Cont m a, ContId m) -> ContId m
forall a b. (a, b) -> b
snd [(Cont m a, ContId m)]
xs
let propagate :: Event m ()
propagate =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Int
n' <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Int
counter
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs
Bool
f1 <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m [a]
c
Maybe SomeException
f2 <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
case (Bool
f1, Maybe SomeException
f2) of
(Bool
False, Maybe SomeException
Nothing) ->
do [a]
rs <- [Ref m a] -> (Ref m a -> m a) -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ref m a]
results ((Ref m a -> m a) -> m [a]) -> (Ref m a -> m a) -> m [a]
forall a b. (a -> b) -> a -> b
$ Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m a -> m a) -> (Ref m a -> Event m a) -> Ref m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> Event m a
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> [a] -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m [a]
c [a]
rs
(Bool
False, Just SomeException
e) ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> SomeException -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m [a]
c SomeException
e
(Bool
True, Maybe SomeException
_) ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m [a]
c
cont :: Ref m a -> a -> Event m ()
cont Ref m a
result a
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m a
result a
a
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
econt :: SomeException -> Event m ()
econt SomeException
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Maybe SomeException
r <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
case Maybe SomeException
r of
Maybe SomeException
Nothing -> Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Maybe SomeException -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe SomeException)
catchRef (Maybe SomeException -> Event m ())
-> Maybe SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
Just SomeException
e' -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
ccont :: p -> Event m ()
ccont p
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
[(Ref m a, (Cont m a, ContId m))]
-> ((Ref m a, (Cont m a, ContId m)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Ref m a]
-> [(Cont m a, ContId m)] -> [(Ref m a, (Cont m a, ContId m))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ref m a]
results [(Cont m a, ContId m)]
xs) (((Ref m a, (Cont m a, ContId m)) -> m ()) -> m ())
-> ((Ref m a, (Cont m a, ContId m)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Ref m a
result, (Cont m a
x, ContId m
cid)) ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m a
x (Ref m a -> a -> Event m ()
forall a. Ref m a -> a -> Event m ()
cont Ref m a
result) SomeException -> Event m ()
econt () -> Event m ()
forall {p}. p -> Event m ()
ccont ContId m
cid (ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool) -> ContParamsAux m -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m [a]
c)
Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m [a]
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m [a]
c
else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> [a] -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m [a]
c []
else m ()
worker
contParallel_ :: MonadDES m
=> [(Cont m a, ContId m)]
-> Cont m ()
{-# INLINABLE contParallel_ #-}
contParallel_ :: forall (m :: * -> *) a.
MonadDES m =>
[(Cont m a, ContId m)] -> Cont m ()
contParallel_ [(Cont m a, ContId m)]
xs =
(ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let n :: Int
n = [(Cont m a, ContId m)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Cont m a, ContId m)]
xs
r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
worker :: m ()
worker =
do Ref m Int
counter <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
Ref m (Maybe SomeException)
catchRef <- Run m
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException)))
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> Simulation m (Ref m (Maybe SomeException))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe SomeException
forall a. Maybe a
Nothing
DisposableEvent m
hs <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
ContId m -> [ContId m] -> Event m (DisposableEvent m)
forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind (ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m () -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m ()
c) ([ContId m] -> Event m (DisposableEvent m))
-> [ContId m] -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
((Cont m a, ContId m) -> ContId m)
-> [(Cont m a, ContId m)] -> [ContId m]
forall a b. (a -> b) -> [a] -> [b]
map (Cont m a, ContId m) -> ContId m
forall a b. (a, b) -> b
snd [(Cont m a, ContId m)]
xs
let propagate :: Event m ()
propagate =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Int
n' <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Int
counter
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs
Bool
f1 <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m ()
c
Maybe SomeException
f2 <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
case (Bool
f1, Maybe SomeException
f2) of
(Bool
False, Maybe SomeException
Nothing) ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
(Bool
False, Just SomeException
e) ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> SomeException -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m ()
c SomeException
e
(Bool
True, Maybe SomeException
_) ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m ()
c
cont :: p -> Event m ()
cont p
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
econt :: SomeException -> Event m ()
econt SomeException
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Maybe SomeException
r <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
case Maybe SomeException
r of
Maybe SomeException
Nothing -> Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Maybe SomeException -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe SomeException)
catchRef (Maybe SomeException -> Event m ())
-> Maybe SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
Just SomeException
e' -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
ccont :: p -> Event m ()
ccont p
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
[(Int, (Cont m a, ContId m))]
-> ((Int, (Cont m a, ContId m)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [(Cont m a, ContId m)] -> [(Int, (Cont m a, ContId m))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [(Cont m a, ContId m)]
xs) (((Int, (Cont m a, ContId m)) -> m ()) -> m ())
-> ((Int, (Cont m a, ContId m)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (Cont m a
x, ContId m
cid)) ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m a
x a -> Event m ()
forall {p}. p -> Event m ()
cont SomeException -> Event m ()
econt () -> Event m ()
forall {p}. p -> Event m ()
ccont ContId m
cid (ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool) -> ContParamsAux m -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m () -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m ()
c)
Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m ()
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m ()
c
else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m ()
c ()
else m ()
worker
rerunCont :: MonadDES m => Cont m a -> ContId m -> Cont m a
{-# INLINABLE rerunCont #-}
rerunCont :: forall (m :: * -> *) a.
MonadDES m =>
Cont m a -> ContId m -> Cont m a
rerunCont Cont m a
x ContId m
cid =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let worker :: m ()
worker =
do DisposableEvent m
hs <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
ContId m -> [ContId m] -> Event m (DisposableEvent m)
forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind (ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) [ContId m
cid]
let cont :: a -> Event m ()
cont a
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c a
a
econt :: SomeException -> Event m ()
econt SomeException
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> SomeException -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m a
c SomeException
e
ccont :: p -> Event m ()
ccont p
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m a
x a -> Event m ()
cont SomeException -> Event m ()
econt () -> Event m ()
forall {p}. p -> Event m ()
ccont ContId m
cid (ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool) -> ContParamsAux m -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c)
Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else m ()
worker
spawnCont :: MonadDES m => ContCancellation -> Cont m () -> ContId m -> Cont m ()
{-# INLINABLE spawnCont #-}
spawnCont :: forall (m :: * -> *).
MonadDES m =>
ContCancellation -> Cont m () -> ContId m -> Cont m ()
spawnCont ContCancellation
cancellation Cont m ()
x ContId m
cid =
(ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let worker :: m ()
worker =
do DisposableEvent m
hs <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
ContId m
-> ContCancellation -> ContId m -> Event m (DisposableEvent m)
forall (m :: * -> *).
MonadDES m =>
ContId m
-> ContCancellation -> ContId m -> Event m (DisposableEvent m)
contCancellationConnect
(ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m () -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m ()
c) ContCancellation
cancellation ContId m
cid
let cont :: p -> Event m ()
cont p
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs
econt :: e -> Event m a
econt e
e =
(Point m -> m a) -> Event m a
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m a) -> Event m a) -> (Point m -> m a) -> Event m a
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs
Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m a -> m a) -> Event m a -> m a
forall a b. (a -> b) -> a -> b
$ e -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent e
e
ccont :: p -> Event m ()
ccont p
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
Cont m ()
-> (() -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m ()
x () -> Event m ()
forall {p}. p -> Event m ()
cont SomeException -> Event m ()
forall {e} {a}. Exception e => e -> Event m a
econt () -> Event m ()
forall {p}. p -> Event m ()
ccont ContId m
cid Bool
False
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m ()
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m ()
c
else m ()
worker
newtype FrozenCont m a =
FrozenCont { forall (m :: * -> *) a.
FrozenCont m a -> Event m (Maybe (ContParams m a))
unfreezeCont :: Event m (Maybe (ContParams m a))
}
freezeCont :: MonadDES m => ContParams m a -> Event m (FrozenCont m a)
{-# INLINABLE freezeCont #-}
freezeCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m (FrozenCont m a)
freezeCont ContParams m a
c =
(Point m -> m (FrozenCont m a)) -> Event m (FrozenCont m a)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (FrozenCont m a)) -> Event m (FrozenCont m a))
-> (Point m -> m (FrozenCont m a)) -> Event m (FrozenCont m a)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
Ref m (Maybe (DisposableEvent m))
rh <- Run m
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m))))
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall a b. (a -> b) -> a -> b
$ Maybe (DisposableEvent m)
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
Ref m (Maybe (ContParams m a))
rc <- Run m
-> Simulation m (Ref m (Maybe (ContParams m a)))
-> m (Ref m (Maybe (ContParams m a)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (ContParams m a)))
-> m (Ref m (Maybe (ContParams m a))))
-> Simulation m (Ref m (Maybe (ContParams m a)))
-> m (Ref m (Maybe (ContParams m a)))
forall a b. (a -> b) -> a -> b
$ Maybe (ContParams m a)
-> Simulation m (Ref m (Maybe (ContParams m a)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef (Maybe (ContParams m a)
-> Simulation m (Ref m (Maybe (ContParams m a))))
-> Maybe (ContParams m a)
-> Simulation m (Ref m (Maybe (ContParams m a)))
forall a b. (a -> b) -> a -> b
$
ContParams m a -> Maybe (ContParams m a)
forall a. a -> Maybe a
Just (ContParams m a -> Maybe (ContParams m a))
-> ContParams m a -> Maybe (ContParams m a)
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Int -> ContParams m a
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Int -> ContParams m a
substituteContPriority ContParams m a
c (Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPriority Point m
p)
DisposableEvent m
h <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating (ContId m -> Signal m ()) -> ContId m -> Signal m ()
forall a b. (a -> b) -> a -> b
$
ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$
ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
e ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Maybe (DisposableEvent m)
h <- Point m
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m)))
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Event m (Maybe (DisposableEvent m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
rh
case Maybe (DisposableEvent m)
h of
Maybe (DisposableEvent m)
Nothing ->
String -> m ()
forall a. HasCallStack => String -> a
error String
"The handler was lost: freezeCont."
Just DisposableEvent m
h ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
Maybe (ContParams m a)
c <- Point m
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m a)) -> Event m (Maybe (ContParams m a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m a))
rc
case Maybe (ContParams m a)
c of
Maybe (ContParams m a)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams m a
c ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m a))
-> Maybe (ContParams m a) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m a))
rc Maybe (ContParams m a)
forall a. Maybe a
Nothing
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh (DisposableEvent m -> Maybe (DisposableEvent m)
forall a. a -> Maybe a
Just DisposableEvent m
h)
FrozenCont m a -> m (FrozenCont m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrozenCont m a -> m (FrozenCont m a))
-> FrozenCont m a -> m (FrozenCont m a)
forall a b. (a -> b) -> a -> b
$
Event m (Maybe (ContParams m a)) -> FrozenCont m a
forall (m :: * -> *) a.
Event m (Maybe (ContParams m a)) -> FrozenCont m a
FrozenCont (Event m (Maybe (ContParams m a)) -> FrozenCont m a)
-> Event m (Maybe (ContParams m a)) -> FrozenCont m a
forall a b. (a -> b) -> a -> b
$
(Point m -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a))
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a)))
-> (Point m -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a))
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
Maybe (ContParams m a)
c <- Point m
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m a)) -> Event m (Maybe (ContParams m a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m a))
rc
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m a))
-> Maybe (ContParams m a) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m a))
rc Maybe (ContParams m a)
forall a. Maybe a
Nothing
Maybe (ContParams m a) -> m (Maybe (ContParams m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContParams m a)
c
freezeContReentering :: MonadDES m => ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
{-# INLINABLE freezeContReentering #-}
freezeContReentering :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams m a
c a
a Event m ()
m =
(Point m -> m (FrozenCont m a)) -> Event m (FrozenCont m a)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (FrozenCont m a)) -> Event m (FrozenCont m a))
-> (Point m -> m (FrozenCont m a)) -> Event m (FrozenCont m a)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
Ref m (Maybe (DisposableEvent m))
rh <- Run m
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m))))
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall a b. (a -> b) -> a -> b
$ Maybe (DisposableEvent m)
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
Ref m (Maybe (ContParams m a))
rc <- Run m
-> Simulation m (Ref m (Maybe (ContParams m a)))
-> m (Ref m (Maybe (ContParams m a)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (ContParams m a)))
-> m (Ref m (Maybe (ContParams m a))))
-> Simulation m (Ref m (Maybe (ContParams m a)))
-> m (Ref m (Maybe (ContParams m a)))
forall a b. (a -> b) -> a -> b
$ Maybe (ContParams m a)
-> Simulation m (Ref m (Maybe (ContParams m a)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef (Maybe (ContParams m a)
-> Simulation m (Ref m (Maybe (ContParams m a))))
-> Maybe (ContParams m a)
-> Simulation m (Ref m (Maybe (ContParams m a)))
forall a b. (a -> b) -> a -> b
$
ContParams m a -> Maybe (ContParams m a)
forall a. a -> Maybe a
Just (ContParams m a -> Maybe (ContParams m a))
-> ContParams m a -> Maybe (ContParams m a)
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Int -> ContParams m a
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Int -> ContParams m a
substituteContPriority ContParams m a
c (Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPriority Point m
p)
DisposableEvent m
h <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating (ContId m -> Signal m ()) -> ContId m -> Signal m ()
forall a b. (a -> b) -> a -> b
$
ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
e ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Maybe (DisposableEvent m)
h <- Point m
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m)))
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Event m (Maybe (DisposableEvent m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
rh
case Maybe (DisposableEvent m)
h of
Maybe (DisposableEvent m)
Nothing ->
String -> m ()
forall a. HasCallStack => String -> a
error String
"The handler was lost: freezeContReentering."
Just DisposableEvent m
h ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
Maybe (ContParams m a)
c <- Point m
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m a)) -> Event m (Maybe (ContParams m a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m a))
rc
case Maybe (ContParams m a)
c of
Maybe (ContParams m a)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams m a
c ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m a))
-> Maybe (ContParams m a) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m a))
rc Maybe (ContParams m a)
forall a. Maybe a
Nothing
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh (DisposableEvent m -> Maybe (DisposableEvent m)
forall a. a -> Maybe a
Just DisposableEvent m
h)
FrozenCont m a -> m (FrozenCont m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrozenCont m a -> m (FrozenCont m a))
-> FrozenCont m a -> m (FrozenCont m a)
forall a b. (a -> b) -> a -> b
$
Event m (Maybe (ContParams m a)) -> FrozenCont m a
forall (m :: * -> *) a.
Event m (Maybe (ContParams m a)) -> FrozenCont m a
FrozenCont (Event m (Maybe (ContParams m a)) -> FrozenCont m a)
-> Event m (Maybe (ContParams m a)) -> FrozenCont m a
forall a b. (a -> b) -> a -> b
$
(Point m -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a))
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a)))
-> (Point m -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a))
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
Maybe (ContParams m a)
c <- Point m
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m a)) -> Event m (Maybe (ContParams m a))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m a))
rc
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (ContParams m a))
-> Maybe (ContParams m a) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m a))
rc Maybe (ContParams m a)
forall a. Maybe a
Nothing
case Maybe (ContParams m a)
c of
Maybe (ContParams m a)
Nothing -> Maybe (ContParams m a) -> m (Maybe (ContParams m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContParams m a)
forall a. Maybe a
Nothing
z :: Maybe (ContParams m a)
z@(Just ContParams m a
c) ->
do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
ContId m -> Event m Bool
forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contPreemptionBegun (ContId m -> Event m Bool) -> ContId m -> Event m Bool
forall a b. (a -> b) -> a -> b
$
ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
if Bool -> Bool
not Bool
f
then Maybe (ContParams m a) -> m (Maybe (ContParams m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContParams m a)
z
else do let c :: ContParams m a
c = ContParams m a
c { contCont = \a
a -> Event m ()
m }
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
sleepCont ContParams m a
forall {a}. ContParams m a
c a
a
Maybe (ContParams m a) -> m (Maybe (ContParams m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContParams m a)
forall a. Maybe a
Nothing
reenterCont :: MonadDES m => ContParams m a -> a -> Event m ()
{-# INLINE reenterCont #-}
reenterCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m a
c a
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
ContId m -> Event m Bool
forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contPreemptionBegun (ContId m -> Event m Bool) -> ContId m -> Event m Bool
forall a b. (a -> b) -> a -> b
$
ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
if Bool -> Bool
not Bool
f
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
ContId m -> Event m Bool
forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contPreemptionBegun (ContId m -> Event m Bool) -> ContId m -> Event m Bool
forall a b. (a -> b) -> a -> b
$
ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
if Bool -> Bool
not Bool
f
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c a
a
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
sleepCont ContParams m a
c a
a
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
sleepCont ContParams m a
c a
a
sleepCont :: MonadDES m => ContParams m a -> a -> Event m ()
{-# INLINABLE sleepCont #-}
sleepCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
sleepCont ContParams m a
c a
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
Ref m (Maybe (DisposableEvent m))
rh <- Run m
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m))))
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall a b. (a -> b) -> a -> b
$ Maybe (DisposableEvent m)
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
DisposableEvent m
h <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Signal m ContEvent
-> (ContEvent -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ContEvent
forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal (ContId m -> Signal m ContEvent) -> ContId m -> Signal m ContEvent
forall a b. (a -> b) -> a -> b
$
ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ((ContEvent -> Event m ()) -> Event m (DisposableEvent m))
-> (ContEvent -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \ContEvent
e ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Maybe (DisposableEvent m)
h <- Point m
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m)))
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Event m (Maybe (DisposableEvent m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
rh
case Maybe (DisposableEvent m)
h of
Maybe (DisposableEvent m)
Nothing ->
String -> m ()
forall a. HasCallStack => String -> a
error String
"The handler was lost: sleepCont."
Just DisposableEvent m
h ->
do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
case ContEvent
e of
ContEvent
ContCancellationInitiating ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
ContEvent
ContPreemptionEnding ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m a
c a
a
ContEvent
ContPreemptionBeginning ->
String -> m ()
forall a. HasCallStack => String -> a
error String
"The computation was already preempted: sleepCont."
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh (DisposableEvent m -> Maybe (DisposableEvent m)
forall a. a -> Maybe a
Just DisposableEvent m
h)
substituteCont :: MonadDES m => ContParams m a -> (a -> Event m ()) -> ContParams m a
{-# INLINE substituteCont #-}
substituteCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> (a -> Event m ()) -> ContParams m a
substituteCont ContParams m a
c a -> Event m ()
m = ContParams m a
c { contCont = m }
substituteContPriority :: MonadDES m => ContParams m a -> EventPriority -> ContParams m a
{-# INLINABLE substituteContPriority #-}
substituteContPriority :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Int -> ContParams m a
substituteContPriority ContParams m a
c Int
priority = ContParams m a
c { contCont = cont,
contAux = (contAux c) { contECont = econt,
contCCont = ccont } }
where cont :: a -> Event m ()
cont a
a =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if Int
priority Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPriority Point m
p
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Int -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c a
a
econt :: SomeException -> Event m ()
econt SomeException
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if Int
priority Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPriority Point m
p
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParamsAux m -> SomeException -> Event m ()
forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) SomeException
e
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Int -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
ContParams m a -> SomeException -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m a
c SomeException
e
ccont :: () -> Event m ()
ccont ()
e =
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
if Int
priority Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Point m -> Int
forall (m :: * -> *). Point m -> Int
pointPriority Point m
p
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParamsAux m -> () -> Event m ()
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ()
e
else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Double -> Int -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority (Event m () -> Event m ()) -> Event m () -> Event m ()
forall a b. (a -> b) -> a -> b
$
ContParamsAux m -> () -> Event m ()
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ()
e
contAwait :: MonadDES m => Signal m a -> Cont m a
{-# INLINABLE contAwait #-}
contAwait :: forall (m :: * -> *) a. MonadDES m => Signal m a -> Cont m a
contAwait Signal m a
signal =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c0 ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
FrozenCont m a
c <- Point m -> Event m (FrozenCont m a) -> m (FrozenCont m a)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (FrozenCont m a) -> m (FrozenCont m a))
-> Event m (FrozenCont m a) -> m (FrozenCont m a)
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m (FrozenCont m a)
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m (FrozenCont m a)
freezeCont ContParams m a
c0
Ref m (Maybe (DisposableEvent m))
r1 <- Run m
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m))))
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall a b. (a -> b) -> a -> b
$ Maybe (DisposableEvent m)
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
Ref m (Maybe (DisposableEvent m))
r2 <- Run m
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m))))
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
-> m (Ref m (Maybe (DisposableEvent m)))
forall a b. (a -> b) -> a -> b
$ Maybe (DisposableEvent m)
-> Simulation m (Ref m (Maybe (DisposableEvent m)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
DisposableEvent m
h1 <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
signal ((a -> Event m ()) -> Event m (DisposableEvent m))
-> (a -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
\a
a -> (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$
\Point m
p -> do Maybe (DisposableEvent m)
x1 <- Point m
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m)))
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Event m (Maybe (DisposableEvent m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
r1
Maybe (DisposableEvent m)
x2 <- Point m
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m)))
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Event m (Maybe (DisposableEvent m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
r2
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r1 Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r2 Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
case Maybe (DisposableEvent m)
x1 of
Maybe (DisposableEvent m)
Nothing ->
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just DisposableEvent m
h1 ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h1
case Maybe (DisposableEvent m)
x2 of
Maybe (DisposableEvent m)
Nothing ->
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just DisposableEvent m
h2 ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h2
Maybe (ContParams m a)
c <- Point m
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a)))
-> Event m (Maybe (ContParams m a)) -> m (Maybe (ContParams m a))
forall a b. (a -> b) -> a -> b
$ FrozenCont m a -> Event m (Maybe (ContParams m a))
forall (m :: * -> *) a.
FrozenCont m a -> Event m (Maybe (ContParams m a))
unfreezeCont FrozenCont m a
c
case Maybe (ContParams m a)
c of
Maybe (ContParams m a)
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ContParams m a
c ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m a
c a
a
DisposableEvent m
h2 <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating (ContId m -> Signal m ()) -> ContId m -> Signal m ()
forall a b. (a -> b) -> a -> b
$ ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c0) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
\()
a -> (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$
\Point m
p -> do Maybe (DisposableEvent m)
x1 <- Point m
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m)))
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Event m (Maybe (DisposableEvent m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
r1
Maybe (DisposableEvent m)
x2 <- Point m
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m)))
-> Event m (Maybe (DisposableEvent m))
-> m (Maybe (DisposableEvent m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Event m (Maybe (DisposableEvent m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
r2
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r1 Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r2 Maybe (DisposableEvent m)
forall a. Maybe a
Nothing
case Maybe (DisposableEvent m)
x1 of
Maybe (DisposableEvent m)
Nothing ->
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just DisposableEvent m
h1 ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h1
case Maybe (DisposableEvent m)
x2 of
Maybe (DisposableEvent m)
Nothing ->
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just DisposableEvent m
h2 ->
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h2
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r1 (Maybe (DisposableEvent m) -> Event m ())
-> Maybe (DisposableEvent m) -> Event m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Maybe (DisposableEvent m)
forall a. a -> Maybe a
Just DisposableEvent m
h1
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (DisposableEvent m))
-> Maybe (DisposableEvent m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r2 (Maybe (DisposableEvent m) -> Event m ())
-> Maybe (DisposableEvent m) -> Event m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Maybe (DisposableEvent m)
forall a. a -> Maybe a
Just DisposableEvent m
h2
transferCont :: MonadDES m => Cont m () -> Cont m a
{-# INLINABLE transferCont #-}
transferCont :: forall (m :: * -> *) a. MonadDES m => Cont m () -> Cont m a
transferCont Cont m ()
x =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do let worker :: m ()
worker =
do let cid :: ContId m
cid = ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
cont :: a -> Event m a
cont = a -> Event m a
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return
econt :: SomeException -> Event m a
econt = SomeException -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent
ccont :: a -> Event m a
ccont = a -> Event m a
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool) -> ContParamsAux m -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall a. HasCallStack => String -> a
error String
"Cannot be combined with the exception handling: unsafeTransferCont"
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
Cont m ()
-> (() -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m ()
x () -> Event m ()
forall a. a -> Event m a
cont SomeException -> Event m ()
forall {a}. SomeException -> Event m a
econt () -> Event m ()
forall a. a -> Event m a
ccont ContId m
cid Bool
False
Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else m ()
worker
traceCont :: MonadDES m => String -> Cont m a -> Cont m a
{-# INLINABLE traceCont #-}
traceCont :: forall (m :: * -> *) a.
MonadDES m =>
String -> Cont m a -> Cont m a
traceCont String
message (Cont ContParams m a -> Event m ()
m) =
(ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
(Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
if Bool
z
then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
else String -> m () -> m ()
forall a. String -> a -> a
trace (String
"t = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m ContParams m a
c