diff --git a/examples/Lists.hs b/examples/Lists.hs
--- a/examples/Lists.hs
+++ b/examples/Lists.hs
@@ -7,8 +7,8 @@
 lists :: forall a. (Typeable a, Ord a, Arbitrary a, CoArbitrary a) =>
          a -> [Sig]
 lists a = [
-  arith (undefined :: Int),
-  funs (undefined :: a),
+  -- arith (undefined :: Int),
+  -- funs (undefined :: a),
 
   ["x", "y", "z"] `vars` (undefined :: a),
   ["xs", "ys", "zs"] `vars` (undefined :: [a]),
@@ -17,13 +17,13 @@
   "[]"      `fun0` ([]      :: [a]),
   ":"       `fun2` ((:)     :: a -> [a] -> [a])],
 
-  "head"    `fun1` (head    :: [a] -> a),
-  "tail"    `fun1` (tail    :: [a] -> [a]),
-  "unit"    `fun1` (return  :: a -> [a]),
+  -- "head"    `fun1` (head    :: [a] -> a),
+  -- "tail"    `fun1` (tail    :: [a] -> [a]),
+  -- "unit"    `fun1` (return  :: a -> [a]),
   "++"      `fun2` ((++)    :: [a] -> [a] -> [a]),
-  "length"  `fun1` (length  :: [a] -> Int),
-  "reverse" `fun1` (reverse :: [a] -> [a]),
-  "map"     `fun2` (map     :: (a -> a) -> [a] -> [a])
+  -- "length"  `fun1` (length  :: [a] -> Int),
+  "reverse" `fun1` (reverse :: [a] -> [a])
+  -- "map"     `fun2` (map     :: (a -> a) -> [a] -> [a])
   ]
 
 main = quickSpec (lists (undefined :: A))
diff --git a/quickspec.cabal b/quickspec.cabal
--- a/quickspec.cabal
+++ b/quickspec.cabal
@@ -1,5 +1,5 @@
 Name:                quickspec
-Version:             0.9.3
+Version:             0.9.4
 Cabal-version:       >=1.6
 Build-type:          Simple
 
@@ -91,4 +91,4 @@
 
   Build-depends:
     base < 5, containers, transformers, QuickCheck >= 2.7,
-    random, spoon >= 0.2, array, ghc-prim, mtl
+    random, spoon >= 0.2, array, ghc-prim, mtl, unordered-containers
diff --git a/src/Test/QuickSpec/Prelude.hs b/src/Test/QuickSpec/Prelude.hs
--- a/src/Test/QuickSpec/Prelude.hs
+++ b/src/Test/QuickSpec/Prelude.hs
@@ -12,9 +12,13 @@
 -- | Just a type.
 --   You can instantiate your polymorphic functions at this type
 --   to include them in a signature.
-newtype A = A Int deriving (Eq, Ord, Typeable, Arbitrary, CoArbitrary, Partial, Show)
-newtype B = B Int deriving (Eq, Ord, Typeable, Arbitrary, CoArbitrary, Partial, Show)
-newtype C = C Int deriving (Eq, Ord, Typeable, Arbitrary, CoArbitrary, Partial, Show)
+newtype A = A Int deriving (Eq, Ord, Typeable, Arbitrary, CoArbitrary, Show)
+newtype B = B Int deriving (Eq, Ord, Typeable, Arbitrary, CoArbitrary, Show)
+newtype C = C Int deriving (Eq, Ord, Typeable, Arbitrary, CoArbitrary, Show)
+
+instance Partial A where unlifted (A x) = fmap A (unlifted x)
+instance Partial B where unlifted (B x) = fmap B (unlifted x)
+instance Partial C where unlifted (C x) = fmap C (unlifted x)
 
 -- | A type with two elements.
 --   Use this instead of @A@ if testing doesn't work well because
diff --git a/src/Test/QuickSpec/Reasoning/UnionFind.hs b/src/Test/QuickSpec/Reasoning/UnionFind.hs
--- a/src/Test/QuickSpec/Reasoning/UnionFind.hs
+++ b/src/Test/QuickSpec/Reasoning/UnionFind.hs
@@ -8,10 +8,15 @@
 import Data.IntMap(IntMap)
 import qualified Data.IntMap as IntMap
 
+data Info = Rep Int | NonRep Int
+
+defaultInfo :: Info
+defaultInfo = Rep 1
+
 data S = S {
-      links :: IntMap Int,
-      sym :: Int
-    }
+  info :: IntMap Info,
+  sym :: Int
+  }
 
 type UF = State S
 data Replacement = Int :> Int
@@ -28,9 +33,9 @@
 initial :: Int -> S
 initial n = S IntMap.empty n
 
-modifyLinks f = modify (\s -> s { links = f (links s) })
+modifyInfo f = modify (\s -> s { info = f (info s) })
 modifySym f = modify (\s -> s { sym = f (sym s) })
-putLinks l = modifyLinks (const l)
+putInfo i = modifyInfo (const i)
 
 newSym :: UF Int
 newSym = do
@@ -43,10 +48,19 @@
 s =:= t = do
   rs <- rep s
   rt <- rep t
-  if (rs /= rt) then do
-    modifyLinks (IntMap.insert rs rt)
-    return (Just (rs :> rt))
-   else return Nothing
+  if (rs /= rt) then fmap Just (unifyRep rs rt) else return Nothing
+
+unifyRep :: Int -> Int -> UF Replacement
+unifyRep s t = do
+  ss <- gets (IntMap.findWithDefault 0 s . reps)
+  st <- gets (IntMap.findWithDefault 0 t . reps)
+  if ss <= st then replace s t ss st else replace t s st ss
+
+replace :: Int -> Int -> Int -> Int -> UF Replacement
+replace s t ss st = do
+  modifyReps (IntMap.delete s . IntMap.insert t (ss+st+1))
+  modifyLinks (IntMap.insert s t)
+  return (s :> t)
 
 rep :: Int -> UF Int
 rep t = do