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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | 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 = Cont a -> (a -> Cont b) -> Cont b
forall a b. Cont a -> (a -> Cont b) -> Cont b
bindC Cont a
m a -> Cont b
k

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

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

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

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

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

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

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

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

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

-- | 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 (ContParamsAux -> ContId) -> ContParamsAux -> ContId
forall a b. (a -> b) -> a -> b
$ ContParams a -> ContParamsAux
forall a. ContParams a -> ContParamsAux
contAux ContParams a
c)
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ (ContParamsAux -> () -> Event ()
contCCont (ContParamsAux -> () -> Event ())
-> ContParamsAux -> () -> Event ()
forall a b. (a -> b) -> a -> b
$ ContParams a -> ContParamsAux
forall a. ContParams a -> ContParamsAux
contAux ContParams a
c) ()

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

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

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

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

-- | 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) = 
  (ContParams a -> Event ()) -> Cont a
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams a -> Event ()) -> Cont a)
-> (ContParams a -> Event ()) -> Cont a
forall a b. (a -> b) -> a -> b
$ \ContParams a
c ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  if ContParamsAux -> Bool
contCatchFlag (ContParamsAux -> Bool)
-> (ContParams a -> ContParamsAux) -> ContParams a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContParams a -> ContParamsAux
forall a. ContParams a -> ContParamsAux
contAux (ContParams a -> Bool) -> ContParams a -> Bool
forall a b. (a -> b) -> a -> b
$ ContParams a
c
  then IO a -> Point -> ContParams a -> IO ()
forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithCatch (Run -> IO a
m (Run -> IO a) -> Run -> IO a
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p) Point
p ContParams a
c
  else IO a -> Point -> ContParams a -> IO ()
forall a. IO a -> Point -> ContParams a -> IO ()
liftIOWithoutCatch (Run -> IO a
m (Run -> IO a) -> Run -> IO a
forall a b. (a -> b) -> a -> b
$ Point -> Run
pointRun Point
p) Point
p ContParams a
c

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

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

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

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

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

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

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

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

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

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

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

-- | 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 =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Bool
f <- Point -> Event Bool -> IO Bool
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event Bool -> IO Bool) -> Event Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
          ContId -> Event Bool
contPreemptionBegun (ContId -> Event Bool) -> ContId -> Event Bool
forall a b. (a -> b) -> a -> b
$
          ContParamsAux -> ContId
contId (ContParamsAux -> ContId) -> ContParamsAux -> ContId
forall a b. (a -> b) -> a -> b
$ ContParams a -> ContParamsAux
forall a. ContParams a -> ContParamsAux
contAux ContParams a
c
     if Bool -> Bool
not Bool
f
       then Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p) (Event () -> Event ()) -> Event () -> Event ()
forall a b. (a -> b) -> a -> b
$
            (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
            do Bool
f <- Point -> Event Bool -> IO Bool
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event Bool -> IO Bool) -> Event Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
                    ContId -> Event Bool
contPreemptionBegun (ContId -> Event Bool) -> ContId -> Event Bool
forall a b. (a -> b) -> a -> b
$
                    ContParamsAux -> ContId
contId (ContParamsAux -> ContId) -> ContParamsAux -> ContId
forall a b. (a -> b) -> a -> b
$ ContParams a -> ContParamsAux
forall a. ContParams a -> ContParamsAux
contAux ContParams a
c
               if Bool -> Bool
not Bool
f
                 then Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
                      ContParams a -> a -> Event ()
forall a. ContParams a -> a -> Event ()
resumeCont ContParams a
c a
a
                 else Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
                      ContParams a -> a -> Event ()
forall a. ContParams a -> a -> Event ()
sleepCont ContParams a
c a
a
       else Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$
            ContParams a -> a -> Event ()
forall a. ContParams a -> a -> Event ()
sleepCont ContParams a
c a
a

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

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

-- | Await the signal.
contAwait :: Signal a -> Cont a
contAwait :: forall a. Signal a -> Cont a
contAwait Signal a
signal =
  (ContParams a -> Event ()) -> Cont a
forall a. (ContParams a -> Event ()) -> Cont a
Cont ((ContParams a -> Event ()) -> Cont a)
-> (ContParams a -> Event ()) -> Cont a
forall a b. (a -> b) -> a -> b
$ \ContParams a
c0 ->
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do FrozenCont a
c <- Point -> Event (FrozenCont a) -> IO (FrozenCont a)
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (FrozenCont a) -> IO (FrozenCont a))
-> Event (FrozenCont a) -> IO (FrozenCont a)
forall a b. (a -> b) -> a -> b
$ ContParams a -> Event (FrozenCont a)
forall a. ContParams a -> Event (FrozenCont a)
freezeCont ContParams a
c0
     IORef (Maybe DisposableEvent)
r1 <- Maybe DisposableEvent -> IO (IORef (Maybe DisposableEvent))
forall a. a -> IO (IORef a)
newIORef Maybe DisposableEvent
forall a. Maybe a
Nothing
     IORef (Maybe DisposableEvent)
r2 <- Maybe DisposableEvent -> IO (IORef (Maybe DisposableEvent))
forall a. a -> IO (IORef a)
newIORef Maybe DisposableEvent
forall a. Maybe a
Nothing
     DisposableEvent
h1 <- Point -> Event DisposableEvent -> IO DisposableEvent
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event DisposableEvent -> IO DisposableEvent)
-> Event DisposableEvent -> IO DisposableEvent
forall a b. (a -> b) -> a -> b
$
           Signal a -> (a -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal Signal a
signal ((a -> Event ()) -> Event DisposableEvent)
-> (a -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$ 
           \a
a -> (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ 
                 \Point
p -> do Maybe DisposableEvent
x1 <- IORef (Maybe DisposableEvent) -> IO (Maybe DisposableEvent)
forall a. IORef a -> IO a
readIORef IORef (Maybe DisposableEvent)
r1
                          Maybe DisposableEvent
x2 <- IORef (Maybe DisposableEvent) -> IO (Maybe DisposableEvent)
forall a. IORef a -> IO a
readIORef IORef (Maybe DisposableEvent)
r2
                          IORef (Maybe DisposableEvent) -> Maybe DisposableEvent -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
r1 Maybe DisposableEvent
forall a. Maybe a
Nothing
                          IORef (Maybe DisposableEvent) -> Maybe DisposableEvent -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
r2 Maybe DisposableEvent
forall a. Maybe a
Nothing
                          case Maybe DisposableEvent
x1 of
                            Maybe DisposableEvent
Nothing ->
                              () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just DisposableEvent
h1 ->
                              Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h1
                          case Maybe DisposableEvent
x2 of
                            Maybe DisposableEvent
Nothing ->
                              () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just DisposableEvent
h2 ->
                              Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h2
                          Maybe (ContParams a)
c <- Point -> Event (Maybe (ContParams a)) -> IO (Maybe (ContParams a))
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (Maybe (ContParams a)) -> IO (Maybe (ContParams a)))
-> Event (Maybe (ContParams a)) -> IO (Maybe (ContParams a))
forall a b. (a -> b) -> a -> b
$ FrozenCont a -> Event (Maybe (ContParams a))
forall a. FrozenCont a -> Event (Maybe (ContParams a))
unfreezeCont FrozenCont a
c
                          case Maybe (ContParams a)
c of
                            Maybe (ContParams a)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just ContParams a
c  ->
                              Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContParams a -> a -> Event ()
forall a. ContParams a -> a -> Event ()
reenterCont ContParams a
c a
a
     DisposableEvent
h2 <- Point -> Event DisposableEvent -> IO DisposableEvent
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event DisposableEvent -> IO DisposableEvent)
-> Event DisposableEvent -> IO DisposableEvent
forall a b. (a -> b) -> a -> b
$
           Signal () -> (() -> Event ()) -> Event DisposableEvent
forall a. Signal a -> (a -> Event ()) -> Event DisposableEvent
handleSignal (ContId -> Signal ()
contCancellationInitiating (ContId -> Signal ()) -> ContId -> Signal ()
forall a b. (a -> b) -> a -> b
$ ContParamsAux -> ContId
contId (ContParamsAux -> ContId) -> ContParamsAux -> ContId
forall a b. (a -> b) -> a -> b
$ ContParams a -> ContParamsAux
forall a. ContParams a -> ContParamsAux
contAux ContParams a
c0) ((() -> Event ()) -> Event DisposableEvent)
-> (() -> Event ()) -> Event DisposableEvent
forall a b. (a -> b) -> a -> b
$
           \()
a -> (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$
                 \Point
p -> do Maybe DisposableEvent
x1 <- IORef (Maybe DisposableEvent) -> IO (Maybe DisposableEvent)
forall a. IORef a -> IO a
readIORef IORef (Maybe DisposableEvent)
r1
                          Maybe DisposableEvent
x2 <- IORef (Maybe DisposableEvent) -> IO (Maybe DisposableEvent)
forall a. IORef a -> IO a
readIORef IORef (Maybe DisposableEvent)
r2
                          IORef (Maybe DisposableEvent) -> Maybe DisposableEvent -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
r1 Maybe DisposableEvent
forall a. Maybe a
Nothing
                          IORef (Maybe DisposableEvent) -> Maybe DisposableEvent -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
r2 Maybe DisposableEvent
forall a. Maybe a
Nothing
                          case Maybe DisposableEvent
x1 of
                            Maybe DisposableEvent
Nothing ->
                              () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just DisposableEvent
h1 ->
                              Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h1
                          case Maybe DisposableEvent
x2 of
                            Maybe DisposableEvent
Nothing ->
                              () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just DisposableEvent
h2 ->
                              Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Event ()
disposeEvent DisposableEvent
h2
     IORef (Maybe DisposableEvent) -> Maybe DisposableEvent -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
r1 (Maybe DisposableEvent -> IO ()) -> Maybe DisposableEvent -> IO ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Maybe DisposableEvent
forall a. a -> Maybe a
Just DisposableEvent
h1          
     IORef (Maybe DisposableEvent) -> Maybe DisposableEvent -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe DisposableEvent)
r2 (Maybe DisposableEvent -> IO ()) -> Maybe DisposableEvent -> IO ()
forall a b. (a -> b) -> a -> b
$ DisposableEvent -> Maybe DisposableEvent
forall a. a -> Maybe a
Just DisposableEvent
h2

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

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