{-# LANGUAGE TypeFamilies #-}

-- |
-- Module     : Simulation.Aivika.Lattice.Internal.Event
-- Copyright  : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 7.10.3
--
-- The module defines an event queue, where 'LIO' is an instance of 'EventQueueing'.
-- Also it defines basic functions for running nested computations within lattice nodes.
--
module Simulation.Aivika.Lattice.Internal.Event
       (estimateStrictRef,
        estimateLazyRef) where

import Data.IORef

import Control.Monad
import Control.Monad.Trans

import qualified Simulation.Aivika.PriorityQueue.Pure as PQ

import Simulation.Aivika.Trans
import Simulation.Aivika.Trans.Internal.Types

import Simulation.Aivika.Lattice.Internal.LIO
import Simulation.Aivika.Lattice.Internal.Estimate
import qualified Simulation.Aivika.Lattice.Internal.Ref.Strict as R
import qualified Simulation.Aivika.Lattice.Internal.Ref.Lazy as LazyR

-- | An implementation of the 'EventQueueing' type class.
instance EventQueueing LIO where

  -- | The event queue type.
  data EventQueue LIO =
    EventQueueLIO { EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ()))
queuePQ :: R.Ref (PQ.PriorityQueue (Point LIO -> LIO ())),
                    -- ^ the underlying priority queue
                    EventQueue LIO -> IORef Bool
queueBusy :: IORef Bool,
                    -- ^ whether the queue is currently processing events
                    EventQueue LIO -> Ref Double
queueTime :: R.Ref Double
                    -- ^ the actual time of the event queue
                  }

  newEventQueue :: Specs LIO -> LIO (EventQueue LIO)
newEventQueue Specs LIO
specs =
    do IORef Bool
f  <- IO (IORef Bool) -> LIO (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> LIO (IORef Bool))
-> IO (IORef Bool) -> LIO (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
       Ref Double
t  <- Double -> LIO (Ref Double)
forall a. a -> LIO (Ref a)
R.newRef0 (Specs LIO -> Double
forall (m :: * -> *). Specs m -> Double
spcStartTime Specs LIO
specs)
       Ref (PriorityQueue (Point LIO -> LIO ()))
pq <- PriorityQueue (Point LIO -> LIO ())
-> LIO (Ref (PriorityQueue (Point LIO -> LIO ())))
forall a. a -> LIO (Ref a)
R.newRef0 PriorityQueue (Point LIO -> LIO ())
forall a. PriorityQueue a
PQ.emptyQueue
       EventQueue LIO -> LIO (EventQueue LIO)
forall (m :: * -> *) a. Monad m => a -> m a
return EventQueueLIO :: Ref (PriorityQueue (Point LIO -> LIO ()))
-> IORef Bool -> Ref Double -> EventQueue LIO
EventQueueLIO { queuePQ :: Ref (PriorityQueue (Point LIO -> LIO ()))
queuePQ   = Ref (PriorityQueue (Point LIO -> LIO ()))
pq,
                              queueBusy :: IORef Bool
queueBusy = IORef Bool
f,
                              queueTime :: Ref Double
queueTime = Ref Double
t }

  enqueueEvent :: Double -> Event LIO () -> Event LIO ()
enqueueEvent Double
t (Event Point LIO -> LIO ()
m) =
    (Point LIO -> LIO ()) -> Event LIO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point LIO -> LIO ()) -> Event LIO ())
-> (Point LIO -> LIO ()) -> Event LIO ()
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
    let pq :: Ref (PriorityQueue (Point LIO -> LIO ()))
pq = EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ()))
queuePQ (EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ())))
-> EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ()))
forall a b. (a -> b) -> a -> b
$ Run LIO -> EventQueue LIO
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue (Run LIO -> EventQueue LIO) -> Run LIO -> EventQueue LIO
forall a b. (a -> b) -> a -> b
$ Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
    in Point LIO -> Event LIO () -> LIO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point LIO
p (Event LIO () -> LIO ()) -> Event LIO () -> LIO ()
forall a b. (a -> b) -> a -> b
$
       Ref (PriorityQueue (Point LIO -> LIO ()))
-> (PriorityQueue (Point LIO -> LIO ())
    -> PriorityQueue (Point LIO -> LIO ()))
-> Event LIO ()
forall a. Ref a -> (a -> a) -> Event LIO ()
R.modifyRef Ref (PriorityQueue (Point LIO -> LIO ()))
pq ((PriorityQueue (Point LIO -> LIO ())
  -> PriorityQueue (Point LIO -> LIO ()))
 -> Event LIO ())
-> (PriorityQueue (Point LIO -> LIO ())
    -> PriorityQueue (Point LIO -> LIO ()))
-> Event LIO ()
forall a b. (a -> b) -> a -> b
$ \PriorityQueue (Point LIO -> LIO ())
x -> PriorityQueue (Point LIO -> LIO ())
-> Double
-> (Point LIO -> LIO ())
-> PriorityQueue (Point LIO -> LIO ())
forall a. PriorityQueue a -> Double -> a -> PriorityQueue a
PQ.enqueue PriorityQueue (Point LIO -> LIO ())
x Double
t Point LIO -> LIO ()
m

  runEventWith :: EventProcessing -> Event LIO a -> Dynamics LIO a
runEventWith EventProcessing
processing (Event Point LIO -> LIO a
e) =
    (Point LIO -> LIO a) -> Dynamics LIO a
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics ((Point LIO -> LIO a) -> Dynamics LIO a)
-> (Point LIO -> LIO a) -> Dynamics LIO a
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
    (LIOParams -> IO a) -> LIO a
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO a) -> LIO a) -> (LIOParams -> IO a) -> LIO a
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
    do LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         Point LIO -> Dynamics LIO () -> LIO ()
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point LIO
p (Dynamics LIO () -> LIO ()) -> Dynamics LIO () -> LIO ()
forall a b. (a -> b) -> a -> b
$
         EventProcessing -> Dynamics LIO ()
processEvents EventProcessing
processing
       LIOParams -> LIO a -> IO a
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO a -> IO a) -> LIO a -> IO a
forall a b. (a -> b) -> a -> b
$
         Point LIO -> LIO a
e Point LIO
p

  eventQueueCount :: Event LIO Int
eventQueueCount =
    (Point LIO -> LIO Int) -> Event LIO Int
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point LIO -> LIO Int) -> Event LIO Int)
-> (Point LIO -> LIO Int) -> Event LIO Int
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
    let pq :: Ref (PriorityQueue (Point LIO -> LIO ()))
pq = EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ()))
queuePQ (EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ())))
-> EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ()))
forall a b. (a -> b) -> a -> b
$ Run LIO -> EventQueue LIO
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue (Run LIO -> EventQueue LIO) -> Run LIO -> EventQueue LIO
forall a b. (a -> b) -> a -> b
$ Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
    in Point LIO -> Event LIO Int -> LIO Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point LIO
p (Event LIO Int -> LIO Int) -> Event LIO Int -> LIO Int
forall a b. (a -> b) -> a -> b
$
       (PriorityQueue (Point LIO -> LIO ()) -> Int)
-> Event LIO (PriorityQueue (Point LIO -> LIO ())) -> Event LIO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PriorityQueue (Point LIO -> LIO ()) -> Int
forall a. PriorityQueue a -> Int
PQ.queueCount (Event LIO (PriorityQueue (Point LIO -> LIO ())) -> Event LIO Int)
-> Event LIO (PriorityQueue (Point LIO -> LIO ())) -> Event LIO Int
forall a b. (a -> b) -> a -> b
$ Ref (PriorityQueue (Point LIO -> LIO ()))
-> Event LIO (PriorityQueue (Point LIO -> LIO ()))
forall a. Ref a -> Event LIO a
R.readRef Ref (PriorityQueue (Point LIO -> LIO ()))
pq

-- | Process the pending events.
processPendingEventsCore :: Bool -> Dynamics LIO ()
processPendingEventsCore :: Bool -> Dynamics LIO ()
processPendingEventsCore Bool
includingCurrentEvents = (Point LIO -> LIO ()) -> Dynamics LIO ()
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics Point LIO -> LIO ()
r where
  r :: Point LIO -> LIO ()
r Point LIO
p =
    (LIOParams -> IO ()) -> LIO ()
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO ()) -> LIO ()) -> (LIOParams -> IO ()) -> LIO ()
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
    do let q :: EventQueue LIO
q = Run LIO -> EventQueue LIO
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue (Run LIO -> EventQueue LIO) -> Run LIO -> EventQueue LIO
forall a b. (a -> b) -> a -> b
$ Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
           f :: IORef Bool
f = EventQueue LIO -> IORef Bool
queueBusy EventQueue LIO
q
       Bool
f' <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
f
       if Bool
f'
         then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
              [Char]
"Detected an event loop, which may indicate to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [Char]
"a logical error in the model: processPendingEventsCore"
         else do IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
f Bool
True
                 LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                   Point LIO -> Dynamics LIO () -> LIO ()
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point LIO
p (Dynamics LIO () -> LIO ()) -> Dynamics LIO () -> LIO ()
forall a b. (a -> b) -> a -> b
$
                   Bool -> Dynamics LIO ()
processPendingEventsUnsafe Bool
includingCurrentEvents
                 IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
f Bool
False

-- | Process the pending events in unsafe manner.
processPendingEventsUnsafe :: Bool -> Dynamics LIO ()
processPendingEventsUnsafe :: Bool -> Dynamics LIO ()
processPendingEventsUnsafe Bool
includingCurrentEvents = (Point LIO -> LIO ()) -> Dynamics LIO ()
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics Point LIO -> LIO ()
r where
  r :: Point LIO -> LIO ()
r Point LIO
p =
    (LIOParams -> IO ()) -> LIO ()
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO ()) -> LIO ()) -> (LIOParams -> IO ()) -> LIO ()
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
    let q :: EventQueue LIO
q = Run LIO -> EventQueue LIO
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue (Run LIO -> EventQueue LIO) -> Run LIO -> EventQueue LIO
forall a b. (a -> b) -> a -> b
$ Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
    in EventQueue LIO -> Point LIO -> LIOParams -> IO ()
call EventQueue LIO
q Point LIO
p LIOParams
ps
  call :: EventQueue LIO -> Point LIO -> LIOParams -> IO ()
call EventQueue LIO
q Point LIO
p LIOParams
ps =
    do let pq :: Ref (PriorityQueue (Point LIO -> LIO ()))
pq = EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ()))
queuePQ EventQueue LIO
q
           r :: Run LIO
r  = Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
       Bool
f <- LIOParams -> LIO Bool -> IO Bool
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO Bool -> IO Bool) -> LIO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
            (PriorityQueue (Point LIO -> LIO ()) -> Bool)
-> LIO (PriorityQueue (Point LIO -> LIO ())) -> LIO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PriorityQueue (Point LIO -> LIO ()) -> Bool
forall a. PriorityQueue a -> Bool
PQ.queueNull (LIO (PriorityQueue (Point LIO -> LIO ())) -> LIO Bool)
-> LIO (PriorityQueue (Point LIO -> LIO ())) -> LIO Bool
forall a b. (a -> b) -> a -> b
$ Ref (PriorityQueue (Point LIO -> LIO ()))
-> LIO (PriorityQueue (Point LIO -> LIO ()))
forall a. Ref a -> LIO a
R.readRef0 Ref (PriorityQueue (Point LIO -> LIO ()))
pq
       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 (Double
t2, Point LIO -> LIO ()
c2) <- LIOParams
-> LIO (Double, Point LIO -> LIO ())
-> IO (Double, Point LIO -> LIO ())
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO (Double, Point LIO -> LIO ())
 -> IO (Double, Point LIO -> LIO ()))
-> LIO (Double, Point LIO -> LIO ())
-> IO (Double, Point LIO -> LIO ())
forall a b. (a -> b) -> a -> b
$
                        (PriorityQueue (Point LIO -> LIO ())
 -> (Double, Point LIO -> LIO ()))
-> LIO (PriorityQueue (Point LIO -> LIO ()))
-> LIO (Double, Point LIO -> LIO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PriorityQueue (Point LIO -> LIO ())
-> (Double, Point LIO -> LIO ())
forall a. PriorityQueue a -> (Double, a)
PQ.queueFront (LIO (PriorityQueue (Point LIO -> LIO ()))
 -> LIO (Double, Point LIO -> LIO ()))
-> LIO (PriorityQueue (Point LIO -> LIO ()))
-> LIO (Double, Point LIO -> LIO ())
forall a b. (a -> b) -> a -> b
$ Ref (PriorityQueue (Point LIO -> LIO ()))
-> LIO (PriorityQueue (Point LIO -> LIO ()))
forall a. Ref a -> LIO a
R.readRef0 Ref (PriorityQueue (Point LIO -> LIO ()))
pq
            let t :: Ref Double
t = EventQueue LIO -> Ref Double
queueTime EventQueue LIO
q
            Double
t' <- LIOParams -> LIO Double -> IO Double
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO Double -> IO Double) -> LIO Double -> IO Double
forall a b. (a -> b) -> a -> b
$
                  Ref Double -> LIO Double
forall a. Ref a -> LIO a
R.readRef0 Ref Double
t
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
t2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
t') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ 
              [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"The time value is too small: processPendingEventsCore"
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Double
t2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Point LIO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point LIO
p) Bool -> Bool -> Bool
||
                  (Bool
includingCurrentEvents Bool -> Bool -> Bool
&& (Double
t2 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Point LIO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point LIO
p))) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              do let sc :: Specs LIO
sc = Point LIO -> Specs LIO
forall (m :: * -> *). Point m -> Specs m
pointSpecs Point LIO
p
                     t0 :: Double
t0 = Specs LIO -> Double
forall (m :: * -> *). Specs m -> Double
spcStartTime Specs LIO
sc
                     dt :: Double
dt = Specs LIO -> Double
forall (m :: * -> *). Specs m -> Double
spcDT Specs LIO
sc
                     n2 :: Int
n2 = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dt)
                     p2 :: Point LIO
p2 = Point LIO
p { pointTime :: Double
pointTime = Double
t2,
                              pointIteration :: Int
pointIteration = Int
n2,
                              pointPhase :: Int
pointPhase = -Int
1 }
                 LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                   Ref Double -> Double -> LIO ()
forall a. Ref a -> a -> LIO ()
R.writeRef0 Ref Double
t Double
t2
                 LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                   Ref (PriorityQueue (Point LIO -> LIO ())) -> LIO ()
forall a. Ref a -> LIO ()
R.defineTopRef0_ Ref (PriorityQueue (Point LIO -> LIO ()))
pq
                 LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                   Ref (PriorityQueue (Point LIO -> LIO ()))
-> (PriorityQueue (Point LIO -> LIO ())
    -> PriorityQueue (Point LIO -> LIO ()))
-> LIO ()
forall a. Ref a -> (a -> a) -> LIO ()
R.modifyRef0 Ref (PriorityQueue (Point LIO -> LIO ()))
pq PriorityQueue (Point LIO -> LIO ())
-> PriorityQueue (Point LIO -> LIO ())
forall a. PriorityQueue a -> PriorityQueue a
PQ.dequeue
                 LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                   Point LIO -> LIO ()
c2 Point LIO
p2
                 EventQueue LIO -> Point LIO -> LIOParams -> IO ()
call EventQueue LIO
q Point LIO
p LIOParams
ps

-- | Process the pending events synchronously, i.e. without past.
processPendingEvents :: Bool -> Dynamics LIO ()
processPendingEvents :: Bool -> Dynamics LIO ()
processPendingEvents Bool
includingCurrentEvents = (Point LIO -> LIO ()) -> Dynamics LIO ()
forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics Point LIO -> LIO ()
r where
  r :: Point LIO -> LIO ()
r Point LIO
p =
    (LIOParams -> IO ()) -> LIO ()
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO ()) -> LIO ()) -> (LIOParams -> IO ()) -> LIO ()
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
    do let q :: EventQueue LIO
q = Run LIO -> EventQueue LIO
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue (Run LIO -> EventQueue LIO) -> Run LIO -> EventQueue LIO
forall a b. (a -> b) -> a -> b
$ Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
           t :: Ref Double
t = EventQueue LIO -> Ref Double
queueTime EventQueue LIO
q
       Double
t' <- LIOParams -> LIO Double -> IO Double
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO Double -> IO Double) -> LIO Double -> IO Double
forall a b. (a -> b) -> a -> b
$
             Point LIO -> Event LIO Double -> LIO Double
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point LIO
p (Event LIO Double -> LIO Double) -> Event LIO Double -> LIO Double
forall a b. (a -> b) -> a -> b
$
             Ref Double -> Event LIO Double
forall a. Ref a -> Event LIO a
R.readRef Ref Double
t
       if Point LIO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point LIO
p Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
t'
         then [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
              [Char]
"The current time is less than " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [Char]
"the time in the queue: processPendingEvents"
         else LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              Point LIO -> Dynamics LIO () -> LIO ()
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point LIO
p (Dynamics LIO () -> LIO ()) -> Dynamics LIO () -> LIO ()
forall a b. (a -> b) -> a -> b
$
              Bool -> Dynamics LIO ()
processPendingEventsCore Bool
includingCurrentEvents

-- | A memoized value.
processEventsIncludingCurrent :: Dynamics LIO ()
processEventsIncludingCurrent :: Dynamics LIO ()
processEventsIncludingCurrent = Bool -> Dynamics LIO ()
processPendingEvents Bool
True

-- | A memoized value.
processEventsIncludingEarlier :: Dynamics LIO ()
processEventsIncludingEarlier :: Dynamics LIO ()
processEventsIncludingEarlier = Bool -> Dynamics LIO ()
processPendingEvents Bool
False

-- | A memoized value.
processEventsIncludingCurrentCore :: Dynamics LIO ()
processEventsIncludingCurrentCore :: Dynamics LIO ()
processEventsIncludingCurrentCore = Bool -> Dynamics LIO ()
processPendingEventsCore Bool
True

-- | A memoized value.
processEventsIncludingEarlierCore :: Dynamics LIO ()
processEventsIncludingEarlierCore :: Dynamics LIO ()
processEventsIncludingEarlierCore = Bool -> Dynamics LIO ()
processPendingEventsCore Bool
True

-- | Process the events.
processEvents :: EventProcessing -> Dynamics LIO ()
processEvents :: EventProcessing -> Dynamics LIO ()
processEvents EventProcessing
CurrentEvents = Dynamics LIO ()
processEventsIncludingCurrent
processEvents EventProcessing
EarlierEvents = Dynamics LIO ()
processEventsIncludingEarlier
processEvents EventProcessing
CurrentEventsOrFromPast = Dynamics LIO ()
processEventsIncludingCurrentCore
processEvents EventProcessing
EarlierEventsOrFromPast = Dynamics LIO ()
processEventsIncludingEarlierCore

-- | Initialize the event queue in the current lattice node if required.
initEventQueue :: Event LIO ()
initEventQueue :: Event LIO ()
initEventQueue =
  (Point LIO -> LIO ()) -> Event LIO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point LIO -> LIO ()) -> Event LIO ())
-> (Point LIO -> LIO ()) -> Event LIO ()
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
  (LIOParams -> IO ()) -> LIO ()
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO ()) -> LIO ()) -> (LIOParams -> IO ()) -> LIO ()
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
  do let pq :: Ref (PriorityQueue (Point LIO -> LIO ()))
pq = EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ()))
queuePQ (EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ())))
-> EventQueue LIO -> Ref (PriorityQueue (Point LIO -> LIO ()))
forall a b. (a -> b) -> a -> b
$ Run LIO -> EventQueue LIO
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue Run LIO
r
         r :: Run LIO
r  = Point LIO -> Run LIO
forall (m :: * -> *). Point m -> Run m
pointRun Point LIO
p
     Bool
f <- LIOParams -> LIO Bool -> IO Bool
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO Bool -> IO Bool) -> LIO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
          Ref (PriorityQueue (Point LIO -> LIO ())) -> LIO Bool
forall a. Ref a -> LIO Bool
R.topRefDefined0 Ref (PriorityQueue (Point LIO -> LIO ()))
pq
     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 case LIOParams -> Maybe LIOParams
parentLIOParams LIOParams
ps of
            Maybe LIOParams
Nothing  -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"The root must be initialized: initEventQueue"
            Just LIOParams
ps' ->
              do Point LIO
p' <- LIOParams -> LIO (Point LIO) -> IO (Point LIO)
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO (Point LIO) -> IO (Point LIO))
-> LIO (Point LIO) -> IO (Point LIO)
forall a b. (a -> b) -> a -> b
$
                       Run LIO -> Parameter LIO (Point LIO) -> LIO (Point LIO)
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run LIO
r
                       Parameter LIO (Point LIO)
latticePoint
                 LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps' (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                   Point LIO -> Event LIO () -> LIO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point LIO
p'
                   Event LIO ()
initEventQueue
          LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ref (PriorityQueue (Point LIO -> LIO ())) -> LIO ()
forall a. Ref a -> LIO ()
R.defineTopRef0_ Ref (PriorityQueue (Point LIO -> LIO ()))
pq
          LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Point LIO -> Dynamics LIO () -> LIO ()
forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point LIO
p (Dynamics LIO () -> LIO ()) -> Dynamics LIO () -> LIO ()
forall a b. (a -> b) -> a -> b
$
            Bool -> Dynamics LIO ()
processPendingEventsUnsafe Bool
True

-- | Estimate the specified reference.
estimateStrictRef :: R.Ref a -> Estimate LIO a
estimateStrictRef :: Ref a -> Estimate LIO a
estimateStrictRef Ref a
r =
  (Point LIO -> LIO a) -> Estimate LIO a
forall (m :: * -> *) a. (Point m -> m a) -> Estimate m a
Estimate ((Point LIO -> LIO a) -> Estimate LIO a)
-> (Point LIO -> LIO a) -> Estimate LIO a
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
  (LIOParams -> IO a) -> LIO a
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO a) -> LIO a) -> (LIOParams -> IO a) -> LIO a
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
  do LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       Point LIO -> Event LIO () -> LIO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point LIO
p
       Event LIO ()
initEventQueue
     LIOParams -> LIO a -> IO a
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO a -> IO a) -> LIO a -> IO a
forall a b. (a -> b) -> a -> b
$
       Ref a -> LIO a
forall a. Ref a -> LIO a
R.readRef0 Ref a
r

-- | Estimate the specified reference.
estimateLazyRef :: LazyR.Ref a -> Estimate LIO a
estimateLazyRef :: Ref a -> Estimate LIO a
estimateLazyRef Ref a
r =
  (Point LIO -> LIO a) -> Estimate LIO a
forall (m :: * -> *) a. (Point m -> m a) -> Estimate m a
Estimate ((Point LIO -> LIO a) -> Estimate LIO a)
-> (Point LIO -> LIO a) -> Estimate LIO a
forall a b. (a -> b) -> a -> b
$ \Point LIO
p ->
  (LIOParams -> IO a) -> LIO a
forall a. (LIOParams -> IO a) -> LIO a
LIO ((LIOParams -> IO a) -> LIO a) -> (LIOParams -> IO a) -> LIO a
forall a b. (a -> b) -> a -> b
$ \LIOParams
ps ->
  do LIOParams -> LIO () -> IO ()
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO () -> IO ()) -> LIO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       Point LIO -> Event LIO () -> LIO ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point LIO
p
       Event LIO ()
initEventQueue
     LIOParams -> LIO a -> IO a
forall a. LIOParams -> LIO a -> IO a
invokeLIO LIOParams
ps (LIO a -> IO a) -> LIO a -> IO a
forall a b. (a -> b) -> a -> b
$
       Ref a -> LIO a
forall a. Ref a -> LIO a
LazyR.readRef0 Ref a
r