diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,8 +1,16 @@
 Changelog for the `reactive-banana` package
 -------------------------------------------
 
-**Version 1.3.1.0** (2002-08-11)
+**Version 1.3.2.0** (2023-01-22)
 
+* Fixed multiple space leaks for dynamic event switching by completely redesigning low-level internals. Added automated tests on garbage collection and space leaks in order to make sure that the leaks stay fixed. [#261][], [#267][], [#268][]
+
+  [#268]: https://github.com/HeinrichApfelmus/reactive-banana/pull/268
+  [#267]: https://github.com/HeinrichApfelmus/reactive-banana/pull/267
+  [#261]: https://github.com/HeinrichApfelmus/reactive-banana/issues/261
+
+**Version 1.3.1.0** (2022-08-11)
+
 * Various internal performance improvements. [#257][], [#258][]
 * Fix a space leak in dynamic event switching. [#256][]
 * Reduce memory usage of `stepper`/`accumB`. [#260][]
@@ -54,7 +62,6 @@
   [#211]: https://github.com/HeinrichApfelmus/reactive-banana/pull/211
   [#212]: https://github.com/HeinrichApfelmus/reactive-banana/pull/212
   [#220]: https://github.com/HeinrichApfelmus/reactive-banana/pull/219
-
 
 **version 1.2.1.0**
 
diff --git a/reactive-banana.cabal b/reactive-banana.cabal
--- a/reactive-banana.cabal
+++ b/reactive-banana.cabal
@@ -1,5 +1,5 @@
 Name:                reactive-banana
-Version:             1.3.1.0
+Version:             1.3.2.0
 Synopsis:            Library for functional reactive programming (FRP).
 Description:
     Reactive-banana is a library for Functional Reactive Programming (FRP).
@@ -25,7 +25,12 @@
 Category:            FRP
 Cabal-version:       1.18
 Build-type:          Simple
-Tested-with:         GHC == 8.4.3, GHC == 8.6.1
+Tested-with:         GHC == 9.4.1
+                   , GHC == 9.2.4
+                   , GHC == 8.10.7
+                   , GHC == 8.8.4
+                   , GHC == 8.6.5
+                   , GHC == 8.4.4
 
 extra-source-files:     CHANGELOG.md,
                         doc/examples/*.hs
@@ -41,6 +46,7 @@
     hs-source-dirs:     src
 
     build-depends:      base >= 4.2 && < 5,
+                        deepseq >= 1.4.3.0 && < 1.5,
                         semigroups >= 0.13 && < 0.21,
                         containers >= 0.5 && < 0.7,
                         transformers >= 0.2 && < 0.7,
@@ -48,6 +54,7 @@
                         unordered-containers >= 0.2.1.0 && < 0.3,
                         hashable >= 1.1 && < 1.5,
                         pqueue >= 1.0 && < 1.5,
+                        stm >= 2.5 && < 2.6,
                         these >= 0.2 && < 1.2
 
     exposed-modules:
@@ -57,45 +64,80 @@
                         Reactive.Banana.Frameworks,
                         Reactive.Banana.Model,
                         Reactive.Banana.Prim.Mid,
-                        Reactive.Banana.Prim.High.Cached
+                        Reactive.Banana.Prim.High.Cached,
+                        Reactive.Banana.Prim.Low.Graph,
+                        Reactive.Banana.Prim.Low.GraphGC,
+                        Reactive.Banana.Prim.Low.Ref
 
     other-modules:
                         Control.Monad.Trans.ReaderWriterIO,
                         Control.Monad.Trans.RWSIO,
-                        Reactive.Banana.Prim.Low.Compile,
-                        Reactive.Banana.Prim.Low.Dependencies,
-                        Reactive.Banana.Prim.Low.Evaluation,
-                        Reactive.Banana.Prim.Low.Graph,
-                        Reactive.Banana.Prim.Low.IO,
                         Reactive.Banana.Prim.Low.OrderedBag,
-                        Reactive.Banana.Prim.Low.Plumbing,
-                        Reactive.Banana.Prim.Low.Types,
-                        Reactive.Banana.Prim.Low.Util,
+                        Reactive.Banana.Prim.Low.GraphTraversal,
                         Reactive.Banana.Prim.Mid.Combinators,
+                        Reactive.Banana.Prim.Mid.Compile,
+                        Reactive.Banana.Prim.Mid.Evaluation,
+                        Reactive.Banana.Prim.Mid.IO,
+                        Reactive.Banana.Prim.Mid.Plumbing,
                         Reactive.Banana.Prim.Mid.Test,
+                        Reactive.Banana.Prim.Mid.Types,
                         Reactive.Banana.Prim.High.Combinators,
                         Reactive.Banana.Types
-    
+
     ghc-options: -Wall -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-uni-patterns -Werror=missing-fields -Werror=partial-fields -Wno-name-shadowing
 
-Test-Suite tests
+Test-Suite unit
     default-language:   Haskell98
     type:               exitcode-stdio-1.0
-    hs-source-dirs:     tests
-    main-is:            Main.hs
-    other-modules:      Plumbing
-    build-depends:      base >= 4.2 && < 5,
+    hs-source-dirs:     test
+    main-is:            reactive-banana-tests.hs
+    other-modules:      Reactive.Banana.Test.High.Combinators,
+                        Reactive.Banana.Test.High.Plumbing,
+                        Reactive.Banana.Test.High.Space,
+                        Reactive.Banana.Test.Mid.Space,
+                        Reactive.Banana.Test.Low.Gen,
+                        Reactive.Banana.Test.Low.Graph,
+                        Reactive.Banana.Test.Low.GraphGC
+    build-depends:      base >= 4.7 && < 5,
+                        containers,
+                        deepseq >= 1.4.3.0 && < 1.5,
+                        hashable,
+                        pqueue,
+                        reactive-banana,
+                        semigroups,
+                        transformers,
                         tasty,
                         tasty-hunit,
-                        reactive-banana, vault, containers,
-                        semigroups, transformers,
-                        unordered-containers, hashable, psqueues, pqueue, these
+                        tasty-quickcheck >= 0.10.1.2 && < 0.11,
+                        QuickCheck >= 2.10 && < 2.15,
+                        unordered-containers,
+                        vault,
+                        these
 
+Benchmark space
+  default-language:     Haskell2010
+  type:                 exitcode-stdio-1.0
+  build-depends:        base
+                      , reactive-banana
+                      , tasty-quickcheck
+                      , tasty
+                      , QuickCheck
+  hs-source-dirs:       test
+  main-is:              space.hs
+  other-modules:        Reactive.Banana.Test.Mid.Space
+                      , Reactive.Banana.Test.High.Space
+  ghc-options:        -rtsopts -eventlog
 
+
 Benchmark benchmark
-  default-language:   Haskell2010
-  type:          exitcode-stdio-1.0
-  build-depends: base, tasty-bench, reactive-banana, containers, random, tasty
-  hs-source-dirs: benchmark
-  main-is: Main.hs
-  ghc-options:  "-with-rtsopts=-A32m"
+  default-language:     Haskell2010
+  type:                 exitcode-stdio-1.0
+  build-depends:        base
+                      , reactive-banana
+                      , containers
+                      , random
+                      , tasty
+                      , tasty-bench
+  hs-source-dirs:       benchmark
+  main-is:              Main.hs
+  ghc-options:          "-with-rtsopts=-A32m"
diff --git a/src/Control/Monad/Trans/RWSIO.hs b/src/Control/Monad/Trans/RWSIO.hs
--- a/src/Control/Monad/Trans/RWSIO.hs
+++ b/src/Control/Monad/Trans/RWSIO.hs
@@ -26,7 +26,6 @@
     (<*>) = apR
 
 instance Monad m => Monad (RWSIOT r w s m) where
-    return = returnR
     (>>=)  = bindR
 
 instance MonadFix m => MonadFix (RWSIOT r w s m) where mfix = mfixR
@@ -44,9 +43,6 @@
 
 fmapR :: Functor m => (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b
 fmapR f m = R $ \x -> fmap f (run m x)
-
-returnR :: Monad m => a -> RWSIOT r w s m a
-returnR a = R $ \_ -> return a
 
 bindR :: Monad m => RWSIOT r w s m a -> (a -> RWSIOT r w s m b) -> RWSIOT r w s m b
 bindR m k = R $ \x -> run m x >>= \a -> run (k a) x
diff --git a/src/Control/Monad/Trans/ReaderWriterIO.hs b/src/Control/Monad/Trans/ReaderWriterIO.hs
--- a/src/Control/Monad/Trans/ReaderWriterIO.hs
+++ b/src/Control/Monad/Trans/ReaderWriterIO.hs
@@ -25,7 +25,6 @@
     (<*>) = apR
 
 instance Monad m => Monad (ReaderWriterIOT r w m) where
-    return = returnR
     (>>=)  = bindR
 
 instance MonadFix m => MonadFix (ReaderWriterIOT r w m) where mfix = mfixR
@@ -50,9 +49,6 @@
 
 fmapR :: Functor m => (a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b
 fmapR f m = ReaderWriterIOT $ \x y -> fmap f (run m x y)
-
-returnR :: Monad m => a -> ReaderWriterIOT r w m a
-returnR a = ReaderWriterIOT $ \_ _ -> return a
 
 bindR :: Monad m => ReaderWriterIOT r w m a -> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b
 bindR m k = ReaderWriterIOT $ \x y -> run m x y >>= \a -> run (k a) x y
diff --git a/src/Reactive/Banana/Frameworks.hs b/src/Reactive/Banana/Frameworks.hs
--- a/src/Reactive/Banana/Frameworks.hs
+++ b/src/Reactive/Banana/Frameworks.hs
@@ -33,7 +33,7 @@
     interpretFrameworks, newEvent, mapEventIO, newBehavior,
 
     -- * Running event networks
-    EventNetwork, actuate, pause,
+    EventNetwork, actuate, pause, getSize,
 
     ) where
 
@@ -331,6 +331,12 @@
 -- the current event has been processed completely.
 pause :: EventNetwork -> IO ()
 pause   = Prim.pause . unEN
+
+-- | PROVISIONAL.
+-- Measure of the number of events in the event network.
+-- Useful for understanding space usage.
+getSize :: EventNetwork -> IO Int
+getSize = Prim.getSize . unEN
 
 {-----------------------------------------------------------------------------
     Utilities
diff --git a/src/Reactive/Banana/Prim/High/Combinators.hs b/src/Reactive/Banana/Prim/High/Combinators.hs
--- a/src/Reactive/Banana/Prim/High/Combinators.hs
+++ b/src/Reactive/Banana/Prim/High/Combinators.hs
@@ -45,12 +45,12 @@
 -- | Data type representing an event network.
 data EventNetwork = EventNetwork
     { actuated :: IORef Bool
+    , size :: IORef Int
     , s :: MVar Prim.Network
     }
 
-
 runStep :: EventNetwork -> Prim.Step -> IO ()
-runStep EventNetwork{ actuated, s } f = whenFlag actuated $ do
+runStep EventNetwork{ actuated, s, size } f = whenFlag actuated $ do
     output <- mask $ \restore -> do
         s1 <- takeMVar s                   -- read and take lock
         -- pollValues <- sequence polls    -- poll mutable data
@@ -58,11 +58,14 @@
             restore (f s1)                 -- calculate new state
                 `onException` putMVar s s1 -- on error, restore the original state
         putMVar s s2                       -- write state
+        writeIORef size =<< Prim.getSize s2
         return output
     output                                 -- run IO actions afterwards
   where
     whenFlag flag action = readIORef flag >>= \b -> when b action
 
+getSize :: EventNetwork -> IO Int
+getSize EventNetwork{size} = readIORef size
 
 actuate :: EventNetwork -> IO ()
 actuate EventNetwork{ actuated } = writeIORef actuated True
@@ -75,12 +78,14 @@
 compile setup = do
     actuated <- newIORef False                   -- flag to set running status
     s        <- newEmptyMVar                     -- setup callback machinery
+    size     <- newIORef 0
 
-    let eventNetwork = EventNetwork{ actuated, s }
+    let eventNetwork = EventNetwork{ actuated, s, size }
 
     (_output, s0) <-                             -- compile initial graph
         Prim.compile (runReaderT setup eventNetwork) =<< Prim.emptyNetwork
     putMVar s s0                                -- set initial state
+    writeIORef size =<< Prim.getSize s0
 
     return eventNetwork
 
diff --git a/src/Reactive/Banana/Prim/Low/Compile.hs b/src/Reactive/Banana/Prim/Low/Compile.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Low/Compile.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE NamedFieldPuns #-}
-module Reactive.Banana.Prim.Low.Compile where
-
-import Control.Exception (evaluate)
-import Data.Functor
-import Data.IORef
-
-import           Reactive.Banana.Prim.Mid.Combinators (mapP)
-import           Reactive.Banana.Prim.Low.IO
-import qualified Reactive.Banana.Prim.Low.OrderedBag  as OB
-import           Reactive.Banana.Prim.Low.Plumbing
-import           Reactive.Banana.Prim.Low.Types
-
-{-----------------------------------------------------------------------------
-   Compilation
-------------------------------------------------------------------------------}
--- | Change a 'Network' of pulses and latches by
--- executing a 'BuildIO' action.
-compile :: BuildIO a -> Network -> IO (a, Network)
-compile m Network{nTime, nOutputs, nAlwaysP} = do
-    (a, topology, os) <- runBuildIO (nTime, nAlwaysP) m
-    doit topology
-
-    let state2 = Network
-            { nTime    = next nTime
-            , nOutputs = OB.inserts nOutputs os
-            , nAlwaysP
-            }
-    return (a,state2)
-
-emptyNetwork :: IO Network
-emptyNetwork = do
-  (alwaysP, _, _) <- runBuildIO undefined $ newPulse "alwaysP" (return $ Just ())
-  pure Network
-    { nTime    = next beginning
-    , nOutputs = OB.empty
-    , nAlwaysP = alwaysP
-    }
-
-{-----------------------------------------------------------------------------
-    Testing
-------------------------------------------------------------------------------}
--- | Simple interpreter for pulse/latch networks.
---
--- Mainly useful for testing functionality
---
--- Note: The result is not computed lazily, for similar reasons
--- that the 'sequence' function does not compute its result lazily.
-interpret :: (Pulse a -> BuildIO (Pulse b)) -> [Maybe a] -> IO [Maybe b]
-interpret f xs = do
-    o   <- newIORef Nothing
-    let network = do
-            (pin, sin) <- liftBuild newInput
-            pmid       <- f pin
-            pout       <- liftBuild $ mapP return pmid
-            liftBuild $ addHandler pout (writeIORef o . Just)
-            return sin
-
-    -- compile initial network
-    (sin, state) <- compile network =<< emptyNetwork
-
-    let go Nothing  s1 = return (Nothing,s1)
-        go (Just a) s1 = do
-            (reactimate,s2) <- sin a s1
-            reactimate              -- write output
-            ma <- readIORef o       -- read output
-            writeIORef o Nothing
-            return (ma,s2)
-
-    mapAccumM go state xs         -- run several steps
-
--- | Execute an FRP network with a sequence of inputs.
--- Make sure that outputs are evaluated, but don't display their values.
---
--- Mainly useful for testing whether there are space leaks.
-runSpaceProfile :: Show b => (Pulse a -> BuildIO (Pulse b)) -> [a] -> IO ()
-runSpaceProfile f xs = do
-    let g = do
-        (p1, fire) <- liftBuild newInput
-        p2 <- f p1
-        p3 <- mapP return p2                -- wrap into Future
-        addHandler p3 (void . evaluate)
-        return fire
-    (step,network) <- compile g =<< emptyNetwork
-
-    let fire x s1 = do
-            (outputs, s2) <- step x s1
-            outputs                     -- don't forget to execute outputs
-            return ((), s2)
-
-    mapAccumM_ fire network xs
-
--- | 'mapAccum' for a monad.
-mapAccumM :: Monad m => (a -> s -> m (b,s)) -> s -> [a] -> m [b]
-mapAccumM _ _  []     = return []
-mapAccumM f s0 (x:xs) = do
-    (b,s1) <- f x s0
-    bs     <- mapAccumM f s1 xs
-    return (b:bs)
-
--- | Strict 'mapAccum' for a monad. Discards results.
-mapAccumM_ :: Monad m => (a -> s -> m (b,s)) -> s -> [a] -> m ()
-mapAccumM_ _ _   []     = return ()
-mapAccumM_ f !s0 (x:xs) = do
-    (_,s1) <- f x s0
-    mapAccumM_ f s1 xs
diff --git a/src/Reactive/Banana/Prim/Low/Dependencies.hs b/src/Reactive/Banana/Prim/Low/Dependencies.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Low/Dependencies.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE LambdaCase #-}
-module Reactive.Banana.Prim.Low.Dependencies (
-    -- | Utilities for operating on node dependencies.
-    addChild, changeParent, buildDependencies,
-    ) where
-
-import           Control.Monad
-import           Data.Monoid
-import           System.Mem.Weak
-
-import qualified Reactive.Banana.Prim.Low.Graph as Graph
-import           Reactive.Banana.Prim.Low.Types
-import           Reactive.Banana.Prim.Low.Util
-
-{-----------------------------------------------------------------------------
-    Accumulate dependency information for nodes
-------------------------------------------------------------------------------}
--- | Add a new child node to a parent node.
-addChild :: SomeNode -> SomeNode -> DependencyBuilder
-addChild parent child = (Endo $ Graph.insertEdge (parent,child), mempty)
-
--- | Assign a new parent to a child node.
--- INVARIANT: The child may have only one parent node.
-changeParent :: Pulse a -> Pulse b -> DependencyBuilder
-changeParent child parent = (mempty, [(P child, P parent)])
-
--- | Execute the information in the dependency builder
--- to change network topology.
-buildDependencies :: DependencyBuilder -> IO ()
-buildDependencies (Endo f, parents) = do
-    sequence_ [x `doAddChild` y | x <- Graph.listParents gr, y <- Graph.getChildren gr x]
-    sequence_ [x `doChangeParent` y | (P x, P y) <- parents]
-    where
-    gr :: Graph.Graph SomeNode
-    gr = f Graph.emptyGraph
-
-{-----------------------------------------------------------------------------
-    Set dependencies of individual notes
-------------------------------------------------------------------------------}
--- | Add a child node to the children of a parent 'Pulse'.
-connectChild
-    :: Pulse a  -- ^ Parent node whose '_childP' field is to be updated.
-    -> SomeNode -- ^ Child node to add.
-    -> IO (Weak SomeNode)
-                -- ^ Weak reference with the child as key and the parent as value.
-connectChild parent child = do
-    w <- mkWeakNodeValue child child
-    modify' parent $ update childrenP (w:)
-    mkWeakNodeValue child (P parent)        -- child keeps parent alive
-
--- | Add a child node to a parent node and update evaluation order.
-doAddChild :: SomeNode -> SomeNode -> IO ()
-doAddChild (P parent) (P child) = do
-    level1 <- _levelP <$> readRef child
-    level2 <- _levelP <$> readRef parent
-    let level = level1 `max` (level2 + 1)
-    w <- parent `connectChild` P child
-    modify' child $ set levelP level . update parentsP (w:)
-doAddChild (P parent) node = void $ parent `connectChild` node
-doAddChild (L _) _ = error "doAddChild: Cannot add children to LatchWrite"
-doAddChild (O _) _ = error "doAddChild: Cannot add children to Output"
-
--- | Remove a node from its parents and all parents from this node.
-removeParents :: Pulse a -> IO ()
-removeParents child = do
-    c@Pulse{_parentsP} <- readRef child
-    -- delete this child (and dead children) from all parent nodes
-    forM_ _parentsP $ \w -> do
-        Just (P parent) <- deRefWeak w  -- get parent node
-        finalize w                      -- severe connection in garbage collector
-        let isGoodChild w = deRefWeak w >>= \x ->
-              case x of
-                Just y | y /= P child -> return True
-                _                     -> do
-                  -- The old parent refers to this child. In this case we'll remove
-                  -- this child from the parent, but we also need to finalize the
-                  -- weak pointer that points to the child. We need to do this because
-                  -- otherwise the weak pointer will stay alive (even though it's
-                  -- unreachable) for as long as the child is alive
-                  -- https://github.com/HeinrichApfelmus/reactive-banana/pull/256
-                  finalize w
-                  return False
-        new <- filterM isGoodChild . _childrenP =<< readRef parent
-        modify' parent $ set childrenP new
-    -- replace parents by empty list
-    put child $ c{_parentsP = []}
-
--- | Set the parent of a pulse to a different pulse.
-doChangeParent :: Pulse a -> Pulse b -> IO ()
-doChangeParent child parent = do
-    -- remove all previous parents and connect to new parent
-    removeParents child
-    w <- parent `connectChild` P child
-    modify' child $ update parentsP (w:)
-
-    -- calculate level difference between parent and node
-    levelParent <- _levelP <$> readRef parent
-    levelChild  <- _levelP <$> readRef child
-    let d = levelParent - levelChild + 1
-    -- level parent - d = level child - 1
-
-    -- lower all parents of the node if the parent was higher than the node
-    when (d > 0) $ do
-        parents <- Graph.reversePostOrder (P parent) getParents
-        forM_ parents $ \case
-            P node -> modify' node $ update levelP (subtract d)
-            L _    -> error "doChangeParent: Cannot change parent of LatchWrite"
-            O _    -> error "doChangeParent: Cannot change parent of Output"
-
-{-----------------------------------------------------------------------------
-    Helper functions
-------------------------------------------------------------------------------}
-getParents :: SomeNode -> IO [SomeNode]
-getParents (P p) = deRefWeaks . _parentsP =<< readRef p
-getParents _     = return []
diff --git a/src/Reactive/Banana/Prim/Low/Evaluation.hs b/src/Reactive/Banana/Prim/Low/Evaluation.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Low/Evaluation.hs
+++ /dev/null
@@ -1,120 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE RecordWildCards #-}
-module Reactive.Banana.Prim.Low.Evaluation (
-    step
-    ) where
-
-import Control.Monad ( join )
-import           Control.Monad.IO.Class
-import qualified Control.Monad.Trans.RWSIO          as RWS
-import qualified Data.PQueue.Prio.Min               as Q
-import qualified Data.Vault.Lazy                    as Lazy
-import           System.Mem.Weak
-
-import qualified Reactive.Banana.Prim.Low.OrderedBag as OB
-import           Reactive.Banana.Prim.Low.Plumbing
-import           Reactive.Banana.Prim.Low.Types
-import           Reactive.Banana.Prim.Low.Util
-
-type Queue = Q.MinPQueue Level
-
-{-----------------------------------------------------------------------------
-    Evaluation step
-------------------------------------------------------------------------------}
--- | Evaluate all the pulses in the graph,
--- Rebuild the graph as necessary and update the latch values.
-step :: Inputs -> Step
-step (inputs,pulses)
-        Network{ nTime = time1
-        , nOutputs = outputs1
-        , nAlwaysP = alwaysP
-        }
-    = do
-
-    -- evaluate pulses
-    ((_, (latchUpdates, outputs)), topologyUpdates, os)
-            <- runBuildIO (time1, alwaysP)
-            $  runEvalP pulses
-            $  evaluatePulses inputs
-
-    doit latchUpdates                           -- update latch values from pulses
-    doit topologyUpdates                        -- rearrange graph topology
-    let actions :: [(Output, EvalO)]
-        actions = OB.inOrder outputs outputs1   -- EvalO actions in proper order
-
-        state2 :: Network
-        !state2 = Network
-            { nTime    = next time1
-            , nOutputs = OB.inserts outputs1 os
-            , nAlwaysP = alwaysP
-            }
-    return (runEvalOs $ map snd actions, state2)
-
-runEvalOs :: [EvalO] -> IO ()
-runEvalOs = mapM_ join
-
-{-----------------------------------------------------------------------------
-    Traversal in dependency order
-------------------------------------------------------------------------------}
--- | Update all pulses in the graph, starting from a given set of nodes
-evaluatePulses :: [SomeNode] -> EvalP ()
-evaluatePulses roots = wrapEvalP $ \r -> go r =<< insertNodes r roots Q.empty
-    where
-    go :: RWS.Tuple BuildR (EvalPW, BuildW) Lazy.Vault -> Queue SomeNode -> IO ()
-    go r q =
-        case ({-# SCC minView #-} Q.minView q) of
-            Nothing         -> return ()
-            Just (node, q)  -> do
-                children <- unwrapEvalP r (evaluateNode node)
-                q        <- insertNodes r children q
-                go r q
-
--- | Recalculate a given node and return all children nodes
--- that need to evaluated subsequently.
-evaluateNode :: SomeNode -> EvalP [SomeNode]
-evaluateNode (P p) = {-# SCC evaluateNodeP #-} do
-    Pulse{..} <- readRef p
-    ma        <- _evalP
-    writePulseP _keyP ma
-    case ma of
-        Nothing -> return []
-        Just _  -> liftIO $ deRefWeaks _childrenP
-evaluateNode (L lw) = {-# SCC evaluateNodeL #-} do
-    time           <- askTime
-    LatchWrite{..} <- readRef lw
-    mlatch         <- liftIO $ deRefWeak _latchLW -- retrieve destination latch
-    case mlatch of
-        Nothing    -> return ()
-        Just latch -> do
-            a <- _evalLW                    -- calculate new latch value
-            -- liftIO $ Strict.evaluate a      -- see Note [LatchStrictness]
-            rememberLatchUpdate $           -- schedule value to be set later
-                modify' latch $ \l ->
-                    a `seq` l { _seenL = time, _valueL = a }
-    return []
-evaluateNode (O o) = {-# SCC evaluateNodeO #-} do
-    debug "evaluateNode O"
-    Output{..} <- readRef o
-    m          <- _evalO                    -- calculate output action
-    rememberOutput (o,m)
-    return []
-
--- | Insert nodes into the queue
-insertNodes :: RWS.Tuple BuildR (EvalPW, BuildW) Lazy.Vault -> [SomeNode] -> Queue SomeNode -> IO (Queue SomeNode)
-insertNodes (RWS.Tuple (time,_) _ _) = go
-    where
-    go :: [SomeNode] -> Queue SomeNode -> IO (Queue SomeNode)
-    go []              q = return q
-    go (node@(P p):xs) q = do
-        Pulse{..} <- readRef p
-        if time <= _seenP
-            then go xs q        -- pulse has already been put into the queue once
-            else do             -- pulse needs to be scheduled for evaluation
-                put p $! (let p = Pulse{..} in p { _seenP = time })
-                go xs $! Q.insert _levelP node q
-    go (node:xs)      q = go xs $! Q.insert ground node q
-            -- O and L nodes have only one parent, so
-            -- we can insert them at an arbitrary level
diff --git a/src/Reactive/Banana/Prim/Low/Graph.hs b/src/Reactive/Banana/Prim/Low/Graph.hs
--- a/src/Reactive/Banana/Prim/Low/Graph.hs
+++ b/src/Reactive/Banana/Prim/Low/Graph.hs
@@ -1,102 +1,300 @@
+{-# language BangPatterns #-}
+{-# language NamedFieldPuns #-}
+{-# language RecordWildCards #-}
+{-# language ScopedTypeVariables #-}
 {-----------------------------------------------------------------------------
     reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Low.Graph
+    ( Graph
+    , empty
+    , getOutgoing
+    , getIncoming
+    , size
+    , edgeCount
+    , listConnectedVertices
 
-    Implementation of graph-related functionality
+    , deleteVertex
+    , insertEdge
+    , deleteEdge
+    , clearPredecessors
+    , collectGarbage
+
+    , topologicalSort
+    , Step (..)
+    , walkSuccessors
+    , walkSuccessors_
+
+    -- * Internal
+    , Level
+    , getLevel
+
+    -- * Debugging
+    , showDot
+    ) where
+
+import Data.Functor.Identity
+    ( Identity (..) )
+import Data.Hashable
+    ( Hashable )
+import Data.Maybe
+    ( fromMaybe )
+import Reactive.Banana.Prim.Low.GraphTraversal
+    ( reversePostOrder )
+
+import qualified Data.List as L
+import qualified Data.HashMap.Strict as Map
+import qualified Data.HashSet as Set
+import qualified Data.PQueue.Prio.Min as Q
+
+type Queue = Q.MinPQueue
+type Map = Map.HashMap
+type Set = Set.HashSet
+
+{-----------------------------------------------------------------------------
+    Levels
 ------------------------------------------------------------------------------}
-{-# language ScopedTypeVariables#-}
+-- | 'Level's are used to keep track of the order of vertices —
+-- Lower levels come first.
+type Level = Int
 
-module Reactive.Banana.Prim.Low.Graph
-  ( Graph
-  , emptyGraph
-  , insertEdge
-  , getChildren
-  , getParents
-  , listParents
-  , reversePostOrder
-  ) where
+ground :: Level
+ground = 0
 
-import           Data.Functor.Identity
-import           Data.Hashable
-import qualified Data.HashMap.Strict   as Map
-import qualified Data.HashSet          as Set
-import           Data.Maybe
+{-----------------------------------------------------------------------------
+    Graph
+------------------------------------------------------------------------------}
+{- | A directed graph
+whose set of vertices is the set of all values of the type @v@
+and whose edges are associated with data of type @e@.
 
+Note that a 'Graph' does not have a notion of vertex membership
+— by design, /all/ values of the type @v@ are vertices of the 'Graph'.
+The main purpose of 'Graph' is to keep track of directed edges between
+vertices; a vertex with at least one edge incident on it is called
+a /connected vertex/.
+For efficiency, only the connected vertices are stored.
+-}
+data Graph v e = Graph
+    { -- | Mapping from each vertex to its direct successors
+      -- (possibly empty).
+      outgoing :: !(Map v (Map v e))
+
+      -- | Mapping from each vertex to its direct predecessors
+      -- (possibly empty).
+    , incoming :: !(Map v (Map v e))
+
+      -- | Mapping from each vertex to its 'Level'.
+      -- Invariant: If x precedes y, then x has a lower level than y.
+    , levels :: !(Map v Level)
+    } deriving (Eq, Show)
+
+-- | The graph with no edges.
+empty :: Graph v e
+empty = Graph
+    { outgoing = Map.empty
+    , incoming = Map.empty
+    , levels = Map.empty
+    }
+
+-- | Get all direct successors of a vertex in a 'Graph'.
+getOutgoing :: (Eq v, Hashable v) => Graph v e -> v -> [(e,v)]
+getOutgoing Graph{outgoing} x =
+    map shuffle $ Map.toList $ fromMaybe Map.empty $ Map.lookup x outgoing
+  where
+      shuffle (x,y) = (y,x)
+
+-- | Get all direct predecessors of a vertex in a 'Graph'.
+getIncoming :: (Eq v, Hashable v) => Graph v e -> v -> [(v,e)]
+getIncoming Graph{incoming} x =
+    Map.toList $ fromMaybe Map.empty $ Map.lookup x incoming
+
+-- | Get the 'Level' of a vertex in a 'Graph'.
+getLevel :: (Eq v, Hashable v) => Graph v e -> v -> Level
+getLevel Graph{levels} x = fromMaybe ground $ Map.lookup x levels
+
+-- | List all connected vertices,
+-- i.e. vertices on which at least one edge is incident.
+listConnectedVertices :: (Eq v, Hashable v) => Graph v e -> [v]
+listConnectedVertices Graph{incoming,outgoing} = 
+    Map.keys $ (() <$ outgoing) `Map.union` (() <$ incoming)
+
+-- | Number of connected vertices,
+-- i.e. vertices on which at least one edge is incident.
+size :: (Eq v, Hashable v) => Graph v e -> Int
+size Graph{incoming,outgoing} =
+    Map.size $ (() <$ outgoing) `Map.union` (() <$ incoming)
+
+-- | Number of edges.
+edgeCount :: (Eq v, Hashable v) => Graph v e -> Int
+edgeCount Graph{incoming,outgoing} =
+    (count incoming + count outgoing) `div` 2
+  where
+    count = Map.foldl' (\a v -> Map.size v + a) 0
+
 {-----------------------------------------------------------------------------
-    Graphs and topological sorting
+    Insertion
 ------------------------------------------------------------------------------}
-data Graph a = Graph
-    { -- | The mapping from each node to the set of nodes reachable by an out-edge. If a node has no out-edges, it is
-      -- not a member of this map.
-      --
-      -- Invariant: the values are non-empty lists.
-      children :: Map.HashMap a [a]
-      -- | The Mapping from each node to the set of nodes reachable by an in-edge. If a node has no in-edges, it is not
-      -- a member of this map.
-      --
-      -- Invariant: the values are non-empty lists.
-    , parents  :: Map.HashMap a [a]
-      -- | The set of nodes.
-      --
-      -- Invariant: equals (key children `union` keys parents)
-    , nodes    :: Set.HashSet a
+-- | Insert an edge from the first to the second vertex into the 'Graph'.
+insertEdge :: (Eq v, Hashable v) => (v,v) -> e -> Graph v e -> Graph v e
+insertEdge (x,y) exy g0@Graph{..} = Graph
+    { outgoing
+        = Map.insertWith (\new old -> new <> old) x (Map.singleton y exy)
+        $ insertDefaultIfNotMember y Map.empty
+        $ outgoing
+    , incoming
+        = Map.insertWith (\new old -> new <> old) y (Map.singleton x exy)
+        . insertDefaultIfNotMember x Map.empty
+        $ incoming
+    , levels
+        = adjustLevels
+        $ levels0
     }
+  where
+    getLevel z = fromMaybe ground . Map.lookup z
+    levels0
+        = insertDefaultIfNotMember x (ground-1)
+        . insertDefaultIfNotMember y ground
+        $ levels
 
--- | The graph with no edges and no nodes.
-emptyGraph :: Graph a
-emptyGraph = Graph Map.empty Map.empty Set.empty
+    levelDifference = getLevel y levels0 - 1 - getLevel x levels0
+    adjustLevel g x = Map.adjust (+ levelDifference) x g
+    adjustLevels ls
+        | levelDifference >= 0 = ls
+        | otherwise            = L.foldl' adjustLevel ls predecessors
+      where
+        Identity predecessors =
+            reversePostOrder [x] (Identity . map fst . getIncoming g0)
 
--- | Insert an edge from the first node to the second node into the graph.
-insertEdge :: (Eq a, Hashable a) => (a,a) -> Graph a -> Graph a
-insertEdge (x,y) gr = gr
-    { children = Map.insertWith (\new old -> new ++ old) x [y] (children gr)
-    , parents  = Map.insertWith (\new old -> new ++ old) y [x] (parents  gr)
-    , nodes    = Set.insert x $ Set.insert y $ nodes gr
+-- Helper function: Insert a default value if the key is not a member yet
+insertDefaultIfNotMember
+    :: (Eq k, Hashable k)
+    => k -> a -> Map k a -> Map k a
+insertDefaultIfNotMember x def = Map.insertWith (\_ old -> old) x def
+
+{-----------------------------------------------------------------------------
+    Deletion
+------------------------------------------------------------------------------}
+-- | TODO: Not implemented.
+deleteEdge :: (Eq v, Hashable v) => (v,v) -> Graph v e -> Graph v e
+deleteEdge (x,y) g = Graph
+    { outgoing = undefined x g
+    , incoming = undefined y g
+    , levels = undefined
     }
 
--- | Get all immediate children of a node in a graph.
-getChildren :: (Eq a, Hashable a) => Graph a -> a -> [a]
-getChildren gr x = fromMaybe [] . Map.lookup x . children $ gr
+-- | Remove all edges incident on this vertex from the 'Graph'.
+deleteVertex :: (Eq v, Hashable v) => v -> Graph v e -> Graph v e
+deleteVertex x = clearLevels . clearPredecessors x . clearSuccessors x
+  where
+    clearLevels g@Graph{levels} = g{levels = Map.delete x levels}
 
--- | Get all immediate parents of a node in a graph.
-getParents :: (Eq a, Hashable a) => Graph a -> a -> [a]
-getParents gr x = fromMaybe [] . Map.lookup x . parents $ gr
+-- | Remove all the edges that connect the given vertex to its predecessors.
+clearPredecessors :: (Eq v, Hashable v) => v -> Graph v e -> Graph v e
+clearPredecessors x g@Graph{..} = g
+    { outgoing = foldr ($) outgoing
+        [ Map.adjust (Map.delete x) z | (z,_) <- getIncoming g x ]
+    , incoming = Map.delete x incoming
+    }
 
--- | List all nodes such that each parent is listed before all of its children.
-listParents :: forall a. (Eq a, Hashable a) => Graph a -> [a]
-listParents gr = list
-    where
-    -- all nodes without parents
-    ancestors :: [a]
-    -- We can filter from `children`, because a node without incoming edges can only be in the graph if it has outgoing edges.
-    ancestors    = [x | x <- Map.keys (children gr), not (hasParents x)]
-    hasParents x = Map.member x (parents gr)
-    -- all nodes in topological order "parents before children"
-    list = runIdentity $ reversePostOrder' ancestors (Identity . getChildren gr)
+-- | Remove all the edges that connect the given vertex to its successors.
+clearSuccessors :: (Eq v, Hashable v) => v -> Graph v e -> Graph v e
+clearSuccessors x g@Graph{..} = g
+    { outgoing = Map.delete x outgoing
+    , incoming = foldr ($) incoming
+        [ Map.adjust (Map.delete x) z | (_,z) <- getOutgoing g x ]
+    }
 
+-- | Apply `deleteVertex` to all vertices which are not predecessors
+-- of any of the vertices in the given list.
+collectGarbage :: (Eq v, Hashable v) => [v] -> Graph v e -> Graph v e
+collectGarbage roots g@Graph{incoming,outgoing} = g
+    { incoming = Map.filterWithKey (\v _ -> isReachable v) incoming
+        -- incoming edges of reachable members are reachable by definition
+    , outgoing
+        = Map.map (Map.filterWithKey (\v _ -> isReachable v))
+        $ Map.filterWithKey (\v _ -> isReachable v) outgoing
+    }
+  where
+    isReachable x = x `Set.member` reachables
+    reachables
+        = Set.fromList . runIdentity
+        $ reversePostOrder roots
+        $ Identity . map fst . getIncoming g
+
 {-----------------------------------------------------------------------------
-    Graph traversal
+    Topological sort
 ------------------------------------------------------------------------------}
--- | Graph represented as map of immediate children.
-type GraphM m a = a -> m [a]
+-- | If the 'Graph' is acyclic, return a topological sort,
+-- that is a linear ordering of its connected vertices such that
+-- each vertex occurs before its successors.
+--
+-- (Vertices that are not connected are not listed in the topological sort.)
+--
+-- https://en.wikipedia.org/wiki/Topological_sorting
+topologicalSort :: (Eq v, Hashable v) => Graph v e -> [v]
+topologicalSort g@Graph{incoming} =
+    runIdentity $ reversePostOrder roots (Identity . map snd . getOutgoing g)
+  where
+    -- all vertices that have no (direct) predecessors
+    roots = [ x | (x,preds) <- Map.toList incoming, null preds ]
 
--- | Computes the reverse post-order,
--- listing all transitive children of a node.
--- Each node is listed *before* all its children have been listed.
-reversePostOrder :: (Eq a, Hashable a, Monad m) => a -> GraphM m a -> m [a]
-reversePostOrder x = reversePostOrder' [x]
+data Step = Next | Stop
 
--- | Reverse post-order from multiple nodes.
--- INVARIANT: For this to be a valid topological order,
--- none of the nodes may have a parent.
-reversePostOrder' :: (Eq a, Hashable a, Monad m) => [a] -> GraphM m a -> m [a]
-reversePostOrder' xs children = fst <$> go xs [] Set.empty
-    where
-    go []     rpo visited        = return (rpo, visited)
-    go (x:xs) rpo visited
-        | x `Set.member` visited = go xs rpo visited
-        | otherwise              = do
-            xs' <- children x
-            -- visit all children
-            (rpo', visited') <- go xs' rpo (Set.insert x visited)
-            -- prepend this node as all children have been visited
-            go xs (x:rpo') visited'
+-- | Starting from a list of vertices without predecessors,
+-- walk through all successors, but in such a way that every vertex
+-- is visited before its predecessors.
+-- For every vertex, if the function returns `Next`, then
+-- the successors are visited, otherwise the walk at the vertex
+-- stops prematurely.
+--
+-- > topologicalSort g =
+-- >     runIdentity $ walkSuccessors (roots g) (pure Next) g
+--
+walkSuccessors
+    :: forall v e m. (Monad m, Eq v, Hashable v)
+    => [v] -> (v -> m Step) -> Graph v e -> m [v]
+walkSuccessors xs step g = go (Q.fromList $ zipLevels xs) Set.empty []
+  where
+    zipLevels vs = [(getLevel g v, v) | v <- vs]
+
+    go :: Queue Level v -> Set v -> [v] -> m [v]
+    go q0 seen visits = case Q.minView q0 of
+        Nothing -> pure $ reverse visits
+        Just (v,q1)
+            | v `Set.member` seen -> go q1 seen visits
+            | otherwise -> do
+                next <- step v
+                let q2 = case next of
+                      Stop -> q1
+                      Next ->
+                          let successors = zipLevels $ map snd $ getOutgoing g v
+                          in  insertList q1 successors
+                go q2 (Set.insert v seen) (v:visits)
+
+
+insertList :: Ord k => Queue k v -> [(k,v)] -> Queue k v
+insertList = L.foldl' (\q (k,v) -> Q.insert k v q)
+
+walkSuccessors_
+    :: (Monad m, Eq v, Hashable v)
+    => [v] -> (v -> m Step) -> Graph v e -> m ()
+walkSuccessors_ xs step g = walkSuccessors xs step g >> pure ()
+
+{-----------------------------------------------------------------------------
+    Debugging
+------------------------------------------------------------------------------}
+-- | Map to a string in @graphviz@ dot file format.
+showDot
+    :: (Eq v, Hashable v)
+    => (v -> String) -> Graph v e -> String
+showDot fv g = unlines $
+    [ "digraph mygraph {"
+    , "  node [shape=box];"
+    ] <> map showVertex (listConnectedVertices g)
+    <> ["}"]
+  where
+    showVertex x =
+        concat [ "  " <> showEdge x y <> "; " | (_,y) <- getOutgoing g x ]
+    showEdge x y = escape x <> " -> " <> escape y
+    escape = show . fv
diff --git a/src/Reactive/Banana/Prim/Low/GraphGC.hs b/src/Reactive/Banana/Prim/Low/GraphGC.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Low/GraphGC.hs
@@ -0,0 +1,223 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Low.GraphGC
+    ( GraphGC
+    , listReachableVertices
+    , getSize
+    , new
+    , insertEdge
+    , clearPredecessors
+
+    , Step (..)
+    , walkSuccessors
+    , walkSuccessors_
+
+    , removeGarbage
+    
+    -- * Debugging
+    , printDot
+    ) where
+
+import Control.Applicative
+    ( (<|>) )
+import Control.Monad
+    ( unless )
+import Data.IORef
+    ( IORef, atomicModifyIORef', newIORef, readIORef )
+import Data.Maybe
+    ( fromJust )
+import Data.Unique.Really
+    ( Unique )
+import Reactive.Banana.Prim.Low.Graph 
+    ( Graph, Step )
+import Reactive.Banana.Prim.Low.Ref
+    ( Ref, WeakRef )
+
+import qualified Control.Concurrent.STM as STM
+import qualified Data.HashMap.Strict as Map
+import qualified Reactive.Banana.Prim.Low.Graph as Graph
+import qualified Reactive.Banana.Prim.Low.Ref as Ref
+
+type Map = Map.HashMap
+
+{-----------------------------------------------------------------------------
+    GraphGC
+------------------------------------------------------------------------------}
+type WeakEdge v = WeakRef v
+
+-- Graph data
+data GraphD v = GraphD
+    { graph :: !(Graph Unique (WeakEdge v))
+    , references :: !(Map Unique (WeakRef v))
+    }
+
+{- | A directed graph whose edges are mutable
+    and whose vertices are subject to garbage collection.
+
+    The vertices of the graph are mutable references of type 'Ref v'.
+    
+
+    Generally, the vertices of the graph are not necessarily kept reachable
+    by the 'GraphGC' data structure
+    — they need to be kept reachable by other parts of your program.
+
+    That said, the edges in the graph do introduce additional reachability
+    between vertices:
+    Specifically, when an edge (x,y) is present in the graph,
+    then the head @y@ will keep the tail @x@ reachable.
+    (But the liveness of @y@ needs to come from elsewhere, e.g. another edge.)
+    Use 'insertEdge' to insert an edge.
+
+    Moreover, when a vertex is removed because it is no longer reachable,
+    then all edges to and from that vertex will also be removed.
+    In turn, this may cause further vertices and edges to be removed.
+
+    Concerning garbage collection:
+    Note that vertices and edges will not be removed automatically
+    when the Haskell garbage collector runs —
+    they will be marked as garbage by the Haskell runtime,
+    but the actual removal of garbage needs
+    to be done explicitly by calling 'removeGarbage'.
+    This procedure makes it easier to reason about the state of the 'GraphGC'
+    during a call to e.g. 'walkSuccessors'.
+-}
+data GraphGC v = GraphGC
+    { graphRef :: IORef (GraphD v)
+    , deletions :: STM.TQueue Unique
+    }
+
+-- | Create a new 'GraphGC'.
+new :: IO (GraphGC v)
+new = GraphGC <$> newIORef newGraphD <*> STM.newTQueueIO
+  where
+    newGraphD = GraphD
+        { graph = Graph.empty
+        , references = Map.empty
+        }
+
+getSize :: GraphGC v -> IO Int
+getSize GraphGC{graphRef} = Graph.size . graph <$> readIORef graphRef
+
+-- | List all vertices that are reachable and have at least
+-- one edge incident on them.
+-- TODO: Is that really what the function does?
+listReachableVertices :: GraphGC v -> IO [Ref v]
+listReachableVertices GraphGC{graphRef} = do
+    GraphD{references} <- readIORef graphRef
+    concat . Map.elems <$> traverse inspect references
+  where
+    inspect ref = do
+        mv <- Ref.deRefWeak ref
+        pure $ case mv of
+            Nothing -> []
+            Just r -> [r]
+
+-- | Insert an edge from the first vertex to the second vertex.
+insertEdge :: (Ref v, Ref v) -> GraphGC v -> IO ()
+insertEdge (x,y) g@GraphGC{graphRef} = do
+    (xKnown, yKnown) <-
+        insertTheEdge =<< makeWeakPointerThatRepresentsEdge
+    unless xKnown $ Ref.addFinalizer x (finalizeVertex g ux)
+    unless yKnown $ Ref.addFinalizer y (finalizeVertex g uy)
+  where
+    ux = Ref.getUnique x
+    uy = Ref.getUnique y
+
+    makeWeakPointerThatRepresentsEdge =
+        Ref.mkWeak y x Nothing
+
+    insertTheEdge we = atomicModifyIORef' graphRef $
+        \GraphD{graph,references} ->
+            ( GraphD
+                { graph
+                    = Graph.insertEdge (ux,uy) we
+                    $ graph
+                , references
+                    = Map.insert ux (Ref.getWeakRef x)
+                    . Map.insert uy (Ref.getWeakRef y)
+                    $ references
+                }
+            ,   ( ux `Map.member` references
+                , uy `Map.member` references
+                ) 
+            )
+
+-- | Remove all the edges that connect the vertex to its predecessors.
+clearPredecessors :: Ref v -> GraphGC v -> IO ()
+clearPredecessors x GraphGC{graphRef} = do
+    g <- atomicModifyIORef' graphRef $ \g -> (removeIncomingEdges g, g)
+    finalizeIncomingEdges g
+  where
+    removeIncomingEdges g@GraphD{graph} =
+        g{ graph = Graph.clearPredecessors (Ref.getUnique x) graph }
+    finalizeIncomingEdges GraphD{graph} =
+        mapM_ (Ref.finalize . snd) . Graph.getIncoming graph $ Ref.getUnique x
+
+-- | Walk through all successors. See 'Graph.walkSuccessors'.
+walkSuccessors
+    :: Monad m
+    => [Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m [WeakRef v])
+walkSuccessors roots step GraphGC{..} = do
+    GraphD{graph,references} <- readIORef graphRef
+    let rootsMap = Map.fromList
+            [ (Ref.getUnique r, Ref.getWeakRef r) | r <- roots ]
+        fromUnique u = fromJust $
+            Map.lookup u references <|> Map.lookup u rootsMap
+    pure
+        . fmap (map fromUnique)
+        . Graph.walkSuccessors (map Ref.getUnique roots) (step . fromUnique)
+        $ graph
+
+-- | Walk through all successors. See 'Graph.walkSuccessors_'.
+walkSuccessors_ ::
+    Monad m => [Ref v] -> (WeakRef v -> m Step) -> GraphGC v -> IO (m ())
+walkSuccessors_ roots step g = do
+    action <- walkSuccessors roots step g
+    pure $ action >> pure ()
+
+{-----------------------------------------------------------------------------
+    Garbage Collection
+------------------------------------------------------------------------------}
+-- | Explicitly remove all vertices and edges that have been marked
+-- as garbage by the Haskell garbage collector.
+removeGarbage :: GraphGC v -> IO ()
+removeGarbage g@GraphGC{deletions} = do
+    xs <- STM.atomically $ STM.flushTQueue deletions
+    mapM_ (deleteVertex g) xs
+
+-- Delete all edges associated with a vertex from the 'GraphGC'.
+--
+-- TODO: Check whether using an IORef is thread-safe.
+-- I think it's fine because we have a single thread that performs deletions.
+deleteVertex :: GraphGC v -> Unique -> IO ()
+deleteVertex GraphGC{graphRef} x =
+    atomicModifyIORef'_ graphRef $ \GraphD{graph,references} -> GraphD
+        { graph = Graph.deleteVertex x graph
+        , references = Map.delete x references
+        }
+
+-- Finalize a vertex
+finalizeVertex :: GraphGC v -> Unique -> IO ()
+finalizeVertex GraphGC{deletions} =
+    STM.atomically . STM.writeTQueue deletions
+
+{-----------------------------------------------------------------------------
+    Debugging
+------------------------------------------------------------------------------}
+-- | Show the underlying graph in @graphviz@ dot file format.
+printDot :: (Unique -> WeakRef v -> IO String) -> GraphGC v -> IO String
+printDot format GraphGC{graphRef} = do
+    GraphD{graph,references} <- readIORef graphRef
+    strings <- Map.traverseWithKey format references
+    pure $ Graph.showDot (strings Map.!) graph
+
+{-----------------------------------------------------------------------------
+    Helper functions
+------------------------------------------------------------------------------}
+-- | Atomically modify an 'IORef' without returning a result.
+atomicModifyIORef'_ :: IORef a -> (a -> a) -> IO ()
+atomicModifyIORef'_ ref f = atomicModifyIORef' ref $ \x -> (f x, ())
diff --git a/src/Reactive/Banana/Prim/Low/GraphTraversal.hs b/src/Reactive/Banana/Prim/Low/GraphTraversal.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Low/GraphTraversal.hs
@@ -0,0 +1,41 @@
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Low.GraphTraversal
+    ( GraphM
+    , reversePostOrder1
+    , reversePostOrder
+    ) where
+
+import Data.Hashable
+import qualified Data.HashSet as Set
+
+{-----------------------------------------------------------------------------
+    Graph traversal
+------------------------------------------------------------------------------}
+-- | Graph represented as map from a vertex to its direct successors.
+type GraphM m a = a -> m [a]
+
+-- | Computes the reverse post-order,
+-- listing all (transitive) successor of a node.
+--
+-- Each vertex is listed *before* all its direct successors have been listed.
+reversePostOrder1 :: (Eq a, Hashable a, Monad m) => a -> GraphM m a -> m [a]
+reversePostOrder1 x = reversePostOrder [x]
+
+-- | Reverse post-order from multiple vertices.
+--
+-- INVARIANT: For this to be a valid topological order,
+-- none of the vertices may have a direct predecessor.
+reversePostOrder :: (Eq a, Hashable a, Monad m) => [a] -> GraphM m a -> m [a]
+reversePostOrder xs successors = fst <$> go xs [] Set.empty
+    where
+    go []     rpo visited        = return (rpo, visited)
+    go (x:xs) rpo visited
+        | x `Set.member` visited = go xs rpo visited
+        | otherwise              = do
+            xs' <- successors x
+            -- visit all direct successors
+            (rpo', visited') <- go xs' rpo (Set.insert x visited)
+            -- prepend this vertex as all direct successors have been visited
+            go xs (x:rpo') visited'
diff --git a/src/Reactive/Banana/Prim/Low/IO.hs b/src/Reactive/Banana/Prim/Low/IO.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Low/IO.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Reactive.Banana.Prim.Low.IO where
-
-import           Control.Monad.IO.Class
-import qualified Data.Vault.Lazy        as Lazy
-
-import Reactive.Banana.Prim.Mid.Combinators (mapP)
-import Reactive.Banana.Prim.Low.Evaluation  (step)
-import Reactive.Banana.Prim.Low.Plumbing
-import Reactive.Banana.Prim.Low.Types
-import Reactive.Banana.Prim.Low.Util
-
-debug :: String -> a -> a
-debug _ = id
-
-{-----------------------------------------------------------------------------
-    Primitives connecting to the outside world
-------------------------------------------------------------------------------}
--- | Create a new pulse in the network and a function to trigger it.
---
--- Together with 'addHandler', this function can be used to operate with
--- pulses as with standard callback-based events.
-newInput :: forall a. Build (Pulse a, a -> Step)
-newInput = mdo
-    always <- alwaysP
-    key    <- liftIO Lazy.newKey
-    pulse  <- liftIO $ newRef $ Pulse
-        { _keyP      = key
-        , _seenP     = agesAgo
-        , _evalP     = readPulseP pulse    -- get its own value
-        , _childrenP = []
-        , _parentsP  = []
-        , _levelP    = ground
-        , _nameP     = "newInput"
-        }
-    -- Also add the  alwaysP  pulse to the inputs.
-    let run :: a -> Step
-        run a = step ([P pulse, P always], Lazy.insert key (Just a) Lazy.empty)
-    return (pulse, run)
-
--- | Register a handler to be executed whenever a pulse occurs.
---
--- The pulse may refer to future latch values.
-addHandler :: Pulse (Future a) -> (a -> IO ()) -> Build ()
-addHandler p1 f = do
-    p2 <- mapP (fmap f) p1
-    addOutput p2
-
--- | Read the value of a 'Latch' at a particular moment in time.
-readLatch :: Latch a -> Build a
-readLatch = readLatchB
diff --git a/src/Reactive/Banana/Prim/Low/Plumbing.hs b/src/Reactive/Banana/Prim/Low/Plumbing.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Low/Plumbing.hs
+++ /dev/null
@@ -1,250 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecordWildCards, RecursiveDo, ScopedTypeVariables #-}
-module Reactive.Banana.Prim.Low.Plumbing where
-
-import           Control.Monad                                (join)
-import           Control.Monad.IO.Class
-import qualified Control.Monad.Trans.RWSIO          as RWS
-import qualified Control.Monad.Trans.ReaderWriterIO as RW
-import           Data.Functor
-import           Data.IORef
-import qualified Data.Vault.Lazy                    as Lazy
-import           System.IO.Unsafe
-
-import qualified Reactive.Banana.Prim.Low.Dependencies as Deps
-import           Reactive.Banana.Prim.Low.Types
-import           Reactive.Banana.Prim.Low.Util
-import Data.Maybe (fromMaybe)
-
-{-----------------------------------------------------------------------------
-    Build primitive pulses and latches
-------------------------------------------------------------------------------}
--- | Make 'Pulse' from evaluation function
-newPulse :: String -> EvalP (Maybe a) -> Build (Pulse a)
-newPulse name eval = liftIO $ do
-    key <- Lazy.newKey
-    newRef $ Pulse
-        { _keyP      = key
-        , _seenP     = agesAgo
-        , _evalP     = eval
-        , _childrenP = []
-        , _parentsP  = []
-        , _levelP    = ground
-        , _nameP     = name
-        }
-
-{-
-* Note [PulseCreation]
-
-We assume that we do not have to calculate a pulse occurrence
-at the moment we create the pulse. Otherwise, we would have
-to recalculate the dependencies *while* doing evaluation;
-this is a recipe for desaster.
-
--}
-
--- | 'Pulse' that never fires.
-neverP :: Build (Pulse a)
-neverP = liftIO $ do
-    key <- Lazy.newKey
-    newRef $ Pulse
-        { _keyP      = key
-        , _seenP     = agesAgo
-        , _evalP     = return Nothing
-        , _childrenP = []
-        , _parentsP  = []
-        , _levelP    = ground
-        , _nameP     = "neverP"
-        }
-
--- | Return a 'Latch' that has a constant value
-pureL :: a -> Latch a
-pureL a = unsafePerformIO $ newRef $ Latch
-    { _seenL  = beginning
-    , _valueL = a
-    , _evalL  = return a
-    }
-
--- | Make new 'Latch' that can be updated by a 'Pulse'
-newLatch :: forall a. a -> Build (Pulse a -> Build (), Latch a)
-newLatch a = mdo
-    latch <- liftIO $ newRef $ Latch
-        { _seenL  = beginning
-        , _valueL = a
-        , _evalL  = do
-            Latch {..} <- readRef latch
-            RW.tell _seenL  -- indicate timestamp
-            return _valueL  -- indicate value
-        }
-    let
-        err        = error "incorrect Latch write"
-
-        updateOn :: Pulse a -> Build ()
-        updateOn p = do
-            w  <- liftIO $ mkWeakRefValue latch latch
-            lw <- liftIO $ newRef $ LatchWrite
-                { _evalLW  = fromMaybe err <$> readPulseP p
-                , _latchLW = w
-                }
-            -- writer is alive only as long as the latch is alive
-            _  <- liftIO $ mkWeakRefValue latch lw
-            P p `addChild` L lw
-
-    return (updateOn, latch)
-
--- | Make a new 'Latch' that caches a previous computation.
-cachedLatch :: EvalL a -> Latch a
-cachedLatch eval = unsafePerformIO $ mdo
-    latch <- newRef $ Latch
-        { _seenL  = agesAgo
-        , _valueL = error "Undefined value of a cached latch."
-        , _evalL  = do
-            Latch{..} <- liftIO $ readRef latch
-            -- calculate current value (lazy!) with timestamp
-            (a,time)  <- RW.listen eval
-            liftIO $ if time <= _seenL
-                then return _valueL     -- return old value
-                else do                 -- update value
-                    let _seenL  = time
-                    let _valueL = a
-                    a `seq` put latch (Latch {..})
-                    return a
-        }
-    return latch
-
--- | Add a new output that depends on a 'Pulse'.
---
--- TODO: Return function to unregister the output again.
-addOutput :: Pulse EvalO -> Build ()
-addOutput p = do
-    o <- liftIO $ newRef $ Output
-        { _evalO = fromMaybe (return $ debug "nop") <$> readPulseP p
-        }
-    P p `addChild` O o
-    RW.tell $ BuildW (mempty, [o], mempty, mempty)
-
-{-----------------------------------------------------------------------------
-    Build monad
-------------------------------------------------------------------------------}
-runBuildIO :: BuildR -> BuildIO a -> IO (a, Action, [Output])
-runBuildIO i m = do
-        (a, BuildW (topologyUpdates, os, liftIOLaters, _)) <- unfold mempty m
-        doit liftIOLaters          -- execute late IOs
-        return (a,Action $ Deps.buildDependencies topologyUpdates,os)
-    where
-    -- Recursively execute the  buildLater  calls.
-    unfold :: BuildW -> BuildIO a -> IO (a, BuildW)
-    unfold w m = do
-        (a, BuildW (w1, w2, w3, later)) <- RW.runReaderWriterIOT m i
-        let w' = w <> BuildW (w1,w2,w3,mempty)
-        w'' <- case later of
-            Just m  -> snd <$> unfold w' m
-            Nothing -> return w'
-        return (a,w'')
-
-buildLater :: Build () -> Build ()
-buildLater x = RW.tell $ BuildW (mempty, mempty, mempty, Just x)
-
--- | Pretend to return a value right now,
--- but do not actually calculate it until later.
---
--- NOTE: Accessing the value before it's written leads to an error.
---
--- FIXME: Is there a way to have the value calculate on demand?
-buildLaterReadNow :: Build a -> Build a
-buildLaterReadNow m = do
-    ref <- liftIO $ newIORef $
-        error "buildLaterReadNow: Trying to read before it is written."
-    buildLater $ m >>= liftIO . writeIORef ref
-    liftIO $ unsafeInterleaveIO $ readIORef ref
-
-liftBuild :: Build a -> BuildIO a
-liftBuild = id
-
-getTimeB :: Build Time
-getTimeB = fst <$> RW.ask
-
-alwaysP :: Build (Pulse ())
-alwaysP = snd <$> RW.ask
-
-readLatchB :: Latch a -> Build a
-readLatchB = liftIO . readLatchIO
-
-dependOn :: Pulse child -> Pulse parent -> Build ()
-dependOn child parent = P parent `addChild` P child
-
-keepAlive :: Pulse child -> Pulse parent -> Build ()
-keepAlive child parent = liftIO $ void $ mkWeakRefValue child parent
-
-addChild :: SomeNode -> SomeNode -> Build ()
-addChild parent child =
-    RW.tell $ BuildW (Deps.addChild parent child, mempty, mempty, mempty)
-
-changeParent :: Pulse child -> Pulse parent -> Build ()
-changeParent node parent =
-    RW.tell $ BuildW (Deps.changeParent node parent, mempty, mempty, mempty)
-
-liftIOLater :: IO () -> Build ()
-liftIOLater x = RW.tell $ BuildW (mempty, mempty, Action x, mempty)
-
-{-----------------------------------------------------------------------------
-    EvalL monad
-------------------------------------------------------------------------------}
--- | Evaluate a latch (-computation) at the latest time,
--- but discard timestamp information.
-readLatchIO :: Latch a -> IO a
-readLatchIO latch = do
-    Latch{..} <- readRef latch
-    liftIO $ fst <$> RW.runReaderWriterIOT _evalL ()
-
-getValueL :: Latch a -> EvalL a
-getValueL latch = do
-    Latch{..} <- readRef latch
-    _evalL
-
-{-----------------------------------------------------------------------------
-    EvalP monad
-------------------------------------------------------------------------------}
-runEvalP :: Lazy.Vault -> EvalP a -> Build (a, EvalPW)
-runEvalP s1 m = RW.readerWriterIOT $ \r2 -> do
-    (a,_,(w1,w2)) <- RWS.runRWSIOT m r2 s1
-    return ((a,w1), w2)
-
-liftBuildP :: Build a -> EvalP a
-liftBuildP m = RWS.rwsT $ \r2 s -> do
-    (a,w2) <- RW.runReaderWriterIOT m r2
-    return (a,s,(mempty,w2))
-
-askTime :: EvalP Time
-askTime = fst <$> RWS.ask
-
-readPulseP :: Pulse a -> EvalP (Maybe a)
-readPulseP p = do
-    Pulse{..} <- readRef p
-    join . Lazy.lookup _keyP <$> RWS.get
-
-writePulseP :: Lazy.Key (Maybe a) -> Maybe a -> EvalP ()
-writePulseP key a = do
-    s <- RWS.get
-    RWS.put $ Lazy.insert key a s
-
-readLatchP :: Latch a -> EvalP a
-readLatchP = liftBuildP . readLatchB
-
-readLatchFutureP :: Latch a -> EvalP (Future a)
-readLatchFutureP = return . readLatchIO
-
-rememberLatchUpdate :: IO () -> EvalP ()
-rememberLatchUpdate x = RWS.tell ((Action x,mempty),mempty)
-
-rememberOutput :: (Output, EvalO) -> EvalP ()
-rememberOutput x = RWS.tell ((mempty,[x]),mempty)
-
--- worker wrapper to break sharing and support better inlining
-unwrapEvalP :: RWS.Tuple r w s -> RWS.RWSIOT r w s m a -> m a
-unwrapEvalP r m = RWS.run m r
-
-wrapEvalP :: (RWS.Tuple r w s -> m a) -> RWS.RWSIOT r w s m a
-wrapEvalP m = RWS.R m
diff --git a/src/Reactive/Banana/Prim/Low/Ref.hs b/src/Reactive/Banana/Prim/Low/Ref.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Low/Ref.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Low.Ref
+    ( -- * Mutable references with 'Unique'
+      Ref
+    , getUnique
+    , new
+    , equal
+    , read
+    , put
+    , modify'
+
+      -- * Garbage collection and weak pointers to 'Ref'
+    , addFinalizer
+    , getWeakRef
+
+    , WeakRef
+    , mkWeak
+    , deRefWeak
+    , deRefWeaks
+    , finalize
+    ) where
+
+import Prelude hiding ( read )
+
+import Control.DeepSeq
+    ( NFData (..) )
+import Control.Monad
+    ( void )
+import Control.Monad.IO.Class
+    ( MonadIO (liftIO) )
+import Data.Hashable
+    ( Hashable (..) )
+import Data.IORef
+    ( IORef, newIORef, readIORef, writeIORef )
+import Data.Maybe
+    ( catMaybes )
+import Data.Unique.Really
+    ( Unique, newUnique )
+
+import qualified System.Mem.Weak as Weak
+import qualified GHC.Base as GHC
+import qualified GHC.IORef as GHC
+import qualified GHC.STRef as GHC
+import qualified GHC.Weak as GHC
+
+{-----------------------------------------------------------------------------
+    Ref
+------------------------------------------------------------------------------}
+-- | A mutable reference which has a 'Unique' associated with it.
+data Ref a = Ref
+    !Unique         -- Unique associated to the 'Ref'
+    !(IORef a)      -- 'IORef' that stores the value of type 'a'
+    !(WeakRef a)    -- For convenience, a weak pointer to itself
+
+instance NFData (Ref a) where rnf (Ref _ _ _) = ()
+
+instance Eq (Ref a) where (==) = equal
+
+instance Hashable (Ref a) where hashWithSalt s (Ref u _ _) = hashWithSalt s u
+
+getUnique :: Ref a -> Unique
+getUnique (Ref u _ _) = u
+
+getWeakRef :: Ref a -> WeakRef a
+getWeakRef (Ref _ _ w) = w
+
+equal :: Ref a -> Ref b -> Bool
+equal (Ref ua _ _) (Ref ub _ _) = ua == ub
+
+new :: MonadIO m => a -> m (Ref a)
+new a = liftIO $ mdo
+    ra     <- newIORef a
+    result <- Ref <$> newUnique <*> pure ra <*> pure wa
+    wa     <- mkWeakIORef ra result Nothing
+    pure result
+
+read :: MonadIO m => Ref a -> m a
+read ~(Ref _ r _) = liftIO $ readIORef r
+
+put :: MonadIO m => Ref a -> a -> m ()
+put ~(Ref _ r _) = liftIO . writeIORef r
+
+-- | Strictly modify a 'Ref'.
+modify' :: MonadIO m => Ref a -> (a -> a) -> m ()
+modify' ~(Ref _ r _) f = liftIO $
+    readIORef r >>= \x -> writeIORef r $! f x
+
+{-----------------------------------------------------------------------------
+    Weak pointers
+------------------------------------------------------------------------------}
+-- | Add a finalizer to a 'Ref'.
+--
+-- See 'System.Mem.Weak.addFinalizer'.
+addFinalizer :: Ref v -> IO () -> IO ()
+addFinalizer (Ref _ r _) = void . mkWeakIORef r () . Just
+
+-- | Weak pointer to a 'Ref'.
+type WeakRef v = Weak.Weak (Ref v)
+
+-- | Create a weak pointer that associates a key with a value.
+--
+-- See 'System.Mem.Weak.mkWeak'.
+mkWeak
+    :: Ref k -- ^ key
+    -> v -- ^ value
+    -> Maybe (IO ()) -- ^ finalizer
+    -> IO (Weak.Weak v)
+mkWeak (Ref _ r _) = mkWeakIORef r
+
+-- | Finalize a 'WeakRef'.
+--
+-- See 'System.Mem.Weak.finalize'.
+finalize :: WeakRef v -> IO ()
+finalize = Weak.finalize
+
+-- | Dereference a 'WeakRef'.
+--
+-- See 'System.Mem.Weak.deRefWeak'.
+deRefWeak :: Weak.Weak v -> IO (Maybe v)
+deRefWeak = Weak.deRefWeak
+
+-- | Dereference a list of weak pointers while discarding dead ones.
+deRefWeaks :: [Weak.Weak v] -> IO [v]
+deRefWeaks ws = catMaybes <$> mapM Weak.deRefWeak ws
+
+{-----------------------------------------------------------------------------
+    Helpers
+------------------------------------------------------------------------------}
+-- | Create a weak pointer to an 'IORef'.
+--
+-- Unpacking the constructors (e.g. 'GHC.IORef' etc.) is necessary
+-- because the constructors may be unpacked while the 'IORef' is used
+-- — so, the value contained therein is alive, but the constructors are not.
+mkWeakIORef
+    :: IORef k -- ^ key
+    -> v       -- ^ value
+    -> Maybe (IO ()) -- ^ finalizer
+    -> IO (Weak.Weak v)
+mkWeakIORef (GHC.IORef (GHC.STRef r#)) v (Just (GHC.IO finalizer)) =
+    GHC.IO $ \s -> case GHC.mkWeak# r# v finalizer s of
+        (# s1, w #) -> (# s1, GHC.Weak w #)
+mkWeakIORef (GHC.IORef (GHC.STRef r#)) v Nothing =
+    GHC.IO $ \s -> case GHC.mkWeakNoFinalizer# r# v s of
+        (# s1, w #) -> (# s1, GHC.Weak w #)
diff --git a/src/Reactive/Banana/Prim/Low/Types.hs b/src/Reactive/Banana/Prim/Low/Types.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Low/Types.hs
+++ /dev/null
@@ -1,227 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances #-}
-module Reactive.Banana.Prim.Low.Types where
-
-import           Control.Monad.Trans.RWSIO
-import           Control.Monad.Trans.ReaderWriterIO
-import           Data.Hashable
-import           Data.Semigroup
-import qualified Data.Vault.Lazy                    as Lazy
-import           System.IO.Unsafe
-import           System.Mem.Weak
-
-import Reactive.Banana.Prim.Low.Graph            (Graph)
-import Reactive.Banana.Prim.Low.OrderedBag as OB (OrderedBag)
-import Reactive.Banana.Prim.Low.Util
-
-{-----------------------------------------------------------------------------
-    Network
-------------------------------------------------------------------------------}
--- | A 'Network' represents the state of a pulse/latch network,
-data Network = Network
-    { nTime           :: !Time                 -- Current time.
-    , nOutputs        :: !(OrderedBag Output)  -- Remember outputs to prevent garbage collection.
-    , nAlwaysP        :: !(Pulse ())   -- Pulse that always fires.
-    }
-
-type Inputs        = ([SomeNode], Lazy.Vault)
-type EvalNetwork a = Network -> IO (a, Network)
-type Step          = EvalNetwork (IO ())
-
-type Build  = ReaderWriterIOT BuildR BuildW IO
-type BuildR = (Time, Pulse ())
-    -- ( current time
-    -- , pulse that always fires)
-newtype BuildW = BuildW (DependencyBuilder, [Output], Action, Maybe (Build ()))
-    -- reader : current timestamp
-    -- writer : ( actions that change the network topology
-    --          , outputs to be added to the network
-    --          , late IO actions
-    --          , late build actions
-    --          )
-
-instance Semigroup BuildW where
-    BuildW x <> BuildW y = BuildW (x <> y)
-
-instance Monoid BuildW where
-    mempty  = BuildW mempty
-    mappend = (<>)
-
-type BuildIO = Build
-
-type DependencyBuilder = (Endo (Graph SomeNode), [(SomeNode, SomeNode)])
-
-{-----------------------------------------------------------------------------
-    Synonyms
-------------------------------------------------------------------------------}
--- | Priority used to determine evaluation order for pulses.
-type Level = Int
-
-ground :: Level
-ground = 0
-
--- | 'IO' actions as a monoid with respect to sequencing.
-newtype Action = Action { doit :: IO () }
-instance Semigroup Action where
-    Action x <> Action y = Action (x >> y)
-instance Monoid Action where
-    mempty = Action $ return ()
-    mappend = (<>)
-
--- | Lens-like functionality.
-data Lens s a = Lens (s -> a) (a -> s -> s)
-
-set :: Lens s a -> a -> s -> s
-set (Lens _   set)   = set
-
-update :: Lens s a -> (a -> a) -> s -> s
-update (Lens get set) f = \s -> set (f $ get s) s
-
-{-----------------------------------------------------------------------------
-    Pulse and Latch
-------------------------------------------------------------------------------}
-type Pulse  a = Ref (Pulse' a)
-data Pulse' a = Pulse
-    { _keyP      :: Lazy.Key (Maybe a) -- Key to retrieve pulse from cache.
-    , _seenP     :: !Time              -- See note [Timestamp].
-    , _evalP     :: EvalP (Maybe a)    -- Calculate current value.
-    , _childrenP :: [Weak SomeNode]    -- Weak references to child nodes.
-    , _parentsP  :: [Weak SomeNode]    -- Weak reference to parent nodes.
-    , _levelP    :: !Level             -- Priority in evaluation order.
-    , _nameP     :: String             -- Name for debugging.
-    }
-
-instance Show (Pulse a) where
-    show p = _nameP (unsafePerformIO $ readRef p) ++ " " ++ show (hashWithSalt 0 p)
-
-type Latch  a = Ref (Latch' a)
-data Latch' a = Latch
-    { _seenL  :: !Time               -- Timestamp for the current value.
-    , _valueL :: a                   -- Current value.
-    , _evalL  :: EvalL a             -- Recalculate current latch value.
-    }
-type LatchWrite = Ref LatchWrite'
-data LatchWrite' = forall a. LatchWrite
-    { _evalLW  :: EvalP a            -- Calculate value to write.
-    , _latchLW :: Weak (Latch a)     -- Destination 'Latch' to write to.
-    }
-
-type Output  = Ref Output'
-data Output' = Output
-    { _evalO     :: EvalP EvalO
-    }
-
-data SomeNode
-    = forall a. P (Pulse a)
-    | L LatchWrite
-    | O Output
-
-instance Hashable SomeNode where
-    hashWithSalt s (P x) = hashWithSalt s x
-    hashWithSalt s (L x) = hashWithSalt s x
-    hashWithSalt s (O x) = hashWithSalt s x
-
-instance Eq SomeNode where
-    (P x) == (P y) = equalRef x y
-    (L x) == (L y) = equalRef x y
-    (O x) == (O y) = equalRef x y
-    _     == _     = False
-
-{-# INLINE mkWeakNodeValue #-}
-mkWeakNodeValue :: SomeNode -> v -> IO (Weak v)
-mkWeakNodeValue (P x) = mkWeakRefValue x
-mkWeakNodeValue (L x) = mkWeakRefValue x
-mkWeakNodeValue (O x) = mkWeakRefValue x
-
--- Lenses for various parameters
-seenP :: Lens (Pulse' a) Time
-seenP = Lens _seenP  (\a s -> s { _seenP = a })
-
-seenL :: Lens (Latch' a) Time
-seenL = Lens _seenL  (\a s -> s { _seenL = a })
-
-valueL :: Lens (Latch' a) a
-valueL = Lens _valueL (\a s -> s { _valueL = a })
-
-parentsP :: Lens (Pulse' a) [Weak SomeNode]
-parentsP = Lens _parentsP (\a s -> s { _parentsP = a })
-
-childrenP :: Lens (Pulse' a) [Weak SomeNode]
-childrenP = Lens _childrenP (\a s -> s { _childrenP = a })
-
-levelP :: Lens (Pulse' a) Int
-levelP = Lens _levelP (\a s -> s { _levelP = a })
-
--- | Evaluation monads.
-type EvalPW   = (EvalLW, [(Output, EvalO)])
-type EvalLW   = Action
-
-type EvalO    = Future (IO ())
-type Future   = IO
-
--- Note: For efficiency reasons, we unroll the monad transformer stack.
--- type EvalP = RWST () Lazy.Vault EvalPW Build
-type EvalP    = RWSIOT BuildR (EvalPW,BuildW) Lazy.Vault IO
-    -- writer : (latch updates, IO action)
-    -- state  : current pulse values
-
--- Computation with a timestamp that indicates the last time it was performed.
-type EvalL    = ReaderWriterIOT () Time IO
-
-{-----------------------------------------------------------------------------
-    Show functions for debugging
-------------------------------------------------------------------------------}
-printNode :: SomeNode -> IO String
-printNode (P p) = _nameP <$> readRef p
-printNode (L _) = return "L"
-printNode (O _) = return "O"
-
-{-----------------------------------------------------------------------------
-    Time monoid
-------------------------------------------------------------------------------}
--- | A timestamp local to this program run.
---
--- Useful e.g. for controlling cache validity.
-newtype Time = T Integer deriving (Eq, Ord, Show, Read)
-
--- | Before the beginning of time. See Note [TimeStamp]
-agesAgo :: Time
-agesAgo = T (-1)
-
-beginning :: Time
-beginning = T 0
-
-next :: Time -> Time
-next (T n) = T (n+1)
-
-instance Semigroup Time where
-    T x <> T y = T (max x y)
-
-instance Monoid Time where
-    mappend = (<>)
-    mempty  = beginning
-
-{-----------------------------------------------------------------------------
-    Notes
-------------------------------------------------------------------------------}
-{- Note [Timestamp]
-
-The time stamp indicates how recent the current value is.
-
-For Pulse:
-During pulse evaluation, a time stamp equal to the current
-time indicates that the pulse has already been evaluated in this phase.
-
-For Latch:
-The timestamp indicates the last time at which the latch has been written to.
-
-    agesAgo   = The latch has never been written to.
-    beginning = The latch has been written to before everything starts.
-
-The second description is ensured by the fact that the network
-writes timestamps that begin at time `next beginning`.
-
--}
diff --git a/src/Reactive/Banana/Prim/Low/Util.hs b/src/Reactive/Banana/Prim/Low/Util.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Low/Util.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
-module Reactive.Banana.Prim.Low.Util where
-
-import           Control.Monad
-import           Control.Monad.IO.Class
-import           Data.Hashable
-import           Data.IORef
-import           Data.Maybe                    (catMaybes)
-import           Data.Unique.Really
-import qualified GHC.Base               as GHC
-import qualified GHC.IORef              as GHC
-import qualified GHC.STRef              as GHC
-import qualified GHC.Weak               as GHC
-import           System.Mem.Weak
-
-debug :: MonadIO m => String -> m ()
--- debug = liftIO . putStrLn
-debug _ = return ()
-
-nop :: Monad m => m ()
-nop = return ()
-
-{-----------------------------------------------------------------------------
-    IORefs that can be hashed
-------------------------------------------------------------------------------}
-data Ref a = Ref !(IORef a) !Unique
-
-instance Eq (Ref a) where (==) = equalRef
-
-instance Hashable (Ref a) where hashWithSalt s (Ref _ u) = hashWithSalt s u
-
-equalRef :: Ref a -> Ref b -> Bool
-equalRef (Ref _ a) (Ref _ b) = a == b
-
-newRef :: MonadIO m => a -> m (Ref a)
-newRef a = liftIO $ liftM2 Ref (newIORef a) newUnique
-
-readRef :: MonadIO m => Ref a -> m a
-readRef ~(Ref ref _) = liftIO $ readIORef ref
-
-put :: MonadIO m => Ref a -> a -> m ()
-put ~(Ref ref _) = liftIO . writeIORef ref
-
--- | Strictly modify an 'IORef'.
-modify' :: MonadIO m => Ref a -> (a -> a) -> m ()
-modify' ~(Ref ref _) f = liftIO $ readIORef ref >>= \x -> writeIORef ref $! f x
-
-{-----------------------------------------------------------------------------
-    Weak pointers
-------------------------------------------------------------------------------}
-mkWeakIORefValue :: IORef a -> value -> IO (Weak value)
-mkWeakIORefValue (GHC.IORef (GHC.STRef r#)) val = GHC.IO $ \s ->
-  case GHC.mkWeakNoFinalizer# r# val s of (# s1, w #) -> (# s1, GHC.Weak w #)
-
-mkWeakRefValue :: MonadIO m => Ref a -> value -> m (Weak value)
-mkWeakRefValue (Ref ref _) v = liftIO $ mkWeakIORefValue ref v
-
--- | Dereference a list of weak pointers while discarding dead ones.
-deRefWeaks :: [Weak v] -> IO [v]
-deRefWeaks ws = catMaybes <$> mapM deRefWeak ws
diff --git a/src/Reactive/Banana/Prim/Mid.hs b/src/Reactive/Banana/Prim/Mid.hs
--- a/src/Reactive/Banana/Prim/Mid.hs
+++ b/src/Reactive/Banana/Prim/Mid.hs
@@ -9,7 +9,7 @@
     -- have a look at "Reactive.Banana" instead.
 
     -- * Evaluation
-    Step, Network, emptyNetwork,
+    Step, EvalNetwork, Network, emptyNetwork, getSize,
 
     -- * Build FRP networks
     Build, liftIOLater, BuildIO, liftBuild, buildLater, buildLaterReadNow, compile,
@@ -33,20 +33,23 @@
     pureL, mapL, applyL, accumL, applyP,
 
     -- * Dynamic event switching
-    switchL, executeP, switchP
+    switchL, executeP, switchP,
 
     -- * Notes
     -- $recursion
+    
+    -- * Debugging
+    printDot
   ) where
 
 
 import Control.Monad.IO.Class
-import Reactive.Banana.Prim.Low.Compile
-import Reactive.Banana.Prim.Low.IO
-import Reactive.Banana.Prim.Low.Plumbing
-    ( neverP, alwaysP, liftBuild, buildLater, buildLaterReadNow, liftIOLater )
-import Reactive.Banana.Prim.Low.Types
 import Reactive.Banana.Prim.Mid.Combinators
+import Reactive.Banana.Prim.Mid.Compile
+import Reactive.Banana.Prim.Mid.IO
+import Reactive.Banana.Prim.Mid.Plumbing
+    ( neverP, alwaysP, liftBuild, buildLater, buildLaterReadNow, liftIOLater )
+import Reactive.Banana.Prim.Mid.Types
 import Reactive.Banana.Prim.High.Cached
 
 {-----------------------------------------------------------------------------
diff --git a/src/Reactive/Banana/Prim/Mid/Combinators.hs b/src/Reactive/Banana/Prim/Mid/Combinators.hs
--- a/src/Reactive/Banana/Prim/Mid/Combinators.hs
+++ b/src/Reactive/Banana/Prim/Mid/Combinators.hs
@@ -1,20 +1,25 @@
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-----------------------------------------------------------------------------
     reactive-banana
 ------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}
 module Reactive.Banana.Prim.Mid.Combinators where
 
 import Control.Monad
+    ( join )
 import Control.Monad.IO.Class
+    ( liftIO )
 
-import Reactive.Banana.Prim.Low.Plumbing
+import Reactive.Banana.Prim.Mid.Plumbing
     ( newPulse, newLatch, cachedLatch
     , dependOn, keepAlive, changeParent
     , getValueL
     , readPulseP, readLatchP, readLatchFutureP, liftBuildP,
     )
-import qualified Reactive.Banana.Prim.Low.Plumbing (pureL)
-import           Reactive.Banana.Prim.Low.Types    (Latch, Future, Pulse, Build, EvalP)
+import qualified Reactive.Banana.Prim.Mid.Plumbing
+    ( pureL )
+import Reactive.Banana.Prim.Mid.Types
+    ( Latch, Future, Pulse, Build, EvalP )
 
 debug :: String -> a -> a
 -- debug s = trace s
@@ -85,7 +90,7 @@
     return p
 
 pureL :: a -> Latch a
-pureL = Reactive.Banana.Prim.Low.Plumbing.pureL
+pureL = Reactive.Banana.Prim.Mid.Plumbing.pureL
 
 -- specialization of   mapL f = applyL (pureL f)
 mapL :: (a -> b) -> Latch a -> Latch b
@@ -132,22 +137,25 @@
     eval Nothing  = return Nothing
 
 switchP :: Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
-switchP p pp = mdo
+switchP p pp = do
+    -- track the latest Pulse in a Latch
     lp <- stepperL p pp
-    let
-        -- switch to a new parent
+
+    -- fetch the latest Pulse value
+    pout <- newPulse "switchP_out" (readPulseP =<< readLatchP lp)
+
+    let -- switch the Pulse `pout` to a new parent,
+        -- keeping track of the new dependencies.
         switch = do
             mnew <- readPulseP pp
             case mnew of
-                Nothing  -> return ()
-                Just new -> liftBuildP $ p2 `changeParent` new
-            return Nothing
-        -- fetch value from old parent
-        eval = readPulseP =<< readLatchP lp
+                Nothing  -> pure ()
+                Just new -> liftBuildP $ pout `changeParent` new
+            pure Nothing
 
-    p1 <- newPulse "switchP_in" switch :: Build (Pulse ())
-    p1 `dependOn` pp
-    p2 <- newPulse "switchP_out" eval
-    p2 `dependOn` p
-    p2 `keepAlive` p1
-    return p2
+    pin <- newPulse "switchP_in" switch :: Build (Pulse ())
+    pin  `dependOn` pp
+    
+    pout `dependOn` p       -- initial dependency
+    pout `keepAlive` pin    -- keep switches happening
+    pure pout
diff --git a/src/Reactive/Banana/Prim/Mid/Compile.hs b/src/Reactive/Banana/Prim/Mid/Compile.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Mid/Compile.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Mid.Compile where
+
+import Control.Exception
+    ( evaluate )
+import Data.Functor
+    ( void )
+import Data.IORef
+    ( newIORef, readIORef, writeIORef )
+
+import qualified Reactive.Banana.Prim.Low.GraphGC as GraphGC
+import qualified Reactive.Banana.Prim.Low.OrderedBag as OB
+import           Reactive.Banana.Prim.Mid.Combinators (mapP)
+import           Reactive.Banana.Prim.Mid.Evaluation (applyDependencyChanges)
+import           Reactive.Banana.Prim.Mid.IO
+import           Reactive.Banana.Prim.Mid.Plumbing
+import           Reactive.Banana.Prim.Mid.Types
+
+{-----------------------------------------------------------------------------
+   Compilation
+------------------------------------------------------------------------------}
+-- | Change a 'Network' of pulses and latches by
+-- executing a 'BuildIO' action.
+compile :: BuildIO a -> Network -> IO (a, Network)
+compile m Network{nTime, nOutputs, nAlwaysP, nGraphGC} = do
+    (a, dependencyChanges, os) <- runBuildIO (nTime, nAlwaysP) m
+
+    applyDependencyChanges dependencyChanges nGraphGC
+    let state2 = Network
+            { nTime    = next nTime
+            , nOutputs = OB.inserts nOutputs os
+            , nAlwaysP
+            , nGraphGC
+            }
+    return (a,state2)
+
+emptyNetwork :: IO Network
+emptyNetwork = do
+  (alwaysP, _, _) <- runBuildIO undefined $ newPulse "alwaysP" (return $ Just ())
+  nGraphGC <- GraphGC.new
+  pure Network
+    { nTime    = next beginning
+    , nOutputs = OB.empty
+    , nAlwaysP = alwaysP
+    , nGraphGC
+    }
+
+{-----------------------------------------------------------------------------
+    Testing
+------------------------------------------------------------------------------}
+-- | Simple interpreter for pulse/latch networks.
+--
+-- Mainly useful for testing functionality
+--
+-- Note: The result is not computed lazily, for similar reasons
+-- that the 'sequence' function does not compute its result lazily.
+interpret :: (Pulse a -> BuildIO (Pulse b)) -> [Maybe a] -> IO [Maybe b]
+interpret f xs = do
+    o   <- newIORef Nothing
+    let network = do
+            (pin, sin) <- liftBuild newInput
+            pmid       <- f pin
+            pout       <- liftBuild $ mapP return pmid
+            liftBuild $ addHandler pout (writeIORef o . Just)
+            return sin
+
+    -- compile initial network
+    (sin, state) <- compile network =<< emptyNetwork
+
+    let go Nothing  s1 = return (Nothing,s1)
+        go (Just a) s1 = do
+            (reactimate,s2) <- sin a s1
+            reactimate              -- write output
+            ma <- readIORef o       -- read output
+            writeIORef o Nothing
+            return (ma,s2)
+
+    fst <$> mapAccumM go state xs         -- run several steps
+
+-- | Execute an FRP network with a sequence of inputs.
+-- Make sure that outputs are evaluated, but don't display their values.
+--
+-- Mainly useful for testing whether there are space leaks.
+runSpaceProfile :: Show b => (Pulse a -> BuildIO (Pulse b)) -> [a] -> IO ()
+runSpaceProfile f xs = do
+    let g = do
+        (p1, fire) <- liftBuild newInput
+        p2 <- f p1
+        p3 <- mapP return p2                -- wrap into Future
+        addHandler p3 (void . evaluate)
+        return fire
+    (step,network) <- compile g =<< emptyNetwork
+
+    let fire x s1 = do
+            (outputs, s2) <- step x s1
+            outputs                     -- don't forget to execute outputs
+            return ((), s2)
+
+    mapAccumM_ fire network xs
+
+-- | 'mapAccum' for a monad.
+mapAccumM :: Monad m => (a -> s -> m (b,s)) -> s -> [a] -> m ([b],s)
+mapAccumM f s0 = go s0 []
+  where
+    go s1 bs []     = pure (reverse bs,s1)
+    go s1 bs (x:xs) = do
+        (b,s2) <- f x s1
+        go s2 (b:bs) xs
+
+-- | Strict 'mapAccum' for a monad. Discards results.
+mapAccumM_ :: Monad m => (a -> s -> m (b,s)) -> s -> [a] -> m ()
+mapAccumM_ _ _   []     = return ()
+mapAccumM_ f !s0 (x:xs) = do
+    (_,s1) <- f x s0
+    mapAccumM_ f s1 xs
diff --git a/src/Reactive/Banana/Prim/Mid/Evaluation.hs b/src/Reactive/Banana/Prim/Mid/Evaluation.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Mid/Evaluation.hs
@@ -0,0 +1,125 @@
+{-# 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,pulses)
+        Network{ nTime = time1
+        , nOutputs = outputs1
+        , nAlwaysP = alwaysP
+        , nGraphGC
+        }
+    = do
+
+    -- evaluate pulses
+    ((_, (latchUpdates, outputs)), dependencyChanges, os)
+            <- runBuildIO (time1, alwaysP)
+            $  runEvalP pulses
+            $  evaluatePulses inputs 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 = OB.inOrder outputs outputs1  -- EvalO actions in proper order
+
+        state2 :: Network
+        !state2 = Network
+            { nTime    = next time1
+            , nOutputs = OB.inserts outputs1 os
+            , nAlwaysP = alwaysP
+            , nGraphGC
+            }
+    return (runEvalOs $ map snd actions, state2)
+
+runEvalOs :: [EvalO] -> IO ()
+runEvalOs = mapM_ join
+
+{-----------------------------------------------------------------------------
+    Dependency changes
+------------------------------------------------------------------------------}
+-- | Apply all dependency changes to the 'GraphGC'.
+applyDependencyChanges :: DependencyChanges -> Dependencies -> IO ()
+applyDependencyChanges changes g = do
+    sequence_ [applyDependencyChange c g | c@(InsertEdge _ _) <- changes]
+    sequence_ [applyDependencyChange c g | c@(ChangeParentTo _ _) <- changes]
+
+applyDependencyChange
+    :: DependencyChange SomeNode SomeNode -> Dependencies -> IO ()
+applyDependencyChange (InsertEdge parent child) g =
+    GraphGC.insertEdge (parent, child) g
+applyDependencyChange (ChangeParentTo child parent) g = do
+    GraphGC.clearPredecessors child g
+    GraphGC.insertEdge (parent, child) g
+
+{-----------------------------------------------------------------------------
+    Traversal in dependency order
+------------------------------------------------------------------------------}
+-- | Update all pulses in the graph, starting from a given set of nodes
+evaluatePulses :: [SomeNode] -> Dependencies -> EvalP ()
+evaluatePulses inputs g = do
+    action <- liftIO $ GraphGC.walkSuccessors_ inputs evaluateWeakNode g
+    action
+
+evaluateWeakNode :: Ref.WeakRef SomeNodeD -> EvalP GraphGC.Step
+evaluateWeakNode w = do
+    mnode <- liftIO $ Ref.deRefWeak w
+    case mnode of
+        Nothing -> pure GraphGC.Stop
+        Just node -> evaluateNode node
+
+-- | Recalculate a given node and return all children nodes
+-- that need to evaluated subsequently.
+evaluateNode :: SomeNode -> EvalP GraphGC.Step
+evaluateNode someNode = do
+    node <- Ref.read someNode
+    case node of
+        P PulseD{_evalP,_keyP} -> {-# SCC evaluateNodeP #-} do
+            ma <- _evalP
+            writePulseP _keyP ma
+            pure $ case ma of
+                Nothing -> GraphGC.Stop
+                Just _  -> GraphGC.Next
+        L lw -> {-# SCC evaluateLatchWrite #-} do
+            evaluateLatchWrite lw
+            pure GraphGC.Stop
+        O o -> {-# SCC evaluateNodeO #-} do
+            m <- _evalO o -- calculate output action
+            rememberOutput (someNode,m)
+            pure GraphGC.Stop
+
+evaluateLatchWrite :: LatchWriteD -> EvalP ()
+evaluateLatchWrite LatchWriteD{_evalLW,_latchLW} = do
+    time   <- askTime
+    mlatch <- liftIO $ Ref.deRefWeak _latchLW -- retrieve destination latch
+    case mlatch of
+        Nothing    -> pure ()
+        Just latch -> do
+            a <- _evalLW                    -- calculate new latch value
+            -- liftIO $ Strict.evaluate a   -- see Note [LatchStrictness]
+            rememberLatchUpdate $           -- schedule value to be set later
+                Ref.modify' latch $ \l ->
+                    a `seq` l { _seenL = time, _valueL = a }
diff --git a/src/Reactive/Banana/Prim/Mid/IO.hs b/src/Reactive/Banana/Prim/Mid/IO.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Mid/IO.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Mid.IO where
+
+import Control.Monad.IO.Class
+    ( liftIO )
+import qualified Data.Vault.Lazy        as Lazy
+
+import Reactive.Banana.Prim.Mid.Combinators (mapP)
+import Reactive.Banana.Prim.Mid.Evaluation  (step)
+import Reactive.Banana.Prim.Mid.Plumbing
+import Reactive.Banana.Prim.Mid.Types
+import qualified Reactive.Banana.Prim.Low.Ref as Ref
+
+debug :: String -> a -> a
+debug _ = id
+
+{-----------------------------------------------------------------------------
+    Primitives connecting to the outside world
+------------------------------------------------------------------------------}
+-- | Create a new pulse in the network and a function to trigger it.
+--
+-- Together with 'addHandler', this function can be used to operate with
+-- pulses as with standard callback-based events.
+newInput :: forall a. Build (Pulse a, a -> Step)
+newInput = mdo
+    always <- alwaysP
+    _key   <- liftIO Lazy.newKey
+    nodeP  <- liftIO $ Ref.new $ P $ PulseD
+        { _keyP      = _key
+        , _seenP     = agesAgo
+        , _evalP     = readPulseP pulse    -- get its own value
+        , _nameP     = "newInput"
+        }
+    let pulse = Pulse{_key,_nodeP=nodeP}
+    -- Also add the  alwaysP  pulse to the inputs.
+    let run :: a -> Step
+        run a = step ([nodeP, _nodeP always], Lazy.insert _key (Just a) Lazy.empty)
+    pure (pulse, run)
+
+-- | Register a handler to be executed whenever a pulse occurs.
+--
+-- The pulse may refer to future latch values.
+addHandler :: Pulse (Future a) -> (a -> IO ()) -> Build ()
+addHandler p1 f = do
+    p2 <- mapP (fmap f) p1
+    addOutput p2
+
+-- | Read the value of a 'Latch' at a particular moment in time.
+readLatch :: Latch a -> Build a
+readLatch = readLatchB
diff --git a/src/Reactive/Banana/Prim/Mid/Plumbing.hs b/src/Reactive/Banana/Prim/Mid/Plumbing.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Mid/Plumbing.hs
@@ -0,0 +1,259 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Mid.Plumbing where
+
+import Control.Monad
+    ( join, void )
+import Control.Monad.IO.Class
+    ( liftIO )
+import Data.IORef
+    ( newIORef, writeIORef, readIORef )
+import Data.Maybe
+    ( fromMaybe )
+import System.IO.Unsafe
+    ( unsafePerformIO, unsafeInterleaveIO )
+
+import qualified Control.Monad.Trans.RWSIO          as RWS
+import qualified Control.Monad.Trans.ReaderWriterIO as RW
+import qualified Data.Vault.Lazy                    as Lazy
+
+import qualified Reactive.Banana.Prim.Low.Ref as Ref
+import           Reactive.Banana.Prim.Mid.Types
+
+{-----------------------------------------------------------------------------
+    Build primitive pulses and latches
+------------------------------------------------------------------------------}
+-- | Make 'Pulse' from evaluation function
+newPulse :: String -> EvalP (Maybe a) -> Build (Pulse a)
+newPulse name eval = liftIO $ do
+    _key <- Lazy.newKey
+    _nodeP <- Ref.new $ P $ PulseD
+        { _keyP      = _key
+        , _seenP     = agesAgo
+        , _evalP     = eval
+        , _nameP     = name
+        }
+    pure $ Pulse{_key,_nodeP}
+
+{-
+* Note [PulseCreation]
+
+We assume that we do not have to calculate a pulse occurrence
+at the moment we create the pulse. Otherwise, we would have
+to recalculate the dependencies *while* doing evaluation;
+this is a recipe for desaster.
+
+-}
+
+-- | 'Pulse' that never fires.
+neverP :: Build (Pulse a)
+neverP = liftIO $ do
+    _key <- Lazy.newKey
+    _nodeP <- Ref.new $ P $ PulseD
+        { _keyP      = _key
+        , _seenP     = agesAgo
+        , _evalP     = pure Nothing
+        , _nameP     = "neverP"
+        }
+    pure $ Pulse{_key,_nodeP}
+
+-- | Return a 'Latch' that has a constant value
+pureL :: a -> Latch a
+pureL a = unsafePerformIO $ Ref.new $ Latch
+    { _seenL  = beginning
+    , _valueL = a
+    , _evalL  = return a
+    }
+
+-- | Make new 'Latch' that can be updated by a 'Pulse'
+newLatch :: forall a. a -> Build (Pulse a -> Build (), Latch a)
+newLatch a = do
+    latch <- liftIO $ mdo
+        latch <- Ref.new $ Latch
+            { _seenL  = beginning
+            , _valueL = a
+            , _evalL  = do
+                Latch {..} <- Ref.read latch
+                RW.tell _seenL  -- indicate timestamp
+                return _valueL  -- indicate value
+            }
+        pure latch
+
+    let
+        err        = error "incorrect Latch write"
+
+        updateOn :: Pulse a -> Build ()
+        updateOn p = do
+            w  <- liftIO $ Ref.mkWeak latch latch Nothing
+            lw <- liftIO $ Ref.new $ L $ LatchWriteD
+                { _evalLW  = fromMaybe err <$> readPulseP p
+                , _latchLW = w
+                }
+            -- writer is alive only as long as the latch is alive
+            _  <- liftIO $ Ref.mkWeak latch lw Nothing
+            _nodeP p `addChild` lw
+
+    return (updateOn, latch)
+
+-- | Make a new 'Latch' that caches a previous computation.
+cachedLatch :: EvalL a -> Latch a
+cachedLatch eval = unsafePerformIO $ mdo
+    latch <- Ref.new $ Latch
+        { _seenL  = agesAgo
+        , _valueL = error "Undefined value of a cached latch."
+        , _evalL  = do
+            Latch{..} <- liftIO $ Ref.read latch
+            -- calculate current value (lazy!) with timestamp
+            (a,time)  <- RW.listen eval
+            liftIO $ if time <= _seenL
+                then return _valueL     -- return old value
+                else do                 -- update value
+                    let _seenL  = time
+                    let _valueL = a
+                    a `seq` Ref.put latch (Latch {..})
+                    return a
+        }
+    return latch
+
+-- | Add a new output that depends on a 'Pulse'.
+--
+-- TODO: Return function to unregister the output again.
+addOutput :: Pulse EvalO -> Build ()
+addOutput p = do
+    o <- liftIO $ Ref.new $ O $ Output
+        { _evalO = fromMaybe (pure $ pure ()) <$> readPulseP p
+        }
+    _nodeP p `addChild` o
+    RW.tell $ BuildW (mempty, [o], mempty, mempty)
+
+{-----------------------------------------------------------------------------
+    Build monad
+------------------------------------------------------------------------------}
+runBuildIO :: BuildR -> BuildIO a -> IO (a, DependencyChanges, [Output])
+runBuildIO i m = do
+    (a, BuildW (topologyUpdates, os, liftIOLaters, _)) <- unfold mempty m
+    doit liftIOLaters          -- execute late IOs
+    return (a,topologyUpdates,os)
+  where
+    -- Recursively execute the  buildLater  calls.
+    unfold :: BuildW -> BuildIO a -> IO (a, BuildW)
+    unfold w m = do
+        (a, BuildW (w1, w2, w3, later)) <- RW.runReaderWriterIOT m i
+        let w' = w <> BuildW (w1,w2,w3,mempty)
+        w'' <- case later of
+            Just m  -> snd <$> unfold w' m
+            Nothing -> return w'
+        return (a,w'')
+
+buildLater :: Build () -> Build ()
+buildLater x = RW.tell $ BuildW (mempty, mempty, mempty, Just x)
+
+-- | Pretend to return a value right now,
+-- but do not actually calculate it until later.
+--
+-- NOTE: Accessing the value before it's written leads to an error.
+--
+-- FIXME: Is there a way to have the value calculate on demand?
+buildLaterReadNow :: Build a -> Build a
+buildLaterReadNow m = do
+    ref <- liftIO $ newIORef $
+        error "buildLaterReadNow: Trying to read before it is written."
+    buildLater $ m >>= liftIO . writeIORef ref
+    liftIO $ unsafeInterleaveIO $ readIORef ref
+
+liftBuild :: Build a -> BuildIO a
+liftBuild = id
+
+getTimeB :: Build Time
+getTimeB = fst <$> RW.ask
+
+alwaysP :: Build (Pulse ())
+alwaysP = snd <$> RW.ask
+
+readLatchB :: Latch a -> Build a
+readLatchB = liftIO . readLatchIO
+
+dependOn :: Pulse child -> Pulse parent -> Build ()
+dependOn child parent = _nodeP parent `addChild` _nodeP child
+
+keepAlive :: Pulse child -> Pulse parent -> Build ()
+keepAlive child parent = liftIO $ void $
+    Ref.mkWeak (_nodeP child) (_nodeP parent) Nothing
+
+addChild :: SomeNode -> SomeNode -> Build ()
+addChild parent child =
+    RW.tell $ BuildW ([InsertEdge parent child], mempty, mempty, mempty)
+
+changeParent :: Pulse child -> Pulse parent -> Build ()
+changeParent pulse0 parent0 =
+    RW.tell $ BuildW ([ChangeParentTo pulse parent], mempty, mempty, mempty)
+   where
+     pulse = _nodeP pulse0
+     parent = _nodeP parent0
+
+liftIOLater :: IO () -> Build ()
+liftIOLater x = RW.tell $ BuildW (mempty, mempty, Action x, mempty)
+
+{-----------------------------------------------------------------------------
+    EvalL monad
+------------------------------------------------------------------------------}
+-- | Evaluate a latch (-computation) at the latest time,
+-- but discard timestamp information.
+readLatchIO :: Latch a -> IO a
+readLatchIO latch = do
+    Latch{..} <- Ref.read latch
+    liftIO $ fst <$> RW.runReaderWriterIOT _evalL ()
+
+getValueL :: Latch a -> EvalL a
+getValueL latch = do
+    Latch{..} <- Ref.read latch
+    _evalL
+
+{-----------------------------------------------------------------------------
+    EvalP monad
+------------------------------------------------------------------------------}
+runEvalP :: Lazy.Vault -> EvalP a -> Build (a, EvalPW)
+runEvalP s1 m = RW.readerWriterIOT $ \r2 -> do
+    (a,_,(w1,w2)) <- RWS.runRWSIOT m r2 s1
+    return ((a,w1), w2)
+
+liftBuildP :: Build a -> EvalP a
+liftBuildP m = RWS.rwsT $ \r2 s -> do
+    (a,w2) <- RW.runReaderWriterIOT m r2
+    return (a,s,(mempty,w2))
+
+askTime :: EvalP Time
+askTime = fst <$> RWS.ask
+
+readPulseP :: Pulse a -> EvalP (Maybe a)
+readPulseP Pulse{_key} =
+    join . Lazy.lookup _key <$> RWS.get
+
+writePulseP :: Lazy.Key (Maybe a) -> Maybe a -> EvalP ()
+writePulseP key a = do
+    s <- RWS.get
+    RWS.put $ Lazy.insert key a s
+
+readLatchP :: Latch a -> EvalP a
+readLatchP = liftBuildP . readLatchB
+
+readLatchFutureP :: Latch a -> EvalP (Future a)
+readLatchFutureP = return . readLatchIO
+
+rememberLatchUpdate :: IO () -> EvalP ()
+rememberLatchUpdate x = RWS.tell ((Action x,mempty),mempty)
+
+rememberOutput :: (Output, EvalO) -> EvalP ()
+rememberOutput x = RWS.tell ((mempty,[x]),mempty)
+
+-- worker wrapper to break sharing and support better inlining
+unwrapEvalP :: RWS.Tuple r w s -> RWS.RWSIOT r w s m a -> m a
+unwrapEvalP r m = RWS.run m r
+
+wrapEvalP :: (RWS.Tuple r w s -> m a) -> RWS.RWSIOT r w s m a
+wrapEvalP m = RWS.R m
diff --git a/src/Reactive/Banana/Prim/Mid/Test.hs b/src/Reactive/Banana/Prim/Mid/Test.hs
--- a/src/Reactive/Banana/Prim/Mid/Test.hs
+++ b/src/Reactive/Banana/Prim/Mid/Test.hs
@@ -1,7 +1,7 @@
+{-# LANGUAGE RecursiveDo #-}
 {-----------------------------------------------------------------------------
     reactive-banana
 ------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo #-}
 module Reactive.Banana.Prim.Mid.Test where
 
 import Reactive.Banana.Prim.Mid
diff --git a/src/Reactive/Banana/Prim/Mid/Types.hs b/src/Reactive/Banana/Prim/Mid/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Mid/Types.hs
@@ -0,0 +1,218 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Mid.Types where
+
+import Data.Hashable
+    ( hashWithSalt )
+import Data.Unique.Really
+    ( Unique )
+import Control.Monad.Trans.RWSIO
+    ( RWSIOT )
+import Control.Monad.Trans.ReaderWriterIO
+    ( ReaderWriterIOT )
+import Reactive.Banana.Prim.Low.OrderedBag
+    ( OrderedBag )
+import System.IO.Unsafe
+    ( unsafePerformIO )
+import System.Mem.Weak
+    ( Weak )
+
+import qualified Data.Vault.Lazy as Lazy
+import qualified Reactive.Banana.Prim.Low.Ref as Ref
+import qualified Reactive.Banana.Prim.Low.GraphGC as GraphGC
+
+{-----------------------------------------------------------------------------
+    Network
+------------------------------------------------------------------------------}
+-- | A 'Network' represents the state of a pulse/latch network,
+data Network = Network
+    { nTime           :: !Time                 -- Current time.
+    , nOutputs        :: !(OrderedBag Output)  -- Remember outputs to prevent garbage collection.
+    , nAlwaysP        :: !(Pulse ())   -- Pulse that always fires.
+    , nGraphGC        :: Dependencies
+    }
+
+getSize :: Network -> IO Int
+getSize = GraphGC.getSize . nGraphGC
+
+type Dependencies  = GraphGC.GraphGC SomeNodeD
+type Inputs        = ([SomeNode], Lazy.Vault)
+type EvalNetwork a = Network -> IO (a, Network)
+type Step          = EvalNetwork (IO ())
+
+type Build  = ReaderWriterIOT BuildR BuildW IO
+type BuildR = (Time, Pulse ())
+    -- ( current time
+    -- , pulse that always fires)
+newtype BuildW = BuildW (DependencyChanges, [Output], Action, Maybe (Build ()))
+    -- reader : current timestamp
+    -- writer : ( actions that change the network topology
+    --          , outputs to be added to the network
+    --          , late IO actions
+    --          , late build actions
+    --          )
+
+instance Semigroup BuildW where
+    BuildW x <> BuildW y = BuildW (x <> y)
+
+instance Monoid BuildW where
+    mempty  = BuildW mempty
+    mappend = (<>)
+
+type BuildIO = Build
+
+data DependencyChange parent child
+    = InsertEdge parent child
+    | ChangeParentTo child parent
+type DependencyChanges = [DependencyChange SomeNode SomeNode]
+
+{-----------------------------------------------------------------------------
+    Synonyms
+------------------------------------------------------------------------------}
+-- | 'IO' actions as a monoid with respect to sequencing.
+newtype Action = Action { doit :: IO () }
+instance Semigroup Action where
+    Action x <> Action y = Action (x >> y)
+instance Monoid Action where
+    mempty = Action $ return ()
+    mappend = (<>)
+
+{-----------------------------------------------------------------------------
+    Pulse and Latch
+------------------------------------------------------------------------------}
+data Pulse a = Pulse
+    { _key :: Lazy.Key (Maybe a) -- Key to retrieve pulse value from cache.
+    , _nodeP :: SomeNode         -- Reference to its own node
+    }
+
+data PulseD a = PulseD
+    { _keyP      :: Lazy.Key (Maybe a) -- Key to retrieve pulse from cache.
+    , _seenP     :: !Time              -- See note [Timestamp].
+    , _evalP     :: EvalP (Maybe a)    -- Calculate current value.
+    , _nameP     :: String             -- Name for debugging.
+    }
+
+instance Show (Pulse a) where
+    show p = name <> " " <> show (hashWithSalt 0 $ _nodeP p)
+      where
+        name = case unsafePerformIO $ Ref.read $ _nodeP p of
+              P pulseD -> _nameP pulseD
+              _ -> ""
+
+showUnique :: Unique -> String
+showUnique = show . hashWithSalt 0
+
+type Latch  a = Ref.Ref (LatchD a)
+data LatchD a = Latch
+    { _seenL  :: !Time               -- Timestamp for the current value.
+    , _valueL :: a                   -- Current value.
+    , _evalL  :: EvalL a             -- Recalculate current latch value.
+    }
+
+type LatchWrite = SomeNode
+data LatchWriteD = forall a. LatchWriteD
+    { _evalLW  :: EvalP a            -- Calculate value to write.
+    , _latchLW :: Weak (Latch a)     -- Destination 'Latch' to write to.
+    }
+
+type Output  = SomeNode
+data OutputD = Output
+    { _evalO     :: EvalP EvalO
+    }
+
+type SomeNode = Ref.Ref SomeNodeD
+data SomeNodeD
+    = forall a. P (PulseD a)
+    | L LatchWriteD
+    | O OutputD
+
+{-# INLINE mkWeakNodeValue #-}
+mkWeakNodeValue :: SomeNode -> v -> IO (Weak v)
+mkWeakNodeValue x v = Ref.mkWeak x v Nothing
+
+-- | Evaluation monads.
+type EvalPW   = (EvalLW, [(Output, EvalO)])
+type EvalLW   = Action
+
+type EvalO    = Future (IO ())
+type Future   = IO
+
+-- Note: For efficiency reasons, we unroll the monad transformer stack.
+-- type EvalP = RWST () Lazy.Vault EvalPW Build
+type EvalP    = RWSIOT BuildR (EvalPW,BuildW) Lazy.Vault IO
+    -- writer : (latch updates, IO action)
+    -- state  : current pulse values
+
+-- Computation with a timestamp that indicates the last time it was performed.
+type EvalL    = ReaderWriterIOT () Time IO
+
+{-----------------------------------------------------------------------------
+    Show functions for debugging
+------------------------------------------------------------------------------}
+printNode :: SomeNode -> IO String
+printNode node = do
+    someNode <- Ref.read node
+    pure $ case someNode of
+        P p -> _nameP p
+        L _ -> "L"
+        O _ -> "O"
+
+-- | Show the graph of the 'Network' in @graphviz@ dot file format.
+printDot :: Network -> IO String
+printDot = GraphGC.printDot format . nGraphGC
+  where
+    format u weakref = do
+         mnode <- Ref.deRefWeak weakref
+         ((showUnique u <> ": ") <>) <$> case mnode of
+             Nothing -> pure "(x_x)"
+             Just node -> printNode node
+
+{-----------------------------------------------------------------------------
+    Time monoid
+------------------------------------------------------------------------------}
+-- | A timestamp local to this program run.
+--
+-- Useful e.g. for controlling cache validity.
+newtype Time = T Integer deriving (Eq, Ord, Show, Read)
+
+-- | Before the beginning of time. See Note [TimeStamp]
+agesAgo :: Time
+agesAgo = T (-1)
+
+beginning :: Time
+beginning = T 0
+
+next :: Time -> Time
+next (T n) = T (n+1)
+
+instance Semigroup Time where
+    T x <> T y = T (max x y)
+
+instance Monoid Time where
+    mappend = (<>)
+    mempty  = beginning
+
+{-----------------------------------------------------------------------------
+    Notes
+------------------------------------------------------------------------------}
+{- Note [Timestamp]
+
+The time stamp indicates how recent the current value is.
+
+For Pulse:
+During pulse evaluation, a time stamp equal to the current
+time indicates that the pulse has already been evaluated in this phase.
+
+For Latch:
+The timestamp indicates the last time at which the latch has been written to.
+
+    agesAgo   = The latch has never been written to.
+    beginning = The latch has been written to before everything starts.
+
+The second description is ensured by the fact that the network
+writes timestamps that begin at time `next beginning`.
+
+-}
diff --git a/src/Reactive/Banana/Types.hs b/src/Reactive/Banana/Types.hs
--- a/src/Reactive/Banana/Types.hs
+++ b/src/Reactive/Banana/Types.hs
@@ -163,7 +163,6 @@
 instance Functor Future where fmap f = F . fmap f . unF
 
 instance Monad Future where
-    return  = F . return
     m >>= g = F $ unF m >>= unF . g
 
 instance Applicative Future where
@@ -224,7 +223,6 @@
 -- boilerplate class instances
 instance Functor Moment where fmap f = M . fmap f . unM
 instance Monad Moment where
-    return  = M . return
     m >>= g = M $ unM m >>= unM . g
 instance Applicative Moment where
     pure    = M . pure
@@ -239,7 +237,6 @@
 
 instance Functor MomentIO where fmap f = MIO . fmap f . unMIO
 instance Monad MomentIO where
-    return  = MIO . return
     m >>= g = MIO $ unMIO m >>= unMIO . g
 instance Applicative MomentIO where
     pure    = MIO . pure
diff --git a/test/Reactive/Banana/Test/High/Combinators.hs b/test/Reactive/Banana/Test/High/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/test/Reactive/Banana/Test/High/Combinators.hs
@@ -0,0 +1,255 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE RecursiveDo #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+-- | Exemplar test for various high-level combinators.
+module Reactive.Banana.Test.High.Combinators
+    ( tests
+    ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+    ( when, join )
+import Test.Tasty
+    ( defaultMain, testGroup, TestTree )
+import Test.Tasty.HUnit
+    ( testCase, assertBool )
+
+import Reactive.Banana.Test.High.Plumbing
+
+tests :: TestTree
+tests = testGroup "Combinators, high level"
+    [ testGroup "Simple"
+        [ testModelMatch "id"      id
+        , testModelMatch "never1"  never1
+        , testModelMatch "fmap1"   fmap1
+        , testModelMatch "filter1" filter1
+        , testModelMatch "filter2" filter2
+        , testModelMatchM "accumE1" accumE1
+        ]
+    , testGroup "Complex"
+        [ testModelMatchM "counter"     counter
+        , testModelMatch "double"      double
+        , testModelMatch "sharing"     sharing
+        , testModelMatch "mergeFilter" mergeFilter
+        , testModelMatchM "recursive1A"  recursive1A
+        , testModelMatchM "recursive1B"  recursive1B
+        , testModelMatchM "recursive2"  recursive2
+        , testModelMatchM "recursive3"  recursive3
+        , testModelMatchM "recursive4a" recursive4a
+        -- , testModelMatchM "recursive4b" recursive4b
+        , testModelMatchM "accumBvsE"   accumBvsE
+        ]
+    , testGroup "Dynamic Event Switching"
+        [ testModelMatch  "observeE_id"         observeE_id
+        , testModelMatch  "observeE_stepper"    observeE_stepper
+        , testModelMatchM "valueB_immediate"    valueB_immediate
+        -- , testModelMatchM "valueB_recursive1" valueB_recursive1
+        -- , testModelMatchM "valueB_recursive2" valueB_recursive2
+        , testModelMatchM "dynamic_apply"       dynamic_apply
+        , testModelMatchM "switchE1"            switchE1
+        , testModelMatchM "switchB1"            switchB1
+        , testModelMatchM "switchB2"            switchB2
+        ]
+    , testGroup "Regression tests"
+        [ testModelMatchM "issue79" issue79
+        ]
+    -- TODO:
+    --  * algebraic laws
+    --  * larger examples
+    --  * quickcheck
+    ]
+
+{-----------------------------------------------------------------------------
+    Testing
+------------------------------------------------------------------------------}
+matchesModel
+    :: (Show b, Eq b)
+    => (Event a -> Moment (Event b)) -> [a] -> IO Bool
+matchesModel f xs = do
+    bs1 <- return $ interpretModel f (singletons xs)
+    bs2 <- interpretGraph f (singletons xs)
+    -- bs3 <- interpretFrameworks f xs
+    let bs = [bs1,bs2]
+    let b = all (==bs1) bs
+    when (not b) $ mapM_ print bs
+    return b
+
+singletons = map Just
+
+-- test whether model matches
+testModelMatchM
+    :: (Show b, Eq b)
+    => String -> (Event Int -> Moment (Event b)) -> TestTree
+testModelMatchM name f = testCase name $ assertBool "matchesModel" =<< matchesModel f [1..8::Int]
+testModelMatch name f = testModelMatchM name (return . f)
+
+-- individual tests for debugging
+testModel :: (Event Int -> Event b) -> [Maybe b]
+testModel f = interpretModel (return . f) $ singletons [1..8::Int]
+testGraph f = interpretGraph (return . f) $ singletons [1..8::Int]
+
+testModelM f = interpretModel f $ singletons [1..8::Int]
+testGraphM f = interpretGraph f $ singletons [1..8::Int]
+
+
+{-----------------------------------------------------------------------------
+    Tests
+------------------------------------------------------------------------------}
+never1 :: Event Int -> Event Int
+never1    = const never
+fmap1     = fmap (+1)
+
+filterE p = filterJust . fmap (\e -> if p e then Just e else Nothing)
+filter1   = filterE (>= 3)
+filter2   = filterE (>= 3) . fmap (subtract 1)
+accumE1   = accumE 0 . ((+1) <$)
+
+counter e = do
+    bcounter <- accumB 0 $ fmap (\_ -> (+1)) e
+    return $ applyE (pure const <*> bcounter) e
+
+merge e1 e2 = mergeWith id id (++) (list e1) (list e2)
+    where list = fmap (:[])
+
+double e  = merge e e
+sharing e = merge e1 e1
+    where e1 = filterE (< 3) e
+
+mergeFilter e1 = mergeWith id id (+) e2 e3
+    where
+    e3 = fmap (+1) $ filterE even e1
+    e2 = fmap (+1) $ filterE odd  e1
+
+recursive1A e1 = mdo
+    let e2 = applyE ((+) <$> b) e1
+    b <- stepperB 0 e2
+    return e2
+recursive1B e1 = mdo
+    b <- stepperB 0 e2
+    let e2 = applyE ((+) <$> b) e1
+    return e2
+
+recursive2 e1 = mdo
+    b  <- fmap ((+) <$>) $ stepperB 0 e3
+    let e2 = applyE b e1
+    let e3 = applyE (id <$> b) e1   -- actually equal to e2
+    return e2
+
+type Dummy = Int
+
+-- Counter that can be decreased as long as it's >= 0 .
+recursive3 :: Event Dummy -> Moment (Event Int)
+recursive3 edec = mdo
+    bcounter <- accumB 4 $ (subtract 1) <$ ecandecrease
+    let ecandecrease = whenE ((>0) <$> bcounter) edec
+    return $ applyE (const <$> bcounter) ecandecrease
+
+-- Recursive 4 is an example reported by Merijn Verstraaten
+--   https://github.com/HeinrichApfelmus/reactive-banana/issues/56
+-- Minimization:
+recursive4a :: Event Int -> Moment (Event (Bool, Int))
+recursive4a eInput = mdo
+    focus       <- stepperB False $ fst <$> resultE
+    let resultE = resultB <@ eInput
+    let resultB = (,) <$> focus <*> pureB 0
+    return $ resultB <@ eInput
+
+{-
+-- Full example:
+recursive4b :: Event Int -> Event (Bool, Int)
+recursive4b eInput = result <@ eInput
+    where
+    focus     = stepperB False $ fst <$> result <@ eInput
+    interface = (,) <$> focus <*> cntrVal
+    (cntrVal, focusChange) = counter eInput focus
+    result    = stepperB id ((***id) <$> focusChange) <*> interface
+
+    filterApply :: Behavior (a -> Bool) -> Event a -> Event a
+    filterApply b e = filterJust $ sat <$> b <@> e
+        where sat p x = if p x then Just x else Nothing
+
+    counter :: Event Int -> Behavior Bool -> (Behavior Int, Event (Bool -> Bool))
+    counter input active = (result, not <$ eq)
+        where
+        result = accumB 0 $ (+) <$> neq
+        eq     = filterApply ((==) <$> result) input
+        neq    = filterApply ((/=) <$> result) input
+-}
+
+-- Test 'accumE' vs 'accumB'.
+accumBvsE :: Event Dummy -> Moment (Event [Int])
+accumBvsE e = mdo
+    e1 <- accumE 0 ((+1) <$ e)
+
+    b  <- accumB 0 ((+1) <$ e)
+    let e2 = applyE (const <$> b) e
+
+    return $ merge e1 e2
+
+observeE_id = observeE . fmap return -- = id
+
+observeE_stepper :: Event Int -> Event Int
+observeE_stepper e = observeE $ (valueB =<< mb) <$ e
+    where
+    mb :: Moment (Behavior Int)
+    mb = stepper 0 e
+
+valueB_immediate e = do
+    x <- valueB =<< stepper 0 e
+    return $ x <$ e
+
+{-- The following tests would need to use the  valueBLater  combinator
+
+valueB_recursive1 e1 = mdo
+    _ <- initialB b
+    let b = stepper 0 e1
+    return $ b <@ e1
+
+valueB_recursive2 e1 = mdo
+    x <- initialB b
+    let bf = const x <$ stepper 0 e1
+    let b  = stepper 0 $ (bf <*> b) <@ e1
+    return $ b <@ e1
+-}
+
+dynamic_apply e = do
+    b <- stepper 0 e
+    return $ observeE $ (valueB b) <$ e
+    -- = stepper 0 e <@ e
+
+switchE1 e = switchE e (e <$ e)
+
+switchB1 e = do
+    b0 <- stepper 0 e
+    b1 <- stepper 0 e
+    b  <- switchB b0 $ (\x -> if odd x then b1 else b0) <$> e
+    return $ b <@ e
+
+switchB2 e = do
+    b0 <- stepper 0 $ filterE even e
+    b1 <- stepper 1 $ filterE odd  e
+    b  <- switchB b0 $ (\x -> if odd x then b1 else b0) <$> e
+    return $ b <@ e
+
+{-----------------------------------------------------------------------------
+    Regression tests
+------------------------------------------------------------------------------}
+issue79 :: Event Dummy -> Moment (Event String)
+issue79 inputEvent = mdo
+    let
+        appliedEvent  = (\_ _ -> 1) <$> lastValue <@> inputEvent
+        filteredEvent = filterE (const True) appliedEvent
+        fmappedEvent  = fmap id (filteredEvent)
+    lastValue <- stepper 1 $ fmappedEvent
+
+    let outputEvent = mergeWith id id (++)
+            (const "filtered event" <$> filteredEvent)
+            (((" and " ++) . show) <$> mergeWith id id (+) appliedEvent fmappedEvent)
+
+    return $ outputEvent
+
diff --git a/test/Reactive/Banana/Test/High/Plumbing.hs b/test/Reactive/Banana/Test/High/Plumbing.hs
new file mode 100644
--- /dev/null
+++ b/test/Reactive/Banana/Test/High/Plumbing.hs
@@ -0,0 +1,104 @@
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+-- * Synopsis
+-- | Merge model and implementation into a single type. Not pretty.
+module Reactive.Banana.Test.High.Plumbing where
+
+import Control.Applicative
+import Control.Monad (liftM, ap)
+import Control.Monad.Fix
+
+import qualified Reactive.Banana.Model as X
+import qualified Reactive.Banana as Y
+
+{-----------------------------------------------------------------------------
+    Types as pairs
+------------------------------------------------------------------------------}
+
+data Event    a = E (X.Event    a) (Y.Event    a)
+data Behavior a = B (X.Behavior a) (Y.Behavior a)
+data Moment   a = M (X.Moment   a) (Y.Moment   a)
+
+-- pair extractions
+fstE (E x _) = x; sndE (E _ y) = y
+fstB (B x _) = x; sndB (B _ y) = y
+fstM (M x _) = x; sndM (M _ y) = y
+
+-- partial embedding functions
+ex x = E x undefined; ey y = E undefined y
+bx x = B x undefined; by y = B undefined y
+mx x = M x undefined; my y = M undefined y
+
+-- interpretation
+interpretModel :: (Event a -> Moment (Event b)) -> [Maybe a] -> [Maybe b]
+interpretModel f = X.interpret (fmap fstE . fstM . f . ex)
+
+interpretGraph :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
+interpretGraph f = Y.interpret (fmap sndE . sndM . f . ey)
+
+{-----------------------------------------------------------------------------
+    Primitive combinators
+------------------------------------------------------------------------------}
+never                               = E X.never Y.never
+filterJust (E x y)                  = E (X.filterJust x) (Y.filterJust y)
+mergeWith f g h (E x1 y1) (E x2 y2) = E (X.mergeWith f g h x1 x2) (Y.mergeWith f g h y1 y2)
+mapE f (E x y)                      = E (fmap f x) (fmap f y)
+applyE ~(B x1 y1) (E x2 y2)         = E (X.apply x1 x2) (y1 Y.<@> y2)
+
+instance Functor Event where fmap = mapE
+
+pureB a                         = B (pure a) (pure a)
+applyB (B x1 y1) (B x2 y2)      = B (x1 <*> x2) (y1 <*> y2)
+mapB f (B x y)                  = B (fmap f x) (fmap f y)
+
+instance Functor     Behavior where fmap = mapB
+instance Applicative Behavior where pure = pureB; (<*>) = applyB
+
+instance Functor Moment where fmap = liftM
+instance Applicative Moment where
+    pure a = M (pure a) (pure a)
+    (<*>) = ap
+instance Monad Moment where
+    ~(M x y) >>= g = M (x >>= fstM . g) (y >>= sndM . g)
+instance MonadFix Moment where
+    mfix f = M (mfix fx) (mfix fy)
+        where
+        fx a = let M x _ = f a in x
+        fy a = let M _ y = f a in y
+
+
+accumE   a ~(E x y) = M
+    (ex <$> X.accumE a x)
+    (ey <$> Y.accumE a y)
+stepperB a ~(E x y) = M
+    (bx <$> X.stepper a x)
+    (by <$> Y.stepper a y)
+stepper            = stepperB
+
+valueB ~(B x y) = M (X.valueB x) (Y.valueB y)
+
+observeE :: Event (Moment a) -> Event a
+observeE (E x y) = E (X.observeE $ fmap fstM x) (Y.observeE $ fmap sndM y)
+
+switchE :: Event a -> Event (Event a) -> Moment (Event a)
+switchE (E x0 y0) (E x y) = M
+    (fmap ex $ X.switchE x0 $ fstE <$> x)
+    (fmap ey $ Y.switchE y0 $ sndE <$> y)
+
+switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a)
+switchB (B x y) (E xe ye) = M
+    (fmap bx $ X.switchB x $ fmap fstB xe)
+    (fmap by $ Y.switchB y $ fmap sndB ye)
+
+{-----------------------------------------------------------------------------
+    Derived combinators
+------------------------------------------------------------------------------}
+accumB acc e1 = do
+    e2 <- accumE acc e1
+    stepperB acc e2
+whenE b = filterJust . applyE ((\b e -> if b then Just e else Nothing) <$> b)
+
+infixl 4 <@>, <@
+b <@ e  = applyE (const <$> b) e
+b <@> e = applyE b e
diff --git a/test/Reactive/Banana/Test/High/Space.hs b/test/Reactive/Banana/Test/High/Space.hs
new file mode 100644
--- /dev/null
+++ b/test/Reactive/Banana/Test/High/Space.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE RecursiveDo #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+-- | Exemplar tests for space usage and garbage collection.
+module Reactive.Banana.Test.High.Space where
+
+import Control.Monad
+    ( forM )
+import Test.Tasty
+    ( testGroup, TestTree )
+import Test.Tasty.QuickCheck
+    ( testProperty )
+
+import qualified Test.QuickCheck as Q
+import qualified Test.QuickCheck.Monadic as Q
+
+import qualified Control.Exception as Memory
+import qualified Control.Concurrent as System
+import qualified System.Mem as System
+
+import Reactive.Banana
+import Reactive.Banana.Frameworks
+
+tests :: TestTree
+tests = testGroup "Space usage, high level"
+    [ testGroup "Network size stays bounded"
+        [ testBoundedNetworkSize "execute" execute1
+        , testBoundedNetworkSize "observe accumE, issue #261" observeAccumE1
+        , testBoundedNetworkSize "execute accumE, issue #261" executeAccumE1
+        , testBoundedNetworkSize "switch accumE, issue #261" switchAccumE1
+        ]
+    ]
+
+{-----------------------------------------------------------------------------
+    Tests
+------------------------------------------------------------------------------}
+execute1 :: Event Int -> MomentIO (Event (Event Int))
+execute1 e = execute $ (\i -> liftIO $ Memory.evaluate (i <$ e)) <$> e
+
+observeAccumE1 :: Event Int -> MomentIO (Event (Event ()))
+observeAccumE1 e = pure $ observeE (accumE () never <$ e)
+
+executeAccumE1 :: Event Int -> MomentIO (Event (Event ()))
+executeAccumE1 e = execute (accumE () (id <$ e) <$ e)
+
+switchAccumE1 :: Event Int -> MomentIO (Event ())
+switchAccumE1 e = do
+    let e2 :: Event (Event ())
+        e2 = observeE (accumE () (id <$ e) <$ e)
+    switchE never e2
+
+{-----------------------------------------------------------------------------
+    Test harness
+------------------------------------------------------------------------------}
+-- | Execute an FRP network with a sequence of inputs
+-- with intermittend of garbage collection and record network sizes.
+runNetworkSizes
+    :: (Event a -> MomentIO (Event ignore))
+    -> [a] -> IO [Int]
+runNetworkSizes f xs = do
+    (network, fire) <- setup
+    run network fire
+  where
+    setup = do
+        (ah, fire) <- newAddHandler
+        network <- compile $ do
+            ein  <- fromAddHandler ah
+            eout <- f ein
+            reactimate $ pure () <$ eout
+        performSufficientGC
+        actuate network
+        pure (network, fire)
+
+    run network fire = forM xs $ \i -> do
+        fire i
+        performSufficientGC
+        System.yield
+        Memory.evaluate =<< getSize network
+
+-- | Test whether the network size stays bounded.
+testBoundedNetworkSize
+    :: String
+    -> (Event Int -> MomentIO (Event ignore))
+    -> TestTree
+testBoundedNetworkSize name f = testProperty name $
+    Q.once $ Q.monadicIO $ do
+        sizes <- liftIO $ runNetworkSizes f [1..n]
+        Q.monitor
+            $ Q.counterexample "network size grows"
+            . Q.counterexample ("network sizes: " <> show sizes)
+        Q.assert $ isBounded sizes
+  where
+    n = 20 :: Int
+    isBounded sizes = sizes !! 3 >= sizes !! (n-1)
+
+performSufficientGC :: IO ()
+performSufficientGC = System.performMinorGC
diff --git a/test/Reactive/Banana/Test/Low/Gen.hs b/test/Reactive/Banana/Test/Low/Gen.hs
new file mode 100644
--- /dev/null
+++ b/test/Reactive/Banana/Test/Low/Gen.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+-- | Generation of intereseting example graphs.
+module Reactive.Banana.Test.Low.Gen
+    (
+    -- * Simple graph types for testing
+      TestGraph (..)
+    , DeltaGraph (..)
+    , Vertex
+
+    -- * Example graphs
+    , mkLinearChain
+    , mkSquare
+    
+    -- * Generators
+    , genTestGraph
+    , genLinearChain
+    , genSquare
+    , genSquareSide
+    , shuffleEdges
+    ) where
+
+import Test.QuickCheck
+    ( Gen )
+import qualified Test.QuickCheck as Q
+
+{-----------------------------------------------------------------------------
+    Graphs for testing
+------------------------------------------------------------------------------}
+type Vertex = Int
+
+data DeltaGraph
+    = InsertEdge Vertex Vertex
+    deriving (Eq, Show)
+
+data TestGraph = TestGraph
+    { vertices :: [Vertex]
+    , edges :: [DeltaGraph]
+    } deriving (Eq, Show)
+
+{-----------------------------------------------------------------------------
+    Interesting example graphs
+------------------------------------------------------------------------------}
+-- | A linear chain   1 -> 2 -> 3 -> … -> n .
+mkLinearChain :: Int -> TestGraph
+mkLinearChain n = TestGraph{vertices,edges}
+  where
+    vertices = [1..n]
+    edges = zipWith InsertEdge vertices (drop 1 vertices)
+
+-- | A cartesian product of linear chains
+mkSquare :: Int -> TestGraph
+mkSquare n = TestGraph{vertices,edges}
+  where
+    toInt (x,y) = (x-1) + n*(y-1) + 1
+    vertices = [ toInt (x,y) | y <- [1..n], x <- [1..n]]
+    edges =
+        [ InsertEdge (toInt (x,y)) (toInt (x+1,y))
+        | y <- [1..n]
+        , x <- [1..n-1]
+        ]
+        ++ 
+        [ InsertEdge (toInt (x,y)) (toInt (x,y+1))
+        | y <- [1..n-1]
+        , x <- [1..n]
+        ]
+
+{-----------------------------------------------------------------------------
+    Generating various graphs
+------------------------------------------------------------------------------}
+-- | Interesting generator for 'TestGraph'.
+genTestGraph :: Gen TestGraph
+genTestGraph = shuffleEdges =<< Q.frequency
+    [ (1, genLinearChain)
+    , (1, genSquare)
+    ]
+
+shuffleEdges :: TestGraph -> Gen TestGraph
+shuffleEdges g@TestGraph{edges} = (\e -> g{edges = e})<$> Q.shuffle edges
+
+genLinearChain :: Gen TestGraph
+genLinearChain = Q.sized $ pure . mkLinearChain
+
+genSquare :: Gen TestGraph
+genSquare = mkSquare <$> genSquareSide
+
+genSquareSide :: Gen Int
+genSquareSide = Q.sized $ \n -> Q.chooseInt (2,floorSqrt (2*n) + 2)
+
+floorSqrt :: Int -> Int
+floorSqrt = floor . sqrt . fromIntegral
diff --git a/test/Reactive/Banana/Test/Low/Graph.hs b/test/Reactive/Banana/Test/Low/Graph.hs
new file mode 100644
--- /dev/null
+++ b/test/Reactive/Banana/Test/Low/Graph.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+-- | Property tests for 'Graph'.
+module Reactive.Banana.Test.Low.Graph
+    ( tests
+    , mkGraph
+    ) where
+
+import Reactive.Banana.Prim.Low.Graph 
+    ( Graph )
+import Reactive.Banana.Test.Low.Gen
+    ( DeltaGraph (..), TestGraph (..), Vertex )
+import Test.QuickCheck
+    ( Gen, Property, (===), (=/=) )
+import Test.Tasty
+    ( testGroup, TestTree )
+import Test.Tasty.QuickCheck
+    ( testProperty )
+
+import qualified Data.List as List
+import qualified Test.QuickCheck as Q
+import qualified Reactive.Banana.Test.Low.Gen as Q
+
+import qualified Reactive.Banana.Prim.Low.Graph as Graph
+
+tests :: TestTree
+tests = testGroup "Graph"
+    [ testGroup "walkSuccessors"
+        [ testProperty "Predecessors have lower levels" prop_levelsInvariant
+        , testProperty "succeeds on a square" prop_walkSquare
+        ]
+    ]
+
+{-----------------------------------------------------------------------------
+    Properties
+------------------------------------------------------------------------------}
+prop_levelsInvariant :: Property
+prop_levelsInvariant = Q.forAll Q.genTestGraph $ \g0 ->
+    let g = mkGraph g0
+        level x = Graph.getLevel g x
+    in
+        Q.conjoin [ level x < level y | InsertEdge x y <- edges g0 ]
+
+-- | Run 'walkSuccessors' on a square (with edges inserted randomly).
+walkSquare :: Int -> Gen [Vertex]
+walkSquare n = do
+    g <- mkGraph <$> Q.shuffleEdges (Q.mkSquare n)
+    Graph.walkSuccessors [1] (const step) g
+  where
+    step = Q.frequency [(10,pure Graph.Next), (1,pure Graph.Stop)]
+
+prop_walkSquare :: Property
+prop_walkSquare =
+    Q.forAll Q.genSquareSide
+    $ \n -> Q.cover 10 (n >= 10) "large square"
+    $ Q.forAll (walkSquare n)
+    $ \walk ->
+    let correctOrder (x,y) =
+            Q.counterexample (show y <> " precedes " <> show x)
+                $ not $ (fromInt n y) `before` (fromInt n x)
+
+        checkOrder = Q.conjoin $ replicate 10 $ do
+            m <- Q.chooseInt (1, length walk - 1)
+            pure
+                $ Q.conjoin
+                $ map correctOrder
+                $ pairsFromPivot m walk
+
+    in  Q.counterexample ("Walk result: " <> show walk)
+        $ length walk >= 1
+  where
+    fromInt :: Int -> Vertex -> (Int, Int)
+    fromInt n x = ((x-1) `mod` n, (x-1) `div` n)
+
+    (x1,y1) `before` (x2,y2) = x1 <= x2 && y1 <= y2
+
+pairsFromPivot :: Int -> [a] -> [(a,a)]
+pairsFromPivot n [] = []
+pairsFromPivot n xs = [(a,b) | a <- as] ++ [(b,c) | c <- cs]
+  where
+    (as, b:cs) = splitAt m xs
+    m = max (length xs - 1) $ min 0 $ n
+
+{-----------------------------------------------------------------------------
+    Test graphs
+------------------------------------------------------------------------------}
+-- | Generate a 'Graph' from a 'TestGraph'.
+mkGraph :: TestGraph -> Graph Vertex ()
+mkGraph TestGraph{edges} = List.foldl' insertEdge Graph.empty edges
+  where
+    insertEdge g (InsertEdge x y) = Graph.insertEdge (x,y) () g
diff --git a/test/Reactive/Banana/Test/Low/GraphGC.hs b/test/Reactive/Banana/Test/Low/GraphGC.hs
new file mode 100644
--- /dev/null
+++ b/test/Reactive/Banana/Test/Low/GraphGC.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+-- | Property tests for 'GraphGC'.
+module Reactive.Banana.Test.Low.GraphGC
+    ( tests
+    ) where
+
+import Control.Monad
+    ( when )
+import Control.Monad.IO.Class
+    ( liftIO )
+import Data.Map.Strict
+    ( Map )
+import Data.Unique.Really
+    ( Unique )
+import Reactive.Banana.Prim.Low.Graph 
+    ( Graph )
+import Reactive.Banana.Prim.Low.GraphGC
+    ( GraphGC )
+import Reactive.Banana.Test.Low.Gen
+    ( DeltaGraph (..), TestGraph (..), Vertex )
+import Test.QuickCheck
+    ( Gen, Property, (===), (=/=) )
+import Test.Tasty
+    ( testGroup, TestTree )
+import Test.Tasty.QuickCheck
+    ( testProperty )
+
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import qualified Control.DeepSeq as Memory
+import qualified Control.Exception as Memory
+import qualified System.Mem as System
+import qualified Control.Concurrent as System
+
+import qualified Test.QuickCheck as Q
+import qualified Test.QuickCheck.Monadic as Q
+import qualified Reactive.Banana.Test.Low.Graph as Q
+import qualified Reactive.Banana.Test.Low.Gen as Q
+
+import qualified Reactive.Banana.Prim.Low.Graph as Graph
+import qualified Reactive.Banana.Prim.Low.GraphGC as GraphGC
+import qualified Reactive.Banana.Prim.Low.Ref as Ref
+
+
+tests :: TestTree
+tests = testGroup "GraphGC"
+    [ testGroup "Garbage collection (GC)"
+        [ testProperty "retains the reachable vertices" prop_performGC
+        , testProperty "not doing GC retains all vertices" prop_notPerformGC
+        ]
+    ]
+
+{-----------------------------------------------------------------------------
+    Properties
+------------------------------------------------------------------------------}
+prop_performGC :: Property
+prop_performGC =
+    Q.forAll Q.genTestGraph
+    $ \g0 -> Q.forAll (genGarbageCollectionRoots g0)
+    $ \roots ->
+    let g = Q.mkGraph g0
+        expected = Graph.collectGarbage roots g
+    in  Q.cover 10 (Graph.size g == Graph.size expected)
+            "no   vertices unreachable"
+        $ Q.cover 75 (Graph.size g > Graph.size expected)
+            "some vertices unreachable"
+        $ Q.cover 15 (Graph.size g > 2*Graph.size expected)
+            "many vertices unreachable"
+        $ Q.monadicIO $ liftIO $ do
+            (actual, vertices) <- mkGraphGC g0
+            let rootRefs = map (vertices Map.!) roots
+            Memory.evaluate $ Memory.rnf rootRefs
+
+            System.performMajorGC
+            GraphGC.removeGarbage actual
+            reachables <- traverse Ref.read =<<
+                GraphGC.listReachableVertices actual
+
+            -- keep rootsRef reachable until this point
+            rootsFromRef <- traverse Ref.read rootRefs
+
+            pure $
+                ( roots === rootsFromRef )
+                Q..&&.
+                ( Set.fromList (Graph.listConnectedVertices expected)
+                    === Set.fromList reachables
+                )
+
+prop_notPerformGC :: Property
+prop_notPerformGC =
+    Q.forAll Q.genSquareSide
+    $ \n -> Q.monadicIO $ liftIO $ do
+        -- Trigger a garbage collection now so that it is
+        -- highly unlikely to happen in the subsequent lines
+        System.performMinorGC
+
+        let g = Q.mkLinearChain n
+
+        (actual, _) <- mkGraphGC g
+        GraphGC.removeGarbage actual
+        reachables <- traverse Ref.read =<<
+            GraphGC.listReachableVertices actual
+
+        pure $
+            Set.fromList reachables === Set.fromList [1..n]
+
+{-----------------------------------------------------------------------------
+    Test graphs
+------------------------------------------------------------------------------}
+-- | Generate a 'GraphGC' from a 'TestGraph'.
+mkGraphGC :: TestGraph -> IO (GraphGC Vertex, Map Vertex (Ref.Ref Vertex))
+mkGraphGC TestGraph{vertices,edges} = do
+    g <- GraphGC.new
+    refMap <- Map.fromList . zip vertices <$> traverse Ref.new vertices
+    let insertEdge (InsertEdge x y) = do
+            GraphGC.insertEdge (refMap Map.! x, refMap Map.! y) g
+    traverse insertEdge edges
+    pure (g, refMap)
+
+-- | Randomly generate a set of garbage collection roots.
+genGarbageCollectionRoots :: TestGraph -> Gen [Vertex]
+genGarbageCollectionRoots TestGraph{vertices} = Q.sized $ \n ->
+    sequence . replicate (n `mod` 10) $ Q.elements vertices
diff --git a/test/Reactive/Banana/Test/Mid/Space.hs b/test/Reactive/Banana/Test/Mid/Space.hs
new file mode 100644
--- /dev/null
+++ b/test/Reactive/Banana/Test/Mid/Space.hs
@@ -0,0 +1,122 @@
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+-- | Exemplar tests for space usage and garbage collection.
+module Reactive.Banana.Test.Mid.Space where
+
+import Control.Monad
+    ( foldM )
+import Control.Monad.IO.Class
+    ( liftIO )
+import Test.Tasty
+    ( testGroup, TestTree )
+import Test.Tasty.QuickCheck
+    ( testProperty )
+
+import qualified Test.QuickCheck as Q
+import qualified Test.QuickCheck.Monadic as Q
+
+import qualified Control.Exception as Memory
+import qualified Control.Concurrent as System
+import qualified System.Mem as System
+
+import Reactive.Banana.Prim.Mid
+    ( Build, BuildIO, Network, Pulse, Latch )
+import qualified Reactive.Banana.Prim.Mid as Prim
+
+tests :: TestTree
+tests = testGroup "Space usage, mid level"
+    [ testGroup "Network size stays bounded"
+        [ testBoundedNetworkSize "executeP accumL" executeAccum1
+        , testBoundedNetworkSize "switchP executeP accumL" switchAccum1
+        ]
+    ]
+
+{-----------------------------------------------------------------------------
+    Tests
+------------------------------------------------------------------------------}
+executeAccum1 :: Pulse Int -> Build (Pulse (Pulse Int))
+executeAccum1 p1 = do
+    p2 <- Prim.mapP mkP p1
+    Prim.executeP p2 ()
+  where
+    mkP :: Int -> () -> Build (Pulse Int)
+    mkP i () = do
+        piId <- Prim.mapP (const id) p1
+        (_, pi) <- Prim.accumL i piId
+        pure pi
+
+switchAccum1 :: Pulse Int -> Build (Pulse Int)
+switchAccum1 p1 = do
+    p2 <- executeAccum1 p1
+    Prim.switchP p1 p2
+
+{-----------------------------------------------------------------------------
+    Test harness
+------------------------------------------------------------------------------}
+-- | Compile an FRP network description into a state machine,
+-- which also performs garbage collection after every step.
+compileToStateMachine
+    :: (Pulse a -> BuildIO (Pulse ignore))
+    -> IO (Network, a -> Network -> IO Network)
+compileToStateMachine f = do
+    (step,network0) <- Prim.compile build =<< Prim.emptyNetwork
+    pure (network0, doStep step)
+  where
+    build = do
+        (p1, step) <- Prim.newInput
+        p2 <- f p1
+        p3 <- Prim.mapP pure p2 -- wrap into Future
+        Prim.addHandler p3 (\_ -> pure ())
+        pure step
+
+    doStep step x network1 = do
+        (outputs, network2) <- step x network1
+        outputs         -- don't forget to execute outputs
+        performSufficientGC
+        System.yield    -- wait for finalizers to run
+        pure network2
+
+-- | Execute an FRP network with a sequence of inputs
+-- with intermittend of garbage collection and record network sizes.
+runNetworkSizes
+    :: (Pulse a -> BuildIO (Pulse ignore))
+    -> [a] -> IO [Int]
+runNetworkSizes f xs = do
+    (network0, step0) <- compileToStateMachine f
+    let step1 x network1 = do
+            network2 <- step0 x network1
+            size <- Memory.evaluate =<< Prim.getSize network2
+            pure (size, network2)
+    fst <$> Prim.mapAccumM step1 network0 xs
+
+-- | Test whether the network size stays bounded.
+testBoundedNetworkSize
+    :: String
+    -> (Pulse Int -> Build (Pulse ignore))
+    -> TestTree
+testBoundedNetworkSize name f = testProperty name $
+    Q.once $ Q.monadicIO $ do
+        sizes <- liftIO $ runNetworkSizes f [1..n]
+        Q.monitor
+            $ Q.counterexample "network size grows"
+            . Q.counterexample ("network sizes: " <> show sizes)
+        Q.assert $ isBounded sizes
+  where
+    n = 20 :: Int
+    isBounded sizes = sizes !! 3 >= sizes !! (n-1)
+
+performSufficientGC :: IO ()
+performSufficientGC = System.performMinorGC
+
+{-----------------------------------------------------------------------------
+    Debugging
+------------------------------------------------------------------------------}
+-- | Print network after a given sequence of inputs
+printNetwork
+    :: (Pulse a -> BuildIO (Pulse ignore))
+    -> [a] -> IO String
+printNetwork f xs = do
+    (network0, step) <- compileToStateMachine f
+    network1 <- foldM (flip step) network0 xs
+    Prim.printDot network1
diff --git a/test/reactive-banana-tests.hs b/test/reactive-banana-tests.hs
new file mode 100644
--- /dev/null
+++ b/test/reactive-banana-tests.hs
@@ -0,0 +1,27 @@
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Main where
+
+import Test.Tasty
+    ( defaultMain, testGroup )
+
+import qualified Reactive.Banana.Test.Low.Graph
+import qualified Reactive.Banana.Test.Low.GraphGC
+import qualified Reactive.Banana.Test.Mid.Space
+import qualified Reactive.Banana.Test.High.Combinators
+import qualified Reactive.Banana.Test.High.Space
+
+main = defaultMain $ testGroup "reactive-banana"
+    [ testGroup "Low-level"
+        [ Reactive.Banana.Test.Low.Graph.tests
+        , Reactive.Banana.Test.Low.GraphGC.tests
+        ]
+    , testGroup "Mid-level"
+        [ Reactive.Banana.Test.Mid.Space.tests
+        ]
+    , testGroup "High-level"
+        [ Reactive.Banana.Test.High.Combinators.tests
+        , Reactive.Banana.Test.High.Space.tests
+        ]
+    ]
diff --git a/test/space.hs b/test/space.hs
new file mode 100644
--- /dev/null
+++ b/test/space.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE BangPatterns #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Main where
+
+import Control.Monad
+  ( foldM, void )
+
+import qualified Reactive.Banana.Test.Mid.Space as Mid
+import qualified Reactive.Banana.Test.High.Space as High
+
+main :: IO ()
+main = do
+    say "Running..."
+    -- void $ High.runNetworkSizes High.executeAccumE1 [1..20000]
+    -- void $ High.runNetworkSizes High.switchAccumE1 [1..10000]
+    -- void $ High.runNetworkSizes High.observeAccumE1 [1..10000]
+    -- void $ runMidNetwork Mid.executeAccum1 [1..50000]
+    void $ runMidNetwork Mid.switchAccum1 [1..20000]
+    say "Done"
+
+say :: String -> IO ()
+say = putStrLn
+
+{-----------------------------------------------------------------------------
+    Test harness
+------------------------------------------------------------------------------}
+runMidNetwork f xs = do
+    (network0, step) <- Mid.compileToStateMachine f
+    void $ runStrict step xs network0
+
+runStrict :: Monad m => (a -> s -> m s) -> [a] -> s -> m s
+runStrict f [] !s = pure s
+runStrict f (x:xs) !s = runStrict f xs =<< f x s
diff --git a/tests/Main.hs b/tests/Main.hs
deleted file mode 100644
--- a/tests/Main.hs
+++ /dev/null
@@ -1,248 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-
-    Test cases and examples
-------------------------------------------------------------------------------}
-{-# LANGUAGE FlexibleContexts, Rank2Types, NoMonomorphismRestriction, RecursiveDo #-}
-
-import Control.Arrow
-import Control.Monad (when, join)
-
-import Test.Tasty (defaultMain, testGroup, TestTree)
-import Test.Tasty.HUnit (testCase, assertBool)
-
-import Control.Applicative
-import Plumbing
-
-
-main = defaultMain $ testGroup "Tests"
-    [ testGroup "Simple"
-        [ testModelMatch "id"      id
-        , testModelMatch "never1"  never1
-        , testModelMatch "fmap1"   fmap1
-        , testModelMatch "filter1" filter1
-        , testModelMatch "filter2" filter2
-        , testModelMatchM "accumE1" accumE1
-        ]
-    , testGroup "Complex"
-        [ testModelMatchM "counter"     counter
-        , testModelMatch "double"      double
-        , testModelMatch "sharing"     sharing
-        , testModelMatch "mergeFilter" mergeFilter
-        , testModelMatchM "recursive1A"  recursive1A
-        , testModelMatchM "recursive1B"  recursive1B
-        , testModelMatchM "recursive2"  recursive2
-        , testModelMatchM "recursive3"  recursive3
-        , testModelMatchM "recursive4a" recursive4a
-        -- , testModelMatchM "recursive4b" recursive4b
-        , testModelMatchM "accumBvsE"   accumBvsE
-        ]
-    , testGroup "Dynamic Event Switching"
-        [ testModelMatch  "observeE_id"         observeE_id
-        , testModelMatch  "observeE_stepper"    observeE_stepper
-        , testModelMatchM "valueB_immediate"    valueB_immediate
-        -- , testModelMatchM "valueB_recursive1" valueB_recursive1
-        -- , testModelMatchM "valueB_recursive2" valueB_recursive2
-        , testModelMatchM "dynamic_apply"       dynamic_apply
-        , testModelMatchM "switchE1"            switchE1
-        , testModelMatchM "switchB1"            switchB1
-        , testModelMatchM "switchB2"            switchB2
-        ]
-    , testGroup "Regression tests"
-        [ testModelMatchM "issue79" issue79
-        ]
-    -- TODO:
-    --  * algebraic laws
-    --  * larger examples
-    --  * quickcheck
-    ]
-
-{-----------------------------------------------------------------------------
-    Testing
-------------------------------------------------------------------------------}
-matchesModel
-    :: (Show b, Eq b)
-    => (Event a -> Moment (Event b)) -> [a] -> IO Bool
-matchesModel f xs = do
-    bs1 <- return $ interpretModel f (singletons xs)
-    bs2 <- interpretGraph f (singletons xs)
-    -- bs3 <- interpretFrameworks f xs
-    let bs = [bs1,bs2]
-    let b = all (==bs1) bs
-    when (not b) $ mapM_ print bs
-    return b
-
-singletons = map Just
-
--- test whether model matches
-testModelMatchM
-    :: (Show b, Eq b)
-    => String -> (Event Int -> Moment (Event b)) -> TestTree
-testModelMatchM name f = testCase name $ assertBool "matchesModel" =<< matchesModel f [1..8::Int]
-testModelMatch name f = testModelMatchM name (return . f)
-
--- individual tests for debugging
-testModel :: (Event Int -> Event b) -> [Maybe b]
-testModel f = interpretModel (return . f) $ singletons [1..8::Int]
-testGraph f = interpretGraph (return . f) $ singletons [1..8::Int]
-
-testModelM f = interpretModel f $ singletons [1..8::Int]
-testGraphM f = interpretGraph f $ singletons [1..8::Int]
-
-
-{-----------------------------------------------------------------------------
-    Tests
-------------------------------------------------------------------------------}
-never1 :: Event Int -> Event Int
-never1    = const never
-fmap1     = fmap (+1)
-
-filterE p = filterJust . fmap (\e -> if p e then Just e else Nothing)
-filter1   = filterE (>= 3)
-filter2   = filterE (>= 3) . fmap (subtract 1)
-accumE1   = accumE 0 . ((+1) <$)
-
-counter e = do
-    bcounter <- accumB 0 $ fmap (\_ -> (+1)) e
-    return $ applyE (pure const <*> bcounter) e
-
-merge e1 e2 = mergeWith id id (++) (list e1) (list e2)
-    where list = fmap (:[])
-
-double e  = merge e e
-sharing e = merge e1 e1
-    where e1 = filterE (< 3) e
-
-mergeFilter e1 = mergeWith id id (+) e2 e3
-    where
-    e3 = fmap (+1) $ filterE even e1
-    e2 = fmap (+1) $ filterE odd  e1
-
-recursive1A e1 = mdo
-    let e2 = applyE ((+) <$> b) e1
-    b <- stepperB 0 e2
-    return e2
-recursive1B e1 = mdo
-    b <- stepperB 0 e2
-    let e2 = applyE ((+) <$> b) e1
-    return e2
-
-recursive2 e1 = mdo
-    b  <- fmap ((+) <$>) $ stepperB 0 e3
-    let e2 = applyE b e1
-    let e3 = applyE (id <$> b) e1   -- actually equal to e2
-    return e2
-
-type Dummy = Int
-
--- Counter that can be decreased as long as it's >= 0 .
-recursive3 :: Event Dummy -> Moment (Event Int)
-recursive3 edec = mdo
-    bcounter <- accumB 4 $ (subtract 1) <$ ecandecrease
-    let ecandecrease = whenE ((>0) <$> bcounter) edec
-    return $ applyE (const <$> bcounter) ecandecrease
-
--- Recursive 4 is an example reported by Merijn Verstraaten
---   https://github.com/HeinrichApfelmus/reactive-banana/issues/56
--- Minimization:
-recursive4a :: Event Int -> Moment (Event (Bool, Int))
-recursive4a eInput = mdo
-    focus       <- stepperB False $ fst <$> resultE
-    let resultE = resultB <@ eInput
-    let resultB = (,) <$> focus <*> pureB 0
-    return $ resultB <@ eInput
-
-{-
--- Full example:
-recursive4b :: Event Int -> Event (Bool, Int)
-recursive4b eInput = result <@ eInput
-    where
-    focus     = stepperB False $ fst <$> result <@ eInput
-    interface = (,) <$> focus <*> cntrVal
-    (cntrVal, focusChange) = counter eInput focus
-    result    = stepperB id ((***id) <$> focusChange) <*> interface
-
-    filterApply :: Behavior (a -> Bool) -> Event a -> Event a
-    filterApply b e = filterJust $ sat <$> b <@> e
-        where sat p x = if p x then Just x else Nothing
-
-    counter :: Event Int -> Behavior Bool -> (Behavior Int, Event (Bool -> Bool))
-    counter input active = (result, not <$ eq)
-        where
-        result = accumB 0 $ (+) <$> neq
-        eq     = filterApply ((==) <$> result) input
-        neq    = filterApply ((/=) <$> result) input
--}
-
--- Test 'accumE' vs 'accumB'.
-accumBvsE :: Event Dummy -> Moment (Event [Int])
-accumBvsE e = mdo
-    e1 <- accumE 0 ((+1) <$ e)
-
-    b  <- accumB 0 ((+1) <$ e)
-    let e2 = applyE (const <$> b) e
-
-    return $ merge e1 e2
-
-observeE_id = observeE . fmap return -- = id
-
-observeE_stepper :: Event Int -> Event Int
-observeE_stepper e = observeE $ (valueB =<< mb) <$ e
-    where
-    mb :: Moment (Behavior Int)
-    mb = stepper 0 e
-
-valueB_immediate e = do
-    x <- valueB =<< stepper 0 e
-    return $ x <$ e
-
-{-- The following tests would need to use the  valueBLater  combinator
-
-valueB_recursive1 e1 = mdo
-    _ <- initialB b
-    let b = stepper 0 e1
-    return $ b <@ e1
-
-valueB_recursive2 e1 = mdo
-    x <- initialB b
-    let bf = const x <$ stepper 0 e1
-    let b  = stepper 0 $ (bf <*> b) <@ e1
-    return $ b <@ e1
--}
-
-dynamic_apply e = do
-    b <- stepper 0 e
-    return $ observeE $ (valueB b) <$ e
-    -- = stepper 0 e <@ e
-
-switchE1 e = switchE e (e <$ e)
-
-switchB1 e = do
-    b0 <- stepper 0 e
-    b1 <- stepper 0 e
-    b  <- switchB b0 $ (\x -> if odd x then b1 else b0) <$> e
-    return $ b <@ e
-
-switchB2 e = do
-    b0 <- stepper 0 $ filterE even e
-    b1 <- stepper 1 $ filterE odd  e
-    b  <- switchB b0 $ (\x -> if odd x then b1 else b0) <$> e
-    return $ b <@ e
-
-{-----------------------------------------------------------------------------
-    Regression tests
-------------------------------------------------------------------------------}
-issue79 :: Event Dummy -> Moment (Event String)
-issue79 inputEvent = mdo
-    let
-        appliedEvent  = (\_ _ -> 1) <$> lastValue <@> inputEvent
-        filteredEvent = filterE (const True) appliedEvent
-        fmappedEvent  = fmap id (filteredEvent)
-    lastValue <- stepper 1 $ fmappedEvent
-
-    let outputEvent = mergeWith id id (++)
-            (const "filtered event" <$> filteredEvent)
-            (((" and " ++) . show) <$> mergeWith id id (+) appliedEvent fmappedEvent)
-
-    return $ outputEvent
-
diff --git a/tests/Plumbing.hs b/tests/Plumbing.hs
deleted file mode 100644
--- a/tests/Plumbing.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
--- * Synopsis
--- | Merge model and implementation into a single type. Not pretty.
-
-module Plumbing where
-
-import Control.Applicative
-import Control.Monad (liftM, ap)
-import Control.Monad.Fix
-
-import qualified Reactive.Banana.Model as X
-import qualified Reactive.Banana as Y
-
-{-----------------------------------------------------------------------------
-    Types as pairs
-------------------------------------------------------------------------------}
-
-data Event    a = E (X.Event    a) (Y.Event    a)
-data Behavior a = B (X.Behavior a) (Y.Behavior a)
-data Moment   a = M (X.Moment   a) (Y.Moment   a)
-
--- pair extractions
-fstE (E x _) = x; sndE (E _ y) = y
-fstB (B x _) = x; sndB (B _ y) = y
-fstM (M x _) = x; sndM (M _ y) = y
-
--- partial embedding functions
-ex x = E x undefined; ey y = E undefined y
-bx x = B x undefined; by y = B undefined y
-mx x = M x undefined; my y = M undefined y
-
--- interpretation
-interpretModel :: (Event a -> Moment (Event b)) -> [Maybe a] -> [Maybe b]
-interpretModel f = X.interpret (fmap fstE . fstM . f . ex)
-
-interpretGraph :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
-interpretGraph f = Y.interpret (fmap sndE . sndM . f . ey)
-
-{-----------------------------------------------------------------------------
-    Primitive combinators
-------------------------------------------------------------------------------}
-never                               = E X.never Y.never
-filterJust (E x y)                  = E (X.filterJust x) (Y.filterJust y)
-mergeWith f g h (E x1 y1) (E x2 y2) = E (X.mergeWith f g h x1 x2) (Y.mergeWith f g h y1 y2)
-mapE f (E x y)                      = E (fmap f x) (fmap f y)
-applyE ~(B x1 y1) (E x2 y2)         = E (X.apply x1 x2) (y1 Y.<@> y2)
-
-instance Functor Event where fmap = mapE
-
-pureB a                         = B (pure a) (pure a)
-applyB (B x1 y1) (B x2 y2)      = B (x1 <*> x2) (y1 <*> y2)
-mapB f (B x y)                  = B (fmap f x) (fmap f y)
-
-instance Functor     Behavior where fmap = mapB
-instance Applicative Behavior where pure = pureB; (<*>) = applyB
-
-instance Functor Moment where fmap = liftM
-instance Applicative Moment where
-    pure  = return
-    (<*>) = ap
-instance Monad Moment where
-    return a = M (return a) (return a)
-    ~(M x y) >>= g = M (x >>= fstM . g) (y >>= sndM . g)
-instance MonadFix Moment where
-    mfix f = M (mfix fx) (mfix fy)
-        where
-        fx a = let M x _ = f a in x
-        fy a = let M _ y = f a in y
-
-
-accumE   a ~(E x y) = M
-    (ex <$> X.accumE a x)
-    (ey <$> Y.accumE a y)
-stepperB a ~(E x y) = M
-    (bx <$> X.stepper a x)
-    (by <$> Y.stepper a y)
-stepper            = stepperB
-
-valueB ~(B x y) = M (X.valueB x) (Y.valueB y)
-
-observeE :: Event (Moment a) -> Event a
-observeE (E x y) = E (X.observeE $ fmap fstM x) (Y.observeE $ fmap sndM y)
-
-switchE :: Event a -> Event (Event a) -> Moment (Event a)
-switchE (E x0 y0) (E x y) = M
-    (fmap ex $ X.switchE x0 $ fstE <$> x)
-    (fmap ey $ Y.switchE y0 $ sndE <$> y)
-
-switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a)
-switchB (B x y) (E xe ye) = M
-    (fmap bx $ X.switchB x $ fmap fstB xe)
-    (fmap by $ Y.switchB y $ fmap sndB ye)
-
-{-----------------------------------------------------------------------------
-    Derived combinators
-------------------------------------------------------------------------------}
-accumB acc e1 = do
-    e2 <- accumE acc e1
-    stepperB acc e2
-whenE b = filterJust . applyE ((\b e -> if b then Just e else Nothing) <$> b)
-
-infixl 4 <@>, <@
-b <@ e  = applyE (const <$> b) e
-b <@> e = applyE b e