-- |
-- Module     : Simulation.Aivika.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
--
-- This is an internal implementation module that should never be used directly.
--
-- 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.Internal.Cont
       (ContCancellation(..),
        ContId,
        ContEvent(..),
        Cont(..),
        ContParams,
        FrozenCont,
        newContId,
        contSignal,
        contCancellationInitiated,
        contCancellationInitiate,
        contCancellationInitiating,
        contCancellationActivated,
        contCancellationBind,
        contCancellationConnect,
        contPreemptionBegun,
        contPreemptionBegin,
        contPreemptionBeginning,
        contPreemptionEnd,
        contPreemptionEnding,
        invokeCont,
        runCont,
        rerunCont,
        spawnCont,
        contParallel,
        contParallel_,
        catchCont,
        finallyCont,
        throwCont,
        resumeCont,
        resumeECont,
        reenterCont,
        freezeCont,
        freezeContReentering,
        unfreezeCont,
        substituteCont,
        substituteContPriority,
        contCanceled,
        contAwait,
        transferCont,
        traceCont) where

import Data.IORef
import Data.Array
import Data.Array.IO.Safe
import Data.Monoid

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

import Debug.Trace

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Parameter
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Signal

-- | 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 =
  ContId { ContId -> IORef Bool
contCancellationInitiatedRef :: IORef Bool,
           ContId -> IORef Bool
contCancellationActivatedRef :: IORef Bool,
           ContId -> IORef Int
contPreemptionCountRef :: IORef Int,
           ContId -> SignalSource ContEvent
contSignalSource :: SignalSource ContEvent
         }

instance Eq ContId where
  ContId
x == :: ContId -> ContId -> Bool
== ContId
y = ContId -> IORef Bool
contCancellationInitiatedRef ContId
x forall a. Eq a => a -> a -> Bool
== ContId -> IORef Bool
contCancellationInitiatedRef ContId
y  -- unique references

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

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

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

-- | Signal when the cancellation is intiating.
contCancellationInitiating :: ContId -> Signal ()
contCancellationInitiating :: ContId -> Signal ()
contCancellationInitiating =
  forall a. (a -> Bool) -> Signal a -> Signal ()
filterSignal_ (ContEvent
ContCancellationInitiating forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId -> Signal ContEvent
contSignal

-- | Whether the cancellation was initiated.
contCancellationInitiated :: ContId -> Event Bool
contCancellationInitiated :: ContId -> Event Bool
contCancellationInitiated ContId
x =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p -> forall a. IORef a -> IO a
readIORef (ContId -> IORef Bool
contCancellationInitiatedRef ContId
x)

-- | Whether the cancellation was activated.
contCancellationActivated :: ContId -> IO Bool
contCancellationActivated :: ContId -> IO Bool
contCancellationActivated =
  forall a. IORef a -> IO a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId -> IORef Bool
contCancellationActivatedRef

-- | Deactivate the cancellation.
contCancellationDeactivate :: ContId -> IO ()
contCancellationDeactivate :: ContId -> IO ()
contCancellationDeactivate ContId
x =
  forall a. IORef a -> a -> IO ()
writeIORef (ContId -> IORef Bool
contCancellationActivatedRef ContId
x) Bool
False

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

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

-- | Initiate the cancellation.
contCancellationInitiate :: ContId -> Event ()
contCancellationInitiate :: ContId -> Event ()
contCancellationInitiate ContId
x =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool
f <- forall a. IORef a -> IO a
readIORef (ContId -> IORef Bool
contCancellationInitiatedRef ContId
x)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do forall a. IORef a -> a -> IO ()
writeIORef (ContId -> IORef Bool
contCancellationInitiatedRef ContId
x) Bool
True
          forall a. IORef a -> a -> IO ()
writeIORef (ContId -> IORef Bool
contCancellationActivatedRef ContId
x) Bool
True
          forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
            forall a. SignalSource a -> a -> Event ()
triggerSignal (ContId -> SignalSource ContEvent
contSignalSource ContId
x) ContEvent
ContCancellationInitiating

-- | Preempt the computation.
contPreemptionBegin :: ContId -> Event ()
contPreemptionBegin :: ContId -> Event ()
contPreemptionBegin ContId
x =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool
f <- forall a. IORef a -> IO a
readIORef (ContId -> IORef Bool
contCancellationInitiatedRef ContId
x)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do Int
n <- forall a. IORef a -> IO a
readIORef (ContId -> IORef Int
contPreemptionCountRef ContId
x)
          let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ Int
1
          Int
n' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (ContId -> IORef Int
contPreemptionCountRef ContId
x) Int
n'
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
            forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
            forall a. SignalSource a -> a -> Event ()
triggerSignal (ContId -> SignalSource ContEvent
contSignalSource ContId
x) ContEvent
ContPreemptionBeginning

-- | Proceed with the computation after it was preempted earlier.
contPreemptionEnd :: ContId -> Event ()
contPreemptionEnd :: ContId -> Event ()
contPreemptionEnd ContId
x =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool
f <- forall a. IORef a -> IO a
readIORef (ContId -> IORef Bool
contCancellationInitiatedRef ContId
x)
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do Int
n <- forall a. IORef a -> IO a
readIORef (ContId -> IORef Int
contPreemptionCountRef ContId
x)
          let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
- Int
1
          Int
n' seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef (ContId -> IORef Int
contPreemptionCountRef ContId
x) Int
n'
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
            forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
            forall a. SignalSource a -> a -> Event ()
triggerSignal (ContId -> SignalSource ContEvent
contSignalSource ContId
x) ContEvent
ContPreemptionEnding

-- | Signal when the computation is preempted.
contPreemptionBeginning :: ContId -> Signal ()
contPreemptionBeginning :: ContId -> Signal ()
contPreemptionBeginning =
  forall a. (a -> Bool) -> Signal a -> Signal ()
filterSignal_ (ContEvent
ContPreemptionBeginning forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContId -> Signal ContEvent
contSignal

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

-- | Whether the computation was preemtped.
contPreemptionBegun :: ContId -> Event Bool
contPreemptionBegun :: ContId -> Event Bool
contPreemptionBegun ContId
x =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
n <- forall a. IORef a -> IO a
readIORef (ContId -> IORef Int
contPreemptionCountRef ContId
x)
     forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n forall a. Ord a => a -> a -> Bool
> Int
0)

-- | 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 a = Cont (ContParams a -> Event ())

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

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

instance Monad Cont where
  Cont a
m >>= :: forall a b. Cont a -> (a -> Cont b) -> Cont b
>>= a -> Cont b
k = forall a b. Cont a -> (a -> Cont b) -> Cont b
bindC Cont a
m a -> Cont b
k

instance ParameterLift Cont where
  liftParameter :: forall a. Parameter a -> Cont a
liftParameter = forall a. Parameter a -> Cont a
liftPC

instance SimulationLift Cont where
  liftSimulation :: forall a. Simulation a -> Cont a
liftSimulation = forall a. Simulation a -> Cont a
liftSC

instance DynamicsLift Cont where
  liftDynamics :: forall a. Dynamics a -> Cont a
liftDynamics = forall a. Dynamics a -> Cont a
liftDC

instance EventLift Cont where
  liftEvent :: forall a. Event a -> Cont a
liftEvent = forall a. Event a -> Cont a
liftEC

instance Functor Cont where
  fmap :: forall a b. (a -> b) -> Cont a -> Cont b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative Cont where
  pure :: forall a. a -> Cont a
pure = forall a. a -> Cont a
returnC
  <*> :: forall a b. Cont (a -> b) -> Cont a -> Cont b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance MonadIO Cont where
  liftIO :: forall a. IO a -> Cont a
liftIO = forall a. IO a -> Cont a
liftIOC 

instance MC.MonadThrow Cont where
  throwM :: forall e a. Exception e => e -> Cont a
throwM = forall e a. Exception e => e -> Cont a
throwCont

instance MC.MonadCatch Cont where
  catch :: forall e a. Exception e => Cont a -> (e -> Cont a) -> Cont a
catch = forall e a. Exception e => Cont a -> (e -> Cont a) -> Cont a
catchCont

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

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

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

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

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

-- | 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 :: Exception e => e -> Cont a
throwCont :: forall e a. Exception e => e -> Cont a
throwCont = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Exception e => e -> a
throw

-- | Run the 'Cont' computation with the specified cancelation source 
-- and flag indicating whether to catch exceptions from the beginning.
runCont :: Cont a
           -- ^ the computation to run
           -> (a -> Event ())
           -- ^ the main branch 
           -> (SomeException -> Event ())
           -- ^ the branch for handing exceptions
           -> (() -> Event ())
           -- ^ the branch for cancellation
           -> ContId
           -- ^ the computation identifier
           -> Bool
           -- ^ whether to support the exception handling from the beginning
           -> Event ()
runCont :: forall a.
Cont a
-> (a -> Event ())
-> (SomeException -> Event ())
-> (() -> Event ())
-> ContId
-> Bool
-> Event ()
runCont (Cont ContParams a -> Event ()
m) a -> Event ()
cont SomeException -> Event ()
econt () -> Event ()
ccont ContId
cid Bool
catchFlag = 
  ContParams a -> Event ()
m ContParams { contCont :: a -> Event ()
contCont = a -> Event ()
cont,
                 contAux :: ContParamsAux
contAux  = 
                   ContParamsAux { contECont :: SomeException -> Event ()
contECont = SomeException -> Event ()
econt,
                                   contCCont :: () -> Event ()
contCCont = () -> Event ()
ccont,
                                   contId :: ContId
contId = ContId
cid,
                                   contCancelRef :: IORef Bool
contCancelRef = ContId -> IORef Bool
contCancellationActivatedRef ContId
cid, 
                                   contCatchFlag :: Bool
contCatchFlag  = Bool
catchFlag } }

-- | Lift the 'Parameter' computation.
liftPC :: Parameter a -> Cont a
liftPC :: forall a. Parameter a -> Cont a
liftPC (Parameter Run -> IO a
m) = 
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  if ContParamsAux -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ContParams a -> ContParamsAux
contAux forall a b. (a -> b) -> a -> b
$ ContParams a
c
  then forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithCatch (Run -> IO a
m forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p) Point
p ContParams a
c
  else forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithoutCatch (Run -> IO a
m forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p) Point
p ContParams a
c

-- | Lift the 'Simulation' computation.
liftSC :: Simulation a -> Cont a
liftSC :: forall a. Simulation a -> Cont a
liftSC (Simulation Run -> IO a
m) = 
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  if ContParamsAux -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ContParams a -> ContParamsAux
contAux forall a b. (a -> b) -> a -> b
$ ContParams a
c
  then forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithCatch (Run -> IO a
m forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p) Point
p ContParams a
c
  else forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithoutCatch (Run -> IO a
m forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p) Point
p ContParams a
c
     
-- | Lift the 'Dynamics' computation.
liftDC :: Dynamics a -> Cont a
liftDC :: forall a. Dynamics a -> Cont a
liftDC (Dynamics Point -> IO a
m) =
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  if ContParamsAux -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ContParams a -> ContParamsAux
contAux forall a b. (a -> b) -> a -> b
$ ContParams a
c
  then forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithCatch (Point -> IO a
m Point
p) Point
p ContParams a
c
  else forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithoutCatch (Point -> IO a
m Point
p) Point
p ContParams a
c
     
-- | Lift the 'Event' computation.
liftEC :: Event a -> Cont a
liftEC :: forall a. Event a -> Cont a
liftEC (Event Point -> IO a
m) =
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  if ContParamsAux -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ContParams a -> ContParamsAux
contAux forall a b. (a -> b) -> a -> b
$ ContParams a
c
  then forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithCatch (Point -> IO a
m Point
p) Point
p ContParams a
c
  else forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithoutCatch (Point -> IO a
m Point
p) Point
p ContParams a
c
     
-- | Lift the IO computation.
liftIOC :: IO a -> Cont a
liftIOC :: forall a. IO a -> Cont a
liftIOC IO a
m =
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  if ContParamsAux -> Bool
contCatchFlag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ContParams a -> ContParamsAux
contAux forall a b. (a -> b) -> a -> b
$ ContParams a
c
  then forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithCatch IO a
m Point
p ContParams a
c
  else forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithoutCatch IO a
m Point
p ContParams a
c
  
liftIOWithoutCatch :: IO a -> Point -> ContParams a -> IO ()
{-# INLINE liftIOWithoutCatch #-}
liftIOWithoutCatch :: forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithoutCatch IO a
m Point
p ContParams a
c =
  do Bool
z <- forall a. ContParams a -> IO Bool
contCanceled ContParams a
c
     if Bool
z
       then forall a. Point -> ContParams a -> IO ()
cancelCont Point
p ContParams a
c
       else do a
a <- IO a
m
               forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
contCont ContParams a
c a
a

liftIOWithCatch :: IO a -> Point -> ContParams a -> IO ()
{-# NOINLINE liftIOWithCatch #-}
liftIOWithCatch :: forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithCatch IO a
m Point
p ContParams a
c =
  do Bool
z <- forall a. ContParams a -> IO Bool
contCanceled ContParams a
c
     if Bool
z
       then forall a. Point -> ContParams a -> IO ()
cancelCont Point
p ContParams a
c
       else do IORef a
aref <- forall a. a -> IO (IORef a)
newIORef forall a. HasCallStack => a
undefined
               IORef (Maybe SomeException)
eref <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
               forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (IO a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IORef a -> a -> IO ()
writeIORef IORef a
aref) 
                 (forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe SomeException)
eref forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
               Maybe SomeException
e <- forall a. IORef a -> IO a
readIORef IORef (Maybe SomeException)
eref
               case Maybe SomeException
e of
                 Maybe SomeException
Nothing -> 
                   do a
a <- forall a. IORef a -> IO a
readIORef IORef a
aref
                      -- tail recursive
                      forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
contCont ContParams a
c a
a
                 Just SomeException
e ->
                   -- tail recursive
                   forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ (ContParamsAux -> SomeException -> Event ()
contECont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ContParams a -> ContParamsAux
contAux) ContParams a
c SomeException
e

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

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

-- | Test whether the computation is canceled.
contCanceled :: ContParams a -> IO Bool
{-# INLINE contCanceled #-}
contCanceled :: forall a. ContParams a -> IO Bool
contCanceled ContParams a
c = forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ ContParamsAux -> IORef Bool
contCancelRef forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams a
c

-- | 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 :: [(Cont a, ContId)]
                -- ^ the list of:
                -- the nested computation,
                -- the computation identifier
                -> Cont [a]
contParallel :: forall a. [(Cont a, ContId)] -> Cont [a]
contParallel [(Cont a, ContId)]
xs =
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams [a]
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Cont a, ContId)]
xs
         worker :: IO ()
worker =
           do IOArray Int a
results   <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (Int
1, Int
n) :: IO (IOArray Int a)
              IORef Int
counter   <- forall a. a -> IO (IORef a)
newIORef Int
0
              IORef (Maybe SomeException)
catchRef  <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
              DisposableEvent
hs <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                    ContId -> [ContId] -> Event DisposableEvent
contCancellationBind (ContParamsAux -> ContId
contId forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams [a]
c) forall a b. (a -> b) -> a -> b
$
                    forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Cont a, ContId)]
xs
              let propagate :: Event ()
propagate =
                    forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
                    do Int
n' <- forall a. IORef a -> IO a
readIORef IORef Int
counter
                       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n' forall a. Eq a => a -> a -> Bool
== Int
n) forall a b. (a -> b) -> a -> b
$
                         do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
hs  -- unbind the cancellation sources
                            Bool
f1 <- forall a. ContParams a -> IO Bool
contCanceled ContParams [a]
c
                            Maybe SomeException
f2 <- forall a. IORef a -> IO a
readIORef IORef (Maybe SomeException)
catchRef
                            case (Bool
f1, Maybe SomeException
f2) of
                              (Bool
False, Maybe SomeException
Nothing) ->
                                do [a]
rs <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems IOArray Int a
results
                                   forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
resumeCont ContParams [a]
c [a]
rs
                              (Bool
False, Just SomeException
e) ->
                                forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> SomeException -> Event ()
resumeECont ContParams [a]
c SomeException
e
                              (Bool
True, Maybe SomeException
_) ->
                                forall a. Point -> ContParams a -> IO ()
cancelCont Point
p ContParams [a]
c
                  cont :: Int -> a -> Event ()
cont Int
i a
a =
                    forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
                    do forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
results Int
i a
a
                       forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
propagate
                  econt :: SomeException -> Event ()
econt SomeException
e =
                    forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
                    do forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       Maybe SomeException
r <- forall a. IORef a -> IO a
readIORef IORef (Maybe SomeException)
catchRef
                       case Maybe SomeException
r of
                         Maybe SomeException
Nothing -> forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe SomeException)
catchRef forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SomeException
e
                         Just SomeException
e' -> forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- ignore the next error
                       forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
propagate
                  ccont :: p -> Event ()
ccont p
e =
                    forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
                    do forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef Int
counter (forall a. Num a => a -> a -> a
+ Int
1)
                       -- the main computation was automatically canceled
                       forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
propagate
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
n] [(Cont a, ContId)]
xs) forall a b. (a -> b) -> a -> b
$ \(Int
i, (Cont a
x, ContId
cid)) ->
                forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                forall a.
Cont a
-> (a -> Event ())
-> (SomeException -> Event ())
-> (() -> Event ())
-> ContId
-> Bool
-> Event ()
runCont Cont a
x (Int -> a -> Event ()
cont Int
i) SomeException -> Event ()
econt forall {p}. p -> Event ()
ccont ContId
cid (ContParamsAux -> Bool
contCatchFlag forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams [a]
c)
     Bool
z <- forall a. ContParams a -> IO Bool
contCanceled ContParams [a]
c
     if Bool
z
       then forall a. Point -> ContParams a -> IO ()
cancelCont Point
p ContParams [a]
c
       else if Int
n forall a. Eq a => a -> a -> Bool
== Int
0
            then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
contCont ContParams [a]
c []
            else IO ()
worker

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

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

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

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

-- | Freeze the computation parameters temporarily.
freezeCont :: ContParams a -> Event (FrozenCont a)
freezeCont :: forall a. ContParams a -> Event (FrozenCont a)
freezeCont ContParams a
c =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do IORef (Maybe DisposableEvent)
rh <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     IORef (Maybe (ContParams a))
rc <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> Int -> ContParams a
substituteContPriority ContParams a
c (Point -> Int
pointPriority Point
p)
     DisposableEvent
h <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
          forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal (ContId -> Signal ()
contCancellationInitiating forall a b. (a -> b) -> a -> b
$
                        ContParamsAux -> ContId
contId forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams a
c) forall a b. (a -> b) -> a -> b
$ \()
e ->
          forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
          do Maybe DisposableEvent
h <- forall a. IORef a -> IO a
readIORef IORef (Maybe DisposableEvent)
rh
             case Maybe DisposableEvent
h of
               Maybe DisposableEvent
Nothing ->
                 forall a. HasCallStack => String -> a
error String
"The handler was lost: freezeCont."
               Just DisposableEvent
h ->
                 do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h
                    Maybe (ContParams a)
c <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams a))
rc
                    case Maybe (ContParams a)
c of
                      Maybe (ContParams a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      Just ContParams a
c  ->
                        do forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams a))
rc forall a. Maybe a
Nothing
                           forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                             Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) forall a b. (a -> b) -> a -> b
$
                             forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
                             do Bool
z <- forall a. ContParams a -> IO Bool
contCanceled ContParams a
c
                                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$ forall a. Point -> ContParams a -> IO ()
cancelCont Point
p ContParams a
c
     forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
rh (forall a. a -> Maybe a
Just DisposableEvent
h)
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
       forall a. Event (Maybe (ContParams a)) -> FrozenCont a
FrozenCont forall a b. (a -> b) -> a -> b
$
       forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
       do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h
          Maybe (ContParams a)
c <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams a))
rc
          forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams a))
rc forall a. Maybe a
Nothing
          forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContParams a)
c

-- | Freeze the computation parameters specifying what should be done when reentering the computation.
freezeContReentering :: ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering :: forall a. ContParams a -> a -> Event () -> Event (FrozenCont a)
freezeContReentering ContParams a
c a
a Event ()
m =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do IORef (Maybe DisposableEvent)
rh <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     IORef (Maybe (ContParams a))
rc <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> Int -> ContParams a
substituteContPriority ContParams a
c (Point -> Int
pointPriority Point
p)
     DisposableEvent
h <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
          forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal (ContId -> Signal ()
contCancellationInitiating forall a b. (a -> b) -> a -> b
$
                        ContParamsAux -> ContId
contId forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams a
c) forall a b. (a -> b) -> a -> b
$ \()
e ->
          forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
          do Maybe DisposableEvent
h <- forall a. IORef a -> IO a
readIORef IORef (Maybe DisposableEvent)
rh
             case Maybe DisposableEvent
h of
               Maybe DisposableEvent
Nothing ->
                 forall a. HasCallStack => String -> a
error String
"The handler was lost: freezeContReentering."
               Just DisposableEvent
h ->
                 do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h
                    Maybe (ContParams a)
c <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams a))
rc
                    case Maybe (ContParams a)
c of
                      Maybe (ContParams a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                      Just ContParams a
c  ->
                        do forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams a))
rc forall a. Maybe a
Nothing
                           forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                             Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) forall a b. (a -> b) -> a -> b
$
                             forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
                             do Bool
z <- forall a. ContParams a -> IO Bool
contCanceled ContParams a
c
                                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$ forall a. Point -> ContParams a -> IO ()
cancelCont Point
p ContParams a
c
     forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
rh (forall a. a -> Maybe a
Just DisposableEvent
h)
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
       forall a. Event (Maybe (ContParams a)) -> FrozenCont a
FrozenCont forall a b. (a -> b) -> a -> b
$
       forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
       do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h
          Maybe (ContParams a)
c <- forall a. IORef a -> IO a
readIORef IORef (Maybe (ContParams a))
rc
          forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (ContParams a))
rc forall a. Maybe a
Nothing
          case Maybe (ContParams a)
c of
            Maybe (ContParams a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            z :: Maybe (ContParams a)
z@(Just ContParams a
c) ->
              do Bool
f <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                      ContId -> Event Bool
contPreemptionBegun forall a b. (a -> b) -> a -> b
$
                      ContParamsAux -> ContId
contId forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams a
c
                 if Bool -> Bool
not Bool
f
                   then forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ContParams a)
z
                   else do let c :: ContParams a
c = ContParams a
c { contCont :: a -> Event ()
contCont = \a
a -> Event ()
m }
                           forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
sleepCont forall {a}. ContParams a
c a
a
                           forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Reenter the computation parameters when needed.
reenterCont :: ContParams a -> a -> Event ()
{-# INLINE reenterCont #-}
reenterCont :: forall a. ContParams a -> a -> Event ()
reenterCont ContParams a
c a
a =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool
f <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
          ContId -> Event Bool
contPreemptionBegun forall a b. (a -> b) -> a -> b
$
          ContParamsAux -> ContId
contId forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams a
c
     if Bool -> Bool
not Bool
f
       then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
            Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) forall a b. (a -> b) -> a -> b
$
            forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
            do Bool
f <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                    ContId -> Event Bool
contPreemptionBegun forall a b. (a -> b) -> a -> b
$
                    ContParamsAux -> ContId
contId forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams a
c
               if Bool -> Bool
not Bool
f
                 then forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                      forall a. ContParams a -> a -> Event ()
resumeCont ContParams a
c a
a
                 else forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                      forall a. ContParams a -> a -> Event ()
sleepCont ContParams a
c a
a
       else forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
            forall a. ContParams a -> a -> Event ()
sleepCont ContParams a
c a
a

-- | Sleep until the preempted computation will be reentered.
sleepCont :: ContParams a -> a -> Event ()
{-# NOINLINE sleepCont #-}
sleepCont :: forall a. ContParams a -> a -> Event ()
sleepCont ContParams a
c a
a =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do IORef (Maybe DisposableEvent)
rh <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     DisposableEvent
h  <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
           forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal (ContId -> Signal ContEvent
contSignal forall a b. (a -> b) -> a -> b
$
                         ContParamsAux -> ContId
contId forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> ContParamsAux
contAux ContParams a
c) forall a b. (a -> b) -> a -> b
$ \ContEvent
e ->
           forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
           do Maybe DisposableEvent
h <- forall a. IORef a -> IO a
readIORef IORef (Maybe DisposableEvent)
rh
              case Maybe DisposableEvent
h of
                Maybe DisposableEvent
Nothing ->
                  forall a. HasCallStack => String -> a
error String
"The handler was lost: sleepCont."
                Just DisposableEvent
h ->
                  do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h
                     case ContEvent
e of
                       ContEvent
ContCancellationInitiating ->
                         forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                         Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) forall a b. (a -> b) -> a -> b
$
                         forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
                         do Bool
z <- forall a. ContParams a -> IO Bool
contCanceled ContParams a
c
                            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
z forall a b. (a -> b) -> a -> b
$ forall a. Point -> ContParams a -> IO ()
cancelCont Point
p ContParams a
c
                       ContEvent
ContPreemptionEnding ->
                         forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
                         Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) forall a b. (a -> b) -> a -> b
$
                         forall a. ContParams a -> a -> Event ()
reenterCont ContParams a
c a
a
                       ContEvent
ContPreemptionBeginning ->
                         forall a. HasCallStack => String -> a
error String
"The computation was already preempted: sleepCont."
     forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
rh (forall a. a -> Maybe a
Just DisposableEvent
h)

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

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

-- | Await the signal.
contAwait :: Signal a -> Cont a
contAwait :: forall a. Signal a -> Cont a
contAwait Signal a
signal =
  forall a. (ContParams a -> Event ()) -> Cont a
Cont forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do FrozenCont a
c <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> Event (FrozenCont a)
freezeCont ContParams a
c
     IORef (Maybe DisposableEvent)
r <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     DisposableEvent
h <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$
          forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
signal forall a b. (a -> b) -> a -> b
$ 
          \a
a -> forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ 
                \Point
p -> do Maybe DisposableEvent
x <- forall a. IORef a -> IO a
readIORef IORef (Maybe DisposableEvent)
r
                         case Maybe DisposableEvent
x of
                           Maybe DisposableEvent
Nothing ->
                             forall a. HasCallStack => String -> a
error String
"The signal was lost: contAwait."
                           Just DisposableEvent
x ->
                             do forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
x
                                Maybe (ContParams a)
c <- forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. FrozenCont a -> Event (Maybe (ContParams a))
unfreezeCont FrozenCont a
c
                                case Maybe (ContParams a)
c of
                                  Maybe (ContParams a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                  Just ContParams a
c  ->
                                    forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. ContParams a -> a -> Event ()
reenterCont ContParams a
c a
a
     forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
r forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just DisposableEvent
h          

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

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