diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,30 @@
+## 0.6.4 [2024.10.27]
+* Drop support for pre-8.0 versions of GHC.
+
+## 0.6.3 [2020.10.12]
+* Fix a bug introduced in `data-reify-0.6.2` where `reifyGraph` could return
+  `Graph`s with duplicate key-value pairs.
+
+## 0.6.2 [2020.09.30]
+* Use `HashMap`s and `IntSet`s internally for slightly better performance.
+
+## 0.6.1
+* Fix warnings in GHC 7.10.
+
+## 0.5
+* Merge the mono-typed and dynamic version again, by using 'DynStableName', an
+  unphantomized version of StableName.
+
+## 0.4
+* Use 'Int' as a synonym for 'Unique' rather than 'Data.Unique' for node ids,
+  by popular demand.
+
+## 0.3
+* Provide two versions of 'MuRef', the mono-typed version, for trees of a
+  single type, and the dynamic-typed version, for trees of different types.
+
+## 0.2
+* Use 'StableName's, making `data-reify` much faster.
+
+## 0.1
+* Use unsafe pointer compares.
diff --git a/Data/Reify.hs b/Data/Reify.hs
--- a/Data/Reify.hs
+++ b/Data/Reify.hs
@@ -1,87 +1,137 @@
-{-# LANGUAGE  TypeFamilies, RankNTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 module Data.Reify (
         MuRef(..),
         module Data.Reify.Graph,
-        reifyGraph
+        reifyGraph,
+        reifyGraphs
         ) where
 
 import Control.Concurrent.MVar
-import System.Mem.StableName
-import Data.IntMap as M
-import Unsafe.Coerce
 
-import Control.Applicative
+import qualified Data.HashMap.Lazy as HM
+import Data.HashMap.Lazy (HashMap)
+import Data.Hashable as H
 import Data.Reify.Graph
+import qualified Data.IntSet as IS
+import Data.IntSet (IntSet)
 
+import System.Mem.StableName
 
 -- | 'MuRef' is a class that provided a way to reference into a specific type,
 -- and a way to map over the deferenced internals.
-
 class MuRef a where
   type DeRef a :: * -> *
 
-  mapDeRef :: (Applicative f) => 
-              (forall b . (MuRef b, DeRef a ~ DeRef b) => b -> f u) 
-                        -> a 
+  mapDeRef :: (Applicative f) =>
+              (forall b . (MuRef b, DeRef a ~ DeRef b) => b -> f u)
+                        -> a
                         -> f (DeRef a u)
 
 -- | 'reifyGraph' takes a data structure that admits 'MuRef', and returns a 'Graph' that contains
--- the dereferenced nodes, with their children as 'Int' rather than recursive values.
-
+-- the dereferenced nodes, with their children as 'Unique's rather than recursive values.
 reifyGraph :: (MuRef s) => s -> IO (Graph (DeRef s))
-reifyGraph m = do rt1 <- newMVar M.empty
-                  rt2 <- newMVar []
+reifyGraph m = do rt1 <- newMVar HM.empty
                   uVar <- newMVar 0
-                  root <- findNodes rt1 rt2 uVar m
-                  pairs <- readMVar rt2
-                  return (Graph pairs root)
+                  reifyWithContext rt1 uVar m
 
-findNodes :: (MuRef s) 
-          => MVar (IntMap [(DynStableName,Int)])  
-          -> MVar [(Int,DeRef s Int)] 
-          -> MVar Int
-          -> s 
-          -> IO Int
-findNodes rt1 rt2 uVar j | j `seq` True = do
+-- | 'reifyGraphs' takes a 'Traversable' container 't s' of a data structure 's'
+-- admitting 'MuRef', and returns a 't (Graph (DeRef s))' with the graph nodes
+-- resolved within the same context.
+--
+-- This allows for, e.g., a list of mutually recursive structures.
+reifyGraphs :: (MuRef s, Traversable t) => t s -> IO (t (Graph (DeRef s)))
+reifyGraphs coll = do rt1 <- newMVar HM.empty
+                      uVar <- newMVar 0
+                      traverse (reifyWithContext rt1 uVar) coll
+                        -- NB: We deliberately reuse the same map of stable
+                        -- names and unique supply across all iterations of the
+                        -- traversal to ensure that the same context is used
+                        -- when reifying all elements of the container.
+
+-- Reify a data structure's 'Graph' using the supplied map of stable names and
+-- unique supply.
+reifyWithContext :: (MuRef s)
+                 => MVar (HashMap DynStableName Unique)
+                 -> MVar Unique
+                 -> s
+                 -> IO (Graph (DeRef s))
+reifyWithContext rt1 uVar j = do
+  rt2 <- newMVar []
+  nodeSetVar <- newMVar IS.empty
+  root <- findNodes rt1 rt2 uVar nodeSetVar j
+  pairs <- readMVar rt2
+  return (Graph pairs root)
+
+-- The workhorse for 'reifyGraph' and 'reifyGraphs'.
+findNodes :: (MuRef s)
+          => MVar (HashMap DynStableName Unique)
+             -- ^ A map of stable names to unique numbers.
+             --   Invariant: all 'Uniques' that appear in the range are less
+             --   than the current value in the unique name supply.
+          -> MVar [(Unique,DeRef s Unique)]
+             -- ^ The key-value pairs in the 'Graph' that is being built.
+             --   Invariant 1: the domain of this association list is a subset
+             --   of the range of the map of stable names.
+             --   Invariant 2: the domain of this association list will never
+             --   contain duplicate keys.
+          -> MVar Unique
+             -- ^ A supply of unique names.
+          -> MVar IntSet
+             -- ^ The unique numbers that we have encountered so far.
+             --   Invariant: this set is a subset of the range of the map of
+             --   stable names.
+          -> s
+             -- ^ The value for which we will reify a 'Graph'.
+          -> IO Unique
+             -- ^ The unique number for the value above.
+findNodes rt1 rt2 uVar nodeSetVar !j = do
         st <- makeDynStableName j
         tab <- takeMVar rt1
-        case mylookup st tab of
+        nodeSet <- takeMVar nodeSetVar
+        case HM.lookup st tab of
           Just var -> do putMVar rt1 tab
-                         return $ var
-          Nothing -> 
-                    do var <- newUnique uVar
-                       putMVar rt1 $ M.insertWith (++) (hashDynStableName st) [(st,var)] tab
-                       res <- mapDeRef (findNodes rt1 rt2 uVar) j
-                       tab' <- takeMVar rt2
-                       putMVar rt2 $ (var,res) : tab'
-                       return var
-findNodes _ _ _ _ = error "findNodes: strictness seq function failed to return True"
-
-mylookup :: DynStableName -> IntMap [(DynStableName,Int)] -> Maybe Int
-mylookup h tab =
-           case M.lookup (hashDynStableName h) tab of
-             Just tab2 -> Prelude.lookup h [ (c,u) | (c,u) <- tab2 ]
-             Nothing ->  Nothing
+                         if var `IS.member` nodeSet
+                           then do putMVar nodeSetVar nodeSet
+                                   return var
+                           else recurse var nodeSet
+          Nothing -> do var <- newUnique uVar
+                        putMVar rt1 $ HM.insert st var tab
+                        recurse var nodeSet
+  where
+    recurse :: Unique -> IntSet -> IO Unique
+    recurse var nodeSet = do
+      putMVar nodeSetVar $ IS.insert var nodeSet
+      res <- mapDeRef (findNodes rt1 rt2 uVar nodeSetVar) j
+      tab' <- takeMVar rt2
+      putMVar rt2 $ (var,res) : tab'
+      return var
 
-newUnique :: MVar Int -> IO Int
+newUnique :: MVar Unique -> IO Unique
 newUnique var = do
   v <- takeMVar var
   let v' = succ v
   putMVar var v'
   return v'
-  
--- Stable names that not use phantom types.
+
+-- Stable names that do not use phantom types.
 -- As suggested by Ganesh Sittampalam.
-data DynStableName = DynStableName (StableName ())
+-- Note: GHC can't unpack these because of the existential
+-- quantification, but there doesn't seem to be much
+-- potential to unpack them anyway.
+data DynStableName = forall a. DynStableName !(StableName a)
 
-hashDynStableName :: DynStableName -> Int
-hashDynStableName (DynStableName sn) = hashStableName sn
+instance Hashable DynStableName where
+  hashWithSalt s (DynStableName n) = hashWithSalt s n
 
 instance Eq DynStableName where
-	(DynStableName sn1) == (DynStableName sn2) = sn1 == sn2
+  DynStableName m == DynStableName n =
+    eqStableName m n
 
 makeDynStableName :: a -> IO DynStableName
 makeDynStableName a = do
-	st <- makeStableName a
-	return $ DynStableName (unsafeCoerce st)
-	
+    st <- makeStableName a
+    return $ DynStableName st
diff --git a/Data/Reify/Graph.hs b/Data/Reify/Graph.hs
--- a/Data/Reify/Graph.hs
+++ b/Data/Reify/Graph.hs
@@ -10,7 +10,8 @@
 -- This is the shared definition of a 'Graph' in Data.Reify.
 
 
-{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Data.Reify.Graph (
         Graph(..),
@@ -18,10 +19,10 @@
         ) where
 
 -- | 'Graph' is a basic graph structure over nodes of the higher kind 'e', with a single root.
--- There is an assumption that there is no Unique used in a node which does not have a 
+-- There is an assumption that there is no Unique used in a node which does not have a
 -- corresponding entry is the association list.
--- The idea with this structure is that it is trivial to convert into an 'Array', 
--- 'IntMap', or into a Martin Erwig's Functional Graph, as required.   
+-- The idea with this structure is that it is trivial to convert into an 'Array',
+-- 'IntMap', or into a Martin Erwig's Functional Graph, as required.
 
 data Graph e = Graph [(Unique,e Unique)] Unique
 
@@ -29,8 +30,8 @@
 type Unique = Int
 
 -- | If 'e' is s Functor, and 'e' is 'Show'-able, then we can 'Show' a 'Graph'.
-instance (Show (e Int)) => Show (Graph e) where
+instance (Show (e Unique)) => Show (Graph e) where
   show (Graph netlist start) = "let " ++ show [ (u,e)
-                                              | (u,e) <- netlist 
+                                              | (u,e) <- netlist
                                               ] ++ " in " ++ show start
 
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,9 @@
+# data-reify [![Hackage version](https://img.shields.io/hackage/v/data-reify.svg?style=flat)](http://hackage.haskell.org/package/data-reify) [![Build Status](https://github.com/ku-fpg/data-reify/workflows/Haskell-CI/badge.svg)](https://github.com/ku-fpg/data-reify/actions?query=workflow%3AHaskell-CI)
+
+`data-reify` provided the ability to turn recursive structures into explicit graphs. Many (implicitly or explicitly) recursive data structure can be given this ability, via a type class instance. This gives an alternative to using `Ref` for observable sharing.
+
+Observable sharing in general is unsafe, so we use the IO monad to bound this effect, but can be used safely even with `unsafePerformIO` if some simple conditions are met. Typically this package will be used to tie the knot with DSLs that depend of observable sharing, like Lava.
+
+Providing an instance for `MuRef` is the mechanism for allowing a structure to be reified into a graph, and several examples of this are provided.
+
+History: Version 0.1 used unsafe pointer compares. Version 0.2 of `data-reify` used StableNames, and was much faster. Version 0.3 provided two versions of `MuRef`, the mono-typed version, for trees of a single type, and the dynamic-typed version, for trees of different types. Version 0.4 used `Int` as a synonym for `Unique` rather than `Data.Unique` for node ids, by popular demand. Version 0.5 merged the mono-typed and dynamic version again, by using `DynStableName`, an unphantomized version of `StableName`.
diff --git a/data-reify.cabal b/data-reify.cabal
--- a/data-reify.cabal
+++ b/data-reify.cabal
@@ -1,100 +1,158 @@
 Name:               data-reify
-Version:            0.6
+Version:            0.6.4
 Synopsis:           Reify a recursive data structure into an explicit graph.
-Description:	    'data-reify' provided the ability to turn recursive structures into explicit graphs. 
-		    Many (implicitly or explicitly) recursive data structure can be given this ability, via
-		    a type class instance. This gives an alternative to using 'Ref' for observable sharing.
-		    .
-		    Observable sharing in general is unsafe, so we use the IO monad to bound this effect,
-		    but can be used safely even with 'unsafePerformIO' if some simple conditions are met.
-		    Typically this package will be used to tie the knot with DSL's that depend of
-		    observable sharing, like Lava.
- 		    .
-		    Providing an instance for 'MuRef' is the mechanism for allowing a structure to be 
-		    reified into a graph, and several examples of this are provided.
-		    .
-		    History: 
-		    Version 0.1 used unsafe pointer compares.
-		    Version 0.2 of 'data-reify' used 'StableName's, and was much faster.
-		    Version 0.3 provided two versions of 'MuRef', the mono-typed version,
-		    for trees of a single type,
-		    and the dynamic-typed version, for trees of different types.
-		    Version 0.4 used 'Int' as a synonym for 'Unique' rather than 'Data.Unique'
-		    for node ids, by popular demand.
-		    Version 0.5 merged the mono-typed and dynamic version again, by using 
-		    'DynStableName', an unphantomized version of StableName.
-		    .
-		    &#169; 2009 Andy Gill; BSD3 license.
+Description:	    'data-reify' provided the ability to turn recursive structures into explicit graphs.
+                    Many (implicitly or explicitly) recursive data structure can be given this ability, via
+                    a type class instance. This gives an alternative to using 'Ref' for observable sharing.
+                    .
+                    Observable sharing in general is unsafe, so we use the IO monad to bound this effect,
+                    but can be used safely even with 'unsafePerformIO' if some simple conditions are met.
+                    Typically this package will be used to tie the knot with DSL's that depend of
+                    observable sharing, like Lava.
+                    .
+                    Providing an instance for 'MuRef' is the mechanism for allowing a structure to be
+                    reified into a graph, and several examples of this are provided.
+                    .
+                    &#169; 2009 Andy Gill; BSD3 license.
 
-Category:            Language, Data, Parsing, Reflection 
+Category:            Language, Data, Parsing, Reflection
 License:             BSD3
 License-file:        LICENSE
 Author:              Andy Gill
 Maintainer:          Andy Gill <andygill@ku.edu>
 Copyright:           (c) 2009 Andy Gill
-Homepage:            http://www.ittc.ku.edu/csdl/fpg/Tools/IOReification
-Stability:	     alpha
+Homepage:            http://ku-fpg.github.io/software/data-reify/
+Stability:           alpha
 build-type: 	     Simple
-Cabal-Version:       >= 1.6
+Cabal-Version:       >= 1.10
+tested-with:         GHC == 8.0.2
+                   , GHC == 8.2.2
+                   , GHC == 8.4.4
+                   , GHC == 8.6.5
+                   , GHC == 8.8.4
+                   , GHC == 8.10.7
+                   , GHC == 9.0.2
+                   , GHC == 9.2.8
+                   , GHC == 9.4.8
+                   , GHC == 9.6.6
+                   , GHC == 9.8.2
+                   , GHC == 9.10.1
+extra-source-files:  CHANGELOG.md, README.md
 
+source-repository head
+  type:        git
+  location:    https://github.com/ku-fpg/data-reify
+
 Flag tests
   Description: Enable full development tree
   Default:     False
 
 
 Library
-  Build-Depends: base >= 4 && < 5, containers
+  Build-Depends: base >= 4.9 && < 5
+               , containers >= 0.5.7.1
+               , hashable
+               , unordered-containers
   Exposed-modules:
        Data.Reify,
        Data.Reify.Graph
   Ghc-Options:  -Wall
+  if impl(ghc >= 8.6)
+    ghc-options: -Wno-star-is-type
+  default-language: Haskell2010
 
+test-suite spec
+  type:                exitcode-stdio-1.0
+  main-is:             Spec.hs
+  other-modules:       Data.ReifySpec
+  build-depends:       base
+                     , data-reify
+                     , hspec       == 2.*
+  build-tool-depends:  hspec-discover:hspec-discover == 2.*
+  hs-source-dirs:      spec
+  default-language:    Haskell2010
+  ghc-options:         -Wall -threaded -rtsopts
+
+Executable example1
+  Build-Depends:  base, containers, data-reify
+  Main-Is:        example1.hs
+  Hs-Source-Dirs: examples
+  ghc-options:    -Wall
+  default-language: Haskell2010
+  if !flag(tests)
+    buildable: False
+
+Executable simplify
+  Build-Depends:  base, containers, data-reify
+  Main-Is:        simplify.hs
+  Hs-Source-Dirs: examples
+  ghc-options:    -Wall
+  default-language: Haskell2010
+  if !flag(tests)
+    buildable: False
+
 Executable data-reify-test1
-  Build-Depends:  base
+  Build-Depends:  base, data-reify
   Main-Is:        Test1.hs
-  Hs-Source-Dirs: ., test
+  Hs-Source-Dirs: test
+  ghc-options:    -Wall
+  default-language: Haskell2010
   if !flag(tests)
     buildable: False
 
-
 Executable data-reify-test2
-  Build-Depends:  base
+  Build-Depends:  base, data-reify
   Main-Is:        Test2.hs
-  Hs-Source-Dirs: ., test
+  Hs-Source-Dirs: test
+  ghc-options:    -Wall
+  default-language: Haskell2010
   if !flag(tests)
     buildable: False
 
 Executable data-reify-test3
-  Build-Depends:  base
+  Build-Depends:  base, data-reify
   Main-Is:        Test3.hs
-  Hs-Source-Dirs: ., test
+  Hs-Source-Dirs: test
+  ghc-options:    -Wall
+  default-language: Haskell2010
   if !flag(tests)
     buildable: False
 
 Executable data-reify-test4
-  Build-Depends:  base
+  Build-Depends:  base, data-reify
   Main-Is:        Test4.hs
-  Hs-Source-Dirs: ., test
+  other-modules:  Common
+  Hs-Source-Dirs: test, test-common
+  ghc-options:    -Wall
+  default-language: Haskell2010
   if !flag(tests)
     buildable: False
 
 Executable data-reify-test5
-  Build-Depends:  base
+  Build-Depends:  base, data-reify
   Main-Is:        Test5.hs
-  Hs-Source-Dirs: ., test
+  other-modules:  Common
+  Hs-Source-Dirs: test, test-common
+  ghc-options:    -Wall
+  default-language: Haskell2010
   if !flag(tests)
     buildable: False
 
 Executable data-reify-test6
-  Build-Depends:  base
+  Build-Depends:  base, data-reify
   Main-Is:        Test6.hs
-  Hs-Source-Dirs: ., test
+  other-modules:  Common
+  Hs-Source-Dirs: test, test-common
+  ghc-options:    -Wall
+  default-language: Haskell2010
   if !flag(tests)
     buildable: False
 
 Executable data-reify-test7
-  Build-Depends:  base
+  Build-Depends:  base, data-reify
   Main-Is:        Test7.hs
-  Hs-Source-Dirs: ., test
+  Hs-Source-Dirs: test
+  ghc-options:    -Wall
+  default-language: Haskell2010
   if !flag(tests)
     buildable: False
diff --git a/examples/example1.hs b/examples/example1.hs
new file mode 100644
--- /dev/null
+++ b/examples/example1.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+
+module Main (DistF,Dist,D,share,expand,main) where
+
+import Data.Reify
+import Data.IntMap as IntMap
+
+{-
+This example was written by Edward Kmett for Johan Tibell,
+and can be found at http://lpaste.net/74064
+
+-}
+main :: IO ()
+main = print "example1"
+
+data DistF a
+  = ConcatF [a]
+  | ConcatMapF String [a]
+  | GroupByKeyF [a]
+  | InputF FilePath
+  deriving (Functor, Foldable, Traversable)
+
+newtype Dist a = Dist (DistF (Dist a))
+
+instance MuRef (Dist a) where
+  type DeRef (Dist a) = DistF
+  mapDeRef f (Dist body) = case body of
+    ConcatF xs      -> ConcatF <$> traverse f xs
+    ConcatMapF n xs -> ConcatMapF n <$> traverse f xs
+    GroupByKeyF xs  -> GroupByKeyF <$> traverse f xs
+    InputF fn       -> pure (InputF fn)
+
+data D
+  = Concat [D]
+  | ConcatMap String [D]
+  | GroupByKey [D]
+  | Input FilePath
+  | Var Int
+
+share :: Dist a -> IO (IntMap D, D)
+share d = do
+  Graph nodes s <- reifyGraph d
+  let universe = IntMap.fromList nodes
+      refs = insertWith (+) s (1::Integer) $ Prelude.foldr (\k -> insertWith (+) (fst k) 1) mempty nodes
+      (urefs, mrefs) = IntMap.partition (==1) refs
+      lut = intersectionWith const universe urefs
+  return (mapWithKey (\k _ -> expand lut k) mrefs, expand lut s)
+
+expand :: IntMap (DistF Int) -> Int -> D
+expand m = go where
+  go k = case IntMap.lookup k m of
+    Nothing -> Var k
+    Just d -> case d of
+      ConcatF xs      -> Concat (go <$> xs)
+      ConcatMapF n xs -> ConcatMap n (go <$> xs)
+      GroupByKeyF xs  -> GroupByKey (go <$> xs)
+      InputF fn       -> Input fn
diff --git a/examples/simplify.hs b/examples/simplify.hs
new file mode 100644
--- /dev/null
+++ b/examples/simplify.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-
+ This example simplifies a reified graph so only nodes
+ referenced from multiple places are assigned labels,
+ and unshared terms are folded into the parent by
+ changing the type of the graph to use the free
+ monad (Free e) over the original functor e.
+ -}
+module Main (main) where
+
+-- to define simplification
+import qualified Data.Map.Strict as Map
+import           Data.Map.Strict (Map)
+import           Data.Reify (Graph(Graph), Unique)
+import qualified Data.Set as Set
+
+-- for the example
+import           Data.Reify (MuRef(mapDeRef), DeRef, reifyGraph)
+
+#if !(MIN_VERSION_base(4,11,0))
+import           Data.Semigroup (Semigroup(..))
+#endif
+
+#if !(MIN_VERSION_base(4,18,0))
+import           Control.Applicative (liftA2)
+#endif
+
+-- Self-contained Free monad
+data Free f a = Pure a | Free (f (Free f a))
+deriving instance (Show a, Show (f (Free f a))) => Show (Free f a)
+
+instance Functor f => Functor (Free f) where
+  fmap f = go where
+    go (Pure a)  = Pure (f a)
+    go (Free fa) = Free (go <$> fa)
+
+instance Functor f => Applicative (Free f) where
+  pure = Pure
+  Pure a <*> Pure b = Pure $ a b
+  Pure a <*> Free mb = Free $ fmap a <$> mb
+  Free ma <*> b = Free $ (<*> b) <$> ma
+
+instance Functor f => Monad (Free f) where
+#if !(MIN_VERSION_base(4,11,0))
+  return = Pure
+#endif
+  Pure a >>= f = f a
+  Free m >>= f = Free (fmap (>>= f) m)
+
+newtype Hist a = Hist (Map a Int)
+  deriving Show
+count :: a -> Hist a
+count x = Hist (Map.singleton x 1)
+
+instance (Ord a) => Semigroup (Hist a) where
+  (<>) (Hist m1) (Hist m2) = Hist (Map.unionWith (+) m1 m2)
+
+instance (Ord a) => Monoid (Hist a) where
+  mempty = Hist Map.empty
+#if !(MIN_VERSION_base(4,11,0))
+  mappend (Hist m1) (Hist m2) = Hist (Map.unionWith (+) m1 m2)
+#endif
+  mconcat hists = Hist (Map.unionsWith (+) [m | Hist m <- hists])
+
+-- Count the number of times each Unique is referenced
+-- in the graph.
+occs :: (Foldable e) => Graph e -> Hist Unique
+occs (Graph binds root) = count root `mappend` foldMap (foldMap count . snd) binds
+
+-- nest unshared nodes into parents.
+simpl :: (Functor e, Foldable e) => Graph e -> Graph (Free e)
+simpl g@(Graph binds root) =
+  let Hist counts = occs g
+      repeated = Map.keysSet (Map.filter (>1) counts)
+      grow ix
+        | Set.member ix repeated = Pure ix
+        | otherwise =
+            case lookup ix binds of
+              Just pat -> Free (fmap grow pat)
+              Nothing -> error "this shouldn't happen"
+  in Graph [(k, Free (fmap grow v))
+           | (k,v) <- binds, Set.member k repeated]
+     root
+
+-- A data type for the example.
+data Tree a =
+    Leaf a
+  | Fork (Tree a) (Tree a)
+  deriving (Show)
+data TreeF a t =
+    LeafF a
+  | ForkF t t
+  deriving (Show, Functor, Foldable)
+instance MuRef (Tree a) where
+  type DeRef (Tree a) = TreeF a
+  mapDeRef _     (Leaf v) = pure $ LeafF v
+  mapDeRef child (Fork l r) = liftA2 ForkF (child l) (child r)
+
+-- An example graph.
+loop1, loop2 :: Tree Int
+
+-- loop1 is referenced twice so it must have an explicit
+-- label in the simplified graph whether or not it's the root.
+loop1 = Fork (Fork (Leaf 1) loop1) loop2
+
+-- loop2 is only reference once in the graph, so it will
+-- have a label in the simplified graph only if it is the root.
+loop2 = Fork loop1 (Leaf 2)
+
+main :: IO ()
+main = do
+  putStrLn "Simplifed graph for loop1, should have one label"
+  print . simpl =<< reifyGraph loop1
+  putStrLn "Simplifed graph for loop2, should have two labels"
+  print . simpl =<< reifyGraph loop2
diff --git a/spec/Data/ReifySpec.hs b/spec/Data/ReifySpec.hs
new file mode 100644
--- /dev/null
+++ b/spec/Data/ReifySpec.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Data.ReifySpec where
+
+import qualified Data.List as L
+import Data.Reify
+import Test.Hspec
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = parallel $
+  describe "reifyGraph" $
+    it "should produce a Graph with unique key-value pairs" $ do -- #11
+      g <- reifyGraph s1
+      nubGraph g `shouldBe` g
+
+data State = State Char [State]
+  deriving (Eq, Show)
+
+data StateDeRef r = StateDeRef Char [r]
+  deriving (Eq, Show)
+
+s1, s2, s3 :: State
+s1 = State 'a' [s2,s3]
+s2 = State 'b' [s1,s2]
+s3 = State 'c' [s2,s1]
+
+instance MuRef State where
+  type DeRef State = StateDeRef
+  mapDeRef f (State a tr) = StateDeRef a <$> traverse f tr
+
+nubGraph :: Eq (e Unique) => Graph e -> Graph e
+nubGraph (Graph netlist start) = Graph (L.nub netlist) start
+
+deriving instance Eq (e Unique) => Eq (Graph e)
diff --git a/spec/Spec.hs b/spec/Spec.hs
new file mode 100644
--- /dev/null
+++ b/spec/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/test-common/Common.hs b/test-common/Common.hs
new file mode 100644
--- /dev/null
+++ b/test-common/Common.hs
@@ -0,0 +1,15 @@
+module Common (head_, tail_) where
+
+-- | Like 'head', but with a more specific error message in case the argument is
+-- empty. This is primarily defined to avoid incurring @-Wx-partial@ warnings
+-- whenever 'head' is used.
+head_ :: [a] -> a
+head_ (x:_) = x
+head_ []    = error "head_: Empty list"
+
+-- | Like 'tail', but with a more specific error message in case the argument is
+-- empty. This is primarily defined to avoid incurring @-Wx-partial@ warnings
+-- whenever 'tail' is used.
+tail_ :: [a] -> [a]
+tail_ (_:xs) = xs
+tail_ []     = error "tail_: Empty list"
diff --git a/test/Test1.hs b/test/Test1.hs
--- a/test/Test1.hs
+++ b/test/Test1.hs
@@ -1,13 +1,15 @@
 {-# LANGUAGE TypeFamilies #-}
-module Main where
+module Main (main) where
 
-import qualified Data.Traversable as T
+import           Control.Applicative hiding (Const)
+
 import qualified Data.Foldable as F
-import Data.Monoid
-import Control.Applicative hiding (Const)
-import Data.Unique
-import Data.Reify
+import           Data.Monoid
+import           Data.Reify
+import qualified Data.Traversable as T
 
+import           Prelude
+
 newtype Mu a = In (a (Mu a))
 
 instance (T.Traversable a) => MuRef (Mu a) where
@@ -22,27 +24,29 @@
 type MyList a = Mu (List a)
 
 instance Functor (List a) where
-   fmap f Nil = Nil
+   fmap _ Nil = Nil
    fmap f (Cons a b) = Cons a (f b)
 
 instance F.Foldable (List a) where
-   foldMap f Nil        = mempty
-   foldMap f (Cons a b) = f b
+   foldMap _ Nil        = mempty
+   foldMap f (Cons _ b) = f b
 
 instance T.Traversable (List a) where
   traverse f (Cons a b) = Cons <$> pure a <*> f b
-  traverse f Nil        = pure Nil
-
+  traverse _ Nil        = pure Nil
 
+main :: IO ()
 main = do
         let g1 :: MyList Int
             g1 = In (Cons 1 (In (Cons 2 (In Nil))))
         reifyGraph g1 >>= print
-        let g2 =  In (Cons 1 (In (Cons 2 g2)))
+        let g2 :: MyList Int
+            g2 =  In (Cons 1 (In (Cons 2 g2)))
         reifyGraph g2  >>= print
         let count n m | n == m    = In Nil
                       | otherwise = In (Cons n (count (succ n) m)) 
-        let g3 = count 1 1000 
+        let g3 :: MyList Int
+            g3 = count 1 1000 
         reifyGraph g3  >>= print
         
         
diff --git a/test/Test2.hs b/test/Test2.hs
--- a/test/Test2.hs
+++ b/test/Test2.hs
@@ -1,18 +1,18 @@
 {-# LANGUAGE TypeFamilies #-}
-module Main where
+module Main (main) where
 
+import           Control.Applicative hiding (Const)
+
+import           Data.Reify
 import qualified Data.Traversable as T
-import qualified Data.Foldable as F
-import Data.Monoid
-import Control.Applicative hiding (Const)
-import Data.Unique
-import Data.Reify
-import Control.Monad
 
+import           Prelude
+
 -- Notice how there is nothing Mu-ish about this datatype.
 data State a b = State a [(b,State a b)]
         deriving Show
 
+s0, s1, s2 :: State Int Bool
 s0 = State 0 [(True,s1),(False,s2)]
 s1 = State 1 [(True,s0),(False,s1)]
 s2 = State 2 [(True,s1),(False,s0)]
@@ -28,16 +28,15 @@
 instance Functor (StateDeRef a b) where
    fmap f (StateDeRef a tr) = StateDeRef a [ (b,f s) | (b,s) <- tr ]
 
-
-main = do
-        reifyGraph s0 >>= print
+main :: IO ()
+main = do reifyGraph s0 >>= print
+          reifyGraphs [s0, s1] >>= print
 
-        
 {- Alt:
 
 data State s i o = State s [(i,o,State s i o)]
         deriving Show
-        
+
 state :: s -> State s i o
 state s = State s []
 
@@ -52,5 +51,5 @@
         deriving Show
 
 -}
-     
+
 
diff --git a/test/Test3.hs b/test/Test3.hs
--- a/test/Test3.hs
+++ b/test/Test3.hs
@@ -1,15 +1,14 @@
 {-# LANGUAGE TypeFamilies #-}
-module Main where
+module Main (main) where
 
-import qualified Data.Traversable as T
+import           Control.Applicative hiding (Const)
+
 import qualified Data.Foldable as F
-import Data.Monoid
-import Control.Applicative hiding (Const)
-import Data.Unique
-import Control.Monad
+import           Data.Monoid
+import           Data.Reify
+import qualified Data.Traversable as T
 
-import Data.Reify
-        
+import           Prelude
 
 data Signal = Signal (Circuit Signal)
 
@@ -23,7 +22,7 @@
  | Var String
         deriving (Eq,Ord)
 
-newtype Mu a = In (a (Mu a))
+-- newtype Mu a = In (a (Mu a))
 
 instance MuRef Signal where
   type DeRef Signal = Circuit
@@ -41,17 +40,25 @@
   show (Delay b)        = "delay(" ++ show b ++ ")"
   show (Var str)        = show str
   
+and2 :: (Signal, Signal) -> Signal
 and2 (s1,s2) = Signal (And2 (s1,s2))
+
+xor2 :: (Signal, Signal) -> Signal
 xor2 (s1,s2) = Signal (Xor2 (s1,s2))
+
+mux2 :: Signal -> (Signal, Signal) -> Signal
 mux2 s (s1,s2) = Signal (Mux2 s (s1,s2))
-delay s        = Signal (Delay s)
 
+-- delay :: Signal -> Signal
+-- delay s = Signal (Delay s)
+
 pad :: String -> Signal
 pad nm = Signal (Var nm)
 
 data BitValue = High | Low
         deriving (Eq,Ord)
 
+high, low :: Signal
 high = Signal $ Const High
 low  = Signal $ Const Low
 
@@ -60,65 +67,64 @@
    show Low  = "low"
 
 halfAdder :: (Signal,Signal) -> (Signal,Signal)
-halfAdder (a,b) = (carry,sum)
+halfAdder (a,b) = (carry,sum')
   where carry = and2 (a,b)
-        sum   = xor2 (a,b)
+        sum'  = xor2 (a,b)
 
 fullAdder :: (Signal,(Signal,Signal)) -> (Signal,Signal)
-fullAdder (cin,(a,b)) = (cout,sum)
+fullAdder (cin,(a,b)) = (cout,sum')
   where (car1,sum1) = halfAdder (a,b)
-	(car2,sum)  = halfAdder (cin,sum1)
-	cout        = xor2 (car1,car2)
+        (car2,sum') = halfAdder (cin,sum1)
+        cout        = xor2 (car1,car2)
            
 instance F.Foldable Circuit where
-   foldMap f (And2 (e1,e2)) = f e1 `mappend`  f e2
-   foldMap f (Xor2 (e1,e2)) = f e1 `mappend`  f e2
+   foldMap f (And2 (e1,e2))   = f e1 `mappend`  f e2
+   foldMap f (Xor2 (e1,e2))   = f e1 `mappend`  f e2
    foldMap f (Mux2 s (e1,e2)) = f s `mappend` f e1 `mappend`  f e2
-   foldMap f (Delay s) = f s
-   foldMap f (Const _) = mempty
-   foldMap f (Var _)  = mempty
+   foldMap f (Delay s)        = f s
+   foldMap _ (Const _)        = mempty
+   foldMap _ (Var _)          = mempty
 
 
 instance Functor Circuit where
-   fmap f (And2 (e1,e2)) = And2 (f e1,f e2)
-   fmap f (Xor2 (e1,e2)) = Xor2 (f e1,f e2)
+   fmap f (And2 (e1,e2))   = And2 (f e1,f e2)
+   fmap f (Xor2 (e1,e2))   = Xor2 (f e1,f e2)
    fmap f (Mux2 s (e1,e2)) = Mux2 (f s) (f e1,f e2)
-   fmap f (Delay s)       = Delay (f s)
-   fmap f (Const a) = Const a
-   fmap f (Var a) = Var a
+   fmap f (Delay s)        = Delay (f s)
+   fmap _ (Const a)        = Const a
+   fmap _ (Var a)          = Var a
 
 instance T.Traversable Circuit where
-  traverse f (And2 (e1,e2)) = (\ x y -> And2 (x,y)) <$> f e1 <*> f e2
-  traverse f (Xor2 (e1,e2)) = (\ x y -> Xor2 (x,y))  <$> f e1 <*> f e2
-  traverse f (Mux2 c (e1,e2)) = (\ c x y -> Mux2 c (x,y)) <$> f c <*> f e1 <*> f e2
-  traverse f (Delay s)      = Delay <$> f s
-  traverse f (Const a) = pure (Const a)
-  traverse f (Var a) = pure (Var a)
+  traverse f (And2 (e1,e2))   = (\ x y -> And2 (x,y)) <$> f e1 <*> f e2
+  traverse f (Xor2 (e1,e2))   = (\ x y -> Xor2 (x,y))  <$> f e1 <*> f e2
+  traverse f (Mux2 c (e1,e2)) = (\ c' x y -> Mux2 c' (x,y)) <$> f c <*> f e1 <*> f e2
+  traverse f (Delay s)        = Delay <$> f s
+  traverse _ (Const a)        = pure (Const a)
+  traverse _ (Var a)          = pure (Var a)
 
 rowLA :: (Signal -> (b,b) -> b) -> ((Signal,a) -> (Signal,b)) -> (Signal,[a]) ->
  (Signal,[b])
-rowLA mymux f (cin,[])   = (cin,[])
-rowLA mymux f (cin,[a]) = (car,[sum])
-   where
-           (car,sum)   = f (cin,a)
-rowLA mymux f (cin,cs) = (mux2 cout1 (cout2_lo,cout2_hi),
+rowLA _     _ (cin,[])   = (cin,[])
+rowLA _     f (cin,[a])  = (car,[sum'])
+  where (car,sum')  = f (cin,a)
+rowLA mymux f (cin,cs)   = (mux2 cout1 (cout2_lo,cout2_hi),
                     sums1 ++ 
                         [ mymux cout1 (s_lo,s_hi)
                         | (s_lo,s_hi) <- zip sums2_lo sums2_hi
                         ])
-   where
-           len = length cs `div` 2
-           (cout1,sums1) = rowLA mymux f (cin,take len cs)
-           (cout2_hi,sums2_hi) = rowLA mymux f (high,drop len cs)
-           (cout2_lo,sums2_lo) = rowLA mymux f (low,drop len cs)
-
+  where
+    len = length cs `div` 2
+    (cout1,sums1) = rowLA mymux f (cin,take len cs)
+    (cout2_hi,sums2_hi) = rowLA mymux f (high,drop len cs)
+    (cout2_lo,sums2_lo) = rowLA mymux f (low,drop len cs)
 
+main :: IO ()
 main = do
         let g1 = xor2 (xor2 (pad "a",pad "b"),g1)
         reifyGraph g1 >>= print
         let (g2,_) = rowLA mux2 fullAdder
                                 (pad "c",[ (pad $ "a" ++ show x,pad $ "b" ++ show x)
-                                     | x <- [1..20]
+                                     | x <- [1..20] :: [Int]
                                      ])
         reifyGraph g2  >>= print
 
diff --git a/test/Test4.hs b/test/Test4.hs
--- a/test/Test4.hs
+++ b/test/Test4.hs
@@ -1,46 +1,47 @@
 {-# LANGUAGE TypeFamilies #-}
-module Main where
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Main (main) where
 
-import qualified Data.Traversable as T
-import qualified Data.Foldable as F
-import Data.Monoid
---import Control.Monad
+import Common
 import Control.Applicative hiding (Const)
-
 import Data.Reify
-import Control.Monad
 import System.CPUTime
+import Prelude
 
 data List a b = Nil | Cons a b
   deriving Show
 
 
 instance MuRef [a] where
-  type DeRef [a] = List a 
+  type DeRef [a] = List a
 
   mapDeRef f (x:xs) = Cons x <$> f xs
-  mapDeRef f []     = pure Nil
-  
+  mapDeRef _ []     = pure Nil
+
 instance Functor (List a) where
-   fmap f Nil = Nil
+   fmap _ Nil = Nil
    fmap f (Cons a b) = Cons a (f b)
 
+main :: IO ()
 main = do
-        let g1 = [1..10]
+        let g1 :: [Int]
+            g1 = [1..10]
         reifyGraph g1 >>= print
-        let g2 = [1..10] ++ g2
+        let g2 :: [Int]
+            g2 = [1..10] ++ g2
         reifyGraph g2 >>= print
 
         -- now, some timings.
         ns <- sequence [ timeme n | n <- take 8 (iterate (*2) 1024) ]
-        print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail ns) ]
+        print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail_ ns) ]
 
+timeme :: Int -> IO Float
 timeme n = do
         i <- getCPUTime
         let g3 = [1..n] ++ g3
         reifyGraph g3 >>= \ (Graph xs _) -> putStr $ show (length xs)
         j <- getCPUTime
-        let n :: Float
-            n = fromIntegral ((j - i) `div` 1000000000)
-        putStrLn $ " ==> " ++ show (n / 1000)   
-        return n    
+        let n' :: Float
+            n' = fromIntegral ((j - i) `div` 1000000000)
+        putStrLn $ " ==> " ++ show (n' / 1000)
+        return n'
diff --git a/test/Test5.hs b/test/Test5.hs
--- a/test/Test5.hs
+++ b/test/Test5.hs
@@ -1,30 +1,33 @@
-{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}
-module Main where
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Main (main) where
 
-import qualified Data.Traversable as T
-import qualified Data.Foldable as F
-import Data.Monoid
+import Common
+
 import Control.Applicative hiding (Const)
-import Data.Reify
+
 import Data.Dynamic
+import Data.Reify
 
-import Control.Monad
 import System.CPUTime
 
+import Prelude
+
 data List a b = Nil | Cons a b
   deriving Show
 
 instance Typeable a => MuRef [a] where
-  type DeRef [a] = List a 
+  type DeRef [a] = List a
 
   mapDeRef f (x:xs) = Cons x <$> f xs
-  mapDeRef f []     = pure Nil
+  mapDeRef _ []     = pure Nil
 
 
 instance Functor (List a) where
-   fmap f Nil = Nil
+   fmap _ Nil = Nil
    fmap f (Cons a b) = Cons a (f b)
 
+main :: IO ()
 main = do
         let g1 = [1..(10::Int)]
         reifyGraph g1 >>= print
@@ -33,7 +36,7 @@
 
         -- now, some timings.
         ns <- sequence [ timeme n | n <- take 8 (iterate (*2) 1024) ]
-        print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail ns) ]
+        print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail_ ns) ]
 
 timeme :: Int -> IO Float
 timeme n = do
@@ -41,7 +44,7 @@
         let g3 = [1..n] ++ g3
         reifyGraph g3 >>= \ (Graph xs _) -> putStr $ show (length xs)
         j <- getCPUTime
-        let n :: Float
-            n = fromIntegral ((j - i) `div` 1000000000)
-        putStrLn $ " ==> " ++ show (n / 1000)   
-        return n    
+        let n' :: Float
+            n' = fromIntegral ((j - i) `div` 1000000000)
+        putStrLn $ " ==> " ++ show (n' / 1000)
+        return n'
diff --git a/test/Test6.hs b/test/Test6.hs
--- a/test/Test6.hs
+++ b/test/Test6.hs
@@ -1,34 +1,30 @@
-{-# LANGUAGE TypeFamilies, UndecidableInstances, DeriveDataTypeable, RankNTypes, ExistentialQuantification      #-}
-module Main where
+{-# LANGUAGE TypeFamilies, UndecidableInstances,
+             RankNTypes, ExistentialQuantification, TypeOperators #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Main (main) where
 
-import qualified Data.Traversable as T
-import qualified Data.Foldable as F
-import Data.Monoid
---import Control.Monad
+import Common
+
 import Control.Applicative hiding (Const)
 
+import Data.Dynamic
 import Data.Reify
-import Control.Monad
-import System.CPUTime
-import Data.Typeable
-import Control.Exception as E
 
-
-import Data.Dynamic
+import System.CPUTime
 
 data List b = Nil | Cons b b | Int Int | Lambda b b | Var | Add b b
   deriving Show
 
 instance MuRef Int where
-  type DeRef Int = List 
+  type DeRef Int = List
 
-  mapDeRef f n = pure $ Int n
+  mapDeRef _ n = pure $ Int n
 
 instance (Typeable a, MuRef a,DeRef [a] ~ DeRef a) => MuRef [a] where
-  type DeRef [a] = List 
-  
+  type DeRef [a] = List
+
   mapDeRef f (x:xs) = liftA2 Cons (f x) (f xs)
-  mapDeRef f []     = pure Nil
+  mapDeRef _ []     = pure Nil
 
 
 instance NewVar Exp where
@@ -36,43 +32,44 @@
 --          return $ Var $ toDyn fn
 
 data Exp = ExpVar Dynamic | ExpLit Int | ExpAdd Exp Exp
-  deriving (Typeable, Show)
-  
-  
+  deriving Show
+
+
 instance Eq Exp where
     _ == _ = False
-    
+
 -- instance Eq Dynamic where { a == b = False }
 
 instance MuRef Exp where
   type DeRef Exp = List
-  
-  mapDeRef f (ExpVar _)   = pure Var
-  mapDeRef f (ExpLit i)   = pure $ Int i
+
+  mapDeRef _ (ExpVar _)   = pure Var
+  mapDeRef _ (ExpLit i)   = pure $ Int i
   mapDeRef f (ExpAdd x y) = Add <$> f x <*> f y
 
 
 instance Num Exp where
     (+) = ExpAdd
     fromInteger n = ExpLit (fromInteger n)
-    
+
 instance (MuRef a,Typeable a, NewVar a, Typeable b, MuRef b, DeRef a ~ DeRef (a -> b),DeRef b ~ DeRef (a -> b)) => MuRef (a -> b) where
   type DeRef (a -> b) = List
 
-  mapDeRef f fn = let v = mkVar $ toDyn fn 
+  mapDeRef f fn = let v = mkVar $ toDyn fn
                   in Lambda <$> f v <*> f (fn v)
 
 class NewVar a where
   mkVar :: Dynamic -> a
 
 instance Functor (List) where
-   fmap f Nil = Nil
-   fmap f (Cons a b) = Cons (f a) (f b)
-   fmap f (Int n)    = Int n
+   fmap _ Nil          = Nil
+   fmap f (Cons a b)   = Cons (f a) (f b)
+   fmap _ (Int n)      = Int n
    fmap f (Lambda a b) = Lambda (f a) (f b)
-   fmap f Var   = Var
-   fmap f (Add a b) = Add (f a) (f b)
+   fmap _ Var          = Var
+   fmap f (Add a b)    = Add (f a) (f b)
 
+main :: IO ()
 main = do
         let g1 :: [Int]
             g1 = [1..10]
@@ -81,27 +78,30 @@
             g2 = [1..10] ++ g2
         reifyGraph g2 >>= print
 
-        let g3 = [\ x -> x :: Exp, \ y -> y + head g3 2] ++ g3
+        let g3 = [\ x -> x :: Exp, \ y -> y + head_ g3 2] ++ g3
         reifyGraph g3 >>= print
-        
+
         -- now, some timings.
         ns <- sequence [ timeme n | n <- take 8 (iterate (*2) 1024) ]
-        print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail ns) ]
+        print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail_ ns) ]
 
-zz = let xs = [1..3] 
-         ys = (0::Int) : xs
-     in cycle [xs,ys,tail ys]
+-- zz :: [[Int]]
+-- zz = let xs = [1..3]
+--          ys = (0::Int) : xs
+--      in cycle [xs,ys,tail ys]
+
+timeme :: Int -> IO Float
 timeme n = do
         i <- getCPUTime
         let g3 :: [Int]
             g3 = [1..n] ++ g3
         reifyGraph g3 >>= \ (Graph xs _) -> putStr $ show (length xs)
         j <- getCPUTime
-        let n :: Float
-            n = fromIntegral ((j - i) `div` 1000000000)
-        putStrLn $ " ==> " ++ show (n / 1000)   
-        return n    
-        
-capture :: (Typeable a, Typeable b, NewVar a) => (a -> b) -> (a,b)
-capture f = (a,f a)
-  where a = mkVar (toDyn f)          
+        let n' :: Float
+            n' = fromIntegral ((j - i) `div` 1000000000)
+        putStrLn $ " ==> " ++ show (n' / 1000)
+        return n'
+
+-- capture :: (Typeable a, Typeable b, NewVar a) => (a -> b) -> (a,b)
+-- capture f = (a,f a)
+--   where a = mkVar (toDyn f)
diff --git a/test/Test7.hs b/test/Test7.hs
--- a/test/Test7.hs
+++ b/test/Test7.hs
@@ -1,39 +1,32 @@
-{-# LANGUAGE TypeFamilies, UndecidableInstances, DeriveDataTypeable, RankNTypes, ExistentialQuantification      #-}
-
+{-# LANGUAGE TypeFamilies, UndecidableInstances,
+             RankNTypes, ExistentialQuantification #-}
+module Main (main) where
 
-import qualified Data.Traversable as T
-import qualified Data.Foldable as F
-import Data.Monoid
---import Control.Monad
 import Control.Applicative hiding (Const)
-import Data.Unique
 
-import System.Environment
-
 import Data.Reify
---import Data.Reify
-import Control.Monad
+
 import System.CPUTime
-import Data.Typeable
-import Control.Exception as E
+import System.Environment
 
-import Data.Dynamic
+import Prelude
 
 data Tree = Node Tree Tree | Leaf Int
-         deriving (Show,Eq,Typeable)
+         deriving (Show,Eq)
 
 data T s = N s s | L Int
 
 instance MuRef Tree where
   type DeRef Tree = T
   mapDeRef f (Node t1 t2) = N <$> f t1 <*> f t2
-  mapDeRef f (Leaf i)     = pure $ L i
+  mapDeRef _ (Leaf i)     = pure $ L i
 
 deepTree :: Int -> Int -> Tree
 deepTree 1 x = Leaf x
 deepTree n x = Node (deepTree (pred n) (x * 37)) (deepTree (pred n) (x * 17))
 
 -- no sharing
+deepTree' :: Int -> Tree
 deepTree' n = deepTree n 1
 
 deepTree2 :: Int -> Integer -> Tree -> Tree
@@ -41,25 +34,26 @@
 deepTree2 n v x = Node (deepTree2 (pred n) (v * 37) x) (deepTree2 (pred n) (v * 17) x)
 
 -- sharing
+deepTree2' :: Int -> Tree
 deepTree2' n = let v = deepTree2 n 1 v in v
 
 timeme :: Int -> (Int -> Tree) -> IO Float
 timeme n f = do
         i <- getCPUTime
         let g3 :: Tree
-            g3 = f n 
+            g3 = f n
         reifyGraph g3 >>= \ (Graph xs _) -> putStr $ show (length xs)
         j <- getCPUTime
         let t :: Float
             t = fromIntegral ((j - i) `div` 1000000000)
-        putStrLn $ " " ++ show n ++ " ==> " ++ show (t / 1000)   
-        return t    
-        
+        putStrLn $ " " ++ show n ++ " ==> " ++ show (t / 1000)
+        return t
 
+main :: IO ()
 main = do
   (x:args) <- getArgs
-  sequence [ timeme n (case x of
+  sequence_ [ timeme n (case x of
                          "sharing"    -> deepTree2'
                          "no-sharing" -> deepTree')
-           | n <- map read args
-           ]
+            | n <- map read args
+            ]