diff --git a/bench/SimpleVShort.hs b/bench/SimpleVShort.hs
new file mode 100644
--- /dev/null
+++ b/bench/SimpleVShort.hs
@@ -0,0 +1,64 @@
+module Main where
+
+
+import           Data.Trie.Pred.FastUnified
+import qualified Data.Trie.Pred.FastUnified as FU
+import           Data.Trie.Pred.NormUnified
+import qualified Data.Trie.Pred.NormUnified as NU
+import Criterion.Main
+import           Data.List.NonEmpty
+import qualified Data.List.NonEmpty as NE
+
+
+tdFU = FUMore "foo" Nothing $ NE.fromList
+         [ FURest ("bar":|["baz","qux"]) 1
+         , FUMore "tro" (Just 2) $ NE.fromList
+             [ FUMore "zja" (Just 3) $ NE.fromList
+                 [ FURest ("hda":|["jes","kuq"]) 4 ]
+             , FURest ("end":|["orp","vag"]) 5
+             ]
+         , FURest ("dic":|["but","gea"]) 6
+         ]
+
+tdNU = NUMore "foo" Nothing
+         [ NUMore "bar" Nothing
+             [ NUMore "baz" Nothing
+                 [ NUMore "qux" (Just 1) []
+                 ]
+             ]
+         , NUMore "tro" (Just 2)
+             [ NUMore "zja" (Just 3)
+                 [ NUMore "hda" Nothing
+                     [ NUMore "jes" Nothing
+                         [ NUMore "kuq" (Just 4) []
+                         ]
+                     ]
+                 ]
+             , NUMore "end" Nothing
+                 [ NUMore "orp" Nothing
+                     [ NUMore "vag" (Just 5) []
+                     ]
+                 ]
+             ]
+         , NUMore "dic" Nothing
+             [ NUMore "but" Nothing
+                 [ NUMore "gea" (Just 6) []
+                 ]
+             ]
+         ]
+
+
+
+main = defaultMain
+  [ bgroup "Fast" [ bench "foobarbaz"       $ whnf (FU.lookup $ "foo":|["bar","baz"]) tdFU
+                  , bench "footrozjahdajes" $ whnf (FU.lookup $ "foo":|["tro","zja","hda","jes"]) tdFU
+                  , bench "footroendorpvag" $ whnf (FU.lookup $ "foo":|["tro","end","orp","vag"]) tdFU
+                  , bench "foodicbutgea"    $ whnf (FU.lookup $ "foo":|["dic","but","gea"]) tdFU
+                  ]
+
+  , bgroup "Norm" [ bench "foobarbaz"       $ whnf (NU.lookup $ "foo":|["bar","baz"]) tdNU
+                  , bench "footrozjahdajes" $ whnf (NU.lookup $ "foo":|["tro","zja","hda","jes"]) tdNU
+                  , bench "footroendorpvag" $ whnf (NU.lookup $ "foo":|["tro","end","orp","vag"]) tdNU
+                  , bench "foodicbutgea"    $ whnf (NU.lookup $ "foo":|["dic","but","gea"]) tdNU
+                  ]
+  ]
diff --git a/pred-trie.cabal b/pred-trie.cabal
--- a/pred-trie.cabal
+++ b/pred-trie.cabal
@@ -1,5 +1,5 @@
 Name:                   pred-trie
-Version:                0.0.1
+Version:                0.0.2
 Author:                 Athan Clark <athan.clark@gmail.com>
 Maintainer:             Athan Clark <athan.clark@gmail.com>
 License:                BSD3
@@ -13,8 +13,9 @@
   Default-Language:     Haskell2010
   HS-Source-Dirs:       src
   GHC-Options:          -Wall
-  Exposed-Modules:      Data.Trie.Pred
-  Other-Modules:        Data.Trie.Pred.Internal
+  Exposed-Modules:      Data.Trie.Pred.Unified
+                        Data.Trie.Pred.Unified.Fast
+                        Data.Trie.Pred.Unified.Norm
   Build-Depends:        base >= 4 && < 5
                       , semigroups
 
@@ -29,6 +30,15 @@
                       , hspec
                       , QuickCheck
                       , quickcheck-instances
+
+Benchmark simplevshort
+    Type:               exitcode-stdio-1.0
+    Main-Is:            SimpleVShort.hs
+    HS-Source-Dirs:     bench
+                      , src
+    Build-Depends:      base
+                      , criterion
+                      , semigroups
 
 Source-Repository head
   Type:                 git
diff --git a/src/Data/Trie/Pred.hs b/src/Data/Trie/Pred.hs
deleted file mode 100644
--- a/src/Data/Trie/Pred.hs
+++ /dev/null
@@ -1,99 +0,0 @@
-{-# LANGUAGE
-  GADTs
-  #-}
-
-module Data.Trie.Pred
-  ( PredTrie (..)
-  , lookup
-  , merge
-  , areDisjoint
-  ) where
-
-import Data.Trie.Pred.Internal
-
-import Prelude hiding (lookup)
-import Data.List.NonEmpty hiding (map)
-import Data.List.NonEmpty as NE hiding (map)
-
-
--- | A predicative trie is composed of explicit predicate labels (for equality
--- tests of predicates), a type for node labels, and some content type
-data PredTrie p t x where
-  Rest :: NonEmpty t
-       -> x
-       -> PredTrie p t x
-  More :: t
-       -> Maybe x
-       -> NonEmpty (PredTrie p t x)
-       -> PredTrie p t x
-  Pred :: p
-       -> (t -> Maybe r)
-       -> Maybe (r -> x)
-       -> [PredTrie p t (r -> x)]
-       -> PredTrie p t x
-
-
--- | Overwrites when similar, leaves untouched when not
-merge :: (Eq t, Eq p) => PredTrie p t x -> PredTrie p t x -> PredTrie p t x
-merge xx@(Rest tss@(t:|ts) x) yy@(Rest pss@(p:|ps) y)
-  | tss == pss = yy
-  | t == p     = let
-                   xx' = Rest (NE.fromList ts) x
-                   yy' = Rest (NE.fromList ps) y
-                 in
-                 More p Nothing $
-                   if areDisjoint xx' yy'
-                     then NE.fromList [xx', yy']
-                     else NE.fromList
-                            [merge (Rest (NE.fromList ts) x) (Rest (NE.fromList ps) y)]
-  | otherwise = xx
-merge xx@(More t mx xs) yy@(More p my ys)
-  | t == p = More p my $ NE.fromList $ foldr go [] $ (NE.toList xs) ++ (NE.toList ys)
-  | otherwise = xx
-  where
-    go :: (Eq t, Eq p) => PredTrie p t x -> [PredTrie p t x] -> [PredTrie p t x]
-    go a [] = [a]
-    go a (b:bs) | areDisjoint a b =       a : b : bs
-                | otherwise       = (merge a b) : bs
-merge xx@(Pred t q mrx xrs) yy@(Pred p w mry yrs)
-  | t == p = yy
-  | otherwise = xx
-merge xx@(Rest (t:|ts) x) yy@(More p my ys)
-  | t == p = case ts of
-               [] -> More p (Just x) ys
-               _  -> More p my $ fmap (merge $ Rest (NE.fromList ts) x) ys
-  | otherwise = xx
-merge xx@(More t mx xs) yy@(Rest (p:|ps) y)
-  | t == p = case ps of
-               [] -> More t (Just y) xs
-               _  -> More t mx $ fmap (flip merge $ Rest (NE.fromList ps) y) xs
-  | otherwise = yy
-merge xx yy@(Pred _ _ _ _) = yy -- Predicates are more general
-merge xx@(Pred _ _ _ _) yy = xx
-
-
-areDisjoint :: (Eq t, Eq p) => PredTrie p t x -> PredTrie p t x -> Bool
-areDisjoint (Rest (t:|_) _) (Rest (p:|_) _) = t == p
-areDisjoint (More t _ _)    (More p _ _)    = t == p
-areDisjoint (Pred t _ _ _)  (Pred p _ _ _)  = t == p
-
-
-lookup :: Eq t => NonEmpty t -> PredTrie p t x -> Maybe x
-lookup tss@(t:|ts) (Rest ps x) | tss == ps = Just x
-                               | otherwise = Nothing
-lookup     (t:|ts) (More t' mx xs) | t == t' =
-  case ts of
-    [] -> mx
-    _  -> getFirst $ NE.toList $ fmap (lookup $ NE.fromList ts) xs
-                                   | otherwise = Nothing
-lookup     (t:|ts) (Pred _ p mrx xrs) =
-  p t >>=
-    \r -> case ts of
-      [] -> ($ r) <$> mrx
-      _  -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)
-
-
-getFirst :: [Maybe a] -> Maybe a
-getFirst [] = Nothing
-getFirst (Nothing:xs) = getFirst xs
-getFirst (Just x :xs) = Just x
diff --git a/src/Data/Trie/Pred/Internal.hs b/src/Data/Trie/Pred/Internal.hs
deleted file mode 100644
--- a/src/Data/Trie/Pred/Internal.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module Data.Trie.Pred.Internal
-    (
-    ) where
diff --git a/src/Data/Trie/Pred/Unified.hs b/src/Data/Trie/Pred/Unified.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Pred/Unified.hs
@@ -0,0 +1,21 @@
+module Data.Trie.Pred.Unified where
+
+import Data.Trie.Pred.Unified.Norm
+import qualified Data.Trie.Pred.Unified.Norm as NU
+import Data.Monoid
+
+
+data RPTrie t x = Rooted (Maybe x) [NUPTrie t x]
+
+instance (Eq t) => Monoid (RPTrie t x) where
+  mempty = Rooted Nothing []
+  mappend = Data.Trie.Pred.Unified.merge
+
+merge :: (Eq t) => RPTrie t x -> RPTrie t x -> RPTrie t x
+merge (Rooted mx xs) (Rooted my ys) =
+  Rooted my $ foldr go [] $ xs ++ ys
+  where
+    go :: (Eq t) => NUPTrie t x -> [NUPTrie t x] -> [NUPTrie t x]
+    go a [] = [a]
+    go a (b:bs) | NU.areDisjoint a b =          a : b : bs
+                | otherwise          = (NU.merge a b) : bs
diff --git a/src/Data/Trie/Pred/Unified/Fast.hs b/src/Data/Trie/Pred/Unified/Fast.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Pred/Unified/Fast.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE
+  GADTs
+  #-}
+
+module Data.Trie.Pred.Unified.Fast
+  ( FUPTrie (..)
+  , lookup
+  , merge
+  , areDisjoint
+  ) where
+
+import Prelude hiding (lookup)
+import Data.List.NonEmpty hiding (map)
+import Data.List.NonEmpty as NE hiding (map)
+
+
+
+-- | A fast, unified, predicative trie. Singleton, leaf-ending
+-- branches have their own data constructor, predicate labels and literals
+-- have a unified type.
+data FUPTrie t x where
+  FURest :: NonEmpty t
+         -> x
+         -> FUPTrie t x
+  FUMore :: t
+         -> Maybe x
+         -> NonEmpty (FUPTrie t x)
+         -> FUPTrie t x
+  FUPred :: t
+         -> (t -> Maybe r)
+         -> Maybe (r -> x)
+         -> [FUPTrie t (r -> x)]
+         -> FUPTrie t x
+
+
+-- | Overwrites when similar, leaves untouched when not
+merge :: (Eq t) => FUPTrie t x -> FUPTrie t x -> FUPTrie t x
+merge xx@(FURest tss@(t:|ts) x) yy@(FURest pss@(p:|ps) y)
+  | tss == pss = yy
+  | t == p     = let
+                   xx' = FURest (NE.fromList ts) x
+                   yy' = FURest (NE.fromList ps) y
+                 in
+                 FUMore p Nothing $
+                   if areDisjoint xx' yy'
+                     then NE.fromList [xx', yy']
+                     else NE.fromList
+                            [merge (FURest (NE.fromList ts) x) (FURest (NE.fromList ps) y)]
+  | otherwise = xx
+merge xx@(FUMore t mx xs) yy@(FUMore p my ys)
+  | t == p = FUMore p my $ NE.fromList $ foldr go [] $ (NE.toList xs) ++ (NE.toList ys)
+  | otherwise = xx
+  where
+    go :: (Eq t) => FUPTrie t x -> [FUPTrie t x] -> [FUPTrie t x]
+    go a [] = [a]
+    go a (b:bs) | areDisjoint a b =       a : b : bs
+                | otherwise       = (merge a b) : bs
+merge xx@(FUPred t q mrx xrs) yy@(FUPred p w mry yrs)
+  | t == p = yy
+  | otherwise = xx
+merge xx@(FURest (t:|ts) x) yy@(FUMore p my ys)
+  | t == p = case ts of
+               [] -> FUMore p (Just x) ys
+               _  -> FUMore p my $ fmap (merge $ FURest (NE.fromList ts) x) ys
+  | otherwise = xx
+merge xx@(FUMore t mx xs) yy@(FURest (p:|ps) y)
+  | t == p = case ps of
+               [] -> FUMore t (Just y) xs
+               _  -> FUMore t mx $ fmap (flip merge $ FURest (NE.fromList ps) y) xs
+  | otherwise = yy
+merge xx@(FUMore t mx xs) yy@(FUPred p w mrx xrs)
+  | t == p = yy -- predicate children are incompatible
+  | otherwise = xx
+merge xx@(FURest (t:|ts) x) yy@(FUPred p w mry yrs)
+  | t == p = yy
+  | otherwise = xx
+merge xx@(FUPred t q mrx xrs) yy@(FUMore p my ys)
+  | t == p = yy
+  | otherwise = xx
+merge xx@(FUPred t q mrx xrs) yy@(FURest (p:|ps) y)
+  | t == p = yy
+  | otherwise = xx
+
+
+areDisjoint :: (Eq t) => FUPTrie t x -> FUPTrie t x -> Bool
+areDisjoint (FURest (t:|_) _) (FURest (p:|_) _) = t == p
+areDisjoint (FUMore t _ _)    (FUMore p _ _)    = t == p
+areDisjoint (FURest (t:|_) _) (FUMore p _ _)    = t == p
+areDisjoint (FUMore t _ _)    (FURest (p:|_) _) = t == p
+areDisjoint (FUPred t _ _ _)  (FUPred p _ _ _)  = t == p
+areDisjoint (FUPred t _ _ _)  (FUMore p _ _)    = t == p
+areDisjoint (FUPred t _ _ _)  (FURest (p:|_) _) = t == p
+areDisjoint (FUMore t _ _)    (FUPred p _ _ _)  = t == p
+areDisjoint (FURest (t:|_) _) (FUPred p _ _ _)  = t == p
+
+
+lookup :: Eq t => NonEmpty t -> FUPTrie t x -> Maybe x
+lookup tss@(t:|ts) (FURest ps x) | tss == ps = Just x
+                                 | otherwise = Nothing
+lookup     (t:|ts) (FUMore t' mx xs) | t == t' =
+  case ts of
+    [] -> mx
+    _  -> getFirst $ NE.toList $ fmap (lookup $ NE.fromList ts) xs
+                                   | otherwise = Nothing
+lookup     (t:|ts) (FUPred _ p mrx xrs) =
+  p t >>=
+    \r -> case ts of
+      [] -> ($ r) <$> mrx
+      _  -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)
+
+
+getFirst :: [Maybe a] -> Maybe a
+getFirst [] = Nothing
+getFirst (Nothing:xs) = getFirst xs
+getFirst (Just x :xs) = Just x
diff --git a/src/Data/Trie/Pred/Unified/Norm.hs b/src/Data/Trie/Pred/Unified/Norm.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Pred/Unified/Norm.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE
+  GADTs
+  #-}
+
+module Data.Trie.Pred.Unified.Norm
+  ( NUPTrie (..)
+  , lookup
+  , merge
+  , areDisjoint
+  ) where
+
+import Prelude hiding (lookup)
+import Data.List.NonEmpty hiding (map)
+import Data.List.NonEmpty as NE hiding (map)
+
+
+
+data NUPTrie t x where
+  NUMore :: t
+         -> Maybe x
+         -> [NUPTrie t x]
+         -> NUPTrie t x
+  NUPred :: t
+         -> (t -> Maybe r)
+         -> Maybe (r -> x)
+         -> [NUPTrie t (r -> x)]
+         -> NUPTrie t x
+
+
+-- | Overwrites when similar, leaves untouched when not
+merge :: (Eq t) => NUPTrie t x -> NUPTrie t x -> NUPTrie t x
+merge xx@(NUMore t mx xs) yy@(NUMore p my ys)
+  | t == p = NUMore p my $ foldr go [] $ xs ++ ys
+  | otherwise = xx
+  where
+    go :: (Eq t) => NUPTrie t x -> [NUPTrie t x] -> [NUPTrie t x]
+    go a [] = [a]
+    go a (b:bs) | areDisjoint a b =       a : b : bs
+                | otherwise       = (merge a b) : bs
+merge xx@(NUPred t q mrx xrs) yy@(NUPred p w mry yrs)
+  | t == p = yy
+  | otherwise = xx
+merge xx@(NUMore t mx xs) yy@(NUPred p w mrx xrs)
+  | t == p = yy -- predicate children are incompatible
+  | otherwise = xx
+merge xx@(NUPred t q mrx xrs) yy@(NUMore p my ys)
+  | t == p = yy
+  | otherwise = xx
+
+
+areDisjoint :: (Eq t) => NUPTrie t x -> NUPTrie t x -> Bool
+areDisjoint (NUMore t _ _)    (NUMore p _ _)    = t == p
+areDisjoint (NUPred t _ _ _)  (NUPred p _ _ _)  = t == p
+areDisjoint (NUPred t _ _ _)  (NUMore p _ _)    = t == p
+areDisjoint (NUMore t _ _)    (NUPred p _ _ _)  = t == p
+
+
+lookup :: Eq t => NonEmpty t -> NUPTrie t x -> Maybe x
+lookup (t:|ts) (NUMore t' mx xs)
+  | t == t' = case ts of
+    [] -> mx
+    _  -> getFirst $ map (lookup $ NE.fromList ts) xs
+  | otherwise = Nothing
+lookup (t:|ts) (NUPred _ p mrx xrs) =
+  p t >>=
+    \r -> case ts of
+      [] -> ($ r) <$> mrx
+      _  -> ($ r) <$> (getFirst $ map (lookup $ NE.fromList ts) xrs)
+
+
+getFirst :: [Maybe a] -> Maybe a
+getFirst [] = Nothing
+getFirst (Nothing:xs) = getFirst xs
+getFirst (Just x :xs) = Just x