diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,18 @@
 # Unreleased
 
+- Add `memoiseWithCycleDetection` and `Cycle`, enabling cycle detection
+- Implement `Task` using `ReaderT`, improving performance
+- Make buildable with GHC 8.2.2 through 8.8.3
+- Switch from the `dependent-map` package to the `dependent-hashmap` for caches
+- Remove support for Haxl-style automatic parallelisation
+  * Remove strategy parameter from `runTask`
+  * Add `MonadBaseControl`, which allows manual parallelisation using e.g. lifted-async
+  * Remove `Sequential` type
+- Use `IORef`s instead of `MVar`s
+- Add `trackM` function
+- Remove `invalidateReverseDependencies` in favour of `reachableReverseDependencies`
+- Generalise `verifyTraces` to verify using user-supplied data
+
 # 0.2.0.0
 
 - Stop using hashes when verifying traces (gets rid of the `Rock.HashTag` and `Rock.Hashed` modules)
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright Olle Fredriksson (c) 2018-2019
+Copyright Olle Fredriksson (c) 2018-2020
 
 All rights reserved.
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
-# rock [![Hackage](https://img.shields.io/hackage/v/rock.svg)](https://hackage.haskell.org/package/rock)
+# rock [![Build Status](https://travis-ci.com/ollef/rock.svg?branch=master)](https://travis-ci.com/ollef/rock) [![Hackage](https://img.shields.io/hackage/v/rock.svg)](https://hackage.haskell.org/package/rock)
 
-A build system inspired by [Build systems à la carte](https://www.microsoft.com/en-us/research/publication/build-systems-la-carte/) and [Haxl](http://hackage.haskell.org/package/haxl).
+A build system inspired by [Build systems à la carte](https://www.microsoft.com/en-us/research/publication/build-systems-la-carte/).
 
 Used in [Sixten](https://github.com/ollef/sixten) and
 [Sixty](https://github.com/ollef/sixty) to achieve incremental and query driven
@@ -9,15 +9,16 @@
 # Example
 
 ```haskell
+{-# language FlexibleInstances #-}
 {-# language GADTs #-}
-{-# language NoImplicitPrelude #-}
-{-# language OverloadedStrings #-}
 {-# language StandaloneDeriving #-}
 {-# language TemplateHaskell #-}
 
-import Protolude
-
-import Data.GADT.Compare.TH (deriveGEq, deriveGCompare)
+import Control.Monad.IO.Class
+import Data.GADT.Compare.TH (deriveGEq)
+import Data.Hashable
+import Data.Some
+import Data.IORef
 import qualified Rock
 
 data Query a where
@@ -27,13 +28,22 @@
   D :: Query Integer
 
 deriving instance Show (Query a)
-
 deriveGEq ''Query
-deriveGCompare ''Query
 
+instance Hashable (Query a) where
+  hashWithSalt salt query =
+    case query of
+      A -> hashWithSalt salt (0 :: Int)
+      B -> hashWithSalt salt (1 :: Int)
+      C -> hashWithSalt salt (2 :: Int)
+      D -> hashWithSalt salt (3 :: Int)
+
+instance Hashable (Some Query) where
+  hashWithSalt salt (Some query) = hashWithSalt salt query
+
 rules :: Rock.Rules Query
 rules key = do
-  putText $ "Fetching " <> show key
+  liftIO $ putStrLn $ "Fetching " <> show key
   case key of
     A -> pure 10
     B -> do
@@ -48,27 +58,14 @@
 main :: IO ()
 main = do
   do
-    putText "Running"
-    result <- Rock.runTask Rock.sequentially rules (Rock.fetch D)
-    print result
-  do
-    putText "Running with memoisation"
-    memoVar <- newMVar mempty
-    result <-
-      Rock.runTask
-        Rock.sequentially
-        (Rock.memoise memoVar rules)
-        (Rock.fetch D)
+    liftIO $ putStrLn "Running"
+    result <- Rock.runTask rules (Rock.fetch D)
     print result
   do
-    putText "Running with memoisation using the parallel strategy"
-    memoVar <- newMVar mempty
-    result <-
-      Rock.runTask
-        Rock.inParallel
-        (Rock.memoise memoVar rules)
-        (Rock.fetch D)
-    print result
+    liftIO $ putStrLn "Running with memoisation"
+    memoVar <- newIORef mempty
+    result <- Rock.runTask (Rock.memoise memoVar rules) (Rock.fetch D)
+    liftIO $ print result
 ```
 
 Prints
@@ -87,12 +84,6 @@
 Fetching A
 Fetching C
 70
-Running with memoisation using the parallel strategy
-Fetching D
-Fetching C
-Fetching B
-Fetching A
-70
 ```
 
 # Related projects
@@ -102,5 +93,4 @@
 
 # Contributions
 
-... are very welcome, especially in the areas of documentation, examples,
-testing, and benchmarking.
+... are very welcome, especially in the areas of documentation and examples.
diff --git a/examples/Spreadsheet.hs b/examples/Spreadsheet.hs
--- a/examples/Spreadsheet.hs
+++ b/examples/Spreadsheet.hs
@@ -1,12 +1,13 @@
+{-# language FlexibleInstances #-}
 {-# language GADTs #-}
-{-# language NoImplicitPrelude #-}
-{-# language OverloadedStrings #-}
 {-# language StandaloneDeriving #-}
 {-# language TemplateHaskell #-}
 
-import Protolude
-
-import Data.GADT.Compare.TH (deriveGEq, deriveGCompare)
+import Control.Monad.IO.Class
+import Data.GADT.Compare.TH (deriveGEq)
+import Data.Hashable
+import Data.Some
+import Data.IORef
 import qualified Rock
 
 data Query a where
@@ -16,13 +17,22 @@
   D :: Query Integer
 
 deriving instance Show (Query a)
-
 deriveGEq ''Query
-deriveGCompare ''Query
 
+instance Hashable (Query a) where
+  hashWithSalt salt query =
+    case query of
+      A -> hashWithSalt salt (0 :: Int)
+      B -> hashWithSalt salt (1 :: Int)
+      C -> hashWithSalt salt (2 :: Int)
+      D -> hashWithSalt salt (3 :: Int)
+
+instance Hashable (Some Query) where
+  hashWithSalt salt (Some query) = hashWithSalt salt query
+
 rules :: Rock.Rules Query
 rules key = do
-  putText $ "Fetching " <> show key
+  liftIO $ putStrLn $ "Fetching " <> show key
   case key of
     A -> pure 10
     B -> do
@@ -37,24 +47,11 @@
 main :: IO ()
 main = do
   do
-    putText "Running"
-    result <- Rock.runTask Rock.sequentially rules (Rock.fetch D)
-    print result
-  do
-    putText "Running with memoisation"
-    memoVar <- newMVar mempty
-    result <-
-      Rock.runTask
-        Rock.sequentially
-        (Rock.memoise memoVar rules)
-        (Rock.fetch D)
+    liftIO $ putStrLn "Running"
+    result <- Rock.runTask rules (Rock.fetch D)
     print result
   do
-    putText "Running with memoisation using the parallel strategy"
-    memoVar <- newMVar mempty
-    result <-
-      Rock.runTask
-        Rock.inParallel
-        (Rock.memoise memoVar rules)
-        (Rock.fetch D)
-    print result
+    liftIO $ putStrLn "Running with memoisation"
+    memoVar <- newIORef mempty
+    result <- Rock.runTask (Rock.memoise memoVar rules) (Rock.fetch D)
+    liftIO $ print result
diff --git a/rock.cabal b/rock.cabal
--- a/rock.cabal
+++ b/rock.cabal
@@ -1,5 +1,5 @@
 name:                rock
-version:             0.2.0.0
+version:             0.3.0.0
 synopsis:            A build system for incremental, parallel, and demand-driven computations
 description:         See <https://www.github.com/ollef/rock> for more
                      information and
@@ -10,13 +10,17 @@
 license-file:        LICENSE
 author:              Olle Fredriksson
 maintainer:          fredriksson.olle@gmail.com
-copyright:           2018-2019 Olle Fredriksson
+copyright:           2018-2020 Olle Fredriksson
 category:            Development
 build-type:          Simple
 extra-source-files:
                      README.md
                      CHANGELOG.md
 cabal-version:       >=1.10
+tested-with:         GHC == 8.2.2
+                   , GHC == 8.4.3
+                   , GHC == 8.6.5
+                   , GHC == 8.8.3
 
 library
   ghc-options:         -Wall
@@ -35,15 +39,19 @@
                        Rock.Core
                        Rock.Traces
   build-depends:       base >= 4.7 && < 5
-                     , containers
-                     , dependent-map
-                     , dependent-sum
-                     , deriving-compat
-                     , mtl
-                     , transformers
-                     , protolude
+                     , constraints-extras >= 0.3
+                     , dependent-hashmap >= 0.1
+                     , dependent-sum >= 0.6
+                     , deriving-compat >= 0.5
+                     , hashable >= 1.3
+                     , lifted-base >= 0.2
+                     , monad-control >= 1.0
+                     , mtl >= 2.2
+                     , transformers >= 0.5
+                     , transformers-base >= 0.4
+                     , unordered-containers >= 0.2
   default-language:    Haskell2010
-  default-extensions:  OverloadedStrings, NoImplicitPrelude
+  default-extensions:  OverloadedStrings
 
 source-repository head
   type:     git
@@ -62,4 +70,34 @@
                        -threaded
   hs-source-dirs:      examples
   default-language:    Haskell2010
-  build-depends:       base, rock, protolude, dependent-sum-template
+  build-depends:       base
+                     , dependent-sum
+                     , dependent-sum-template
+                     , hashable
+                     , rock
+
+test-suite test-rock
+  type:                exitcode-stdio-1.0
+  main-is:             Main.hs
+  hs-source-dirs:      tests
+  ghc-options:         -Wall
+                       -Wcompat
+                       -Widentities
+                       -Wincomplete-record-updates
+                       -Wincomplete-uni-patterns
+                       -Wmissing-home-modules
+                       -Wpartial-fields
+                       -Wredundant-constraints
+                       -Wtabs
+                       -funbox-strict-fields
+  build-depends:       base >=4.7 && <5
+                     , constraints
+                     , constraints-extras
+                     , dependent-hashmap
+                     , dependent-sum
+                     , hashable
+                     , hedgehog
+                     , mtl
+                     , rock
+                     , unordered-containers
+  default-language:  Haskell2010
diff --git a/src/Rock.hs b/src/Rock.hs
--- a/src/Rock.hs
+++ b/src/Rock.hs
@@ -3,5 +3,5 @@
   , Traces
   ) where
 
-import Rock.Core
+import Rock.Core hiding (Fetch)
 import Rock.Traces
diff --git a/src/Rock/Core.hs b/src/Rock/Core.hs
--- a/src/Rock/Core.hs
+++ b/src/Rock/Core.hs
@@ -1,6 +1,5 @@
 {-# language CPP #-}
 {-# language DefaultSignatures #-}
-{-# language DeriveFunctor #-}
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
 {-# language FunctionalDependencies #-}
@@ -8,30 +7,46 @@
 {-# language GeneralizedNewtypeDeriving #-}
 {-# language RankNTypes #-}
 {-# language ScopedTypeVariables #-}
+{-# language TupleSections #-}
+{-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
 module Rock.Core where
 
-#if MIN_VERSION_base(4,12,0)
-import Protolude hiding (Ap)
-#else
-import Protolude
-#endif
-
+import Control.Concurrent
+import Control.Exception.Lifted
+import Control.Monad.Base
 import Control.Monad.Cont
+import Control.Monad.Except
 import Control.Monad.Identity
+import Control.Monad.Reader
 import qualified Control.Monad.RWS.Lazy as Lazy
 import qualified Control.Monad.RWS.Strict as Strict
 import qualified Control.Monad.State.Lazy as Lazy
 import qualified Control.Monad.State.Strict as Strict
+import Control.Monad.Trans.Control
 import Control.Monad.Trans.Maybe
 import qualified Control.Monad.Writer.Lazy as Lazy
 import qualified Control.Monad.Writer.Strict as Strict
-import Data.Dependent.Map(DMap, GCompare)
-import qualified Data.Dependent.Map as DMap
+import Data.Bifunctor
+import Data.Constraint.Extras
+import Data.Dependent.HashMap (DHashMap)
+import qualified Data.Dependent.HashMap as DHashMap
 import Data.Dependent.Sum
-import Data.GADT.Compare
-import qualified Data.Map as Map
-import qualified Data.Set as Set
+import Data.Foldable
+import Data.Functor.Const
+import Data.GADT.Compare (GEq, GCompare, geq, gcompare, GOrdering(..))
+import Data.GADT.Show (GShow)
+import Data.Hashable
+import Data.HashMap.Lazy (HashMap)
+import qualified Data.HashMap.Lazy as HashMap
+import Data.HashSet (HashSet)
+import qualified Data.HashSet as HashSet
+import Data.IORef
+import Data.Maybe
+import Data.Typeable
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup
+#endif
 import Data.Some
 
 import Rock.Traces(Traces)
@@ -50,20 +65,11 @@
 
 -- | An @IO@ action that is allowed to make @f@ queries using the 'fetch'
 -- method from its 'MonadFetch' instance.
-newtype Task f a = Task { unTask :: IO (Result f a) }
-
--- | The result of a @Task@, which is either done or wanting to make one or
--- more @f@ queries.
-data Result f a
-  = Done a
-  | Blocked !(BlockedTask f a)
-
-data BlockedTask f a where
-  BlockedTask :: Block f a -> (a -> Task f b) -> BlockedTask f b
+newtype Task f a = Task { unTask :: ReaderT (Fetch f) IO a }
+  deriving
+    (Functor, Applicative, Monad, MonadIO, MonadBase IO)
 
-data Block f a where
-  Fetch :: f a -> Block f a
-  Ap :: !(BlockedTask f (a -> b)) -> !(BlockedTask f a) -> Block f b
+newtype Fetch f = Fetch (forall a. f a -> IO a)
 
 -------------------------------------------------------------------------------
 -- * Fetch class
@@ -92,60 +98,16 @@
 -------------------------------------------------------------------------------
 -- Instances
 
-instance Functor (Task f) where
-  {-# INLINE fmap #-}
-  fmap f (Task t) = Task $ fmap f <$> t
-
--- Note: This instance might not fully evaluate @t1@ before @t2@ in
--- @t1 '<*>' t2@ in case @t1@ performs a query using 'fetch'. If this
--- is not desirable, use 'Sequential'.
-instance Applicative (Task f) where
-  {-# INLINE pure #-}
-  pure = Task . pure . Done
-  {-# INLINE (<*>) #-}
-  Task mrf <*> Task mrx = Task $ (<*>) <$> mrf <*> mrx
-
-instance Monad (Task f) where
-  {-# INLINE (>>) #-}
-  (>>) = (*>)
-  {-# INLINE (>>=) #-}
-  Task ma >>= f = Task $ do
-    ra <- ma
-    case ra of
-      Done a -> unTask $ f a
-      Blocked (BlockedTask b k) -> return $ Blocked $ BlockedTask b $ k >=> f
-
-instance MonadIO (Task f) where
-  {-# INLINE liftIO #-}
-  liftIO io = Task $ pure <$> io
-
 instance MonadFetch f (Task f) where
-  fetch key = Task $ pure $ Blocked $ BlockedTask (Fetch key) pure
-
-instance Functor (Result f) where
-  {-# INLINE fmap #-}
-  fmap f (Done x) = Done $ f x
-  fmap f (Blocked b) = Blocked $ f <$> b
-
-instance Applicative (Result f) where
-  {-# INLINE pure #-}
-  pure = Done
-  {-# INLINE (<*>) #-}
-  Done f <*> Done x = Done $ f x
-  Done f <*> Blocked b = Blocked $ f <$> b
-  Blocked b <*> Done x = Blocked $ ($ x) <$> b
-  Blocked b1 <*> Blocked b2 = Blocked $ BlockedTask (Ap b1 b2) pure
-
-instance Monad (Result f) where
-  {-# INLINE (>>) #-}
-  (>>) = (*>)
-  {-# INLINE (>>=) #-}
-  Done x >>= f = f x
-  Blocked (BlockedTask b t) >>= f = Blocked $ BlockedTask b $ t >=> Task . pure . f
+  {-# INLINE fetch #-}
+  fetch key = Task $ do
+    io <- asks (\(Fetch fetch_) -> fetch_ key)
+    liftIO io
 
-instance Functor (BlockedTask f) where
-  {-# INLINE fmap #-}
-  fmap f (BlockedTask b t) = BlockedTask b $ fmap f <$> t
+instance MonadBaseControl IO (Task f) where
+  type StM (Task f) a = StM (ReaderT (Fetch f) IO) a
+  liftBaseWith k = Task $ liftBaseWith $ \ma -> k $ ma . unTask
+  restoreM = Task . restoreM
 
 -------------------------------------------------------------------------------
 -- * Transformations
@@ -155,151 +117,201 @@
   :: (forall b. f b -> Task f' b)
   -> Task f a
   -> Task f' a
-transFetch f task = Task $ do
-  result <- unTask task
-  case result of
-    Done a -> return $ Done a
-    Blocked b -> unTask $ transFetchBlockedTask f b
-
-transFetchBlockedTask
-  :: (forall b. f b -> Task f' b)
-  -> BlockedTask f a
-  -> Task f' a
-transFetchBlockedTask f (BlockedTask b t) = do
-  a <- transFetchBlock f b
-  transFetch f $ t a
-
-transFetchBlock
-  :: (forall b. f b -> Task f' b)
-  -> Block f a
-  -> Task f' a
-transFetchBlock f (Fetch k) = f k
-transFetchBlock f (Ap b1 b2) = transFetchBlockedTask f b1 <*> transFetchBlockedTask f b2
-
--------------------------------------------------------------------------------
--- * Strategies
-
--- | A 'Strategy' specifies how two queries are performed in an 'Applicative'
--- context.
-type Strategy = forall a b. IO (a -> b) -> IO a -> IO b
-
--- | Runs the two queries in sequence.
-sequentially :: Strategy
-sequentially = (<*>)
-
--- | Runs the two queries in parallel.
-inParallel :: Strategy
-inParallel mf mx = withAsync mf $ \af -> do
-  x <- mx
-  f <- wait af
-  return $ f x
-
--- | Uses the underlying instances, except for the Applicative instance which
--- is defined in terms of 'return' and '(>>=)'.
---
--- When used with 'Task', i.e. if you construct @m :: 'Sequential' ('Task' f)
--- a@, this means that fetches within @m@ are done sequentially.
-newtype Sequential m a = Sequential { runSequential :: m a }
-  deriving (Functor, Monad, MonadIO, MonadFetch f)
-
--- | Defined in terms of 'return' and '(>>=)'.
-instance Monad m => Applicative (Sequential m) where
-  {-# INLINE pure #-}
-  pure = Sequential . return
-  {-# INLINE (<*>) #-}
-  Sequential mf <*> Sequential mx = Sequential $ mf >>= \f -> fmap f mx
+transFetch f (Task task) =
+  Task $ ReaderT $ \fetch_ ->
+    runReaderT task $ Fetch $ \key ->
+      runReaderT (unTask $ f key) fetch_
 
 -------------------------------------------------------------------------------
 -- * Running tasks
 
--- | Perform a 'Task', fetching dependency queries from the given 'Rules' function and using the given 'Strategy' for fetches in an 'Applicative' context.
-runTask :: Strategy -> Rules f -> Task f a -> IO a
-runTask strategy rules task = do
-  result <- unTask task
-  case result of
-    Done a -> return a
-    Blocked b -> runBlockedTask strategy rules b
-
-runBlockedTask :: Strategy -> Rules f -> BlockedTask f a -> IO a
-runBlockedTask strategy rules (BlockedTask b f) = do
-  a <- runBlock strategy rules b
-  runTask strategy rules $ f a
-
-runBlock :: Strategy -> Rules f -> Block f a -> IO a
-runBlock strategy rules (Fetch key) =
-  runTask strategy rules $ rules key
-runBlock strategy rules (Ap bf bx) =
-  strategy (runBlockedTask strategy rules bf) (runBlockedTask strategy rules bx)
+-- | Perform a 'Task', fetching dependency queries from the given 'Rules'
+-- function.
+runTask :: Rules f -> Task f a -> IO a
+runTask rules (Task task) =
+  runReaderT task $ Fetch $ runTask rules . rules
 
 -------------------------------------------------------------------------------
 -- * Task combinators
 
--- | Track the query dependencies of a 'Task' in a 'DMap'
-track :: forall f a. GCompare f => Task f a -> Task f (a, DMap f Identity)
-track task = do
-  depsVar <- liftIO $ newMVar mempty
+-- | Track the query dependencies of a 'Task' in a 'DHashMap'.
+track
+  :: forall f g a. (GEq f, Hashable (Some f))
+  => (forall a'. f a' -> a' -> g a')
+  -> Task f a
+  -> Task f (a, DHashMap f g)
+track f =
+  trackM $ \key -> pure . f key
+
+-- | Track the query dependencies of a 'Task' in a 'DHashMap'. Monadic version.
+trackM
+  :: forall f g a. (GEq f, Hashable (Some f))
+  => (forall a'. f a' -> a' -> Task f (g a'))
+  -> Task f a
+  -> Task f (a, DHashMap f g)
+trackM f task = do
+  depsVar <- liftIO $ newIORef mempty
   let
     record :: f b -> Task f b
     record key = do
       value <- fetch key
-      liftIO $ modifyMVar_ depsVar $ pure . DMap.insert key (Identity value)
+      g <- f key value
+      liftIO $ atomicModifyIORef depsVar $ (, ()) . DHashMap.insert key g
       return value
   result <- transFetch record task
-  deps <- liftIO $ readMVar depsVar
+  deps <- liftIO $ readIORef depsVar
   return (result, deps)
 
 -- | Remember what @f@ queries have already been performed and their results in
--- a 'DMap', and reuse them if a query is performed again a second time.
+-- a 'DHashMap', and reuse them if a query is performed again a second time.
 --
--- The 'DMap' should typically not be reused if there has been some change that
+-- The 'DHashMap' should typically not be reused if there has been some change that
 -- might make a query return a different result.
 memoise
   :: forall f g
-  . GCompare f
-  => MVar (DMap f MVar)
+  . (GEq f, Hashable (Some f))
+  => IORef (DHashMap f MVar)
   -> GenRules f g
   -> GenRules f g
-memoise startedVar rules (key :: f a) =
-  join $ liftIO $ modifyMVar startedVar $ \started ->
-    case DMap.lookup key started of
-      Nothing -> do
-        valueVar <- newEmptyMVar
-        return
-          ( DMap.insert key valueVar started
-          , do
-            value <- rules key
-            liftIO $ putMVar valueVar value
-            return value
-          )
-      Just valueVar ->
-        return (started, liftIO $ readMVar valueVar)
+memoise startedVar rules (key :: f a) = do
+  maybeValueVar <- DHashMap.lookup key <$> liftIO (readIORef startedVar)
+  case maybeValueVar of
+    Nothing -> do
+      valueVar <- liftIO newEmptyMVar
+      join $ liftIO $ atomicModifyIORef startedVar $ \started ->
+        case DHashMap.alterLookup (Just . fromMaybe valueVar) key started of
+          (Nothing, started') ->
+            ( started'
+            , do
+              value <- rules key
+              liftIO $ putMVar valueVar value
+              return value
+            )
 
+          (Just valueVar', _started') ->
+            (started, liftIO $ readMVar valueVar')
+
+    Just valueVar ->
+      liftIO $ readMVar valueVar
+
+newtype Cyclic f = Cyclic (Some f)
+  deriving Show
+
+instance (GShow f, Typeable f) => Exception (Cyclic f)
+
+data MemoEntry a
+  = Started !ThreadId !(MVar (Maybe a))
+  | Done !a
+
+-- | Like 'memoise', but throw @'Cyclic' f@ if a query depends on itself, directly or
+-- indirectly.
+--
+-- The 'HashMap' represents dependencies between threads and should not be
+-- reused between invocations.
+memoiseWithCycleDetection
+  :: forall f g
+  . (Typeable f, GShow f, GEq f, Hashable (Some f))
+  => IORef (DHashMap f MemoEntry)
+  -> IORef (HashMap ThreadId ThreadId)
+  -> GenRules f g
+  -> GenRules f g
+memoiseWithCycleDetection startedVar depsVar rules =
+  rules'
+  where
+    rules' (key :: f a) = do
+      maybeEntry <- DHashMap.lookup key <$> liftIO (readIORef startedVar)
+      case maybeEntry of
+        Nothing -> do
+          threadId <- liftIO myThreadId
+          valueVar <- liftIO newEmptyMVar
+          join $ liftIO $ atomicModifyIORef startedVar $ \started ->
+            case DHashMap.alterLookup (Just . fromMaybe (Started threadId valueVar)) key started of
+              (Nothing, started') ->
+                ( started'
+                , (do
+                    value <- rules key
+                    liftIO $ do
+                      atomicModifyIORef startedVar $ \started'' ->
+                        (DHashMap.insert key (Done value) started'', ())
+                      putMVar valueVar $ Just value
+                      return value
+                  ) `catch` \(e :: Cyclic f) ->
+                  (liftIO $ do
+                    atomicModifyIORef startedVar $ \started'' ->
+                      (DHashMap.delete key started'', ())
+                    putMVar valueVar Nothing
+                    throwIO e
+                  )
+                )
+
+              (Just entry, _started') ->
+                (started, waitFor entry)
+
+        Just entry ->
+          waitFor entry
+      where
+        waitFor entry =
+          case entry of
+            Started onThread valueVar -> do
+              threadId <- liftIO myThreadId
+              join $ liftIO $ atomicModifyIORef depsVar $ \deps -> do
+                let
+                  deps' =
+                    HashMap.insert threadId onThread deps
+
+                if detectCycle threadId deps' then
+                  ( deps
+                  , throwIO $ Cyclic $ Some key
+                  )
+                else
+                  ( deps'
+                  , do
+                    maybeValue <- liftIO $ readMVar valueVar
+                    liftIO $ atomicModifyIORef depsVar $ \deps'' -> (HashMap.delete threadId deps'', ())
+                    maybe (rules' key) return maybeValue
+                  )
+
+            Done value ->
+              return value
+
+    detectCycle threadId deps =
+      go threadId
+      where
+        go tid =
+          case HashMap.lookup tid deps of
+            Nothing -> False
+            Just dep
+              | dep == threadId -> True
+              | otherwise -> go dep
+
 -- | Remember the results of previous @f@ queries and what their dependencies
 -- were then.
 --
 -- If all dependencies of a 'NonInput' query are the same, reuse the old result.
 -- 'Input' queries are not reused.
 verifyTraces
-  :: (EqTag f Identity, GCompare f)
-  => MVar (Traces f)
+  :: forall f dep
+  . (Hashable (Some f), GEq f, Has' Eq f dep, Typeable f, GShow f)
+  => IORef (Traces f dep)
+  -> (forall a. f a -> a -> Task f (dep a))
   -> GenRules (Writer TaskKind f) f
   -> Rules f
-verifyTraces tracesVar rules key = do
-  traces <- liftIO $ readMVar tracesVar
-  maybeValue <- case DMap.lookup key traces of
+verifyTraces tracesVar createDependencyRecord rules key = do
+  traces <- liftIO $ readIORef tracesVar
+  maybeValue <- case DHashMap.lookup key traces of
     Nothing -> return Nothing
     Just oldValueDeps ->
-      Traces.verifyDependencies fetch oldValueDeps
+      Traces.verifyDependencies fetch createDependencyRecord oldValueDeps `catch` \(_ :: Cyclic f) ->
+        pure Nothing
   case maybeValue of
     Nothing -> do
-      ((value, taskKind), deps) <- track $ rules $ Writer key
+      ((value, taskKind), deps) <- trackM createDependencyRecord $ rules $ Writer key
       case taskKind of
         Input ->
           return ()
         NonInput ->
-          liftIO $ modifyMVar_ tracesVar
-            $ pure
-            . Traces.record key value deps
+          liftIO $ atomicModifyIORef tracesVar
+            $ (, ()) . Traces.record key value deps
       return value
     Just value -> return value
 
@@ -348,35 +360,34 @@
   after key result
   return result
 
-type ReverseDependencies f = Map (Some f) (Set (Some f))
+type ReverseDependencies f = HashMap (Some f) (HashSet (Some f))
 
--- | Write reverse dependencies to the 'MVar'.
+-- | Write reverse dependencies to the 'IORef.
 trackReverseDependencies
-  :: GCompare f
-  => MVar (ReverseDependencies f)
+  :: (GEq f, Hashable (Some f))
+  => IORef (ReverseDependencies f)
   -> Rules f
   -> Rules f
 trackReverseDependencies reverseDepsVar rules key = do
-  (res, deps) <- track $ rules key
-  unless (DMap.null deps) $ do
-    let newReverseDeps = Map.fromListWith (<>)
-          [ (This depKey, Set.singleton $ This key)
-          | depKey DMap.:=> _ <- DMap.toList deps
+  (res, deps) <- track (\_ _ -> Const ()) $ rules key
+  unless (DHashMap.null deps) $ do
+    let newReverseDeps = HashMap.fromListWith (<>)
+          [ (Some depKey, HashSet.singleton $ Some key)
+          | depKey :=> Const () <- DHashMap.toList deps
           ]
-    liftIO $ modifyMVar_ reverseDepsVar $ pure . Map.unionWith (<>) newReverseDeps
+    liftIO $ atomicModifyIORef reverseDepsVar $ (, ()) . HashMap.unionWith (<>) newReverseDeps
   pure res
 
--- | @'invalidateReverseDependencies' key@ removes all keys reachable, by
--- reverse dependency, from @key@ from the input 'DMap'. It also returns the
+-- | @'reachableReverseDependencies' key@ returns all keys reachable, by
+-- reverse dependency, from @key@ from the input 'DHashMap'. It also returns the
 -- reverse dependency map with those same keys removed.
-invalidateReverseDependencies
-  :: GCompare f
+reachableReverseDependencies
+  :: (GEq f, Hashable (Some f))
   => f a
   -> ReverseDependencies f
-  -> DMap f g
-  -> (ReverseDependencies f, DMap f g)
-invalidateReverseDependencies key reverseDeps m =
+  -> (DHashMap f (Const ()), ReverseDependencies f)
+reachableReverseDependencies key reverseDeps =
   foldl'
-    (\(reverseDeps', m') (This key') -> invalidateReverseDependencies key' reverseDeps' m')
-    (Map.delete (This key) reverseDeps, DMap.delete key m)
-    (Set.toList $ Map.findWithDefault mempty (This key) reverseDeps)
+    (\(m', reverseDeps') (Some key') -> first (<> m') $ reachableReverseDependencies key' reverseDeps')
+    (DHashMap.singleton key $ Const (), HashMap.delete (Some key) reverseDeps)
+    (HashSet.toList $ HashMap.lookupDefault mempty (Some key) reverseDeps)
diff --git a/src/Rock/Traces.hs b/src/Rock/Traces.hs
--- a/src/Rock/Traces.hs
+++ b/src/Rock/Traces.hs
@@ -5,37 +5,43 @@
 {-# language UndecidableInstances #-}
 module Rock.Traces where
 
-import Protolude
-
-import Data.Dependent.Map(DMap, GCompare, DSum((:=>)))
-import qualified Data.Dependent.Map as DMap
+import Control.Monad.IO.Class
+import Data.Constraint.Extras
+import Data.Dependent.HashMap(DHashMap)
+import qualified Data.Dependent.HashMap as DHashMap
 import Data.Dependent.Sum
 import Data.Functor.Classes
+import Data.GADT.Compare
+import Data.GADT.Show
+import Data.Hashable
+import Data.Some
 import Text.Show.Deriving
 
-data ValueDeps f a = ValueDeps
+data ValueDeps f dep a = ValueDeps
   { value :: !a
-  , dependencies :: !(DMap f Identity)
+  , dependencies :: !(DHashMap f dep)
   }
 
 return []
 
-deriving instance (ShowTag f Identity, Show a) => Show (ValueDeps f a)
+deriving instance (Show a, GShow f, Has' Show f dep) => Show (ValueDeps f dep a)
 
-instance ShowTag f Identity => Show1 (ValueDeps f) where
+instance (GShow f, Has' Show f dep) => Show1 (ValueDeps f dep) where
   liftShowsPrec = $(makeLiftShowsPrec ''ValueDeps)
 
-type Traces f = DMap f (ValueDeps f)
+type Traces f dep = DHashMap f (ValueDeps f dep)
 
 verifyDependencies
-  :: (Monad m, EqTag f Identity)
+  :: (MonadIO m, GEq f, Has' Eq f dep)
   => (forall a'. f a' -> m a')
-  -> ValueDeps f a
+  -> (forall a'. f a' -> a' -> m (dep a'))
+  -> ValueDeps f dep a
   -> m (Maybe a)
-verifyDependencies fetch (ValueDeps value_ deps) = do
-  upToDate <- allM (DMap.toList deps) $ \(depKey :=> depValue) -> do
-    depValue' <- fetch depKey
-    return $ eqTagged depKey depKey depValue $ Identity depValue'
+verifyDependencies fetch createDependencyRecord (ValueDeps value_ deps) = do
+  upToDate <- allM (DHashMap.toList deps) $ \(depKey :=> dep) -> do
+    depValue <- fetch depKey
+    newDep <- createDependencyRecord depKey depValue
+    return $ eqTagged depKey depKey dep newDep
   return $ if upToDate
     then Just value_
     else Nothing
@@ -50,12 +56,12 @@
         return False
 
 record
-  :: GCompare f
+  :: (GEq f, Hashable (Some f))
   => f a
   -> a
-  -> DMap f Identity
-  -> Traces f
-  -> Traces f
+  -> DHashMap f g
+  -> Traces f g
+  -> Traces f g
 record k v deps
-  = DMap.insert k
+  = DHashMap.insert k
   $ ValueDeps v deps
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,206 @@
+{-# language CPP #-}
+{-# language FlexibleInstances #-}
+{-# language GADTs #-}
+{-# language MultiParamTypeClasses #-}
+{-# language RankNTypes #-}
+{-# language StandaloneDeriving #-}
+{-# language TypeApplications #-}
+{-# language TemplateHaskell #-}
+{-# language TypeFamilies #-}
+module Main where
+
+import Control.Monad
+import Control.Monad.Identity
+import Control.Monad.IO.Class
+import Data.Constraint.Extras
+import Data.Constraint.Extras.TH
+import qualified Data.Dependent.HashMap as DHashMap
+import Data.Functor.Const
+import Data.GADT.Compare
+import Data.GADT.Show
+import Data.Hashable
+import Data.IORef
+import Data.List
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup
+#endif
+import Data.Some
+import Data.Type.Equality ((:~:)(Refl))
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import Rock
+
+data Key v where
+  IntKey :: Int -> Key Int
+  StringKey :: String -> Key String
+
+deriving instance Show (Key v)
+
+instance GShow Key where
+  gshowsPrec = showsPrec
+
+instance GShow (Writer w Key) where
+  gshowsPrec d (Writer key) = showsPrec d key
+
+instance Hashable (Some Key) where
+  hashWithSalt salt (Some key) =
+    case key of
+      IntKey i -> hashWithSalt salt (0 :: Int, i)
+      StringKey s -> hashWithSalt salt (1 :: Int, s)
+
+deriveArgDict ''Key
+
+instance GEq Key where
+  geq (IntKey i1) (IntKey i2)
+    | i1 == i2 =
+      Just Refl
+  geq (StringKey s1) (StringKey s2)
+    | s1 == s2 =
+      Just Refl
+  geq _ _ =
+    Nothing
+
+instance GCompare Key where
+  gcompare (IntKey i1) (IntKey i2)
+    | i1 == i2 =
+      GEQ
+    | i1 < i2 =
+      GLT
+    | otherwise =
+      GGT
+  gcompare (IntKey _) _ =
+    GLT
+  gcompare _ (IntKey _) =
+    GGT
+  gcompare (StringKey s1) (StringKey s2)
+    | s1 == s2 =
+      GEQ
+    | s1 < s2 =
+      GLT
+    | otherwise =
+      GGT
+
+int :: Gen Int
+int = Gen.int (Range.linear 0 100)
+
+string :: Gen String
+string = Gen.string (Range.linear 0 100) Gen.ascii
+
+key :: Gen (Some Key)
+key =
+  Gen.choice
+    [ Some . IntKey <$> int
+    , Some . StringKey <$> string
+    ]
+
+addRules :: Rules Key
+addRules key_ =
+  case key_ of
+    IntKey i ->
+      pure $ i + 1
+
+    StringKey s ->
+      pure $ s <> "a"
+
+withKeyFetchedCallback :: (Some f -> IO ()) -> GenRules f g -> GenRules f g
+withKeyFetchedCallback keyFetched rules key_ = do
+  liftIO $ keyFetched $ Some key_
+  rules key_
+
+prop_track_tracks :: Property
+prop_track_tracks =
+  property $ do
+    Some key_ <- forAll key
+    startedVar <- liftIO $ newIORef mempty
+    let
+      rules :: Rules Key
+      rules =
+        memoise startedVar addRules
+
+    ((), deps) <- liftIO $ runTask rules $ do
+      void $ fetch key_
+      track (\_ _ -> Const ()) $ void $ fetch key_
+
+    DHashMap.keys deps === [Some key_]
+
+prop_memoise_memoises :: Property
+prop_memoise_memoises =
+  property $ do
+    Some key_ <- forAll key
+    fetchedKeysVar <- liftIO $ newIORef []
+    startedVar <- liftIO $ newIORef mempty
+    let
+      keyFetched k =
+        atomicModifyIORef fetchedKeysVar $ \ks -> (k : ks, ())
+
+      rules :: Rules Key
+      rules =
+        memoise startedVar (withKeyFetchedCallback keyFetched addRules)
+
+    liftIO $ runTask rules $ do
+      void $ fetch key_
+      void $ fetch key_
+
+    fetchedKeys <- liftIO $ readIORef fetchedKeysVar
+    fetchedKeys === [Some key_]
+
+inputRules :: Int -> GenRules (Writer TaskKind Key) Key
+inputRules input (Writer key_) =
+  case key_ of
+    IntKey 0 -> do
+      pure (input, Input)
+
+    IntKey i -> do
+      pure (i + 1, NonInput)
+
+    StringKey "dependent" -> do
+      i <- fetch $ IntKey 0
+      j <- fetch $ IntKey 1
+      pure (show i <> show j, NonInput)
+
+    StringKey s -> do
+      i <- fetch $ IntKey 1
+      j <- fetch $ IntKey 2
+      pure (s <> show i <> show j, NonInput)
+
+prop_verifyTraces :: Property
+prop_verifyTraces =
+  property $ do
+    fetchedKeysVar <- liftIO $ newIORef []
+    startedVar <- liftIO $ newIORef mempty
+    tracesVar <- liftIO $ newIORef mempty
+    let
+      keyFetched k =
+        atomicModifyIORef fetchedKeysVar $ \ks -> (k : ks, ())
+
+      rules :: Int -> Rules Key
+      rules input =
+        memoise startedVar $
+        verifyTraces
+          tracesVar
+          (\query value ->
+            pure $ Const $ has' @Hashable @Identity query $ hash $ Identity value
+          ) $
+        withKeyFetchedCallback keyFetched $
+        inputRules input
+
+    nonDependentKey <- forAll $ Gen.filter (/= "dependent") string
+
+    liftIO $ runTask (rules 1) $ do
+      void $ fetch $ StringKey "dependent"
+      void $ fetch $ StringKey nonDependentKey
+
+    liftIO $ atomicWriteIORef startedVar mempty
+    liftIO $ atomicWriteIORef fetchedKeysVar mempty
+
+    liftIO $ runTask (rules 2) $ do
+      void $ fetch $ StringKey "dependent"
+      void $ fetch $ StringKey nonDependentKey
+
+    fetchedKeys <- liftIO $ readIORef fetchedKeysVar
+    sort fetchedKeys === [Some $ Writer $ IntKey 0, Some $ Writer $ StringKey "dependent"]
+
+main :: IO ()
+main =
+  void $ checkParallel $$(discover)