{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

-- |
-- Module     : Simulation.Aivika.Trans.Internal.Cont
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The 'Cont' monad is a variation of the standard Cont monad 
-- and F# async workflow, where the result of applying 
-- the continuations is the 'Event' computation.
--
module Simulation.Aivika.Trans.Internal.Cont
       (ContParams,
        ContCancellation(..),
        Cont(..),
        ContId,
        ContEvent(..),
        FrozenCont,
        newContId,
        contSignal,
        contCancellationInitiated,
        contCancellationInitiate,
        contCancellationInitiating,
        contCancellationActivated,
        contCancellationBind,
        contCancellationConnect,
        contPreemptionBegun,
        contPreemptionBegin,
        contPreemptionBeginning,
        contPreemptionEnd,
        contPreemptionEnding,
        invokeCont,
        runCont,
        rerunCont,
        spawnCont,
        contParallel,
        contParallel_,
        catchCont,
        finallyCont,
        throwCont,
        resumeCont,
        resumeECont,
        reenterCont,
        freezeCont,
        freezeContReentering,
        unfreezeCont,
        substituteCont,
        substituteContPriority,
        contCanceled,
        contAwait,
        transferCont,
        traceCont) where

import Data.Array
import Data.Monoid

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import qualified Control.Monad.Catch as MC
import Control.Applicative

import Debug.Trace (trace)

import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Signal

-- | It defines how the parent and child computations should be cancelled.
data ContCancellation = CancelTogether
                        -- ^ Cancel the both computations together.
                      | CancelChildAfterParent
                        -- ^ Cancel the child if its parent is cancelled.
                      | CancelParentAfterChild
                        -- ^ Cancel the parent if its child is cancelled.
                      | CancelInIsolation
                        -- ^ Cancel the computations in isolation.

-- | It identifies the 'Cont' computation.
data ContId m =
  ContId { forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef :: Ref m Bool,
           forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef :: Ref m Bool,
           forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef :: Ref m Int,
           forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource :: SignalSource m ContEvent
         }

instance MonadDES m => Eq (ContId m) where
  ContId m
x == :: ContId m -> ContId m -> Bool
== ContId m
y = forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
y

-- | The event that occurs within the 'Cont' computation.
data ContEvent = ContCancellationInitiating
                 -- ^ Cancel the computation.
               | ContPreemptionBeginning
                 -- ^ Preempt the computation.
               | ContPreemptionEnding
                 -- ^ Proceed with the computation after if was preempted.
               deriving (ContEvent -> ContEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContEvent -> ContEvent -> Bool
$c/= :: ContEvent -> ContEvent -> Bool
== :: ContEvent -> ContEvent -> Bool
$c== :: ContEvent -> ContEvent -> Bool
Eq, Eq ContEvent
ContEvent -> ContEvent -> Bool
ContEvent -> ContEvent -> Ordering
ContEvent -> ContEvent -> ContEvent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContEvent -> ContEvent -> ContEvent
$cmin :: ContEvent -> ContEvent -> ContEvent
max :: ContEvent -> ContEvent -> ContEvent
$cmax :: ContEvent -> ContEvent -> ContEvent
>= :: ContEvent -> ContEvent -> Bool
$c>= :: ContEvent -> ContEvent -> Bool
> :: ContEvent -> ContEvent -> Bool
$c> :: ContEvent -> ContEvent -> Bool
<= :: ContEvent -> ContEvent -> Bool
$c<= :: ContEvent -> ContEvent -> Bool
< :: ContEvent -> ContEvent -> Bool
$c< :: ContEvent -> ContEvent -> Bool
compare :: ContEvent -> ContEvent -> Ordering
$ccompare :: ContEvent -> ContEvent -> Ordering
Ord, Int -> ContEvent -> ShowS
[ContEvent] -> ShowS
ContEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContEvent] -> ShowS
$cshowList :: [ContEvent] -> ShowS
show :: ContEvent -> String
$cshow :: ContEvent -> String
showsPrec :: Int -> ContEvent -> ShowS
$cshowsPrec :: Int -> ContEvent -> ShowS
Show)

-- | Create a computation identifier.
newContId :: MonadDES m => Simulation m (ContId m)
{-# INLINABLE newContId #-}
newContId :: forall (m :: * -> *). MonadDES m => Simulation m (ContId m)
newContId =
  forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  do Ref m Bool
r1 <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
     Ref m Bool
r2 <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Bool
False
     Ref m Int
r3 <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
     SignalSource m ContEvent
s  <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     forall (m :: * -> *) a. Monad m => a -> m a
return ContId { contCancellationInitiatedRef :: Ref m Bool
contCancellationInitiatedRef = Ref m Bool
r1,
                     contCancellationActivatedRef :: Ref m Bool
contCancellationActivatedRef = Ref m Bool
r2,
                     contPreemptionCountRef :: Ref m Int
contPreemptionCountRef = Ref m Int
r3,
                     contSignalSource :: SignalSource m ContEvent
contSignalSource = SignalSource m ContEvent
s
                   }

-- | Signal when the computation state changes.
contSignal :: ContId m -> Signal m ContEvent
{-# INLINABLE contSignal #-}
contSignal :: forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal = forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource

-- | Signal when the cancellation is intiating.
contCancellationInitiating :: MonadDES m => ContId m -> Signal m ()
{-# INLINABLE contCancellationInitiating #-}
contCancellationInitiating :: forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating =
  forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContCancellationInitiating forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal

-- | Whether the cancellation was initiated.
contCancellationInitiated :: MonadDES m => ContId m -> Event m Bool
{-# INLINABLE contCancellationInitiated #-}
contCancellationInitiated :: forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contCancellationInitiated =
  forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef

-- | Whether the cancellation was activated.
contCancellationActivated :: MonadDES m => ContId m -> Event m Bool
{-# INLINABLE contCancellationActivated #-}
contCancellationActivated :: forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contCancellationActivated =
  forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef

-- | Deactivate the cancellation.
contCancellationDeactivate :: MonadDES m => ContId m -> Event m ()
{-# INLINABLE contCancellationDeactivate #-}
contCancellationDeactivate :: forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationDeactivate ContId m
x =
  forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
x) Bool
False

-- | If the main computation is cancelled then all the nested ones will be cancelled too.
contCancellationBind :: MonadDES m => ContId m -> [ContId m] -> Event m (DisposableEvent m)
{-# INLINABLE contCancellationBind #-}
contCancellationBind :: forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind ContId m
x [ContId m]
ys =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do [DisposableEvent m]
hs1 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ContId m]
ys forall a b. (a -> b) -> a -> b
$ \ContId m
y ->
       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
       forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
x) forall a b. (a -> b) -> a -> b
$ \()
_ ->
       forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
y
     [DisposableEvent m]
hs2 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ContId m]
ys forall a b. (a -> b) -> a -> b
$ \ContId m
y ->
       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
       forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
y) forall a b. (a -> b) -> a -> b
$ \()
_ ->
       forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
x
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [DisposableEvent m]
hs1 forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [DisposableEvent m]
hs2

-- | Connect the parent computation to the child one.
contCancellationConnect :: MonadDES m
                           => ContId m
                           -- ^ the parent
                           -> ContCancellation
                           -- ^ how to connect
                           -> ContId m
                           -- ^ the child
                           -> Event m (DisposableEvent m)
                           -- ^ computation of the disposable handler
{-# INLINABLE contCancellationConnect #-}
contCancellationConnect :: forall (m :: * -> *).
MonadDES m =>
ContId m
-> ContCancellation -> ContId m -> Event m (DisposableEvent m)
contCancellationConnect ContId m
parent ContCancellation
cancellation ContId m
child =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let m1 :: Event m (DisposableEvent m)
m1 =
           forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
parent) forall a b. (a -> b) -> a -> b
$ \()
_ ->
           forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
child
         m2 :: Event m (DisposableEvent m)
m2 =
           forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
child) forall a b. (a -> b) -> a -> b
$ \()
_ ->
           forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
parent
     DisposableEvent m
h1 <- 
       case ContCancellation
cancellation of
         ContCancellation
CancelTogether -> forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m1
         ContCancellation
CancelChildAfterParent -> forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m1
         ContCancellation
CancelParentAfterChild -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
         ContCancellation
CancelInIsolation -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     DisposableEvent m
h2 <-
       case ContCancellation
cancellation of
         ContCancellation
CancelTogether -> forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m2
         ContCancellation
CancelChildAfterParent -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
         ContCancellation
CancelParentAfterChild -> forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m2
         ContCancellation
CancelInIsolation -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DisposableEvent m
h1 forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
h2

-- | Initiate the cancellation.
contCancellationInitiate :: MonadDES m => ContId m -> Event m ()
{-# INLINABLE contCancellationInitiate #-}
contCancellationInitiate :: forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
x =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
f <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x) Bool
True
          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
x) Bool
True
          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContCancellationInitiating

-- | Preempt the computation.
contPreemptionBegin :: MonadDES m => ContId m -> Event m ()
{-# INLINABLE contPreemptionBegin #-}
contPreemptionBegin :: forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contPreemptionBegin ContId m
x =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
f <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do Int
n <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
          let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ Int
1
          Int
n' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x) Int
n'
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContPreemptionBeginning

-- | Proceed with the computation after it was preempted earlier.
contPreemptionEnd :: MonadDES m => ContId m -> Event m ()
{-# INLINABLE contPreemptionEnd #-}
contPreemptionEnd :: forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contPreemptionEnd ContId m
x =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
f <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do Int
n <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
          let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
- Int
1
          Int
n' seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x) Int
n'
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContPreemptionEnding

-- | Signal when the computation is preempted.
contPreemptionBeginning :: MonadDES m => ContId m -> Signal m ()
{-# INLINABLE contPreemptionBeginning #-}
contPreemptionBeginning :: forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contPreemptionBeginning =
  forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContPreemptionBeginning forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal

-- | Signal when the computation is proceeded after it was preempted before.
contPreemptionEnding :: MonadDES m => ContId m -> Signal m ()
{-# INLINABLE contPreemptionEnding #-}
contPreemptionEnding :: forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contPreemptionEnding =
  forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContPreemptionEnding forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal

-- | Whether the computation was preemtped.
contPreemptionBegun :: MonadDES m => ContId m -> Event m Bool
{-# INLINABLE contPreemptionBegun #-}
contPreemptionBegun :: forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contPreemptionBegun ContId m
x =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
n <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
     forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n forall a. Ord a => a -> a -> Bool
> Int
0)

-- | The 'Cont' type is similar to the standard Cont monad 
-- and F# async workflow but only the result of applying
-- the continuations return the 'Event' computation.
newtype Cont m a = Cont (ContParams m a -> Event m ())

-- | The continuation parameters.
data ContParams m a = 
  ContParams { forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont :: a -> Event m (), 
               forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux  :: ContParamsAux m }

-- | The auxiliary continuation parameters.
data ContParamsAux m =
  ContParamsAux { forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont :: SomeException -> Event m (),
                  forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont :: () -> Event m (),
                  forall (m :: * -> *). ContParamsAux m -> ContId m
contId :: ContId m,
                  forall (m :: * -> *). ContParamsAux m -> Ref m Bool
contCancelRef :: Ref m Bool,
                  forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag  :: Bool }

instance MonadDES m => Monad (Cont m) where

  {-# INLINE (>>=) #-}
  (Cont ContParams m a -> Event m ()
m) >>= :: forall a b. Cont m a -> (a -> Cont m b) -> Cont m b
>>= a -> Cont m b
k =
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m b
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m b
c
       if Bool
z 
         then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m b
c
         else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m forall a b. (a -> b) -> a -> b
$ 
              let cont :: a -> Event m ()
cont a
a = forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m b
c (a -> Cont m b
k a
a)
              in ContParams m b
c { contCont :: a -> Event m ()
contCont = a -> Event m ()
cont }

instance MonadDES m => MonadCompTrans Cont m where

  {-# INLINE liftComp #-}
  liftComp :: forall a. m a -> Cont m a
liftComp m a
m =
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    if forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c
    then forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching m a
m Point m
p ContParams m a
c
    else forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching m a
m Point m
p ContParams m a
c

instance MonadDES m => ParameterLift Cont m where

  {-# INLINE liftParameter #-}
  liftParameter :: forall a. Parameter m a -> Cont m a
liftParameter (Parameter Run m -> m a
m) = 
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    if forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c
    then forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (Run m -> m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) Point m
p ContParams m a
c
    else forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (Run m -> m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) Point m
p ContParams m a
c

instance MonadDES m => SimulationLift Cont m where

  {-# INLINE liftSimulation #-}
  liftSimulation :: forall a. Simulation m a -> Cont m a
liftSimulation (Simulation Run m -> m a
m) = 
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    if forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c
    then forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (Run m -> m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) Point m
p ContParams m a
c
    else forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (Run m -> m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point m
p) Point m
p ContParams m a
c

instance MonadDES m => DynamicsLift Cont m where

  {-# INLINE liftDynamics #-}
  liftDynamics :: forall a. Dynamics m a -> Cont m a
liftDynamics (Dynamics Point m -> m a
m) = 
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    if forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c
    then forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (Point m -> m a
m Point m
p) Point m
p ContParams m a
c
    else forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (Point m -> m a
m Point m
p) Point m
p ContParams m a
c

instance MonadDES m => EventLift Cont m where

  {-# INLINE liftEvent #-}
  liftEvent :: forall a. Event m a -> Cont m a
liftEvent (Event Point m -> m a
m) = 
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    if forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c
    then forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (Point m -> m a
m Point m
p) Point m
p ContParams m a
c
    else forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (Point m -> m a
m Point m
p) Point m
p ContParams m a
c

instance (MonadDES m, MonadIO m) => MonadIO (Cont m) where

  {-# INLINE liftIO #-}
  liftIO :: forall a. IO a -> Cont m a
liftIO IO a
m =
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    if forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c
    then forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m) Point m
p ContParams m a
c
    else forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m) Point m
p ContParams m a
c

instance MonadDES m => Functor (Cont m) where

  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> Cont m a -> Cont m b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance MonadDES m => Applicative (Cont m) where

  {-# INLINE pure #-}
  pure :: forall a. a -> Cont m a
pure a
a = 
    forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
    do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
       if Bool
z 
         then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
         else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a

  {-# INLINE (<*>) #-}
  <*> :: forall a b. Cont m (a -> b) -> Cont m a -> Cont m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance MonadDES m => MC.MonadThrow (Cont m) where

  {-# INLINE throwM #-}
  throwM :: forall e a. Exception e => e -> Cont m a
throwM = forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Cont m a
throwCont

instance MonadDES m => MC.MonadCatch (Cont m) where

  {-# INLINE catch #-}
  catch :: forall e a. Exception e => Cont m a -> (e -> Cont m a) -> Cont m a
catch = forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Cont m a -> (e -> Cont m a) -> Cont m a
catchCont

-- | Invoke the computation.
invokeCont :: ContParams m a -> Cont m a -> Event m ()
{-# INLINE invokeCont #-}
invokeCont :: forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m a
p (Cont ContParams m a -> Event m ()
m) = ContParams m a -> Event m ()
m ContParams m a
p

-- | Cancel the computation.
cancelCont :: MonadDES m => ContParams m a -> Event m ()
{-# NOINLINE cancelCont #-}
cancelCont :: forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationDeactivate (forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c)
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ()

-- | Like @return a >>= k@.
callCont :: MonadDES m => (a -> Cont m b) -> a -> ContParams m b -> Event m ()
{-# INLINABLE callCont #-}
callCont :: forall (m :: * -> *) a b.
MonadDES m =>
(a -> Cont m b) -> a -> ContParams m b -> Event m ()
callCont a -> Cont m b
k a
a ContParams m b
c =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m b
c
     if Bool
z 
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m b
c
       else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m b
c (a -> Cont m b
k a
a)

-- | Exception handling within 'Cont' computations.
catchCont :: (MonadDES m, Exception e) => Cont m a -> (e -> Cont m a) -> Cont m a
{-# INLINABLE catchCont #-}
catchCont :: forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
Cont m a -> (e -> Cont m a) -> Cont m a
catchCont (Cont ContParams m a -> Event m ()
m) e -> Cont m a
h = 
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c0 ->
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p -> 
  do let c :: ContParams m a
c = ContParams m a
c0 { contAux :: ContParamsAux m
contAux = (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c0) { contCatchFlag :: Bool
contCatchFlag = Bool
True } }
     Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z 
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m forall a b. (a -> b) -> a -> b
$
            let econt :: SomeException -> Event m ()
econt SomeException
e0 =
                  case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e0 of
                    Just e
e  -> forall (m :: * -> *) a b.
MonadDES m =>
(a -> Cont m b) -> a -> ContParams m b -> Event m ()
callCont e -> Cont m a
h e
e ContParams m a
c
                    Maybe e
Nothing -> (forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c) SomeException
e0
            in ContParams m a
c { contAux :: ContParamsAux m
contAux = (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) { contECont :: SomeException -> Event m ()
contECont = SomeException -> Event m ()
econt } }
               
-- | A computation with finalization part.
finallyCont :: MonadDES m => Cont m a -> Cont m b -> Cont m a
{-# INLINABLE finallyCont #-}
finallyCont :: forall (m :: * -> *) a b.
MonadDES m =>
Cont m a -> Cont m b -> Cont m a
finallyCont (Cont ContParams m a -> Event m ()
m) (Cont ContParams m b -> Event m ()
m') = 
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c0 -> 
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let c :: ContParams m a
c = ContParams m a
c0 { contAux :: ContParamsAux m
contAux = (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c0) { contCatchFlag :: Bool
contCatchFlag = Bool
True } }
     Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z 
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m forall a b. (a -> b) -> a -> b
$
            let cont :: a -> Event m ()
cont a
a   = 
                  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                  forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' forall a b. (a -> b) -> a -> b
$
                  let cont :: p -> Event m ()
cont p
b = forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
                  in ContParams m a
c { contCont :: b -> Event m ()
contCont = forall {p}. p -> Event m ()
cont }
                econt :: SomeException -> Event m ()
econt SomeException
e  =
                  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                  forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' forall a b. (a -> b) -> a -> b
$
                  let cont :: p -> Event m ()
cont p
b = (forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c) SomeException
e
                  in ContParams m a
c { contCont :: b -> Event m ()
contCont = forall {p}. p -> Event m ()
cont }
                ccont :: () -> Event m ()
ccont () = 
                  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                  forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' forall a b. (a -> b) -> a -> b
$
                  let cont :: p -> Event m ()
cont p
b  = (forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c) ()
                      econt :: p -> Event m ()
econt p
e = (forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux forall a b. (a -> b) -> a -> b
$ ContParams m a
c) ()
                  in ContParams m a
c { contCont :: b -> Event m ()
contCont = forall {p}. p -> Event m ()
cont,
                         contAux :: ContParamsAux m
contAux  = (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) { contECont :: SomeException -> Event m ()
contECont = forall {p}. p -> Event m ()
econt } }
            in ContParams m a
c { contCont :: a -> Event m ()
contCont = a -> Event m ()
cont,
                   contAux :: ContParamsAux m
contAux  = (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) { contECont :: SomeException -> Event m ()
contECont = SomeException -> Event m ()
econt,
                                            contCCont :: () -> Event m ()
contCCont = () -> Event m ()
ccont } }

-- | Throw the exception with the further exception handling.
--
-- By some reason, an exception raised with help of the standard 'throw' function
-- is not handled properly within 'Cont' computation, altough it will be still handled 
-- if it will be wrapped in the 'IO' monad. Therefore, you should use specialised
-- functions like the stated one that use the 'throw' function but within the 'IO' computation,
-- which allows already handling the exception.
throwCont :: (MonadDES m, Exception e) => e -> Cont m a
{-# INLINABLE throwCont #-}
throwCont :: forall (m :: * -> *) e a.
(MonadDES m, Exception e) =>
e -> Cont m a
throwCont = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent

-- | Run the 'Cont' computation with the specified cancelation source 
-- and flag indicating whether to catch exceptions from the beginning.
runCont :: MonadDES m
           => Cont m a
           -- ^ the computation to run
           -> (a -> Event m ())
           -- ^ the main branch 
           -> (SomeException -> Event m ())
           -- ^ the branch for handing exceptions
           -> (() -> Event m ())
           -- ^ the branch for cancellation
           -> ContId m
           -- ^ the computation identifier
           -> Bool
           -- ^ whether to support the exception handling from the beginning
           -> Event m ()
{-# INLINABLE runCont #-}
runCont :: forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont (Cont ContParams m a -> Event m ()
m) a -> Event m ()
cont SomeException -> Event m ()
econt () -> Event m ()
ccont ContId m
cid Bool
catchFlag = 
  ContParams m a -> Event m ()
m ContParams { contCont :: a -> Event m ()
contCont = a -> Event m ()
cont,
                 contAux :: ContParamsAux m
contAux  = 
                   ContParamsAux { contECont :: SomeException -> Event m ()
contECont = SomeException -> Event m ()
econt,
                                   contCCont :: () -> Event m ()
contCCont = () -> Event m ()
ccont,
                                   contId :: ContId m
contId    = ContId m
cid,
                                   contCancelRef :: Ref m Bool
contCancelRef = forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
cid, 
                                   contCatchFlag :: Bool
contCatchFlag  = Bool
catchFlag } }
  
liftWithoutCatching :: MonadDES m => m a -> Point m -> ContParams m a -> m ()
{-# INLINE liftWithoutCatching #-}
liftWithoutCatching :: forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching m a
m Point m
p ContParams m a
c =
  do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else do a
a <- m a
m
               forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a

liftWithCatching :: MonadDES m => m a -> Point m -> ContParams m a -> m ()
{-# NOINLINE liftWithCatching #-}
liftWithCatching :: forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithCatching m a
m Point m
p ContParams m a
c =
  do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else do let r :: Run m
r = forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
               Ref m a
aref <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. HasCallStack => a
undefined
               Ref m (Maybe SomeException)
eref <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
               forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp
                 (m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m a
aref) 
                 (forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe SomeException)
eref forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
               Maybe SomeException
e <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
eref
               case Maybe SomeException
e of
                 Maybe SomeException
Nothing -> 
                   do a
a <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m a
aref
                      -- tail recursive
                      forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
                 Just SomeException
e ->
                   -- tail recursive
                   forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux) ContParams m a
c SomeException
e

-- | Resume the computation by the specified parameters.
resumeCont :: MonadDES m => ContParams m a -> a -> Event m ()
{-# INLINE resumeCont #-}
resumeCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c a
a = 
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a

-- | Resume the exception handling by the specified parameters.
resumeECont :: MonadDES m => ContParams m a -> SomeException -> Event m ()
{-# INLINE resumeECont #-}
resumeECont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m a
c SomeException
e = 
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) SomeException
e

-- | Test whether the computation is canceled.
contCanceled :: MonadDES m => ContParams m a -> Event m Bool
{-# INLINE contCanceled #-}
contCanceled :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c = forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ContParamsAux m -> Ref m Bool
contCancelRef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c

-- | Execute the specified computations in parallel within
-- the current computation and return their results. The cancellation
-- of any of the nested computations affects the current computation.
-- The exception raised in any of the nested computations is propogated
-- to the current computation as well (if the exception handling is
-- supported).
--
-- Here word @parallel@ literally means that the computations are
-- actually executed on a single operating system thread but
-- they are processed simultaneously by the event queue.
contParallel :: MonadDES m
                => [(Cont m a, ContId m)]
                -- ^ the list of pairs:
                -- the nested computation,
                -- the computation identifier
                -> Cont m [a]
{-# INLINABLE contParallel #-}
contParallel :: forall (m :: * -> *) a.
MonadDES m =>
[(Cont m a, ContId m)] -> Cont m [a]
contParallel [(Cont m a, ContId m)]
xs =
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m [a]
c ->
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Cont m a, ContId m)]
xs
         r :: Run m
r = forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
         worker :: m ()
worker =
           do [Ref m a]
results   <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1..Int
n] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. HasCallStack => a
undefined
              Ref m Int
counter   <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
              Ref m (Maybe SomeException)
catchRef  <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
              DisposableEvent m
hs <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind (forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m [a]
c) forall a b. (a -> b) -> a -> b
$
                    forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Cont m a, ContId m)]
xs
              let propagate :: Event m ()
propagate =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Int
n' <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Int
counter
                       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' forall a. Eq a => a -> a -> Bool
== Int
n) forall a b. (a -> b) -> a -> b
$
                         do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation sources
                            Bool
f1 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m [a]
c
                            Maybe SomeException
f2 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
                            case (Bool
f1, Maybe SomeException
f2) of
                              (Bool
False, Maybe SomeException
Nothing) ->
                                do [a]
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ref m a]
results forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef
                                   forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m [a]
c [a]
rs
                              (Bool
False, Just SomeException
e) ->
                                forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m [a]
c SomeException
e
                              (Bool
True, Maybe SomeException
_) ->
                                forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m [a]
c
                  cont :: Ref m a -> a -> Event m ()
cont Ref m a
result a
a =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m a
result a
a
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
                  econt :: SomeException -> Event m ()
econt SomeException
e =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       Maybe SomeException
r <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
                       case Maybe SomeException
r of
                         Maybe SomeException
Nothing -> forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe SomeException)
catchRef forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeException
e
                         Just SomeException
e' -> forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- ignore the next error
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
                  ccont :: p -> Event m ()
ccont p
e =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       -- the main computation was automatically canceled
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Ref m a]
results [(Cont m a, ContId m)]
xs) forall a b. (a -> b) -> a -> b
$ \(Ref m a
result, (Cont m a
x, ContId m
cid)) ->
                forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m a
x (forall {a}. Ref m a -> a -> Event m ()
cont Ref m a
result) SomeException -> Event m ()
econt forall {p}. p -> Event m ()
ccont ContId m
cid (forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m [a]
c)
     Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m [a]
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m [a]
c
       else if Int
n forall a. Eq a => a -> a -> Bool
== Int
0
            then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m [a]
c []
            else m ()
worker

-- | A partial case of 'contParallel' when we are not interested in
-- the results but we are interested in the actions to be peformed by
-- the nested computations.
contParallel_ :: MonadDES m
                 => [(Cont m a, ContId m)]
                 -- ^ the list of pairs:
                 -- the nested computation,
                 -- the computation identifier
                 -> Cont m ()
{-# INLINABLE contParallel_ #-}
contParallel_ :: forall (m :: * -> *) a.
MonadDES m =>
[(Cont m a, ContId m)] -> Cont m ()
contParallel_ [(Cont m a, ContId m)]
xs =
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Cont m a, ContId m)]
xs
         r :: Run m
r = forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
         worker :: m ()
worker =
           do Ref m Int
counter  <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
              Ref m (Maybe SomeException)
catchRef <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
              DisposableEvent m
hs <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind (forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m ()
c) forall a b. (a -> b) -> a -> b
$
                    forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Cont m a, ContId m)]
xs
              let propagate :: Event m ()
propagate =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Int
n' <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Int
counter
                       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' forall a. Eq a => a -> a -> Bool
== Int
n) forall a b. (a -> b) -> a -> b
$
                         do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation sources
                            Bool
f1 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m ()
c
                            Maybe SomeException
f2 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
                            case (Bool
f1, Maybe SomeException
f2) of
                              (Bool
False, Maybe SomeException
Nothing) ->
                                forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
                              (Bool
False, Just SomeException
e) ->
                                forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m ()
c SomeException
e
                              (Bool
True, Maybe SomeException
_) ->
                                forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m ()
c
                  cont :: p -> Event m ()
cont p
a =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       -- ignore the result
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
                  econt :: SomeException -> Event m ()
econt SomeException
e =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       Maybe SomeException
r <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
                       case Maybe SomeException
r of
                         Maybe SomeException
Nothing -> forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe SomeException)
catchRef forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeException
e
                         Just SomeException
e' -> forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- ignore the next error
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
                  ccont :: p -> Event m ()
ccont p
e =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       -- the main computation was automatically canceled
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1] [(Cont m a, ContId m)]
xs) forall a b. (a -> b) -> a -> b
$ \(Int
i, (Cont m a
x, ContId m
cid)) ->
                forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m a
x forall {p}. p -> Event m ()
cont SomeException -> Event m ()
econt forall {p}. p -> Event m ()
ccont ContId m
cid (forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m ()
c)
     Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m ()
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m ()
c
       else if Int
n forall a. Eq a => a -> a -> Bool
== Int
0
            then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m ()
c ()
            else m ()
worker

-- | Rerun the 'Cont' computation with the specified identifier.
rerunCont :: MonadDES m => Cont m a -> ContId m -> Cont m a
{-# INLINABLE rerunCont #-}
rerunCont :: forall (m :: * -> *) a.
MonadDES m =>
Cont m a -> ContId m -> Cont m a
rerunCont Cont m a
x ContId m
cid =
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let worker :: m ()
worker =
           do DisposableEvent m
hs <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind (forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) [ContId m
cid]
              let cont :: a -> Event m ()
cont a
a  =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation source
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c a
a
                  econt :: SomeException -> Event m ()
econt SomeException
e =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation source
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m a
c SomeException
e
                  ccont :: p -> Event m ()
ccont p
e =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation source
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m a
x a -> Event m ()
cont SomeException -> Event m ()
econt forall {p}. p -> Event m ()
ccont ContId m
cid (forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c)
     Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else m ()
worker

-- | Run the 'Cont' computation in parallel but connect the computations.
spawnCont :: MonadDES m => ContCancellation -> Cont m () -> ContId m -> Cont m ()
{-# INLINABLE spawnCont #-}
spawnCont :: forall (m :: * -> *).
MonadDES m =>
ContCancellation -> Cont m () -> ContId m -> Cont m ()
spawnCont ContCancellation
cancellation Cont m ()
x ContId m
cid =
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let worker :: m ()
worker =
           do DisposableEvent m
hs <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *).
MonadDES m =>
ContId m
-> ContCancellation -> ContId m -> Event m (DisposableEvent m)
contCancellationConnect
                    (forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m ()
c) ContCancellation
cancellation ContId m
cid
              let cont :: p -> Event m ()
cont p
a  =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation source
                       -- do nothing and it will finish the computation
                  econt :: e -> Event m a
econt e
e =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation source
                       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent e
e  -- this is all we can do
                  ccont :: p -> Event m ()
ccont p
e =
                    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation source
                       -- do nothing and it will finish the computation
              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m ()
x forall {p}. p -> Event m ()
cont forall {e} {a}. Exception e => e -> Event m a
econt forall {p}. p -> Event m ()
ccont ContId m
cid Bool
False
              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
     Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m ()
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m ()
c
       else m ()
worker

-- | Represents a temporarily frozen computation.
newtype FrozenCont m a =
  FrozenCont { forall (m :: * -> *) a.
FrozenCont m a -> Event m (Maybe (ContParams m a))
unfreezeCont :: Event m (Maybe (ContParams m a))
               -- ^ Unfreeze the computation.
             }

-- | Freeze the computation parameters temporarily.
freezeCont :: MonadDES m => ContParams m a -> Event m (FrozenCont m a)
{-# INLINABLE freezeCont #-}
freezeCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m (FrozenCont m a)
freezeCont ContParams m a
c =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let r :: Run m
r = forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
     Ref m (Maybe (DisposableEvent m))
rh <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
     Ref m (Maybe (ContParams m a))
rc <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a b. (a -> b) -> a -> b
$
       forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Int -> ContParams m a
substituteContPriority ContParams m a
c (forall (m :: * -> *). Point m -> Int
pointPriority Point m
p)  
     DisposableEvent m
h <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating forall a b. (a -> b) -> a -> b
$
                        forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$
                        forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) forall a b. (a -> b) -> a -> b
$ \()
e ->
          forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
          do Maybe (DisposableEvent m)
h <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
rh
             case Maybe (DisposableEvent m)
h of
               Maybe (DisposableEvent m)
Nothing ->
                 forall a. HasCallStack => String -> a
error String
"The handler was lost: freezeCont."
               Just DisposableEvent m
h ->
                 do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh forall a. Maybe a
Nothing
                    forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
                    Maybe (ContParams m a)
c <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m a))
rc
                    case Maybe (ContParams m a)
c of
                      Maybe (ContParams m a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      Just ContParams m a
c  ->
                        do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m a))
rc forall a. Maybe a
Nothing
                           forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                             forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a b. (a -> b) -> a -> b
$
                             forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                             do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
                                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh (forall a. a -> Maybe a
Just DisposableEvent m
h)
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
       forall (m :: * -> *) a.
Event m (Maybe (ContParams m a)) -> FrozenCont m a
FrozenCont forall a b. (a -> b) -> a -> b
$
       forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
       do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
          Maybe (ContParams m a)
c <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m a))
rc
          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m a))
rc forall a. Maybe a
Nothing
          forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContParams m a)
c

-- | Freeze the computation parameters specifying what should be done when reentering the computation.
freezeContReentering :: MonadDES m => ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
{-# INLINABLE freezeContReentering #-}
freezeContReentering :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m () -> Event m (FrozenCont m a)
freezeContReentering ContParams m a
c a
a Event m ()
m =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let r :: Run m
r = forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
     Ref m (Maybe (DisposableEvent m))
rh <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
     Ref m (Maybe (ContParams m a))
rc <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a b. (a -> b) -> a -> b
$
       forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Int -> ContParams m a
substituteContPriority ContParams m a
c (forall (m :: * -> *). Point m -> Int
pointPriority Point m
p)
     DisposableEvent m
h <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating forall a b. (a -> b) -> a -> b
$
                        forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) forall a b. (a -> b) -> a -> b
$ \()
e ->
          forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
          do Maybe (DisposableEvent m)
h <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
rh
             case Maybe (DisposableEvent m)
h of
               Maybe (DisposableEvent m)
Nothing ->
                 forall a. HasCallStack => String -> a
error String
"The handler was lost: freezeContReentering."
               Just DisposableEvent m
h ->
                 do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh forall a. Maybe a
Nothing
                    forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
                    Maybe (ContParams m a)
c <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m a))
rc
                    case Maybe (ContParams m a)
c of
                      Maybe (ContParams m a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      Just ContParams m a
c  ->
                        do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m a))
rc forall a. Maybe a
Nothing
                           forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                             forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a b. (a -> b) -> a -> b
$
                             forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                             do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
                                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh (forall a. a -> Maybe a
Just DisposableEvent m
h)
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
       forall (m :: * -> *) a.
Event m (Maybe (ContParams m a)) -> FrozenCont m a
FrozenCont forall a b. (a -> b) -> a -> b
$
       forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
       do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
          Maybe (ContParams m a)
c <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (ContParams m a))
rc
          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (ContParams m a))
rc forall a. Maybe a
Nothing
          case Maybe (ContParams m a)
c of
            Maybe (ContParams m a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            z :: Maybe (ContParams m a)
z@(Just ContParams m a
c) ->
              do Bool
f <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                      forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contPreemptionBegun forall a b. (a -> b) -> a -> b
$
                      forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
                 if Bool -> Bool
not Bool
f
                   then forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContParams m a)
z
                   else do let c :: ContParams m a
c = ContParams m a
c { contCont :: a -> Event m ()
contCont = \a
a -> Event m ()
m }
                           forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
sleepCont forall {a}. ContParams m a
c a
a
                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
     
-- | Reenter the computation parameters when needed.
reenterCont :: MonadDES m => ContParams m a -> a -> Event m ()
{-# INLINE reenterCont #-}
reenterCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m a
c a
a =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
f <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contPreemptionBegun forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
     if Bool -> Bool
not Bool
f
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
            do Bool
f <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *). MonadDES m => ContId m -> Event m Bool
contPreemptionBegun forall a b. (a -> b) -> a -> b
$
                    forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
               if Bool -> Bool
not Bool
f
                 then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                      forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c a
a
                 else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                      forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
sleepCont ContParams m a
c a
a
       else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
sleepCont ContParams m a
c a
a

-- | Sleep until the preempted computation will be reentered.
sleepCont :: MonadDES m => ContParams m a -> a -> Event m ()
{-# INLINABLE sleepCont #-}
sleepCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
sleepCont ContParams m a
c a
a =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let r :: Run m
r = forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
     Ref m (Maybe (DisposableEvent m))
rh <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
     DisposableEvent m
h  <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
           forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal forall a b. (a -> b) -> a -> b
$
                         forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) forall a b. (a -> b) -> a -> b
$ \ContEvent
e ->
           forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
           do Maybe (DisposableEvent m)
h <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
rh
              case Maybe (DisposableEvent m)
h of
                Maybe (DisposableEvent m)
Nothing ->
                  forall a. HasCallStack => String -> a
error String
"The handler was lost: sleepCont."
                Just DisposableEvent m
h ->
                  do forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh forall a. Maybe a
Nothing
                     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h
                     case ContEvent
e of
                       ContEvent
ContCancellationInitiating ->
                         forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                         forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a b. (a -> b) -> a -> b
$
                         forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                         do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
                            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
                       ContEvent
ContPreemptionEnding ->
                         forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                         forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a b. (a -> b) -> a -> b
$
                         forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m a
c a
a
                       ContEvent
ContPreemptionBeginning ->
                         forall a. HasCallStack => String -> a
error String
"The computation was already preempted: sleepCont."
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
rh (forall a. a -> Maybe a
Just DisposableEvent m
h)

-- | Substitute the continuation.
substituteCont :: MonadDES m => ContParams m a -> (a -> Event m ()) -> ContParams m a
{-# INLINE substituteCont #-}
substituteCont :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> (a -> Event m ()) -> ContParams m a
substituteCont ContParams m a
c a -> Event m ()
m = ContParams m a
c { contCont :: a -> Event m ()
contCont = a -> Event m ()
m }

-- | Substitute the continuation priority.
substituteContPriority :: MonadDES m => ContParams m a -> EventPriority -> ContParams m a
{-# INLINABLE substituteContPriority #-}
substituteContPriority :: forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Int -> ContParams m a
substituteContPriority ContParams m a
c Int
priority = ContParams m a
c { contCont :: a -> Event m ()
contCont = a -> Event m ()
cont,
                                        contAux :: ContParamsAux m
contAux  = (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) { contECont :: SomeException -> Event m ()
contECont = SomeException -> Event m ()
econt,
                                                                 contCCont :: () -> Event m ()
contCCont = () -> Event m ()
ccont } }
  where cont :: a -> Event m ()
cont a
a =
          forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
          if Int
priority forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). Point m -> Int
pointPriority Point m
p
          then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
          else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m a
c a
a
        econt :: SomeException -> Event m ()
econt SomeException
e =
          forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
          if Int
priority forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). Point m -> Int
pointPriority Point m
p
          then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) SomeException
e
          else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m a
c SomeException
e
        ccont :: () -> Event m ()
ccont ()
e =
          forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
          if Int
priority forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). Point m -> Int
pointPriority Point m
p
          then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ()
e
          else forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *).
EventQueueing m =>
Double -> Int -> Event m () -> Event m ()
enqueueEventWithPriority (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) Int
priority forall a b. (a -> b) -> a -> b
$
               forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ()
e

-- | Await the signal.
contAwait :: MonadDES m => Signal m a -> Cont m a
{-# INLINABLE contAwait #-}
contAwait :: forall (m :: * -> *) a. MonadDES m => Signal m a -> Cont m a
contAwait Signal m a
signal =
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c0 ->
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let r :: Run m
r = forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
     FrozenCont m a
c <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m (FrozenCont m a)
freezeCont ContParams m a
c0
     Ref m (Maybe (DisposableEvent m))
r1 <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
     Ref m (Maybe (DisposableEvent m))
r2 <- forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef forall a. Maybe a
Nothing
     DisposableEvent m
h1 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
           forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal Signal m a
signal forall a b. (a -> b) -> a -> b
$ 
           \a
a -> forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ 
                 \Point m
p -> do Maybe (DisposableEvent m)
x1 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
r1
                          Maybe (DisposableEvent m)
x2 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
r2
                          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r1 forall a. Maybe a
Nothing
                          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r2 forall a. Maybe a
Nothing
                          case Maybe (DisposableEvent m)
x1 of
                            Maybe (DisposableEvent m)
Nothing ->
                              forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just DisposableEvent m
h1 ->
                              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h1
                          case Maybe (DisposableEvent m)
x2 of
                            Maybe (DisposableEvent m)
Nothing ->
                              forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just DisposableEvent m
h2 ->
                              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h2
                          Maybe (ContParams m a)
c <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
FrozenCont m a -> Event m (Maybe (ContParams m a))
unfreezeCont FrozenCont m a
c
                          case Maybe (ContParams m a)
c of
                            Maybe (ContParams m a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just ContParams m a
c  ->
                              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
reenterCont ContParams m a
c a
a
     DisposableEvent m
h2 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
           forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c0) forall a b. (a -> b) -> a -> b
$
           \()
a -> forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$
                 \Point m
p -> do Maybe (DisposableEvent m)
x1 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
r1
                          Maybe (DisposableEvent m)
x2 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe (DisposableEvent m))
r2
                          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r1 forall a. Maybe a
Nothing
                          forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r2 forall a. Maybe a
Nothing
                          case Maybe (DisposableEvent m)
x1 of
                            Maybe (DisposableEvent m)
Nothing ->
                              forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just DisposableEvent m
h1 ->
                              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h1
                          case Maybe (DisposableEvent m)
x2 of
                            Maybe (DisposableEvent m)
Nothing ->
                              forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just DisposableEvent m
h2 ->
                              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
h2
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r1 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just DisposableEvent m
h1          
     forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe (DisposableEvent m))
r2 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just DisposableEvent m
h2

-- | Like the GoTo statement it transfers the direction of computation,
-- but raises an exception when used within 'catchCont' or 'finallyCont'.
transferCont :: MonadDES m => Cont m () -> Cont m a
{-# INLINABLE transferCont #-}
transferCont :: forall (m :: * -> *) a. MonadDES m => Cont m () -> Cont m a
transferCont Cont m ()
x =
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let worker :: m ()
worker =
           do let cid :: ContId m
cid   = forall (m :: * -> *). ContParamsAux m -> ContId m
contId forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
                  cont :: a -> Event m a
cont  = forall (m :: * -> *) a. Monad m => a -> m a
return
                  econt :: SomeException -> Event m a
econt = forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent
                  ccont :: a -> Event m a
ccont = forall (m :: * -> *) a. Monad m => a -> m a
return
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) forall a b. (a -> b) -> a -> b
$
                forall a. HasCallStack => String -> a
error String
"Cannot be combined with the exception handling: unsafeTransferCont"
              forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m ()
x forall {a}. a -> Event m a
cont forall {a}. SomeException -> Event m a
econt forall {a}. a -> Event m a
ccont ContId m
cid Bool
False
     Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else m ()
worker

-- | Show the debug message with the current simulation time.
traceCont :: MonadDES m => String -> Cont m a -> Cont m a
{-# INLINABLE traceCont #-}
traceCont :: forall (m :: * -> *) a.
MonadDES m =>
String -> Cont m a -> Cont m a
traceCont String
message (Cont ContParams m a -> Event m ()
m) =
  forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
z <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else forall a. String -> a -> a
trace (String
"t = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (m :: * -> *). Point m -> Double
pointTime Point m
p) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
message) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m ContParams m a
c