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