diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,6 +1,47 @@
-Changelog for the `reactive-banana** package
+Changelog for the `reactive-banana` package
 -------------------------------------------
 
+**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][]
+* Prevent a deadlock if the network crashes when evaluating a `Behavior` or `Event`. [#262][]
+
+  [#257]: https://github.com/HeinrichApfelmus/reactive-banana/pull/257
+  [#258]: https://github.com/HeinrichApfelmus/reactive-banana/pull/258
+  [#256]: https://github.com/HeinrichApfelmus/reactive-banana/pull/256
+  [#262]: https://github.com/HeinrichApfelmus/reactive-banana/pull/262
+  [#260]: https://github.com/HeinrichApfelmus/reactive-banana/pull/260
+
+**Version 1.3.0.0** (2022-03-28)
+
+* Added `Semigroup` and `Monoid` instances to `Moment` and `MomentIO`. [#223][]
+* Add `@>` operator. [#229][]
+* `switchE` now takes an initial event. This is breaking change. The previous behavior can be restored by using `switchE never`. [#165][]
+* Triggering an `AddHandler` no longer allocates, leading to a minor performance improvement. [#237][]
+* A new `once` combinator has been added that filters an `Event` so it only fires once. [#239][]
+* `MonadMoment` instances have been added for all possibly monad transformers (from the `transformers` library). [#248][]
+* Some internal refactoring to reduce allocations and improve performance. [#238][]
+* The `Reactive.Banana.Prim` hierarchy has been changed to better reflect the abstraction hierarchy. [#241][]
+
+  [#165]: https://github.com/HeinrichApfelmus/reactive-banana/pull/165
+  [#229]: https://github.com/HeinrichApfelmus/reactive-banana/pull/229
+  [#223]: https://github.com/HeinrichApfelmus/reactive-banana/pull/223
+  [#237]: https://github.com/HeinrichApfelmus/reactive-banana/pull/237
+  [#238]: https://github.com/HeinrichApfelmus/reactive-banana/pull/238
+  [#239]: https://github.com/HeinrichApfelmus/reactive-banana/pull/239
+  [#241]: https://github.com/HeinrichApfelmus/reactive-banana/pull/241
+  [#248]: https://github.com/HeinrichApfelmus/reactive-banana/pull/248
+
 **Version 1.2.2.0**
 
 * Optimize the implementation of `Graph.listParents` [#209][]
@@ -21,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/benchmark/Main.hs b/benchmark/Main.hs
new file mode 100644
--- /dev/null
+++ b/benchmark/Main.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NumericUnderscores #-}
+module Main ( main ) where
+
+import Control.Monad (replicateM, replicateM_, forM_)
+import qualified Data.IntMap.Strict as IM
+import Reactive.Banana.Combinators ( Event, Behavior, MonadMoment, filterE, accumE, switchB, accumB )
+import Reactive.Banana.Frameworks (MomentIO, newAddHandler, fromAddHandler, compile, actuate, Handler, reactimate)
+import Reactive.Banana ( Event, Behavior, MonadMoment )
+import System.Random (randomRIO)
+import Test.Tasty (withResource)
+import Test.Tasty.Bench (env, defaultMain, bgroup, bench, whnfIO)
+
+main :: IO ()
+main = defaultMain $ [ mkBenchmarkGroup netsize | netsize <- [ 1, 2, 4, 8, 16, 32, 64, 128 ] ] ++
+                     [ boringBenchmark ]
+  where
+    mkBenchmarkGroup netsize =
+      withResource (setupBenchmark netsize) mempty $ \getEnv ->
+        bgroup ("netsize = " <> show netsize)
+          [ mkBenchmark getEnv steps | steps <- [ 1, 2, 4, 8, 16, 32, 64, 128] ]
+      where
+        mkBenchmark getEnv duration = bench ("duration = " <> show duration) $ whnfIO $ do
+          (triggers, clock) <- getEnv
+          let trigMap = IM.fromList $ zip [0..netsize-1] triggers
+          forM_ [1..duration] $ \step -> do
+            randomRs <- replicateM 10 $ randomRIO (0,netsize-1)
+            clock step
+            forM_ randomRs $ \ev ->
+                maybe (error "benchmark: trigger not found") ($ ()) $
+                    IM.lookup ev trigMap
+
+    boringBenchmark = withResource setup mempty $ \getEnv ->
+      bench "Boring" $ whnfIO $ do
+        tick <- getEnv
+        {-# SCC ticks #-} replicateM_ 1_000_000 $ {-# SCC tick #-} tick ()
+      where
+        setup = do
+          (tick, onTick) <- newAddHandler
+          network <- compile $ do
+            e <- fromAddHandler tick
+            reactimate $ return <$> e
+          actuate network
+          return onTick
+
+setupBenchmark :: Int -> IO ([Handler ()], Handler Int)
+setupBenchmark netsize = do
+  (handlers, triggers) <- unzip <$> replicateM netsize newAddHandler
+  (clock   , trigger ) <- newAddHandler
+
+  let networkD :: MomentIO ()
+      networkD = do
+          es :: [Event ()] <-
+            mapM fromAddHandler handlers
+
+          e :: Event Int <-
+            fromAddHandler clock
+
+          countBs :: [Behavior Int] <-
+            traverse count es
+
+          let
+            step10E :: Event Int
+            step10E = filterE (\cnt -> cnt `rem` 10 == 0) e
+
+          selectedB_E :: Event (Behavior Int) <- do
+            fmap head <$> accumE countBs (keepTail <$ step10E)
+
+          selectedB :: Behavior Int <-
+            switchB (head countBs) selectedB_E
+
+          return ()
+
+      count :: MonadMoment m => Event () -> m (Behavior Int)
+      count e = accumB 0 ((+1) <$ e)
+
+  actuate =<< compile networkD
+  return (triggers, trigger)
+  where
+    keepTail :: [a] -> [a]
+    keepTail (_:y:zs) = y:zs
+    keepTail [x]      = [x]
+    keepTail []       = []
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.2.2.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,13 +25,15 @@
 Category:            FRP
 Cabal-version:       1.18
 Build-type:          Simple
-Tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 8.0.1,
-                     GHC == 8.2.2, 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,
-                        src/Reactive/Banana/Test.hs,
-                        src/Reactive/Banana/Test/Plumbing.hs
+                        doc/examples/*.hs
 extra-doc-files:        doc/*.png
 
 Source-repository head
@@ -44,13 +46,15 @@
     hs-source-dirs:     src
 
     build-depends:      base >= 4.2 && < 5,
-                        semigroups >= 0.13 && < 0.20,
+                        deepseq >= 1.4.3.0 && < 1.5,
+                        semigroups >= 0.13 && < 0.21,
                         containers >= 0.5 && < 0.7,
-                        transformers >= 0.2 && < 0.6,
+                        transformers >= 0.2 && < 0.7,
                         vault == 0.3.*,
                         unordered-containers >= 0.2.1.0 && < 0.3,
-                        hashable >= 1.1 && < 1.4,
+                        hashable >= 1.1 && < 1.5,
                         pqueue >= 1.0 && < 1.5,
+                        stm >= 2.5 && < 2.6,
                         these >= 0.2 && < 1.2
 
     exposed-modules:
@@ -59,35 +63,81 @@
                         Reactive.Banana.Combinators,
                         Reactive.Banana.Frameworks,
                         Reactive.Banana.Model,
-                        Reactive.Banana.Prim,
-                        Reactive.Banana.Prim.Cached
+                        Reactive.Banana.Prim.Mid,
+                        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.Internal.Combinators,
-                        Reactive.Banana.Prim.Combinators,
-                        Reactive.Banana.Prim.Compile,
-                        Reactive.Banana.Prim.Dependencies,
-                        Reactive.Banana.Prim.Evaluation,
-                        Reactive.Banana.Prim.Graph,
-                        Reactive.Banana.Prim.IO,
-                        Reactive.Banana.Prim.OrderedBag,
-                        Reactive.Banana.Prim.Plumbing,
-                        Reactive.Banana.Prim.Test,
-                        Reactive.Banana.Prim.Types,
-                        Reactive.Banana.Prim.Util,
+                        Reactive.Banana.Prim.Low.OrderedBag,
+                        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
 
-Test-Suite tests
+    ghc-options: -Wall -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-uni-patterns -Werror=missing-fields -Werror=partial-fields -Wno-name-shadowing
+
+Test-Suite unit
     default-language:   Haskell98
     type:               exitcode-stdio-1.0
-    hs-source-dirs:     src
-    main-is:            Reactive/Banana/Test.hs
-    build-depends:      base >= 4.2 && < 5,
-                        HUnit >= 1.2 && < 2,
-                        test-framework >= 0.6 && < 0.9,
-                        test-framework-hunit >= 0.2 && < 0.4,
-                        reactive-banana, vault, containers,
-                        semigroups, transformers,
-                        unordered-containers, hashable, psqueues, pqueue, these
+    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,
+                        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
+                      , 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/Event/Handler.hs b/src/Control/Event/Handler.hs
--- a/src/Control/Event/Handler.hs
+++ b/src/Control/Event/Handler.hs
@@ -9,12 +9,11 @@
     ) where
 
 
+import           Control.Monad ((>=>), when)
 import           Data.IORef
 import qualified Data.Map    as Map
 import qualified Data.Unique
 
-type Map = Map.Map
-
 {-----------------------------------------------------------------------------
     Types
 ------------------------------------------------------------------------------}
@@ -40,12 +39,12 @@
 
 -- | Map the event value with an 'IO' action.
 mapIO :: (a -> IO b) -> AddHandler a -> AddHandler b
-mapIO f e = AddHandler $ \h -> register e $ \x -> f x >>= h
+mapIO f e = AddHandler $ \h -> register e (f >=> h)
 
 -- | Filter event values that don't return 'True'.
 filterIO :: (a -> IO Bool) -> AddHandler a -> AddHandler a
 filterIO f e = AddHandler $ \h ->
-    register e $ \x -> f x >>= \b -> if b then h x else return ()
+    register e $ \x -> f x >>= \b -> when b $ h x
 
 {-----------------------------------------------------------------------------
     Construction
@@ -68,8 +67,29 @@
             atomicModifyIORef_ handlers $ Map.insert key handler
             return $ atomicModifyIORef_ handlers $ Map.delete key
         runHandlers a =
-            mapM_ ($ a) . map snd . Map.toList =<< readIORef handlers
+            runAll a =<< readIORef handlers
     return (AddHandler register, runHandlers)
 
 atomicModifyIORef_ :: IORef a -> (a -> a) -> IO ()
 atomicModifyIORef_ ref f = atomicModifyIORef ref $ \x -> (f x, ())
+
+-- | A callback is a @a -> IO ()@ function. We define this newtype to provide
+-- a way to combine callbacks ('Monoid' and 'Semigroup' instances), which
+-- allow us to write the efficient 'runAll' function.
+newtype Callback a = Callback { invoke :: a -> IO () }
+
+instance Semigroup (Callback a) where
+    Callback f <> Callback g = Callback $ \a -> f a >> g a
+
+instance Monoid (Callback a) where
+    mempty = Callback $ \_ -> return ()
+
+-- This function can also be seen as
+--
+--   runAll a fs = mapM_ ($ a) fs
+--
+-- The reason we write this using 'foldMap' and 'Callback' is to produce code
+-- that doesn't allocate. See https://github.com/HeinrichApfelmus/reactive-banana/pull/237
+-- for more info.
+runAll :: a -> Map.Map Data.Unique.Unique (a -> IO ()) -> IO ()
+runAll a fs = invoke (foldMap Callback fs) a
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
@@ -7,13 +7,10 @@
     RWSIOT(..), Tuple(..), rwsT, runRWSIOT, tell, ask, get, put,
     ) where
 
-import Control.Applicative
-import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
 import Data.IORef
-import Data.Monoid
 
 {-----------------------------------------------------------------------------
     Type and class instances
@@ -29,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
@@ -48,9 +44,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
 
@@ -92,8 +85,3 @@
 
 put :: MonadIO m => s -> RWSIOT r w s m ()
 put s = R $ \(Tuple _ _ s') -> liftIO $ writeIORef s' s
-
-test :: RWSIOT String String () IO ()
-test = do
-    c <- ask
-    tell c
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
@@ -8,14 +8,10 @@
     ReaderWriterIOT, readerWriterIOT, runReaderWriterIOT, tell, listen, ask, local,
     ) where
 
-import Control.Applicative
-import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
 import Data.IORef
-import Data.Monoid
-import Data.Semigroup
 
 {-----------------------------------------------------------------------------
     Type and class instances
@@ -29,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
@@ -40,24 +35,21 @@
     mx <> my = mx >> my
 
 instance (Monad m, a ~ ()) => Monoid (ReaderWriterIOT r w m a) where
-    mempty          = return ()
-    mx `mappend` my = mx >> my
+    mempty  = return ()
+    mappend = (<>)
 
 {-----------------------------------------------------------------------------
     Functions
 ------------------------------------------------------------------------------}
 liftIOR :: MonadIO m => IO a -> ReaderWriterIOT r w m a
-liftIOR m = ReaderWriterIOT $ \x y -> liftIO m
+liftIOR m = ReaderWriterIOT $ \_ _ -> liftIO m
 
 liftR :: m a -> ReaderWriterIOT r w m a
-liftR m = ReaderWriterIOT $ \x y -> m
+liftR m = ReaderWriterIOT $ \_ _ -> m
 
 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
 
@@ -99,8 +91,3 @@
 
 ask :: Monad m => ReaderWriterIOT r w m r
 ask = ReaderWriterIOT $ \r _ -> return r
-
-test :: ReaderWriterIOT String String IO ()
-test = do
-    c <- ask
-    tell c
diff --git a/src/Reactive/Banana.hs b/src/Reactive/Banana.hs
--- a/src/Reactive/Banana.hs
+++ b/src/Reactive/Banana.hs
@@ -19,7 +19,6 @@
 
 import Reactive.Banana.Combinators
 import Reactive.Banana.Frameworks
-import Reactive.Banana.Types
 
 {-$intro
 
diff --git a/src/Reactive/Banana/Combinators.hs b/src/Reactive/Banana/Combinators.hs
--- a/src/Reactive/Banana/Combinators.hs
+++ b/src/Reactive/Banana/Combinators.hs
@@ -2,6 +2,7 @@
     reactive-banana
 ------------------------------------------------------------------------------}
 {-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module Reactive.Banana.Combinators (
@@ -34,9 +35,9 @@
 
     -- * Derived Combinators
     -- ** Infix operators
-    (<@>), (<@),
+    (<@>), (<@), (@>),
     -- ** Filtering
-    filterJust, filterApply, whenE, split,
+    filterJust, filterApply, whenE, split, once,
     -- ** Accumulation
     -- $Accumulation.
     unions, accumB, mapAccum,
@@ -45,12 +46,10 @@
     ) where
 
 import Control.Applicative
-import Control.Monad
-import Data.Maybe          (isJust, catMaybes)
 import Data.Semigroup
-import Data.These (These(..), these)
+import Data.These (These(..))
 
-import qualified Reactive.Banana.Internal.Combinators as Prim
+import qualified Reactive.Banana.Prim.High.Combinators as Prim
 import           Reactive.Banana.Types
 
 {-----------------------------------------------------------------------------
@@ -277,12 +276,15 @@
 -- | Dynamically switch between 'Event'.
 -- Semantically,
 --
--- > switchE ee = \time0 -> concat [trim t1 t2 e | (t1,t2,e) <- intervals ee, time0 <= t1]
--- >     where
--- >     intervals e        = [(time1, time2, x) | ((time1,x),(time2,_)) <- zip e (tail e)]
+-- > switchE e0 ee0 time0 =
+-- >     concat [ trim t1 t2 e | (t1,t2,e) <- intervals ee ]
+-- >   where
+-- >     laterThan e time0  = [(timex,x) | (timex,x) <- e, time0 < timex ]
+-- >     ee                 = [(time0, e0)] ++ (ee0 `laterThan` time0)
+-- >     intervals ee       = [(time1, time2, e) | ((time1,e),(time2,_)) <- zip ee (tail ee)]
 -- >     trim time1 time2 e = [x | (timex,x) <- e, time1 < timex, timex <= time2]
-switchE :: MonadMoment m => Event (Event a) -> m (Event a)
-switchE = liftMoment . M . fmap E . Prim.switchE . Prim.mapE (unE) . unE
+switchE :: MonadMoment m => Event a -> Event (Event a) -> m (Event a)
+switchE e ee = liftMoment (M (fmap E (Prim.switchE (unE e) (Prim.mapE unE (unE ee)))))
 
 -- | Dynamically switch between 'Behavior'.
 -- Semantically,
@@ -290,12 +292,12 @@
 -- >  switchB b0 eb = \time0 -> \time1 ->
 -- >     last (b0 : [b | (timeb,b) <- eb, time0 <= timeb, timeb < time1]) time1
 switchB :: MonadMoment m => Behavior a -> Event (Behavior a) -> m (Behavior a)
-switchB b = liftMoment . M . fmap B . Prim.switchB (unB b) . Prim.mapE (unB) . unE
+switchB b = liftMoment . M . fmap B . Prim.switchB (unB b) . Prim.mapE unB . unE
 
 {-----------------------------------------------------------------------------
     Derived Combinators
 ------------------------------------------------------------------------------}
-infixl 4 <@>, <@
+infixl 4 <@>, <@, @>
 
 -- | Infix synonym for the 'apply' combinator. Similar to '<*>'.
 --
@@ -309,6 +311,20 @@
 (<@)  :: Behavior b -> Event a -> Event b
 f <@ g = (const <$> f) <@> g
 
+-- | Tag all event occurences with a time-varying value. Similar to '*>'.
+--
+-- This is the flipped version of '<@', but can be useful when combined with
+-- @ApplicativeDo@ to sample from multiple 'Behavior's:
+--
+-- @
+-- reactimate $ onEvent @> do
+--   x <- behavior1
+--   y <- behavior2
+--   return (print (x + y))
+-- @
+(@>) :: Event a -> Behavior b -> Event b
+g @> f = (const <$> f) <@> g
+
 -- | Allow all events that fulfill the time-varying predicate, discard the rest.
 -- Generalization of 'filterE'.
 filterApply :: Behavior (a -> Bool) -> Event a -> Event a
@@ -327,11 +343,22 @@
     where
     fromLeft :: Either a b -> Maybe a
     fromLeft  (Left  a) = Just a
-    fromLeft  (Right b) = Nothing
+    fromLeft  (Right _) = Nothing
 
     fromRight :: Either a b -> Maybe b
-    fromRight (Left  a) = Nothing
+    fromRight (Left  _) = Nothing
     fromRight (Right b) = Just b
+
+
+-- | Keep only the next occurence of an event.
+-- 
+-- @once@ also aids the garbage collector by indicating that the result event can be discarded after its only occurrence.
+--
+-- > once e = \time0 -> take 1 [(t, a) | (t, a) <- e, time0 <= t]
+once :: MonadMoment m => Event a -> m (Event a)
+once e = mdo
+    e1 <- switchE e (never <$ e1)
+    return e1
 
 
 -- $Accumulation.
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
 
@@ -42,7 +42,7 @@
 import           Control.Monad.IO.Class
 import           Data.IORef
 import           Reactive.Banana.Combinators
-import qualified Reactive.Banana.Internal.Combinators as Prim
+import qualified Reactive.Banana.Prim.High.Combinators as Prim
 import           Reactive.Banana.Types
 
 
@@ -332,6 +332,12 @@
 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
 ------------------------------------------------------------------------------}
@@ -342,7 +348,7 @@
 -- inside a 'reactimate'.
 newEvent :: MomentIO (Event a, Handler a)
 newEvent = do
-    (addHandler, fire) <- liftIO $ newAddHandler
+    (addHandler, fire) <- liftIO newAddHandler
     e <- fromAddHandler addHandler
     return (e,fire)
 
@@ -377,7 +383,7 @@
 mapEventIO :: (a -> IO b) -> Event a -> MomentIO (Event b)
 mapEventIO f e1 = do
     (e2, handler) <- newEvent
-    reactimate $ (\a -> f a >>= handler) <$> e1
+    reactimate $ (f >=> handler) <$> e1
     return e2
 
 {-----------------------------------------------------------------------------
@@ -396,7 +402,7 @@
         reactimate $ writeIORef output . Just <$> e2
 
     actuate network
-    bs <- forM xs $ \x -> do
+    forM xs $ \x -> do
         case x of
             Nothing -> return Nothing
             Just x  -> do
@@ -404,7 +410,6 @@
                 b <- readIORef output
                 writeIORef output Nothing
                 return b
-    return bs
 
 -- | Simple way to write a single event handler with
 -- functional reactive programming.
diff --git a/src/Reactive/Banana/Internal/Combinators.hs b/src/Reactive/Banana/Internal/Combinators.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Internal/Combinators.hs
+++ /dev/null
@@ -1,246 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo, FlexibleInstances, NoMonomorphismRestriction #-}
-module Reactive.Banana.Internal.Combinators where
-
-import           Control.Concurrent.MVar
-import           Control.Event.Handler
-import           Control.Monad
-import           Control.Monad.Fix
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Class           (lift)
-import           Control.Monad.Trans.Reader
-import           Data.Functor
-import           Data.Functor.Identity
-import           Data.IORef
-import qualified Reactive.Banana.Prim        as Prim
-import           Reactive.Banana.Prim.Cached
-import           Data.These (These(..), these)
-
-type Build   = Prim.Build
-type Latch a = Prim.Latch a
-type Pulse a = Prim.Pulse a
-type Future  = Prim.Future
-
-{-----------------------------------------------------------------------------
-    Types
-------------------------------------------------------------------------------}
-type Behavior a = Cached Moment (Latch a, Pulse ())
-type Event a    = Cached Moment (Pulse a)
-type Moment     = ReaderT EventNetwork Prim.Build
-
-liftBuild :: Build a -> Moment a
-liftBuild = lift
-
-{-----------------------------------------------------------------------------
-    Interpretation
-------------------------------------------------------------------------------}
-interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
-interpret f = Prim.interpret $ \pulse -> runReaderT (g pulse) undefined
-    where
-    g pulse = runCached =<< f (Prim.fromPure pulse)
-    -- Ignore any  addHandler  inside the  Moment
-
-{-----------------------------------------------------------------------------
-    IO
-------------------------------------------------------------------------------}
--- | Data type representing an event network.
-data EventNetwork = EventNetwork
-    { runStep :: Prim.Step -> IO ()
-    , actuate :: IO ()
-    , pause   :: IO ()
-    }
-
--- | Compile to an event network.
-compile :: Moment () -> IO EventNetwork
-compile setup = do
-    actuated <- newIORef False                   -- flag to set running status
-    s        <- newEmptyMVar                     -- setup callback machinery
-    let
-        whenFlag flag action = readIORef flag >>= \b -> when b action
-        runStep f            = whenFlag actuated $ do
-            s1 <- takeMVar s                    -- read and take lock
-            -- pollValues <- sequence polls     -- poll mutable data
-            (output, s2) <- f s1                -- calculate new state
-            putMVar s s2                        -- write state
-            output                              -- run IO actions afterwards
-
-        eventNetwork = EventNetwork
-            { runStep = runStep
-            , actuate = writeIORef actuated True
-            , pause   = writeIORef actuated False
-            }
-
-    (output, s0) <-                             -- compile initial graph
-        Prim.compile (runReaderT setup eventNetwork) Prim.emptyNetwork
-    putMVar s s0                                -- set initial state
-
-    return $ eventNetwork
-
-fromAddHandler :: AddHandler a -> Moment (Event a)
-fromAddHandler addHandler = do
-    (p, fire) <- liftBuild $ Prim.newInput
-    network   <- ask
-    liftIO $ register addHandler $ runStep network . fire
-    return $ Prim.fromPure p
-
-addReactimate :: Event (Future (IO ())) -> Moment ()
-addReactimate e = do
-    network   <- ask
-    liftBuild $ Prim.buildLater $ do
-        -- Run cached computation later to allow more recursion with `Moment`
-        p <- runReaderT (runCached e) network
-        Prim.addHandler p id
-
-fromPoll :: IO a -> Moment (Behavior a)
-fromPoll poll = do
-    a <- liftIO poll
-    e <- liftBuild $ do
-        p <- Prim.unsafeMapIOP (const poll) =<< Prim.alwaysP
-        return $ Prim.fromPure p
-    stepperB a e
-
-liftIONow :: IO a -> Moment a
-liftIONow = liftIO
-
-liftIOLater :: IO () -> Moment ()
-liftIOLater = lift . Prim.liftBuild . Prim.liftIOLater
-
-imposeChanges :: Behavior a -> Event () -> Behavior a
-imposeChanges = liftCached2 $ \(l1,_) p2 -> return (l1,p2)
-
-{-----------------------------------------------------------------------------
-    Combinators - basic
-------------------------------------------------------------------------------}
-never :: Event a
-never = don'tCache  $ liftBuild $ Prim.neverP
-
-mergeWith
-  :: (a -> c)
-  -> (b -> c)
-  -> (a -> b -> c)
-  -> Event a
-  -> Event b
-  -> Event c
-mergeWith f g h = liftCached2 $ (liftBuild .) . Prim.mergeWithP (Just . f) (Just . g) (\x y -> Just (h x y))
-
-
-filterJust :: Event (Maybe a) -> Event a
-filterJust  = liftCached1 $ liftBuild . Prim.filterJustP
-
-mapE :: (a -> b) -> Event a -> Event b
-mapE f = liftCached1 $ liftBuild . Prim.mapP f
-
-applyE :: Behavior (a -> b) -> Event a -> Event b
-applyE = liftCached2 $ \(~(lf,_)) px -> liftBuild $ Prim.applyP lf px
-
-changesB :: Behavior a -> Event (Future a)
-changesB = liftCached1 $ \(~(lx,px)) -> liftBuild $ Prim.tagFuture lx px
-
-pureB :: a -> Behavior a
-pureB a = cache $ do
-    p <- runCached never
-    return (Prim.pureL a, p)
-
-applyB :: Behavior (a -> b) -> Behavior a -> Behavior b
-applyB = liftCached2 $ \(~(l1,p1)) (~(l2,p2)) -> liftBuild $ do
-    p3 <- Prim.mergeWithP Just Just (const . Just) p1 p2
-    let l3 = Prim.applyL l1 l2
-    return (l3,p3)
-
-mapB :: (a -> b) -> Behavior a -> Behavior b
-mapB f = applyB (pureB f)
-
-{-----------------------------------------------------------------------------
-    Combinators - accumulation
-------------------------------------------------------------------------------}
--- Make sure that the cached computation (Event or Behavior)
--- is executed eventually during this moment.
-trim :: Cached Moment a -> Moment (Cached Moment a)
-trim b = do
-    liftBuildFun Prim.buildLater $ void $ runCached b
-    return b
-
--- Cache a computation at this moment in time
--- and make sure that it is performed in the Build monad eventually
-cacheAndSchedule :: Moment a -> Moment (Cached Moment a)
-cacheAndSchedule m = ask >>= \r -> liftBuild $ do
-    let c = cache (const m r)   -- prevent let-floating!
-    Prim.buildLater $ void $ runReaderT (runCached c) r
-    return c
-
-stepperB :: a -> Event a -> Moment (Behavior a)
-stepperB a e = cacheAndSchedule $ do
-    p0 <- runCached e
-    liftBuild $ do
-        p1    <- Prim.mapP const p0
-        p2    <- Prim.mapP (const ()) p1
-        (l,_) <- Prim.accumL a p1
-        return (l,p2)
-
-accumE :: a -> Event (a -> a) -> Moment (Event a)
-accumE a e1 = cacheAndSchedule $ do
-    p0 <- runCached e1
-    liftBuild $ do
-        (_,p1) <- Prim.accumL a p0
-        return p1
-
-{-----------------------------------------------------------------------------
-    Combinators - dynamic event switching
-------------------------------------------------------------------------------}
-liftBuildFun :: (Build a -> Build b) -> Moment a -> Moment b
-liftBuildFun f m = do
-    r <- ask
-    liftBuild $ f $ runReaderT m r
-
-valueB :: Behavior a -> Moment a
-valueB b = do
-    ~(l,_) <- runCached b
-    liftBuild $ Prim.readLatch l
-
-initialBLater :: Behavior a -> Moment a
-initialBLater = liftBuildFun Prim.buildLaterReadNow . valueB
-
-executeP :: Pulse (Moment a) -> Moment (Pulse a)
-executeP p1 = do
-    r <- ask
-    liftBuild $ do
-        p2 <- Prim.mapP runReaderT p1
-        Prim.executeP p2 r
-
-observeE :: Event (Moment a) -> Event a
-observeE = liftCached1 $ executeP
-
-executeE :: Event (Moment a) -> Moment (Event a)
-executeE e = do
-    -- Run cached computation later to allow more recursion with `Moment`
-    p <- liftBuildFun Prim.buildLaterReadNow $ executeP =<< runCached e
-    return $ fromPure p
-
-switchE :: Event (Event a) -> Moment (Event a)
-switchE e = ask >>= \r -> cacheAndSchedule $ do
-    p1 <- runCached e
-    liftBuild $ do
-        p2 <- Prim.mapP (runReaderT . runCached) p1
-        p3 <- Prim.executeP p2 r
-        Prim.switchP p3
-
-switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a)
-switchB b e = ask >>= \r -> cacheAndSchedule $ do
-    ~(l0,p0) <- runCached b
-    p1       <- runCached e
-    liftBuild $ do
-        p2 <- Prim.mapP (runReaderT . runCached) p1
-        p3 <- Prim.executeP p2 r
-
-        lr <- Prim.switchL l0 =<< Prim.mapP fst p3
-        -- TODO: switch away the initial behavior
-        let c1 = p0                              -- initial behavior changes
-        c2 <- Prim.mapP (const ()) p3            -- or switch happens
-        c3 <- Prim.switchP =<< Prim.mapP snd p3  -- or current behavior changes
-        pr <- merge c1 =<< merge c2 c3
-        return (lr, pr)
-
-merge :: Pulse () -> Pulse () -> Build (Pulse ())
-merge = Prim.mergeWithP Just Just (\_ _ -> Just ())
diff --git a/src/Reactive/Banana/Model.hs b/src/Reactive/Banana/Model.hs
--- a/src/Reactive/Banana/Model.hs
+++ b/src/Reactive/Banana/Model.hs
@@ -2,6 +2,8 @@
     reactive-banana
 ------------------------------------------------------------------------------}
 {-# LANGUAGE RecursiveDo #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 module Reactive.Banana.Model (
     -- * Synopsis
     -- | Model implementation for learning and testing.
@@ -27,6 +29,7 @@
 import Control.Monad
 import Control.Monad.Fix
 import Data.These (These(..), these)
+import Data.Maybe (fromMaybe)
 
 {-$overview
 
@@ -145,9 +148,7 @@
 stepper i e = M $ \time -> B $ replicate time i ++ step i (forgetE time e)
     where
     step i ~(x:xs) = i : step next xs
-        where next = case x of
-                        Just i  -> i
-                        Nothing -> i
+        where next = fromMaybe i x
 
 -- Expressed using recursion and the other primitives
 -- FIXME: Strictness!
@@ -166,9 +167,9 @@
 observeE :: Event (Moment a) -> Event a
 observeE = E . zipWith (\time -> fmap (\m -> unM m time)) [0..] . unE
 
-switchE :: Event (Event a) -> Moment (Event a)
-switchE es = M $ \t -> E $
-    replicate t Nothing ++ switch (unE never) (forgetE t (forgetDiagonalE es))
+switchE :: Event a -> Event (Event a) -> Moment (Event a)
+switchE e es = M $ \t -> E $
+    replicate t Nothing ++ switch (unE e) (forgetE t (forgetDiagonalE es))
     where
     switch (x:xs) (Nothing : ys) = x : switch xs ys
     switch (x: _) (Just xs : ys) = x : switch (tail xs) ys
diff --git a/src/Reactive/Banana/Prim.hs b/src/Reactive/Banana/Prim.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo #-}
-module Reactive.Banana.Prim (
-    -- * Synopsis
-    -- | This is an internal module, useful if you want to
-    -- implemented your own FRP library.
-    -- If you just want to use FRP in your project,
-    -- have a look at "Reactive.Banana" instead.
-
-    -- * Evaluation
-    Step, Network, emptyNetwork,
-
-    -- * Build FRP networks
-    Build, liftIOLater, BuildIO, liftBuild, buildLater, buildLaterReadNow, compile,
-    module Control.Monad.IO.Class,
-
-    -- * Caching
-    module Reactive.Banana.Prim.Cached,
-
-    -- * Testing
-    interpret, mapAccumM, mapAccumM_, runSpaceProfile,
-
-    -- * IO
-    newInput, addHandler, readLatch,
-
-    -- * Pulse
-    Pulse,
-    neverP, alwaysP, mapP, Future, tagFuture, unsafeMapIOP, filterJustP, mergeWithP,
-
-    -- * Latch
-    Latch,
-    pureL, mapL, applyL, accumL, applyP,
-
-    -- * Dynamic event switching
-    switchL, executeP, switchP
-
-    -- * Notes
-    -- $recursion
-  ) where
-
-
-import Control.Monad.IO.Class
-import Reactive.Banana.Prim.Cached
-import Reactive.Banana.Prim.Combinators
-import Reactive.Banana.Prim.Compile
-import Reactive.Banana.Prim.IO
-import Reactive.Banana.Prim.Plumbing (neverP, alwaysP, liftBuild, buildLater, buildLaterReadNow, liftIOLater)
-import Reactive.Banana.Prim.Types
-
-{-----------------------------------------------------------------------------
-    Notes
-------------------------------------------------------------------------------}
--- Note [Recursion]
-{- $recursion
-
-The 'Build' monad is an instance of 'MonadFix' and supports value recursion.
-However, it is built on top of the 'IO' monad, so the recursion is
-somewhat limited.
-
-The main rule for value recursion in the 'IO' monad is that the action
-to be performed must be known in advance. For instance, the following snippet
-will not work, because 'putStrLn' cannot complete its action without
-inspecting @x@, which is not defined until later.
-
->   mdo
->       putStrLn x
->       let x = "Hello recursion"
-
-On the other hand, whenever the sequence of 'IO' actions can be known
-before inspecting any later arguments, the recursion works.
-For instance the snippet
-
->   mdo
->       p1 <- mapP p2
->       p2 <- neverP
->       return p1
-
-works because 'mapP' does not inspect its argument. In other words,
-a call @p1 <- mapP undefined@ would perform the same sequence of 'IO' actions.
-(Internally, it essentially calls 'newIORef'.)
-
-With this issue in mind, almost all operations that build 'Latch'
-and 'Pulse' values have been carefully implemented to not inspect
-their arguments.
-In conjunction with the 'Cached' mechanism for observable sharing,
-this allows us to build combinators that can be used recursively.
-One notable exception is the 'readLatch' function, which must
-inspect its argument in order to be able to read its value.
-
--}
-
-test :: Build (Pulse ())
-test = mdo
-    p1 <- mapP (const ()) p2
-    p2 <- neverP
-    return p1
-
--- Note [LatchStrictness]
-{-
-
-Any value that is stored in the graph over a longer
-period of time must be stored in WHNF.
-
-This implies that the values in a latch must be forced to WHNF
-when storing them. That doesn't have to be immediately
-since we are tying a knot, but it definitely has to be done
-before  evaluateGraph  is done.
-
-It also implies that reading a value from a latch must
-be forced to WHNF before storing it again, so that we don't
-carry around the old collection of latch values.
-This is particularly relevant for `applyL`.
-
-Conversely, since latches are the only way to store values over time,
-this is enough to guarantee that there are no space leaks in this regard.
-
--}
diff --git a/src/Reactive/Banana/Prim/Cached.hs b/src/Reactive/Banana/Prim/Cached.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Cached.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo #-}
-module Reactive.Banana.Prim.Cached (
-    -- | Utility for executing monadic actions once
-    -- and then retrieving values from a cache.
-    --
-    -- Very useful for observable sharing.
-    Cached, runCached, cache, fromPure, don'tCache,
-    liftCached1, liftCached2,
-    ) where
-
-import Control.Monad
-import Control.Monad.Fix
-import Control.Monad.IO.Class
-import Data.IORef
-import System.IO.Unsafe       (unsafePerformIO)
-
-{-----------------------------------------------------------------------------
-    Cache type
-------------------------------------------------------------------------------}
-data Cached m a = Cached (m a)
-
-runCached :: Cached m a -> m a
-runCached (Cached x) = x
-
--- | An action whose result will be cached.
--- Executing the action the first time in the monad will
--- execute the side effects. From then on,
--- only the generated value will be returned.
-{-# NOINLINE cache #-}
-cache :: (MonadFix m, MonadIO m) => m a -> Cached m a
-cache m = unsafePerformIO $ do
-    key <- liftIO $ newIORef Nothing
-    return $ Cached $ do
-        ma <- liftIO $ readIORef key    -- read the cached result
-        case ma of
-            Just a  -> return a         -- return the cached result.
-            Nothing -> mdo
-                liftIO $                -- write the result already
-                    writeIORef key (Just a)
-                a <- m                  -- evaluate
-                return a
-
--- | Return a pure value. Doesn't make use of the cache.
-fromPure :: Monad m => a -> Cached m a
-fromPure = Cached . return
-
--- | Lift an action that is /not/ cached, for instance because it is idempotent.
-don'tCache :: Monad m => m a -> Cached m a
-don'tCache = Cached
-
-liftCached1 :: (MonadFix m, MonadIO m) =>
-    (a -> m b) -> Cached m a -> Cached m b
-liftCached1 f ca = cache $ do
-    a <- runCached ca
-    f a
-
-liftCached2 :: (MonadFix m, MonadIO m) =>
-    (a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
-liftCached2 f ca cb = cache $ do
-    a <- runCached ca
-    b <- runCached cb
-    f a b
diff --git a/src/Reactive/Banana/Prim/Combinators.hs b/src/Reactive/Banana/Prim/Combinators.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Combinators.hs
+++ /dev/null
@@ -1,150 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}
-module Reactive.Banana.Prim.Combinators where
-
-import Control.Applicative
-import Control.Monad
-import Control.Monad.IO.Class
-
-import Reactive.Banana.Prim.Plumbing
-    ( neverP, newPulse, newLatch, cachedLatch
-    , dependOn, keepAlive, changeParent
-    , getValueL
-    , readPulseP, readLatchP, readLatchFutureP, liftBuildP,
-    )
-import qualified Reactive.Banana.Prim.Plumbing (pureL)
-import           Reactive.Banana.Prim.Types    (Latch, Future, Pulse, Build, EvalP)
-
-import Debug.Trace
--- debug s = trace s
-debug s = id
-
-{-----------------------------------------------------------------------------
-    Combinators - basic
-------------------------------------------------------------------------------}
-mapP :: (a -> b) -> Pulse a -> Build (Pulse b)
-mapP f p1 = do
-    p2 <- newPulse "mapP" $ ({-# SCC mapP #-} fmap f <$> readPulseP p1)
-    p2 `dependOn` p1
-    return p2
-
--- | Tag a 'Pulse' with future values of a 'Latch'.
---
--- This is in contrast to 'applyP' which applies the current value
--- of a 'Latch' to a pulse.
-tagFuture :: Latch a -> Pulse b -> Build (Pulse (Future a))
-tagFuture x p1 = do
-    p2 <- newPulse "tagFuture" $
-        fmap . const <$> readLatchFutureP x <*> readPulseP p1
-    p2 `dependOn` p1
-    return p2
-
-filterJustP :: Pulse (Maybe a) -> Build (Pulse a)
-filterJustP p1 = do
-    p2 <- newPulse "filterJustP" $ ({-# SCC filterJustP #-} join <$> readPulseP p1)
-    p2 `dependOn` p1
-    return p2
-
-unsafeMapIOP :: forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b)
-unsafeMapIOP f p1 = do
-        p2 <- newPulse "unsafeMapIOP" $
-            ({-# SCC unsafeMapIOP #-} eval =<< readPulseP p1)
-        p2 `dependOn` p1
-        return p2
-    where
-    eval :: Maybe a -> EvalP (Maybe b)
-    eval (Just x) = Just <$> liftIO (f x)
-    eval Nothing  = return Nothing
-
-mergeWithP
-  :: (a -> Maybe c)
-  -> (b -> Maybe c)
-  -> (a -> b -> Maybe c)
-  -> Pulse a
-  -> Pulse b
-  -> Build (Pulse c)
-mergeWithP f g h px py = do
-  p <- newPulse "mergeWithP" $
-       ({-# SCC mergeWithP #-} eval <$> readPulseP px <*> readPulseP py)
-  p `dependOn` px
-  p `dependOn` py
-  return p
-  where
-    eval Nothing  Nothing  = Nothing
-    eval (Just x) Nothing  = f x
-    eval Nothing  (Just y) = g y
-    eval (Just x) (Just y) = h x y
-
--- See note [LatchRecursion]
-applyP :: Latch (a -> b) -> Pulse a -> Build (Pulse b)
-applyP f x = do
-    p <- newPulse "applyP" $
-        ({-# SCC applyP #-} fmap <$> readLatchP f <*> readPulseP x)
-    p `dependOn` x
-    return p
-
-pureL :: a -> Latch a
-pureL = Reactive.Banana.Prim.Plumbing.pureL
-
--- specialization of   mapL f = applyL (pureL f)
-mapL :: (a -> b) -> Latch a -> Latch b
-mapL f lx = cachedLatch $ ({-# SCC mapL #-} f <$> getValueL lx)
-
-applyL :: Latch (a -> b) -> Latch a -> Latch b
-applyL lf lx = cachedLatch $
-    ({-# SCC applyL #-} getValueL lf <*> getValueL lx)
-
-accumL :: a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
-accumL a p1 = do
-    (updateOn, x) <- newLatch a
-    p2 <- applyP (mapL (\x f -> f x) x) p1
-    updateOn p2
-    return (x,p2)
-
--- specialization of accumL
-stepperL :: a -> Pulse a -> Build (Latch a)
-stepperL a p = do
-    (updateOn, x) <- newLatch a
-    updateOn p
-    return x
-
-{-----------------------------------------------------------------------------
-    Combinators - dynamic event switching
-------------------------------------------------------------------------------}
-switchL :: Latch a -> Pulse (Latch a) -> Build (Latch a)
-switchL l pl = mdo
-    x <- stepperL l pl
-    return $ cachedLatch $ getValueL x >>= getValueL
-
-executeP :: forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
-executeP p1 b = do
-        p2 <- newPulse "executeP" $ ({-# SCC executeP #-} eval =<< readPulseP p1)
-        p2 `dependOn` p1
-        return p2
-    where
-    eval :: Maybe (b -> Build a) -> EvalP (Maybe a)
-    eval (Just x) = Just <$> liftBuildP (x b)
-    eval Nothing  = return Nothing
-
-switchP :: Pulse (Pulse a) -> Build (Pulse a)
-switchP pp = mdo
-    never <- neverP
-    lp    <- stepperL never pp
-    let
-        -- switch to a new parent
-        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
-
-    p1 <- newPulse "switchP_in" switch :: Build (Pulse ())
-    p1 `dependOn` pp
-    p2 <- newPulse "switchP_out" eval
-    p2 `keepAlive` p1
-    return p2
diff --git a/src/Reactive/Banana/Prim/Compile.hs b/src/Reactive/Banana/Prim/Compile.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Compile.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE BangPatterns #-}
-module Reactive.Banana.Prim.Compile where
-
-import Control.Exception (evaluate)
-import Control.Monad     (void)
-import Data.Functor
-import Data.IORef
-
-import           Reactive.Banana.Prim.Combinators
-import           Reactive.Banana.Prim.IO
-import qualified Reactive.Banana.Prim.OrderedBag  as OB
-import           Reactive.Banana.Prim.Plumbing
-import           Reactive.Banana.Prim.Types
-
-{-----------------------------------------------------------------------------
-   Compilation
-------------------------------------------------------------------------------}
--- | Change a 'Network' of pulses and latches by
--- executing a 'BuildIO' action.
-compile :: BuildIO a -> Network -> IO (a, Network)
-compile m state1 = do
-    let time1    = nTime state1
-        outputs1 = nOutputs state1
-
-    theAlwaysP <- case nAlwaysP state1 of
-        Just x   -> return x
-        Nothing  -> do
-            (x,_,_) <- runBuildIO undefined $ newPulse "alwaysP" (return $ Just ())
-            return x
-
-    (a, topology, os) <- runBuildIO (nTime state1, theAlwaysP) m
-    doit topology
-
-    let state2 = Network
-            { nTime    = next time1
-            , nOutputs = OB.inserts outputs1 os
-            , nAlwaysP = Just theAlwaysP
-            }
-    return (a,state2)
-
-{-----------------------------------------------------------------------------
-    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 (\b -> void $ evaluate b)
-        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/Dependencies.hs b/src/Reactive/Banana/Prim/Dependencies.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Dependencies.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-module Reactive.Banana.Prim.Dependencies (
-    -- | Utilities for operating on node dependencies.
-    addChild, changeParent, buildDependencies,
-    ) where
-
-import Control.Monad
-import Data.Functor
-import Data.Monoid
-import System.Mem.Weak
-
-import qualified Reactive.Banana.Prim.Graph as Graph
-import           Reactive.Banana.Prim.Types
-import           Reactive.Banana.Prim.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
-
--- | 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 = not . maybe True (== P child) <$> deRefWeak w
-        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.dfs (P parent) getParents
-        forM_ parents $ \(P node) -> do
-            modify' node $ update levelP (subtract d)
-
-{-----------------------------------------------------------------------------
-    Helper functions
-------------------------------------------------------------------------------}
-getChildren :: SomeNode -> IO [SomeNode]
-getChildren (P p) = deRefWeaks =<< fmap _childrenP (readRef p)
-getChildren _     = return []
-
-getParents :: SomeNode -> IO [SomeNode]
-getParents (P p) = deRefWeaks =<< fmap _parentsP (readRef p)
-getParents _     = return []
diff --git a/src/Reactive/Banana/Prim/Evaluation.hs b/src/Reactive/Banana/Prim/Evaluation.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Evaluation.hs
+++ /dev/null
@@ -1,124 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecordWildCards, BangPatterns #-}
-module Reactive.Banana.Prim.Evaluation (
-    step
-    ) where
-
-import qualified Control.Exception                  as Strict (evaluate)
-import           Control.Monad                                (foldM)
-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.Maybe
-import qualified Data.PQueue.Prio.Min               as Q
-import qualified Data.Vault.Lazy                    as Lazy
-import           System.Mem.Weak
-
-import qualified Reactive.Banana.Prim.OrderedBag as OB
-import           Reactive.Banana.Prim.Plumbing
-import           Reactive.Banana.Prim.Types
-import           Reactive.Banana.Prim.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 = Just alwaysP   -- we assume that this has been built already
-        }
-    = {-# SCC step #-} 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 = Just alwaysP
-            }
-    return (runEvalOs $ map snd actions, state2)
-
-runEvalOs :: [EvalO] -> IO ()
-runEvalOs = sequence_ . map 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 = {-# SCC go #-}
-        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,_) _ _) = {-# SCC insertNodes #-} 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/Graph.hs b/src/Reactive/Banana/Prim/Graph.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Graph.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-
-    Implementation of graph-related functionality
-------------------------------------------------------------------------------}
-{-# language ScopedTypeVariables#-}
-
-module Reactive.Banana.Prim.Graph
-  ( Graph
-  , emptyGraph
-  , insertEdge
-  , getChildren
-  , listParents
-  , dfs
-  ) where
-
-import           Control.Monad
-import           Data.Functor.Identity
-import qualified Data.HashMap.Strict   as Map
-import qualified Data.HashSet          as Set
-import           Data.Hashable
-import           Data.Maybe
-
-{-----------------------------------------------------------------------------
-    Graphs and topological sorting
-------------------------------------------------------------------------------}
-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
-    }
-
--- | The graph with no edges and no nodes.
-emptyGraph :: Graph a
-emptyGraph = Graph Map.empty Map.empty Set.empty
-
--- | 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
-    }
-
--- | Get all immediate children of a node in a graph.
-getChildren :: (Eq a, Hashable a) => Graph a -> a -> [a]
-getChildren gr x = maybe [] id . Map.lookup x . children $ gr
-
--- | Get all immediate parents of a node in a graph.
-getParents :: (Eq a, Hashable a) => Graph a -> a -> [a]
-getParents gr x = maybe [] id . Map.lookup x . parents $ gr
-
--- | 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 :: [a]
-    list = runIdentity $ dfs' ancestors (Identity . getChildren gr)
-
-{-----------------------------------------------------------------------------
-    Graph traversal
-------------------------------------------------------------------------------}
--- | Graph represented as map of successors.
-type GraphM m a = a -> m [a]
-
--- | Depth-first search. List all transitive successors of a node.
--- A node is listed *before* all its successors have been listed.
-dfs :: (Eq a, Hashable a, Monad m) => a -> GraphM m a -> m [a]
-dfs x = dfs' [x]
-
--- | Depth-first serach, refined version.
--- INVARIANT: None of the nodes in the initial list have a predecessor.
-dfs' :: forall a m. (Eq a, Hashable a, Monad m) => [a] -> GraphM m a -> m [a]
-dfs' xs succs = liftM fst $ go xs [] Set.empty
-    where
-    go :: [a] -> [a] -> Set.HashSet a -> m ([a], Set.HashSet a)
-    go []     ys seen            = return (ys, seen)    -- all nodes seen
-    go (x:xs) ys seen
-        | x `Set.member` seen    = go xs ys seen
-        | otherwise              = do
-            xs' <- succs x
-            -- visit all children
-            (ys', seen') <- go xs' ys (Set.insert x seen)
-            -- list this node as all successors have been seen
-            go xs (x:ys') seen'
diff --git a/src/Reactive/Banana/Prim/High/Cached.hs b/src/Reactive/Banana/Prim/High/Cached.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/High/Cached.hs
@@ -0,0 +1,64 @@
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+{-# LANGUAGE RecursiveDo #-}
+module Reactive.Banana.Prim.High.Cached (
+    -- | Utility for executing monadic actions once
+    -- and then retrieving values from a cache.
+    --
+    -- Very useful for observable sharing.
+    Cached, runCached, cache, fromPure, don'tCache,
+    liftCached1, liftCached2,
+    ) where
+
+import Control.Monad.Fix
+import Control.Monad.IO.Class
+import Data.IORef
+import System.IO.Unsafe       (unsafePerformIO)
+
+{-----------------------------------------------------------------------------
+    Cache type
+------------------------------------------------------------------------------}
+data Cached m a = Cached (m a)
+
+runCached :: Cached m a -> m a
+runCached (Cached x) = x
+
+-- | An action whose result will be cached.
+-- Executing the action the first time in the monad will
+-- execute the side effects. From then on,
+-- only the generated value will be returned.
+{-# NOINLINE cache #-}
+cache :: (MonadFix m, MonadIO m) => m a -> Cached m a
+cache m = unsafePerformIO $ do
+    key <- liftIO $ newIORef Nothing
+    return $ Cached $ do
+        ma <- liftIO $ readIORef key    -- read the cached result
+        case ma of
+            Just a  -> return a         -- return the cached result.
+            Nothing -> mdo
+                liftIO $                -- write the result already
+                    writeIORef key (Just a)
+                a <- m                  -- evaluate
+                return a
+
+-- | Return a pure value. Doesn't make use of the cache.
+fromPure :: Monad m => a -> Cached m a
+fromPure = Cached . return
+
+-- | Lift an action that is /not/ cached, for instance because it is idempotent.
+don'tCache :: Monad m => m a -> Cached m a
+don'tCache = Cached
+
+liftCached1 :: (MonadFix m, MonadIO m) =>
+    (a -> m b) -> Cached m a -> Cached m b
+liftCached1 f ca = cache $ do
+    a <- runCached ca
+    f a
+
+liftCached2 :: (MonadFix m, MonadIO m) =>
+    (a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
+liftCached2 f ca cb = cache $ do
+    a <- runCached ca
+    b <- runCached cb
+    f a b
diff --git a/src/Reactive/Banana/Prim/High/Combinators.hs b/src/Reactive/Banana/Prim/High/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/High/Combinators.hs
@@ -0,0 +1,260 @@
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+{-# LANGUAGE FlexibleInstances, NamedFieldPuns, NoMonomorphismRestriction #-}
+module Reactive.Banana.Prim.High.Combinators where
+
+import           Control.Exception
+import           Control.Concurrent.MVar
+import           Control.Event.Handler
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Class           (lift)
+import           Control.Monad.Trans.Reader
+import           Data.IORef
+import qualified Reactive.Banana.Prim.Mid        as Prim
+import           Reactive.Banana.Prim.High.Cached
+
+type Build   = Prim.Build
+type Latch a = Prim.Latch a
+type Pulse a = Prim.Pulse a
+type Future  = Prim.Future
+
+{-----------------------------------------------------------------------------
+    Types
+------------------------------------------------------------------------------}
+type Behavior a = Cached Moment (Latch a, Pulse ())
+type Event a    = Cached Moment (Pulse a)
+type Moment     = ReaderT EventNetwork Prim.Build
+
+liftBuild :: Build a -> Moment a
+liftBuild = lift
+
+{-----------------------------------------------------------------------------
+    Interpretation
+------------------------------------------------------------------------------}
+interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b]
+interpret f = Prim.interpret $ \pulse -> runReaderT (g pulse) undefined
+    where
+    g pulse = runCached =<< f (Prim.fromPure pulse)
+    -- Ignore any  addHandler  inside the  Moment
+
+{-----------------------------------------------------------------------------
+    IO
+------------------------------------------------------------------------------}
+-- | 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, size } f = whenFlag actuated $ do
+    output <- mask $ \restore -> do
+        s1 <- takeMVar s                   -- read and take lock
+        -- pollValues <- sequence polls    -- poll mutable data
+        (output, s2) <-
+            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
+
+pause :: EventNetwork -> IO ()
+pause EventNetwork{ actuated } = writeIORef actuated False
+
+-- | Compile to an event network.
+compile :: Moment () -> IO EventNetwork
+compile setup = do
+    actuated <- newIORef False                   -- flag to set running status
+    s        <- newEmptyMVar                     -- setup callback machinery
+    size     <- newIORef 0
+
+    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
+
+fromAddHandler :: AddHandler a -> Moment (Event a)
+fromAddHandler addHandler = do
+    (p, fire) <- liftBuild Prim.newInput
+    network   <- ask
+    _unregister <- liftIO $ register addHandler $ runStep network . fire
+    return $ Prim.fromPure p
+
+addReactimate :: Event (Future (IO ())) -> Moment ()
+addReactimate e = do
+    network   <- ask
+    liftBuild $ Prim.buildLater $ do
+        -- Run cached computation later to allow more recursion with `Moment`
+        p <- runReaderT (runCached e) network
+        Prim.addHandler p id
+
+fromPoll :: IO a -> Moment (Behavior a)
+fromPoll poll = do
+    a <- liftIO poll
+    e <- liftBuild $ do
+        p <- Prim.unsafeMapIOP (const poll) =<< Prim.alwaysP
+        return $ Prim.fromPure p
+    stepperB a e
+
+liftIONow :: IO a -> Moment a
+liftIONow = liftIO
+
+liftIOLater :: IO () -> Moment ()
+liftIOLater = lift . Prim.liftBuild . Prim.liftIOLater
+
+imposeChanges :: Behavior a -> Event () -> Behavior a
+imposeChanges = liftCached2 $ \(l1,_) p2 -> return (l1,p2)
+
+{-----------------------------------------------------------------------------
+    Combinators - basic
+------------------------------------------------------------------------------}
+never :: Event a
+never = don'tCache  $ liftBuild Prim.neverP
+
+mergeWith
+  :: (a -> c)
+  -> (b -> c)
+  -> (a -> b -> c)
+  -> Event a
+  -> Event b
+  -> Event c
+mergeWith f g h = liftCached2 $ (liftBuild .) . Prim.mergeWithP (Just . f) (Just . g) (\x y -> Just (h x y))
+
+
+filterJust :: Event (Maybe a) -> Event a
+filterJust  = liftCached1 $ liftBuild . Prim.filterJustP
+
+mapE :: (a -> b) -> Event a -> Event b
+mapE f = liftCached1 $ liftBuild . Prim.mapP f
+
+applyE :: Behavior (a -> b) -> Event a -> Event b
+applyE = liftCached2 $ \(~(lf,_)) px -> liftBuild $ Prim.applyP lf px
+
+changesB :: Behavior a -> Event (Future a)
+changesB = liftCached1 $ \(~(lx,px)) -> liftBuild $ Prim.tagFuture lx px
+
+pureB :: a -> Behavior a
+pureB a = cache $ do
+    p <- runCached never
+    return (Prim.pureL a, p)
+
+applyB :: Behavior (a -> b) -> Behavior a -> Behavior b
+applyB = liftCached2 $ \(~(l1,p1)) (~(l2,p2)) -> liftBuild $ do
+    p3 <- Prim.mergeWithP Just Just (const . Just) p1 p2
+    let l3 = Prim.applyL l1 l2
+    return (l3,p3)
+
+mapB :: (a -> b) -> Behavior a -> Behavior b
+mapB f = applyB (pureB f)
+
+{-----------------------------------------------------------------------------
+    Combinators - accumulation
+------------------------------------------------------------------------------}
+-- Make sure that the cached computation (Event or Behavior)
+-- is executed eventually during this moment.
+trim :: Cached Moment a -> Moment (Cached Moment a)
+trim b = do
+    liftBuildFun Prim.buildLater $ void $ runCached b
+    return b
+
+-- Cache a computation at this moment in time
+-- and make sure that it is performed in the Build monad eventually
+cacheAndSchedule :: Moment a -> Moment (Cached Moment a)
+cacheAndSchedule m = ask >>= \r -> liftBuild $ do
+    let c = cache (const m r)   -- prevent let-floating!
+    Prim.buildLater $ void $ runReaderT (runCached c) r
+    return c
+
+stepperB :: a -> Event a -> Moment (Behavior a)
+stepperB a e = cacheAndSchedule $ do
+    p0 <- runCached e
+    liftBuild $ do
+        p1    <- Prim.mapP const p0
+        p2    <- Prim.mapP (const ()) p1
+        (l,_) <- Prim.accumL a p1
+        return (l,p2)
+
+accumE :: a -> Event (a -> a) -> Moment (Event a)
+accumE a e1 = cacheAndSchedule $ do
+    p0 <- runCached e1
+    liftBuild $ do
+        (_,p1) <- Prim.accumL a p0
+        return p1
+
+{-----------------------------------------------------------------------------
+    Combinators - dynamic event switching
+------------------------------------------------------------------------------}
+liftBuildFun :: (Build a -> Build b) -> Moment a -> Moment b
+liftBuildFun f m = do
+    r <- ask
+    liftBuild $ f $ runReaderT m r
+
+valueB :: Behavior a -> Moment a
+valueB b = do
+    ~(l,_) <- runCached b
+    liftBuild $ Prim.readLatch l
+
+initialBLater :: Behavior a -> Moment a
+initialBLater = liftBuildFun Prim.buildLaterReadNow . valueB
+
+executeP :: Pulse (Moment a) -> Moment (Pulse a)
+executeP p1 = do
+    r <- ask
+    liftBuild $ do
+        p2 <- Prim.mapP runReaderT p1
+        Prim.executeP p2 r
+
+observeE :: Event (Moment a) -> Event a
+observeE = liftCached1 executeP
+
+executeE :: Event (Moment a) -> Moment (Event a)
+executeE e = do
+    -- Run cached computation later to allow more recursion with `Moment`
+    p <- liftBuildFun Prim.buildLaterReadNow $ executeP =<< runCached e
+    return $ fromPure p
+
+switchE :: Event a -> Event (Event a) -> Moment (Event a)
+switchE e0 e = ask >>= \r -> cacheAndSchedule $ do
+    p0 <- runCached e0
+    p1 <- runCached e
+    liftBuild $ do
+        p2 <- Prim.mapP (runReaderT . runCached) p1
+
+        p3 <- Prim.executeP p2 r
+        Prim.switchP p0 p3
+
+switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a)
+switchB b e = ask >>= \r -> cacheAndSchedule $ do
+    ~(l0,p0) <- runCached b
+    p1       <- runCached e
+    liftBuild $ do
+        p2 <- Prim.mapP (runReaderT . runCached) p1
+        p3 <- Prim.executeP p2 r
+
+        lr <- Prim.switchL l0 =<< Prim.mapP fst p3
+        -- TODO: switch away the initial behavior
+        let c1 = p0                              -- initial behavior changes
+        c2 <- Prim.mapP (const ()) p3            -- or switch happens
+        never <- Prim.neverP
+        c3 <- Prim.switchP never =<< Prim.mapP snd p3  -- or current behavior changes
+        pr <- merge c1 =<< merge c2 c3
+        return (lr, pr)
+
+merge :: Pulse () -> Pulse () -> Build (Pulse ())
+merge = Prim.mergeWithP Just Just (\_ _ -> Just ())
diff --git a/src/Reactive/Banana/Prim/IO.hs b/src/Reactive/Banana/Prim/IO.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/IO.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Reactive.Banana.Prim.IO where
-
-import           Control.Monad.IO.Class
-import           Data.Functor
-import           Data.IORef
-import qualified Data.Vault.Lazy        as Lazy
-
-import Reactive.Banana.Prim.Combinators (mapP)
-import Reactive.Banana.Prim.Evaluation  (step)
-import Reactive.Banana.Prim.Plumbing
-import Reactive.Banana.Prim.Types
-import Reactive.Banana.Prim.Util
-
-debug s = 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/Graph.hs b/src/Reactive/Banana/Prim/Low/Graph.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Low/Graph.hs
@@ -0,0 +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
+
+    , 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
+------------------------------------------------------------------------------}
+-- | 'Level's are used to keep track of the order of vertices —
+-- Lower levels come first.
+type Level = Int
+
+ground :: Level
+ground = 0
+
+{-----------------------------------------------------------------------------
+    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
+
+{-----------------------------------------------------------------------------
+    Insertion
+------------------------------------------------------------------------------}
+-- | 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
+
+    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)
+
+-- 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
+    }
+
+-- | 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}
+
+-- | 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
+    }
+
+-- | 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
+
+{-----------------------------------------------------------------------------
+    Topological sort
+------------------------------------------------------------------------------}
+-- | 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 ]
+
+data Step = Next | Stop
+
+-- | 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/OrderedBag.hs b/src/Reactive/Banana/Prim/Low/OrderedBag.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Low/OrderedBag.hs
@@ -0,0 +1,42 @@
+{-----------------------------------------------------------------------------
+    reactive-banana
+
+    Implementation of a bag whose elements are ordered by arrival time.
+------------------------------------------------------------------------------}
+{-# LANGUAGE TupleSections #-}
+module Reactive.Banana.Prim.Low.OrderedBag where
+
+import qualified Data.HashMap.Strict as Map
+import           Data.Hashable
+import           Data.List ( foldl', sortBy )
+import           Data.Maybe
+import           Data.Ord
+
+{-----------------------------------------------------------------------------
+    Ordered Bag
+------------------------------------------------------------------------------}
+type Position = Integer
+
+data OrderedBag a = OB !(Map.HashMap a Position) !Position
+
+empty :: OrderedBag a
+empty = OB Map.empty 0
+
+-- | Add an element to an ordered bag after all the others.
+-- Does nothing if the element is already in the bag.
+insert :: (Eq a, Hashable a) => OrderedBag a -> a -> OrderedBag a
+insert (OB xs n) x = OB (Map.insertWith (\_new old -> old) x n xs) (n+1)
+
+-- | Add a sequence of elements to an ordered bag.
+--
+-- The ordering is left-to-right. For example, the head of the sequence
+-- comes after all elements in the bag,
+-- but before the other elements in the sequence.
+inserts :: (Eq a, Hashable a) => OrderedBag a -> [a] -> OrderedBag a
+inserts = foldl' insert
+
+-- | Reorder a list of elements to appear as they were inserted into the bag.
+-- Remove any elements from the list that do not appear in the bag.
+inOrder :: (Eq a, Hashable a) => [(a,b)] -> OrderedBag a -> [(a,b)]
+inOrder xs (OB bag _) = map snd $ sortBy (comparing fst) $
+    mapMaybe (\x -> (,x) <$> Map.lookup (fst x) bag) xs
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/Mid.hs b/src/Reactive/Banana/Prim/Mid.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Mid.hs
@@ -0,0 +1,116 @@
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Mid (
+    -- * Synopsis
+    -- | This is an internal module, useful if you want to
+    -- implemented your own FRP library.
+    -- If you just want to use FRP in your project,
+    -- have a look at "Reactive.Banana" instead.
+
+    -- * Evaluation
+    Step, EvalNetwork, Network, emptyNetwork, getSize,
+
+    -- * Build FRP networks
+    Build, liftIOLater, BuildIO, liftBuild, buildLater, buildLaterReadNow, compile,
+    module Control.Monad.IO.Class,
+
+    -- * Caching
+    module Reactive.Banana.Prim.High.Cached,
+
+    -- * Testing
+    interpret, mapAccumM, mapAccumM_, runSpaceProfile,
+
+    -- * IO
+    newInput, addHandler, readLatch,
+
+    -- * Pulse
+    Pulse,
+    neverP, alwaysP, mapP, Future, tagFuture, unsafeMapIOP, filterJustP, mergeWithP,
+
+    -- * Latch
+    Latch,
+    pureL, mapL, applyL, accumL, applyP,
+
+    -- * Dynamic event switching
+    switchL, executeP, switchP,
+
+    -- * Notes
+    -- $recursion
+    
+    -- * Debugging
+    printDot
+  ) where
+
+
+import Control.Monad.IO.Class
+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
+
+{-----------------------------------------------------------------------------
+    Notes
+------------------------------------------------------------------------------}
+-- Note [Recursion]
+{- $recursion
+
+The 'Build' monad is an instance of 'MonadFix' and supports value recursion.
+However, it is built on top of the 'IO' monad, so the recursion is
+somewhat limited.
+
+The main rule for value recursion in the 'IO' monad is that the action
+to be performed must be known in advance. For instance, the following snippet
+will not work, because 'putStrLn' cannot complete its action without
+inspecting @x@, which is not defined until later.
+
+>   mdo
+>       putStrLn x
+>       let x = "Hello recursion"
+
+On the other hand, whenever the sequence of 'IO' actions can be known
+before inspecting any later arguments, the recursion works.
+For instance the snippet
+
+>   mdo
+>       p1 <- mapP p2
+>       p2 <- neverP
+>       return p1
+
+works because 'mapP' does not inspect its argument. In other words,
+a call @p1 <- mapP undefined@ would perform the same sequence of 'IO' actions.
+(Internally, it essentially calls 'newIORef'.)
+
+With this issue in mind, almost all operations that build 'Latch'
+and 'Pulse' values have been carefully implemented to not inspect
+their arguments.
+In conjunction with the 'Cached' mechanism for observable sharing,
+this allows us to build combinators that can be used recursively.
+One notable exception is the 'readLatch' function, which must
+inspect its argument in order to be able to read its value.
+
+-}
+
+-- Note [LatchStrictness]
+{-
+
+Any value that is stored in the graph over a longer
+period of time must be stored in WHNF.
+
+This implies that the values in a latch must be forced to WHNF
+when storing them. That doesn't have to be immediately
+since we are tying a knot, but it definitely has to be done
+before  evaluateGraph  is done.
+
+It also implies that reading a value from a latch must
+be forced to WHNF before storing it again, so that we don't
+carry around the old collection of latch values.
+This is particularly relevant for `applyL`.
+
+Conversely, since latches are the only way to store values over time,
+this is enough to guarantee that there are no space leaks in this regard.
+
+-}
diff --git a/src/Reactive/Banana/Prim/Mid/Combinators.hs b/src/Reactive/Banana/Prim/Mid/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Mid/Combinators.hs
@@ -0,0 +1,161 @@
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Mid.Combinators where
+
+import Control.Monad
+    ( join )
+import Control.Monad.IO.Class
+    ( liftIO )
+
+import Reactive.Banana.Prim.Mid.Plumbing
+    ( newPulse, newLatch, cachedLatch
+    , dependOn, keepAlive, changeParent
+    , getValueL
+    , readPulseP, readLatchP, readLatchFutureP, liftBuildP,
+    )
+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
+debug _ = id
+
+{-----------------------------------------------------------------------------
+    Combinators - basic
+------------------------------------------------------------------------------}
+mapP :: (a -> b) -> Pulse a -> Build (Pulse b)
+mapP f p1 = do
+    p2 <- newPulse "mapP" ({-# SCC mapP #-} fmap f <$> readPulseP p1)
+    p2 `dependOn` p1
+    return p2
+
+-- | Tag a 'Pulse' with future values of a 'Latch'.
+--
+-- This is in contrast to 'applyP' which applies the current value
+-- of a 'Latch' to a pulse.
+tagFuture :: Latch a -> Pulse b -> Build (Pulse (Future a))
+tagFuture x p1 = do
+    p2 <- newPulse "tagFuture" $
+        fmap . const <$> readLatchFutureP x <*> readPulseP p1
+    p2 `dependOn` p1
+    return p2
+
+filterJustP :: Pulse (Maybe a) -> Build (Pulse a)
+filterJustP p1 = do
+    p2 <- newPulse "filterJustP" ({-# SCC filterJustP #-} join <$> readPulseP p1)
+    p2 `dependOn` p1
+    return p2
+
+unsafeMapIOP :: forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b)
+unsafeMapIOP f p1 = do
+        p2 <- newPulse "unsafeMapIOP"
+            ({-# SCC unsafeMapIOP #-} eval =<< readPulseP p1)
+        p2 `dependOn` p1
+        return p2
+    where
+    eval :: Maybe a -> EvalP (Maybe b)
+    eval (Just x) = Just <$> liftIO (f x)
+    eval Nothing  = return Nothing
+
+mergeWithP
+  :: (a -> Maybe c)
+  -> (b -> Maybe c)
+  -> (a -> b -> Maybe c)
+  -> Pulse a
+  -> Pulse b
+  -> Build (Pulse c)
+mergeWithP f g h px py = do
+  p <- newPulse "mergeWithP"
+       ({-# SCC mergeWithP #-} eval <$> readPulseP px <*> readPulseP py)
+  p `dependOn` px
+  p `dependOn` py
+  return p
+  where
+    eval Nothing  Nothing  = Nothing
+    eval (Just x) Nothing  = f x
+    eval Nothing  (Just y) = g y
+    eval (Just x) (Just y) = h x y
+
+-- See note [LatchRecursion]
+applyP :: Latch (a -> b) -> Pulse a -> Build (Pulse b)
+applyP f x = do
+    p <- newPulse "applyP"
+        ({-# SCC applyP #-} fmap <$> readLatchP f <*> readPulseP x)
+    p `dependOn` x
+    return p
+
+pureL :: a -> Latch a
+pureL = Reactive.Banana.Prim.Mid.Plumbing.pureL
+
+-- specialization of   mapL f = applyL (pureL f)
+mapL :: (a -> b) -> Latch a -> Latch b
+mapL f lx = cachedLatch ({-# SCC mapL #-} f <$> getValueL lx)
+
+applyL :: Latch (a -> b) -> Latch a -> Latch b
+applyL lf lx = cachedLatch
+    ({-# SCC applyL #-} getValueL lf <*> getValueL lx)
+
+accumL :: a -> Pulse (a -> a) -> Build (Latch a, Pulse a)
+accumL a p1 = do
+    (updateOn, x) <- newLatch a
+    p2 <- newPulse "accumL" $ do
+      a <- readLatchP x
+      f <- readPulseP p1
+      return $ fmap (\g -> g a) f
+    p2 `dependOn` p1
+    updateOn p2
+    return (x,p2)
+
+-- specialization of accumL
+stepperL :: a -> Pulse a -> Build (Latch a)
+stepperL a p = do
+    (updateOn, x) <- newLatch a
+    updateOn p
+    return x
+
+{-----------------------------------------------------------------------------
+    Combinators - dynamic event switching
+------------------------------------------------------------------------------}
+switchL :: Latch a -> Pulse (Latch a) -> Build (Latch a)
+switchL l pl = mdo
+    x <- stepperL l pl
+    return $ cachedLatch $ getValueL x >>= getValueL
+
+executeP :: forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a)
+executeP p1 b = do
+        p2 <- newPulse "executeP" ({-# SCC executeP #-} eval =<< readPulseP p1)
+        p2 `dependOn` p1
+        return p2
+    where
+    eval :: Maybe (b -> Build a) -> EvalP (Maybe a)
+    eval (Just x) = Just <$> liftBuildP (x b)
+    eval Nothing  = return Nothing
+
+switchP :: Pulse a -> Pulse (Pulse a) -> Build (Pulse a)
+switchP p pp = do
+    -- track the latest Pulse in a Latch
+    lp <- stepperL p pp
+
+    -- 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  -> pure ()
+                Just new -> liftBuildP $ pout `changeParent` new
+            pure Nothing
+
+    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
new file mode 100644
--- /dev/null
+++ b/src/Reactive/Banana/Prim/Mid/Test.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE RecursiveDo #-}
+{-----------------------------------------------------------------------------
+    reactive-banana
+------------------------------------------------------------------------------}
+module Reactive.Banana.Prim.Mid.Test where
+
+import Reactive.Banana.Prim.Mid
+
+main :: IO ()
+main = test_space1
+
+{-----------------------------------------------------------------------------
+    Functionality tests
+------------------------------------------------------------------------------}
+test_accumL1 :: Pulse Int -> BuildIO (Pulse Int)
+test_accumL1 p1 = liftBuild $ do
+    p2     <- mapP (+) p1
+    (l1,_) <- accumL 0 p2
+    let l2 =  mapL const l1
+    applyP l2 p1
+
+test_recursion1 :: Pulse () -> BuildIO (Pulse Int)
+test_recursion1 p1 = liftBuild $ mdo
+    p2      <- applyP l2 p1
+    p3      <- mapP (const (+1)) p2
+    ~(l1,_) <- accumL (0::Int) p3
+    let l2  =  mapL const l1
+    return p2
+
+-- test garbage collection
+
+{-----------------------------------------------------------------------------
+    Space leak tests
+------------------------------------------------------------------------------}
+test_space1 :: IO ()
+test_space1 = runSpaceProfile test_accumL1 [1::Int .. 2 * 10 ^ (4 :: Int)]
+
+test_space2 :: IO ()
+test_space2 = runSpaceProfile test_recursion1 $ () <$ [1::Int .. 2 * 10 ^ (4 :: Int)]
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/Prim/OrderedBag.hs b/src/Reactive/Banana/Prim/OrderedBag.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/OrderedBag.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-
-    Implementation of a bag whose elements are ordered by arrival time.
-------------------------------------------------------------------------------}
-{-# LANGUAGE TupleSections #-}
-module Reactive.Banana.Prim.OrderedBag where
-
-import           Data.Functor
-import qualified Data.HashMap.Strict as Map
-import           Data.Hashable
-import           Data.List  hiding (insert)
-import           Data.Maybe
-import           Data.Ord
-
-{-----------------------------------------------------------------------------
-    Ordered Bag
-------------------------------------------------------------------------------}
-type Position = Integer
-
-data OrderedBag a = OB !(Map.HashMap a Position) !Position
-
-empty :: OrderedBag a
-empty = OB Map.empty 0
-
--- | Add an element to an ordered bag after all the others.
--- Does nothing if the element is already in the bag.
-insert :: (Eq a, Hashable a) => OrderedBag a -> a -> OrderedBag a
-insert (OB xs n) x = OB (Map.insertWith (\new old -> old) x n xs) (n+1)
-
--- | Add a sequence of elements to an ordered bag.
---
--- The ordering is left-to-right. For example, the head of the sequence
--- comes after all elements in the bag,
--- but before the other elements in the sequence.
-inserts :: (Eq a, Hashable a) => OrderedBag a -> [a] -> OrderedBag a
-inserts = foldl' insert
-
--- | Reorder a list of elements to appear as they were inserted into the bag.
--- Remove any elements from the list that do not appear in the bag.
-inOrder :: (Eq a, Hashable a) => [(a,b)] -> OrderedBag a -> [(a,b)]
-inOrder xs (OB bag _) = map snd $ sortBy (comparing fst) $
-    mapMaybe (\x -> (,x) <$> Map.lookup (fst x) bag) xs
diff --git a/src/Reactive/Banana/Prim/Plumbing.hs b/src/Reactive/Banana/Prim/Plumbing.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Plumbing.hs
+++ /dev/null
@@ -1,254 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecordWildCards, RecursiveDo, BangPatterns, ScopedTypeVariables #-}
-module Reactive.Banana.Prim.Plumbing where
-
-import           Control.Monad                                (join)
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Class
-import qualified Control.Monad.Trans.RWSIO          as RWS
-import qualified Control.Monad.Trans.Reader         as Reader
-import qualified Control.Monad.Trans.ReaderWriterIO as RW
-import           Data.Function                                (on)
-import           Data.Functor
-import           Data.IORef
-import           Data.List                                    (sortBy)
-import           Data.Monoid
-import qualified Data.Vault.Lazy                    as Lazy
-import           System.IO.Unsafe
-
-import qualified Reactive.Banana.Prim.Dependencies as Deps
-import           Reactive.Banana.Prim.Types
-import           Reactive.Banana.Prim.Util
-
-{-----------------------------------------------------------------------------
-    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  = maybe err id <$> 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 = maybe (return $ debug "nop") id <$> 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 = {-# SCC runBuild #-} 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 = (\(x,_) -> x) <$> RW.ask
-
-alwaysP :: Build (Pulse ())
-alwaysP = (\(_,x) -> x) <$> 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 $ mkWeakRefValue child parent >> return ()
-
-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/Test.hs b/src/Reactive/Banana/Prim/Test.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Test.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE RecursiveDo #-}
-module Reactive.Banana.Prim.Test where
-
-import Control.Applicative
-import Reactive.Banana.Prim
-
-main = test_space1
-
-{-----------------------------------------------------------------------------
-    Functionality tests
-------------------------------------------------------------------------------}
-test_accumL1 :: Pulse Int -> BuildIO (Pulse Int)
-test_accumL1 p1 = liftBuild $ do
-    p2     <- mapP (+) p1
-    (l1,_) <- accumL 0 p2
-    let l2 =  mapL const l1
-    p3     <- applyP l2 p1
-    return p3
-
-test_recursion1 :: Pulse () -> BuildIO (Pulse Int)
-test_recursion1 p1 = liftBuild $ mdo
-    p2      <- applyP l2 p1
-    p3      <- mapP (const (+1)) p2
-    ~(l1,_) <- accumL (0::Int) p3
-    let l2  =  mapL const l1
-    return p2
-
--- test garbage collection
-
-{-----------------------------------------------------------------------------
-    Space leak tests
-------------------------------------------------------------------------------}
-test_space1 = runSpaceProfile test_accumL1    $ [1..2*10^4]
-test_space2 = runSpaceProfile test_recursion1 $ () <$ [1..2*10^4]
-
-
diff --git a/src/Reactive/Banana/Prim/Types.hs b/src/Reactive/Banana/Prim/Types.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Types.hs
+++ /dev/null
@@ -1,237 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE ExistentialQuantification, NamedFieldPuns #-}
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-module Reactive.Banana.Prim.Types where
-
-import           Control.Monad.Trans.RWSIO
-import           Control.Monad.Trans.Reader
-import           Control.Monad.Trans.ReaderWriterIO
-import           Data.Functor
-import           Data.Hashable
-import           Data.Monoid (Monoid, mempty, mappend)
-import           Data.Semigroup
-import qualified Data.Vault.Lazy                    as Lazy
-import           System.IO.Unsafe
-import           System.Mem.Weak
-
-import Reactive.Banana.Prim.Graph            (Graph)
-import Reactive.Banana.Prim.OrderedBag as OB (OrderedBag, empty)
-import Reactive.Banana.Prim.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        :: !(Maybe (Pulse ()))   -- Pulse that always fires.
-    }
-
-type Inputs        = ([SomeNode], Lazy.Vault)
-type EvalNetwork a = Network -> IO (a, Network)
-type Step          = EvalNetwork (IO ())
-
-emptyNetwork :: Network
-emptyNetwork = Network
-    { nTime    = next beginning
-    , nOutputs = OB.empty
-    , nAlwaysP = Nothing
-    }
-
-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
-    }
-instance Eq Output where (==) = equalRef
-
-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
-
-{-# 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 l) = return "L"
-printNode (O 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/Util.hs b/src/Reactive/Banana/Prim/Util.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Prim/Util.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
-{-# LANGUAGE MagicHash, UnboxedTuples #-}
-module Reactive.Banana.Prim.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 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 = {-# SCC deRefWeaks #-} fmap catMaybes $ mapM deRefWeak ws
diff --git a/src/Reactive/Banana/Test.hs b/src/Reactive/Banana/Test.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Test.hs
+++ /dev/null
@@ -1,253 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-
-    Test cases and examples
-------------------------------------------------------------------------------}
-{-# LANGUAGE FlexibleContexts, Rank2Types, NoMonomorphismRestriction, RecursiveDo #-}
-
-import Control.Arrow
-import Control.Monad (when, join)
-
-import Test.Framework (defaultMain, testGroup, Test)
-import Test.Framework.Providers.HUnit (testCase)
-
-import Test.HUnit (assert, Assertion)
-
--- import Test.QuickCheck
--- import Test.QuickCheck.Property
-
-import Control.Applicative
-import Reactive.Banana.Test.Plumbing
-
-
-main = defaultMain
-    [ 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)) -> Test
-testModelMatchM name f = testCase name $ assert $ 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)
-
-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/src/Reactive/Banana/Test/Plumbing.hs b/src/Reactive/Banana/Test/Plumbing.hs
deleted file mode 100644
--- a/src/Reactive/Banana/Test/Plumbing.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-{-----------------------------------------------------------------------------
-    reactive-banana
-------------------------------------------------------------------------------}
--- * Synopsis
--- | Merge model and implementation into a single type. Not pretty.
-
-module Reactive.Banana.Test.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.Internal.Combinators 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) (Y.mapE f y)
-applyE ~(B x1 y1) (E x2 y2)         = E (X.apply x1 x2) (Y.applyE y1 y2)
-
-instance Functor Event where fmap = mapE
-
-pureB a                         = B (pure a) (Y.pureB a)
-applyB (B x1 y1) (B x2 y2)      = B (x1 <*> x2) (Y.applyB y1 y2)
-mapB f (B x y)                  = B (fmap f x) (Y.mapB 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
-    (fmap ex $ X.accumE a x)
-    (fmap ey $ Y.accumE a y)
-stepperB a ~(E x y) = M
-    (fmap bx $ X.stepper  a x)
-    (fmap by $ Y.stepperB 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 $ Y.mapE sndM y)
-
-switchE :: Event (Event a) -> Moment (Event a)
-switchE (E x y) = M
-    (fmap ex $ X.switchE $   fmap (fstE) x)
-    (fmap ey $ Y.switchE $ Y.mapE (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 $ Y.mapE (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/src/Reactive/Banana/Types.hs b/src/Reactive/Banana/Types.hs
--- a/src/Reactive/Banana/Types.hs
+++ b/src/Reactive/Banana/Types.hs
@@ -1,3 +1,5 @@
+{-# language CPP #-}
+
 {-----------------------------------------------------------------------------
     reactive-banana
 ------------------------------------------------------------------------------}
@@ -8,15 +10,30 @@
     Future(..),
     ) where
 
-import Data.Semigroup
 import Control.Applicative
-import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Fix
 import Data.String (IsString(..))
+import Control.Monad.Trans.Accum (AccumT)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Except (ExceptT)
+import Control.Monad.Trans.Identity (IdentityT)
+import Control.Monad.Trans.Maybe (MaybeT)
+import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST)
+import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST)
+import Control.Monad.Trans.Reader (ReaderT)
+import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT)
+import qualified Control.Monad.Trans.State.Strict as Strict (StateT)
+import qualified Control.Monad.Trans.Writer.Lazy as Lazy (WriterT)
+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT)
 
-import qualified Reactive.Banana.Internal.Combinators as Prim
+#if MIN_VERSION_transformers(0,5,6)
+import qualified Control.Monad.Trans.RWS.CPS as CPS (RWST)
+import qualified Control.Monad.Trans.Writer.CPS as CPS (WriterT)
+#endif
 
+import qualified Reactive.Banana.Prim.High.Combinators as Prim
+
 {-----------------------------------------------------------------------------
     Types
 ------------------------------------------------------------------------------}
@@ -60,7 +77,7 @@
 -- > mempty :: Event a
 -- > mempty = never
 instance Semigroup a => Monoid (Event a) where
-    mempty  = E $ Prim.never
+    mempty  = E Prim.never
     mappend = (<>)
 
 
@@ -146,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
@@ -187,22 +203,47 @@
 
 instance MonadMoment Moment   where liftMoment = id
 instance MonadMoment MomentIO where liftMoment = MIO . unM
+instance (MonadMoment m, Monoid w) => MonadMoment (AccumT w m) where liftMoment = lift . liftMoment
+instance MonadMoment m => MonadMoment (ExceptT e m) where liftMoment = lift . liftMoment
+instance MonadMoment m => MonadMoment (IdentityT m) where liftMoment = lift . liftMoment
+instance MonadMoment m => MonadMoment (MaybeT m) where liftMoment = lift . liftMoment
+instance (MonadMoment m, Monoid w) => MonadMoment (Lazy.RWST r w s m) where liftMoment = lift . liftMoment
+instance (MonadMoment m, Monoid w) => MonadMoment (Strict.RWST r w s m) where liftMoment = lift . liftMoment
+instance MonadMoment m => MonadMoment (ReaderT r m) where liftMoment = lift . liftMoment
+instance MonadMoment m => MonadMoment (Lazy.StateT s m) where liftMoment = lift . liftMoment
+instance MonadMoment m => MonadMoment (Strict.StateT s m) where liftMoment = lift . liftMoment
+instance (MonadMoment m, Monoid w) => MonadMoment (Lazy.WriterT w m) where liftMoment = lift . liftMoment
+instance (MonadMoment m, Monoid w) => MonadMoment (Strict.WriterT w m) where liftMoment = lift . liftMoment
 
+#if MIN_VERSION_transformers(0,5,6)
+instance MonadMoment m => MonadMoment (CPS.RWST r w s m) where liftMoment = lift . liftMoment
+instance MonadMoment m => MonadMoment (CPS.WriterT w m) where liftMoment = lift . liftMoment
+#endif
+
 -- 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
     f <*> a = M $ unM f <*> unM a
 instance MonadFix Moment where mfix f = M $ mfix (unM . f)
 
+instance Semigroup a => Semigroup (Moment a) where
+    (<>) = liftA2 (<>)
+instance Monoid a => Monoid (Moment a) where
+    mempty = pure mempty
+
+
 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
     f <*> a = MIO $ unMIO f <*> unMIO a
 instance MonadFix MomentIO where mfix f = MIO $ mfix (unMIO . f)
+
+instance Semigroup a => Semigroup (MomentIO a) where
+    (<>) = liftA2 (<>)
+instance Monoid a => Monoid (MomentIO a) where
+    mempty = pure mempty
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