{-# 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 = ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x Ref m Bool -> Ref m Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
y

-- | 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
(ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> Bool) -> Eq ContEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContEvent -> ContEvent -> Bool
== :: ContEvent -> ContEvent -> Bool
$c/= :: ContEvent -> ContEvent -> Bool
/= :: ContEvent -> ContEvent -> Bool
Eq, Eq ContEvent
Eq ContEvent =>
(ContEvent -> ContEvent -> Ordering)
-> (ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> Bool)
-> (ContEvent -> ContEvent -> ContEvent)
-> (ContEvent -> ContEvent -> ContEvent)
-> Ord ContEvent
ContEvent -> ContEvent -> Bool
ContEvent -> ContEvent -> Ordering
ContEvent -> ContEvent -> ContEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ContEvent -> ContEvent -> Ordering
compare :: ContEvent -> ContEvent -> Ordering
$c< :: ContEvent -> ContEvent -> Bool
< :: ContEvent -> ContEvent -> Bool
$c<= :: ContEvent -> ContEvent -> Bool
<= :: ContEvent -> ContEvent -> Bool
$c> :: ContEvent -> ContEvent -> Bool
> :: ContEvent -> ContEvent -> Bool
$c>= :: ContEvent -> ContEvent -> Bool
>= :: ContEvent -> ContEvent -> Bool
$cmax :: ContEvent -> ContEvent -> ContEvent
max :: ContEvent -> ContEvent -> ContEvent
$cmin :: ContEvent -> ContEvent -> ContEvent
min :: ContEvent -> ContEvent -> ContEvent
Ord, Int -> ContEvent -> ShowS
[ContEvent] -> ShowS
ContEvent -> String
(Int -> ContEvent -> ShowS)
-> (ContEvent -> String)
-> ([ContEvent] -> ShowS)
-> Show ContEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContEvent -> ShowS
showsPrec :: Int -> ContEvent -> ShowS
$cshow :: ContEvent -> String
show :: ContEvent -> String
$cshowList :: [ContEvent] -> ShowS
showList :: [ContEvent] -> ShowS
Show)

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

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

-- | 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 =
  (ContEvent -> Bool) -> Signal m ContEvent -> Signal m ()
forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContCancellationInitiating ContEvent -> ContEvent -> Bool
forall a. Eq a => a -> a -> Bool
==) (Signal m ContEvent -> Signal m ())
-> (ContId m -> Signal m ContEvent) -> ContId m -> Signal m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Signal m ContEvent
forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal

-- | 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 =
  Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Ref m Bool -> Event m Bool)
-> (ContId m -> Ref m Bool) -> ContId m -> Event m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef

-- | 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 =
  Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Ref m Bool -> Event m Bool)
-> (ContId m -> Ref m Bool) -> ContId m -> Event m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef

-- | 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 =
  Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
x) Bool
False

-- | 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 =
  (Point m -> m (DisposableEvent m)) -> Event m (DisposableEvent m)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (DisposableEvent m)) -> Event m (DisposableEvent m))
-> (Point m -> m (DisposableEvent m))
-> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do [DisposableEvent m]
hs1 <- [ContId m]
-> (ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ContId m]
ys ((ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m])
-> (ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m]
forall a b. (a -> b) -> a -> b
$ \ContId m
y ->
       Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
       Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
x) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
       ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
y
     [DisposableEvent m]
hs2 <- [ContId m]
-> (ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ContId m]
ys ((ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m])
-> (ContId m -> m (DisposableEvent m)) -> m [DisposableEvent m]
forall a b. (a -> b) -> a -> b
$ \ContId m
y ->
       Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
       Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
y) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
       ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
x
     DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent m -> m (DisposableEvent m))
-> DisposableEvent m -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ [DisposableEvent m] -> DisposableEvent m
forall a. Monoid a => [a] -> a
mconcat [DisposableEvent m]
hs1 DisposableEvent m -> DisposableEvent m -> DisposableEvent m
forall a. Semigroup a => a -> a -> a
<> [DisposableEvent m] -> DisposableEvent m
forall a. Monoid a => [a] -> a
mconcat [DisposableEvent m]
hs2

-- | 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 =
  (Point m -> m (DisposableEvent m)) -> Event m (DisposableEvent m)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m (DisposableEvent m)) -> Event m (DisposableEvent m))
-> (Point m -> m (DisposableEvent m))
-> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let m1 :: Event m (DisposableEvent m)
m1 =
           Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
parent) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
           ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
child
         m2 :: Event m (DisposableEvent m)
m2 =
           Signal m () -> (() -> Event m ()) -> Event m (DisposableEvent m)
forall (m :: * -> *) a.
Signal m a -> (a -> Event m ()) -> Event m (DisposableEvent m)
handleSignal (ContId m -> Signal m ()
forall (m :: * -> *). MonadDES m => ContId m -> Signal m ()
contCancellationInitiating ContId m
child) ((() -> Event m ()) -> Event m (DisposableEvent m))
-> (() -> Event m ()) -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ \()
_ ->
           ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationInitiate ContId m
parent
     DisposableEvent m
h1 <- 
       case ContCancellation
cancellation of
         ContCancellation
CancelTogether -> Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m1
         ContCancellation
CancelChildAfterParent -> Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m1
         ContCancellation
CancelParentAfterChild -> DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent m
forall a. Monoid a => a
mempty
         ContCancellation
CancelInIsolation -> DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent m
forall a. Monoid a => a
mempty
     DisposableEvent m
h2 <-
       case ContCancellation
cancellation of
         ContCancellation
CancelTogether -> Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m2
         ContCancellation
CancelChildAfterParent -> DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent m
forall a. Monoid a => a
mempty
         ContCancellation
CancelParentAfterChild -> Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m (DisposableEvent m)
m2
         ContCancellation
CancelInIsolation -> DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DisposableEvent m
forall a. Monoid a => a
mempty
     DisposableEvent m -> m (DisposableEvent m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DisposableEvent m -> m (DisposableEvent m))
-> DisposableEvent m -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$ DisposableEvent m
h1 DisposableEvent m -> DisposableEvent m -> DisposableEvent m
forall a. Semigroup a => a -> a -> a
<> DisposableEvent m
h2

-- | 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 =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
     Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
       do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x) Bool
True
          Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
x) Bool
True
          Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ SignalSource m ContEvent -> ContEvent -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (ContId m -> SignalSource m ContEvent
forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContCancellationInitiating

-- | 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 =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
     Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
       do Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
          let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          Int
n' Int -> m () -> m ()
forall a b. a -> b -> b
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x) Int
n'
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
            SignalSource m ContEvent -> ContEvent -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (ContId m -> SignalSource m ContEvent
forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContPreemptionBeginning

-- | 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 =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
f <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationInitiatedRef ContId m
x)
     Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
       do Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
          let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          Int
n' Int -> m () -> m ()
forall a b. a -> b -> b
`seq` Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x) Int
n'
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
            SignalSource m ContEvent -> ContEvent -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (ContId m -> SignalSource m ContEvent
forall (m :: * -> *). ContId m -> SignalSource m ContEvent
contSignalSource ContId m
x) ContEvent
ContPreemptionEnding

-- | 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 =
  (ContEvent -> Bool) -> Signal m ContEvent -> Signal m ()
forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContPreemptionBeginning ContEvent -> ContEvent -> Bool
forall a. Eq a => a -> a -> Bool
==) (Signal m ContEvent -> Signal m ())
-> (ContId m -> Signal m ContEvent) -> ContId m -> Signal m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Signal m ContEvent
forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal

-- | 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 =
  (ContEvent -> Bool) -> Signal m ContEvent -> Signal m ()
forall (m :: * -> *) a.
MonadDES m =>
(a -> Bool) -> Signal m a -> Signal m ()
filterSignal_ (ContEvent
ContPreemptionEnding ContEvent -> ContEvent -> Bool
forall a. Eq a => a -> a -> Bool
==) (Signal m ContEvent -> Signal m ())
-> (ContId m -> Signal m ContEvent) -> ContId m -> Signal m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId m -> Signal m ContEvent
forall (m :: * -> *). ContId m -> Signal m ContEvent
contSignal

-- | 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 =
  (Point m -> m Bool) -> Event m Bool
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m Bool) -> Event m Bool)
-> (Point m -> m Bool) -> Event m Bool
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
n <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (ContId m -> Ref m Int
forall (m :: * -> *). ContId m -> Ref m Int
contPreemptionCountRef ContId m
x)
     Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)

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

instance MonadDES m => MonadCompTrans Cont m where

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

instance MonadDES m => ParameterLift Cont m where

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

instance MonadDES m => SimulationLift Cont m where

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

instance MonadDES m => DynamicsLift Cont m where

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

instance MonadDES m => EventLift Cont m where

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

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

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

instance MonadDES m => Functor (Cont m) where

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

instance MonadDES m => Applicative (Cont m) where

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

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

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

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

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

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

-- | 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 =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContId m -> Event m ()
forall (m :: * -> *). MonadDES m => ContId m -> Event m ()
contCancellationDeactivate (ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c)
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ (ContParamsAux m -> () -> Event m ()
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (ContParamsAux m -> () -> Event m ())
-> ContParamsAux m -> () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) ()

-- | 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 =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m b
c
     if Bool
z 
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m b
c
       else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Cont m b -> Event m ()
forall (m :: * -> *) a. ContParams m a -> Cont m a -> Event m ()
invokeCont ContParams m b
c (a -> Cont m b
k a
a)

-- | 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 = 
  (ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c0 ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p -> 
  do let c :: ContParams m a
c = ContParams m a
c0 { contAux = (contAux c0) { contCatchFlag = True } }
     Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z 
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m (ContParams m a -> Event m ()) -> ContParams m a -> Event m ()
forall a b. (a -> b) -> a -> b
$
            let econt :: SomeException -> Event m ()
econt SomeException
e0 =
                  case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e0 of
                    Just e
e  -> (e -> Cont m a) -> e -> ContParams m a -> Event m ()
forall (m :: * -> *) a b.
MonadDES m =>
(a -> Cont m b) -> a -> ContParams m b -> Event m ()
callCont e -> Cont m a
h e
e ContParams m a
c
                    Maybe e
Nothing -> (ContParamsAux m -> SomeException -> Event m ()
forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (ContParamsAux m -> SomeException -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> SomeException
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> SomeException -> Event m ())
-> ContParams m a -> SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a
c) SomeException
e0
            in ContParams m a
c { contAux = (contAux c) { contECont = econt } }
               
-- | 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') = 
  (ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c0 -> 
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let c :: ContParams m a
c = ContParams m a
c0 { contAux = (contAux c0) { contCatchFlag = True } }
     Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z 
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m (ContParams m a -> Event m ()) -> ContParams m a -> Event m ()
forall a b. (a -> b) -> a -> b
$
            let cont :: a -> Event m ()
cont a
a   = 
                  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                  Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' (ContParams m b -> Event m ()) -> ContParams m b -> Event m ()
forall a b. (a -> b) -> a -> b
$
                  let cont :: p -> Event m ()
cont p
b = ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a
                  in ContParams m a
c { contCont = cont }
                econt :: SomeException -> Event m ()
econt SomeException
e  =
                  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                  Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' (ContParams m b -> Event m ()) -> ContParams m b -> Event m ()
forall a b. (a -> b) -> a -> b
$
                  let cont :: p -> Event m ()
cont p
b = (ContParamsAux m -> SomeException -> Event m ()
forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (ContParamsAux m -> SomeException -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> SomeException
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> SomeException -> Event m ())
-> ContParams m a -> SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a
c) SomeException
e
                  in ContParams m a
c { contCont = cont }
                ccont :: () -> Event m ()
ccont () = 
                  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                  Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m b -> Event m ()
m' (ContParams m b -> Event m ()) -> ContParams m b -> Event m ()
forall a b. (a -> b) -> a -> b
$
                  let cont :: p -> Event m ()
cont p
b  = (ContParamsAux m -> () -> Event m ()
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (ContParamsAux m -> () -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> ()
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> () -> Event m ())
-> ContParams m a -> () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a
c) ()
                      econt :: p -> Event m ()
econt p
e = (ContParamsAux m -> () -> Event m ()
forall (m :: * -> *). ContParamsAux m -> () -> Event m ()
contCCont (ContParamsAux m -> () -> Event m ())
-> (ContParams m a -> ContParamsAux m)
-> ContParams m a
-> ()
-> Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux (ContParams m a -> () -> Event m ())
-> ContParams m a -> () -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a
c) ()
                  in ContParams m a
c { contCont = cont,
                         contAux  = (contAux c) { contECont = econt } }
            in ContParams m a
c { contCont = cont,
                   contAux  = (contAux c) { contECont = econt,
                                            contCCont = ccont } }

-- | 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 = Event m a -> Cont m a
forall a. Event m a -> Cont m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
EventLift t m =>
Event m a -> t m a
liftEvent (Event m a -> Cont m a) -> (e -> Event m a) -> e -> Cont m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent

-- | 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 = ContId m -> Ref m Bool
forall (m :: * -> *). ContId m -> Ref m Bool
contCancellationActivatedRef ContId m
cid, 
                                   contCatchFlag :: Bool
contCatchFlag  = Bool
catchFlag } }
  
liftWithoutCatching :: MonadDES m => m a -> Point m -> ContParams m a -> m ()
{-# INLINE liftWithoutCatching #-}
liftWithoutCatching :: forall (m :: * -> *) a.
MonadDES m =>
m a -> Point m -> ContParams m a -> m ()
liftWithoutCatching m a
m Point m
p ContParams m a
c =
  do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else do a
a <- m a
m
               Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a

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

-- | 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 = 
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> a -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m a
c a
a

-- | 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 = 
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ (ContParamsAux m -> SomeException -> Event m ()
forall (m :: * -> *).
ContParamsAux m -> SomeException -> Event m ()
contECont (ContParamsAux m -> SomeException -> Event m ())
-> ContParamsAux m -> SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) SomeException
e

-- | 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 = Ref m Bool -> Event m Bool
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Ref m Bool -> Event m Bool) -> Ref m Bool -> Event m Bool
forall a b. (a -> b) -> a -> b
$ ContParamsAux m -> Ref m Bool
forall (m :: * -> *). ContParamsAux m -> Ref m Bool
contCancelRef (ContParamsAux m -> Ref m Bool) -> ContParamsAux m -> Ref m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c

-- | 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 =
  (ContParams m [a] -> Event m ()) -> Cont m [a]
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m [a] -> Event m ()) -> Cont m [a])
-> (ContParams m [a] -> Event m ()) -> Cont m [a]
forall a b. (a -> b) -> a -> b
$ \ContParams m [a]
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let n :: Int
n = [(Cont m a, ContId m)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Cont m a, ContId m)]
xs
         r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
         worker :: m ()
worker =
           do [Ref m a]
results   <- [Int] -> (Int -> m (Ref m a)) -> m [Ref m a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1..Int
n] ((Int -> m (Ref m a)) -> m [Ref m a])
-> (Int -> m (Ref m a)) -> m [Ref m a]
forall a b. (a -> b) -> a -> b
$ \Int
i -> Run m -> Simulation m (Ref m a) -> m (Ref m a)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m a) -> m (Ref m a))
-> Simulation m (Ref m a) -> m (Ref m a)
forall a b. (a -> b) -> a -> b
$ a -> Simulation m (Ref m a)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef a
forall a. HasCallStack => a
undefined
              Ref m Int
counter   <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
              Ref m (Maybe SomeException)
catchRef  <- Run m
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe SomeException))
 -> m (Ref m (Maybe SomeException)))
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> Simulation m (Ref m (Maybe SomeException))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe SomeException
forall a. Maybe a
Nothing
              DisposableEvent m
hs <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
                    ContId m -> [ContId m] -> Event m (DisposableEvent m)
forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind (ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m [a]
c) ([ContId m] -> Event m (DisposableEvent m))
-> [ContId m] -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
                    ((Cont m a, ContId m) -> ContId m)
-> [(Cont m a, ContId m)] -> [ContId m]
forall a b. (a -> b) -> [a] -> [b]
map (Cont m a, ContId m) -> ContId m
forall a b. (a, b) -> b
snd [(Cont m a, ContId m)]
xs
              let propagate :: Event m ()
propagate =
                    (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Int
n' <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Int
counter
                       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation sources
                            Bool
f1 <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m [a]
c
                            Maybe SomeException
f2 <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
                            case (Bool
f1, Maybe SomeException
f2) of
                              (Bool
False, Maybe SomeException
Nothing) ->
                                do [a]
rs <- [Ref m a] -> (Ref m a -> m a) -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Ref m a]
results ((Ref m a -> m a) -> m [a]) -> (Ref m a -> m a) -> m [a]
forall a b. (a -> b) -> a -> b
$ Point m -> Event m a -> m a
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m a -> m a) -> (Ref m a -> Event m a) -> Ref m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> Event m a
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef
                                   Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> [a] -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m [a]
c [a]
rs
                              (Bool
False, Just SomeException
e) ->
                                Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> SomeException -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m [a]
c SomeException
e
                              (Bool
True, Maybe SomeException
_) ->
                                Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m [a]
c
                  cont :: Ref m a -> a -> Event m ()
cont Ref m a
result a
a =
                    (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                       Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m a
result a
a
                       Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
                  econt :: SomeException -> Event m ()
econt SomeException
e =
                    (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                       Maybe SomeException
r <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
                       case Maybe SomeException
r of
                         Maybe SomeException
Nothing -> Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Maybe SomeException -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe SomeException)
catchRef (Maybe SomeException -> Event m ())
-> Maybe SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
                         Just SomeException
e' -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- ignore the next error
                       Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
                  ccont :: p -> Event m ()
ccont p
e =
                    (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                       -- the main computation was automatically canceled
                       Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
              [(Ref m a, (Cont m a, ContId m))]
-> ((Ref m a, (Cont m a, ContId m)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Ref m a]
-> [(Cont m a, ContId m)] -> [(Ref m a, (Cont m a, ContId m))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ref m a]
results [(Cont m a, ContId m)]
xs) (((Ref m a, (Cont m a, ContId m)) -> m ()) -> m ())
-> ((Ref m a, (Cont m a, ContId m)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Ref m a
result, (Cont m a
x, ContId m
cid)) ->
                Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m a
x (Ref m a -> a -> Event m ()
forall a. Ref m a -> a -> Event m ()
cont Ref m a
result) SomeException -> Event m ()
econt () -> Event m ()
forall {p}. p -> Event m ()
ccont ContId m
cid (ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool) -> ContParamsAux m -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m [a]
c)
     Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m [a]
c
     if Bool
z
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m [a]
c
       else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m [a] -> [a] -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m [a]
c []
            else m ()
worker

-- | 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 =
  (ContParams m () -> Event m ()) -> Cont m ()
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m () -> Event m ()) -> Cont m ())
-> (ContParams m () -> Event m ()) -> Cont m ()
forall a b. (a -> b) -> a -> b
$ \ContParams m ()
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let n :: Int
n = [(Cont m a, ContId m)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Cont m a, ContId m)]
xs
         r :: Run m
r = Point m -> Run m
forall (m :: * -> *). Point m -> Run m
pointRun Point m
p
         worker :: m ()
worker =
           do Ref m Int
counter  <- Run m -> Simulation m (Ref m Int) -> m (Ref m Int)
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m Int) -> m (Ref m Int))
-> Simulation m (Ref m Int) -> m (Ref m Int)
forall a b. (a -> b) -> a -> b
$ Int -> Simulation m (Ref m Int)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
              Ref m (Maybe SomeException)
catchRef <- Run m
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall (m :: * -> *) a. Run m -> Simulation m a -> m a
invokeSimulation Run m
r (Simulation m (Ref m (Maybe SomeException))
 -> m (Ref m (Maybe SomeException)))
-> Simulation m (Ref m (Maybe SomeException))
-> m (Ref m (Maybe SomeException))
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> Simulation m (Ref m (Maybe SomeException))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe SomeException
forall a. Maybe a
Nothing
              DisposableEvent m
hs <- Point m -> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (DisposableEvent m) -> m (DisposableEvent m))
-> Event m (DisposableEvent m) -> m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
                    ContId m -> [ContId m] -> Event m (DisposableEvent m)
forall (m :: * -> *).
MonadDES m =>
ContId m -> [ContId m] -> Event m (DisposableEvent m)
contCancellationBind (ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m () -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m ()
c) ([ContId m] -> Event m (DisposableEvent m))
-> [ContId m] -> Event m (DisposableEvent m)
forall a b. (a -> b) -> a -> b
$
                    ((Cont m a, ContId m) -> ContId m)
-> [(Cont m a, ContId m)] -> [ContId m]
forall a b. (a -> b) -> [a] -> [b]
map (Cont m a, ContId m) -> ContId m
forall a b. (a, b) -> b
snd [(Cont m a, ContId m)]
xs
              let propagate :: Event m ()
propagate =
                    (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Int
n' <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m Int
counter
                       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                         do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent m -> Event m ()
forall (m :: * -> *). DisposableEvent m -> Event m ()
disposeEvent DisposableEvent m
hs  -- unbind the cancellation sources
                            Bool
f1 <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m ()
c
                            Maybe SomeException
f2 <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
                            case (Bool
f1, Maybe SomeException
f2) of
                              (Bool
False, Maybe SomeException
Nothing) ->
                                Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> a -> Event m ()
resumeCont ContParams m ()
c ()
                              (Bool
False, Just SomeException
e) ->
                                Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> SomeException -> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> SomeException -> Event m ()
resumeECont ContParams m ()
c SomeException
e
                              (Bool
True, Maybe SomeException
_) ->
                                Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m ()
c
                  cont :: p -> Event m ()
cont p
a =
                    (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                       -- ignore the result
                       Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
                  econt :: SomeException -> Event m ()
econt SomeException
e =
                    (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                       Maybe SomeException
r <- Point m -> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe SomeException) -> m (Maybe SomeException))
-> Event m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Event m (Maybe SomeException)
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef Ref m (Maybe SomeException)
catchRef
                       case Maybe SomeException
r of
                         Maybe SomeException
Nothing -> Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe SomeException) -> Maybe SomeException -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef Ref m (Maybe SomeException)
catchRef (Maybe SomeException -> Event m ())
-> Maybe SomeException -> Event m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
                         Just SomeException
e' -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- ignore the next error
                       Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
                  ccont :: p -> Event m ()
ccont p
e =
                    (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
                    do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef Ref m Int
counter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                       -- the main computation was automatically canceled
                       Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
propagate
              [(Int, (Cont m a, ContId m))]
-> ((Int, (Cont m a, ContId m)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [(Cont m a, ContId m)] -> [(Int, (Cont m a, ContId m))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] [(Cont m a, ContId m)]
xs) (((Int, (Cont m a, ContId m)) -> m ()) -> m ())
-> ((Int, (Cont m a, ContId m)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (Cont m a
x, ContId m
cid)) ->
                Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m a
x a -> Event m ()
forall {p}. p -> Event m ()
cont SomeException -> Event m ()
econt () -> Event m ()
forall {p}. p -> Event m ()
ccont ContId m
cid (ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool) -> ContParamsAux m -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m () -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m ()
c)
     Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m ()
c
     if Bool
z
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m ()
c
       else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m () -> () -> Event m ()
forall (m :: * -> *) a. ContParams m a -> a -> Event m ()
contCont ContParams m ()
c ()
            else m ()
worker

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

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

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

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

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

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

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

-- | 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 =
  (ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let worker :: m ()
worker =
           do let cid :: ContId m
cid   = ContParamsAux m -> ContId m
forall (m :: * -> *). ContParamsAux m -> ContId m
contId (ContParamsAux m -> ContId m) -> ContParamsAux m -> ContId m
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c
                  cont :: a -> Event m a
cont  = a -> Event m a
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                  econt :: SomeException -> Event m a
econt = SomeException -> Event m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Event m a
throwEvent
                  ccont :: a -> Event m a
ccont = a -> Event m a
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ContParamsAux m -> Bool
forall (m :: * -> *). ContParamsAux m -> Bool
contCatchFlag (ContParamsAux m -> Bool) -> ContParamsAux m -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> ContParamsAux m
forall (m :: * -> *) a. ContParams m a -> ContParamsAux m
contAux ContParams m a
c) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                String -> m ()
forall a. HasCallStack => String -> a
error String
"Cannot be combined with the exception handling: unsafeTransferCont"
              Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Cont m ()
-> (() -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
forall (m :: * -> *) a.
MonadDES m =>
Cont m a
-> (a -> Event m ())
-> (SomeException -> Event m ())
-> (() -> Event m ())
-> ContId m
-> Bool
-> Event m ()
runCont Cont m ()
x () -> Event m ()
forall a. a -> Event m a
cont SomeException -> Event m ()
forall {a}. SomeException -> Event m a
econt () -> Event m ()
forall a. a -> Event m a
ccont ContId m
cid Bool
False
     Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else m ()
worker

-- | 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) =
  (ContParams m a -> Event m ()) -> Cont m a
forall (m :: * -> *) a. (ContParams m a -> Event m ()) -> Cont m a
Cont ((ContParams m a -> Event m ()) -> Cont m a)
-> (ContParams m a -> Event m ()) -> Cont m a
forall a b. (a -> b) -> a -> b
$ \ContParams m a
c ->
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Bool
z <- Point m -> Event m Bool -> m Bool
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Bool -> m Bool) -> Event m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m Bool
forall (m :: * -> *) a.
MonadDES m =>
ContParams m a -> Event m Bool
contCanceled ContParams m a
c
     if Bool
z
       then Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
forall (m :: * -> *) a. MonadDES m => ContParams m a -> Event m ()
cancelCont ContParams m a
c
       else String -> m () -> m ()
forall a. String -> a -> a
trace (String
"t = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ ContParams m a -> Event m ()
m ContParams m a
c