    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-----------------------------------------------------------------------------
        reactive-banana
    ------------------------------------------------------------------------------}
    module Reactive.Banana.Prim.Mid.Evaluation
        ( step
        , applyDependencyChanges
        ) where

    import Control.Monad
        ( join )
    import Control.Monad.IO.Class
        ( liftIO )

    import qualified Reactive.Banana.Prim.Low.GraphGC as GraphGC
    import qualified Reactive.Banana.Prim.Low.OrderedBag as OB
    import qualified Reactive.Banana.Prim.Low.Ref as Ref
    import           Reactive.Banana.Prim.Mid.Plumbing
    import           Reactive.Banana.Prim.Mid.Types

    {-----------------------------------------------------------------------------
        Evaluation step
    ------------------------------------------------------------------------------}
    -- | Evaluate all the pulses in the graph,
    -- Rebuild the graph as necessary and update the latch values.
    step :: Inputs -> Step
    step :: Inputs -> Step
    step ([Output]
    inputs,Vault
    pulses)
            Network{ nTime :: Network -> Time
    nTime = Time
    time1
            , nOutputs :: Network -> OrderedBag Output
    nOutputs = OrderedBag Output
    outputs1
            , nAlwaysP :: Network -> Pulse ()
    nAlwaysP = Pulse ()
    alwaysP
            , Dependencies
    nGraphGC :: Dependencies
    nGraphGC :: Network -> Dependencies
    nGraphGC
            }
        = do

        -- evaluate pulses
        ((_, (latchUpdates, outputs)), dependencyChanges, os)
                <- BuildR
    -> BuildIO ((), EvalPW)
    -> IO (((), EvalPW), DependencyChanges, [Output])
    forall a.
    BuildR -> BuildIO a -> IO (a, DependencyChanges, [Output])
    runBuildIO (Time
    time1, Pulse ()
    alwaysP)
                (BuildIO ((), EvalPW)
     -> IO (((), EvalPW), DependencyChanges, [Output]))
    -> BuildIO ((), EvalPW)
    -> IO (((), EvalPW), DependencyChanges, [Output])
    forall a b. (a -> b) -> a -> b
    $  Vault -> EvalP () -> BuildIO ((), EvalPW)
    forall a. Vault -> EvalP a -> Build (a, EvalPW)
    runEvalP Vault
    pulses
                (EvalP () -> BuildIO ((), EvalPW))
    -> EvalP () -> BuildIO ((), EvalPW)
    forall a b. (a -> b) -> a -> b
    $  [Output] -> Dependencies -> EvalP ()
    evaluatePulses [Output]
    inputs Dependencies
    nGraphGC

        doit latchUpdates                          -- update latch values from pulses
        applyDependencyChanges dependencyChanges   -- rearrange graph topology
            nGraphGC
        GraphGC.removeGarbage nGraphGC             -- remove unreachable pulses
        let actions :: [(Output, EvalO)]
            actions = [(Output, EvalO)] -> OrderedBag Output -> [(Output, EvalO)]
    forall a b.
    (Eq a, Hashable a) =>
    [(a, b)] -> OrderedBag a -> [(a, b)]
    OB.inOrder [(Output, EvalO)]
    outputs OrderedBag Output
    outputs1  -- EvalO actions in proper order

            state2 :: Network
            !state2 = Network
                { nTime :: Time
    nTime    = Time -> Time
    next Time
    time1
                , nOutputs :: OrderedBag Output
    nOutputs = OrderedBag Output -> [Output] -> OrderedBag Output
    forall a. (Eq a, Hashable a) => OrderedBag a -> [a] -> OrderedBag a
    OB.inserts OrderedBag Output
    outputs1 [Output]
    os
                , nAlwaysP :: Pulse ()
    nAlwaysP = Pulse ()
    alwaysP
                , Dependencies
    nGraphGC :: Dependencies
    nGraphGC :: Dependencies
    nGraphGC
                }
        return (runEvalOs $ map snd actions, state2)

    runEvalOs :: [EvalO] -> IO ()
    runEvalOs :: [EvalO] -> IO ()
    runEvalOs = (EvalO -> IO ()) -> [EvalO] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ EvalO -> IO ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join

    {-----------------------------------------------------------------------------
        Dependency changes
    ------------------------------------------------------------------------------}
    -- | Apply all dependency changes to the 'GraphGC'.
    applyDependencyChanges :: DependencyChanges -> Dependencies -> IO ()
    applyDependencyChanges :: DependencyChanges -> Dependencies -> IO ()
    applyDependencyChanges DependencyChanges
    changes Dependencies
    g = do
        [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [DependencyChange Output Output -> Dependencies -> IO ()
    applyDependencyChange DependencyChange Output Output
    c Dependencies
    g | c :: DependencyChange Output Output
    c@(InsertEdge Output
    _ Output
    _) <- DependencyChanges
    changes]
        [IO ()] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [DependencyChange Output Output -> Dependencies -> IO ()
    applyDependencyChange DependencyChange Output Output
    c Dependencies
    g | c :: DependencyChange Output Output
    c@(ChangeParentTo Output
    _ Output
    _) <- DependencyChanges
    changes]

    applyDependencyChange
        :: DependencyChange SomeNode SomeNode -> Dependencies -> IO ()
    applyDependencyChange :: DependencyChange Output Output -> Dependencies -> IO ()
    applyDependencyChange (InsertEdge Output
    parent Output
    child) Dependencies
    g =
        (Output, Output) -> Dependencies -> IO ()
    forall v. (Ref v, Ref v) -> GraphGC v -> IO ()
    GraphGC.insertEdge (Output
    parent, Output
    child) Dependencies
    g
    applyDependencyChange (ChangeParentTo Output
    child Output
    parent) Dependencies
    g = do
        Output -> Dependencies -> IO ()
    forall v. Ref v -> GraphGC v -> IO ()
    GraphGC.clearPredecessors Output
    child Dependencies
    g
        (Output, Output) -> Dependencies -> IO ()
    forall v. (Ref v, Ref v) -> GraphGC v -> IO ()
    GraphGC.insertEdge (Output
    parent, Output
    child) Dependencies
    g

    {-----------------------------------------------------------------------------
        Traversal in dependency order
    ------------------------------------------------------------------------------}
    -- | Update all pulses in the graph, starting from a given set of nodes
    evaluatePulses :: [SomeNode] -> Dependencies -> EvalP ()
    evaluatePulses :: [Output] -> Dependencies -> EvalP ()
    evaluatePulses [Output]
    inputs Dependencies
    g = do
        action <- IO (EvalP ()) -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (EvalP ())
    forall a. IO a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (EvalP ())
     -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (EvalP ()))
    -> IO (EvalP ())
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (EvalP ())
    forall a b. (a -> b) -> a -> b
    $ [Output]
    -> (WeakRef SomeNodeD
        -> RWSIOT BuildR (EvalPW, BuildW) Vault IO Step)
    -> Dependencies
    -> IO (EvalP ())
    forall (m :: * -> *) v.
    Monad m =>
    [Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m ())
    GraphGC.walkSuccessors_ [Output]
    inputs WeakRef SomeNodeD -> RWSIOT BuildR (EvalPW, BuildW) Vault IO Step
    evaluateWeakNode Dependencies
    g
        action

    evaluateWeakNode :: Ref.WeakRef SomeNodeD -> EvalP GraphGC.Step
    evaluateWeakNode :: WeakRef SomeNodeD -> RWSIOT BuildR (EvalPW, BuildW) Vault IO Step
    evaluateWeakNode WeakRef SomeNodeD
    w = do
        mnode <- IO (Maybe Output)
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe Output)
    forall a. IO a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe Output)
     -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe Output))
    -> IO (Maybe Output)
    -> RWSIOT BuildR (EvalPW, BuildW) Vault IO (Maybe Output)
    forall a b. (a -> b) -> a -> b
    $ WeakRef SomeNodeD -> IO (Maybe Output)
    forall v. Weak v -> IO (Maybe v)
    Ref.deRefWeak WeakRef SomeNodeD
    w
        case mnode of
            Maybe Output
    Nothing -> Step -> RWSIOT BuildR (EvalPW, BuildW) Vault IO Step
    forall a. a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Step
    GraphGC.Stop
            Just Output
    node -> Output -> RWSIOT BuildR (EvalPW, BuildW) Vault IO Step
    evaluateNode Output
    node

    -- | Recalculate a given node and return all children nodes
    -- that need to evaluated subsequently.
    evaluateNode :: SomeNode -> EvalP GraphGC.Step
    evaluateNode :: Output -> RWSIOT BuildR (EvalPW, BuildW) Vault IO Step
    evaluateNode Output
    someNode = do
        node <- Output -> RWSIOT BuildR (EvalPW, BuildW) Vault IO SomeNodeD
    forall (m :: * -> *) a. MonadIO m => Ref a -> m a
    Ref.read Output
    someNode
        case node of
            P PulseD{EvalP (Maybe a)
    _evalP :: EvalP (Maybe a)
    _evalP :: forall a. PulseD a -> EvalP (Maybe a)
    _evalP,Key (Maybe a)
    _keyP :: Key (Maybe a)
    _keyP :: forall a. PulseD a -> Key (Maybe a)
    _keyP} -> {-# SCC evaluateNodeP #-} do
                ma <- EvalP (Maybe a)
    _evalP
                writePulseP _keyP ma
                pure $ case ma of
                    Maybe a
    Nothing -> Step
    GraphGC.Stop
                    Just a
    _  -> Step
    GraphGC.Next
            L LatchWriteD
    lw -> {-# SCC evaluateLatchWrite #-} do
                LatchWriteD -> EvalP ()
    evaluateLatchWrite LatchWriteD
    lw
                Step -> RWSIOT BuildR (EvalPW, BuildW) Vault IO Step
    forall a. a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Step
    GraphGC.Stop
            O OutputD
    o -> {-# SCC evaluateNodeO #-} do
                m <- OutputD -> EvalP EvalO
    _evalO OutputD
    o -- calculate output action
                rememberOutput (someNode,m)
                pure GraphGC.Stop

    evaluateLatchWrite :: LatchWriteD -> EvalP ()
    evaluateLatchWrite :: LatchWriteD -> EvalP ()
    evaluateLatchWrite LatchWriteD{EvalP a
    _evalLW :: EvalP a
    _evalLW :: ()
    _evalLW,Weak (Latch a)
    _latchLW :: Weak (Latch a)
    _latchLW :: ()
    _latchLW} = do
        time   <- EvalP Time
    askTime
        mlatch <- liftIO $ Ref.deRefWeak _latchLW -- retrieve destination latch
        case mlatch of
            Maybe (Latch a)
    Nothing    -> () -> EvalP ()
    forall a. a -> RWSIOT BuildR (EvalPW, BuildW) Vault IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            Just Latch a
    latch -> do
                a <- EvalP a
    _evalLW                    -- calculate new latch value
                -- liftIO $ Strict.evaluate a   -- see Note [LatchStrictness]
                rememberLatchUpdate $           -- schedule value to be set later
                    Ref.modify' latch $ \LatchD a
    l ->
                        a
    a a -> LatchD a -> LatchD a
    forall a b. a -> b -> b
    `seq` LatchD a
    l { _seenL = time, _valueL = a }