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