diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bench/Bench.hs b/bench/Bench.hs
--- a/bench/Bench.hs
+++ b/bench/Bench.hs
@@ -1,78 +1,55 @@
+{-# LANGUAGE
+    FlexibleContexts
+  #-}
+
 module Main where
 
+import Build
+
 import           Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import Data.Tree (Tree (..))
-import Data.Trie.List as L
-import Data.Trie.Map as M
-import Data.Tree.Knuth.Forest as K
-import Data.Trie.Knuth as K
-import Data.Trie.Class as TC
-import qualified Data.Map as Map
+import Data.Trie.List              as L
+import Data.Trie.Map               as M
+import Data.Trie.HashMap           as HM
+import Data.Tree.Knuth.Forest      as K
+import Data.Trie.Knuth             as K
+import Data.Trie.Class             as TC
+import qualified Data.Map          as Map
+import qualified Data.HashMap.Lazy as HMap
 import Criterion.Main
 import Control.Monad.State
 
 
-genListTrie :: Int -> ListTrie Int Int
-genListTrie n = ListTrie $ Node (0, Just 0) $ genTree n
-  where
-    genTree :: Int -> [Tree (Int, Maybe Int)]
-    genTree n = evalState (replicateM n $ do
-      i <- getSucc
-      return $ Node (i, Just i) $ genTree (n-1)) 1
 
-
-getSucc :: State Int Int
-getSucc = get <* modify (+1)
-
-
-genMapTrie :: Int -> MapTrie Int Int
-genMapTrie n = MapTrie $ MapStep $ Map.singleton 0
-  (Just 0, Just $ MapTrie $ MapStep $ genMapTree n)
-  where
-    genMapTree :: Int -> Map.Map Int (Maybe Int, Maybe (MapTrie Int Int))
-    genMapTree n = Map.unions $ evalState (replicateM n $ do
-      i <- getSucc
-      return $ Map.singleton i ( Just i
-                               , if n <= 1 then Nothing
-                                 else Just $ MapTrie $ MapStep $ genMapTree (n-1))) 1
-
+deleteMany :: ( Trie NonEmpty Int c
+              ) => Int -> c Int a -> c Int a
+deleteMany top xs =
+  foldr
+    (\p -> TC.delete $ buildMiddleQuery top)
+    xs
+    [1..top]
 
-genKnuthTrie :: Int -> KnuthTrie Int Int
-genKnuthTrie n = KnuthTrie $ Fork (0, Just 0) (genKnuthForest n n) Nil
-  where
-    genKnuthForest :: Int -> Int -> KnuthForest (Int, Maybe Int)
-    genKnuthForest 0 _ = Nil
-    genKnuthForest n s = let cs = if n <= 1 then Nil else genKnuthForest (n-1) (n-1)
-                             ss = if s <= 1 then Nil else genKnuthForest n (s-1)
-                         in Fork (s, Just s) cs ss
+insertMany :: ( Trie NonEmpty Int c
+              ) => Int -> c Int Int -> c Int Int
+insertMany top xs =
+  foldr
+    (\p -> TC.insert (buildMiddleQuery top) 0)
+    xs
+    [1..top]
 
 
 main = defaultMain
-  [ bgroup "lookup"
-    [ bgroup "ListTrie"
-      [ bench "1" $ whnf (TC.lookup $ 0 :| [100])         (genListTrie 100)
-      , bench "2" $ whnf (TC.lookup $ 0 :| [100,99..81])  (genListTrie 100)
-      , bench "3" $ whnf (TC.lookup $ 0 :| [100,99..61])  (genListTrie 100)
-      , bench "4" $ whnf (TC.lookup $ 0 :| [100,99..41])  (genListTrie 100)
-      , bench "5" $ whnf (TC.lookup $ 0 :| [100,99..21])  (genListTrie 100)
-      , bench "6" $ whnf (TC.lookup $ 0 :| [100,99..1])   (genListTrie 100)
-      ]
-    , bgroup "MapTrie"
-      [ bench "1" $ whnf (TC.lookup $ 0 :| [100])         (genMapTrie 100)
-      , bench "2" $ whnf (TC.lookup $ 0 :| [100,99..81])  (genMapTrie 100)
-      , bench "3" $ whnf (TC.lookup $ 0 :| [100,99..61])  (genMapTrie 100)
-      , bench "4" $ whnf (TC.lookup $ 0 :| [100,99..41])  (genMapTrie 100)
-      , bench "5" $ whnf (TC.lookup $ 0 :| [100,99..21])  (genMapTrie 100)
-      , bench "6" $ whnf (TC.lookup $ 0 :| [100,99..1])   (genMapTrie 100)
-      ]
-    , bgroup "KnuthTrie"
-      [ bench "1" $ whnf (TC.lookup $ 0 :| [100])         (genKnuthTrie 100)
-      , bench "2" $ whnf (TC.lookup $ 0 :| [100,99..81])  (genKnuthTrie 100)
-      , bench "3" $ whnf (TC.lookup $ 0 :| [100,99..61])  (genKnuthTrie 100)
-      , bench "4" $ whnf (TC.lookup $ 0 :| [100,99..41])  (genKnuthTrie 100)
-      , bench "5" $ whnf (TC.lookup $ 0 :| [100,99..21])  (genKnuthTrie 100)
-      , bench "6" $ whnf (TC.lookup $ 0 :| [100,99..1])   (genKnuthTrie 100)
-      ]
+  [ bgroup "delete"
+    [ bench "ListTrie"    $ whnf (deleteMany 100) (genListTrie    100)
+    , bench "MapTrie"     $ whnf (deleteMany 100) (genMapTrie     100)
+    , bench "HashMapTrie" $ whnf (deleteMany 100) (genHashMapTrie 100)
+    , bench "KnuthTrie"   $ whnf (deleteMany 100) (genKnuthTrie   100)
+    ]
+  , bgroup "insert"
+    [ bench "ListTrie"    $ whnf (insertMany 100) (genListTrie    100)
+    , bench "MapTrie1"    $ whnf (insertMany 100) (genMapTrie     100)
+    , bench "HashMapTrie" $ whnf (insertMany 100) (genHashMapTrie 100)
+    , bench "KnuthTrie"   $ whnf (insertMany 100) (genKnuthTrie   100)
     ]
   ]
diff --git a/bench/BenchLookup.hs b/bench/BenchLookup.hs
new file mode 100644
--- /dev/null
+++ b/bench/BenchLookup.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE
+    FlexibleContexts
+  #-}
+
+module Main where
+
+import Build
+
+import Data.Trie.Class as TC
+import Criterion.Main
+
+
+main = defaultMain
+  [ bgroup "lookup"
+    [ bgroup "ListTrie"    $ benchOne genListTrie    <$> [10,20..100]
+    , bgroup "MapTrie"     $ benchOne genMapTrie     <$> [10,20..100]
+    , bgroup "HashMapTrie" $ benchOne genHashMapTrie <$> [10,20..100]
+    , bgroup "KnuthTrie"   $ benchOne genKnuthTrie   <$> [10,20..100]
+    ]
+  ]
+  where
+    benchOne gen x = bench (show x) $ whnf (TC.lookup $ buildMiddleQuery x)  (gen 100)
diff --git a/bench/Build.hs b/bench/Build.hs
new file mode 100644
--- /dev/null
+++ b/bench/Build.hs
@@ -0,0 +1,82 @@
+module Build where
+
+
+
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Tree (Tree (..))
+import Data.Trie.List              as L
+import Data.Trie.Map               as M
+import Data.Trie.HashMap           as HM
+import Data.Tree.Knuth.Forest      as K
+import Data.Trie.Knuth             as K
+import qualified Data.Map          as Map
+import qualified Data.HashMap.Lazy as HMap
+import Control.Monad.State
+
+
+buildMiddleQuery :: Int -> NonEmpty Int
+buildMiddleQuery x = 0 :| go x
+  where
+    go n =
+      let half = floor ((fromIntegral n)/2)
+      in if half == 0
+         then []
+         else half : go (floor $ (fromIntegral n)/2)
+
+
+genListTrie :: Int -> ListTrie Int Int
+genListTrie n = ListTrie $ Node (0, Just 0) $ genTree n
+  where
+    genTree :: Int -> [Tree (Int, Maybe Int)]
+    genTree n = flip evalState 1 $ replicateM n $ do
+      i <- getSucc
+      return $ Node (i, Just 0) $ genTree (floor $ (fromIntegral n)/2)
+
+
+getSucc :: State Int Int
+getSucc = do
+  i <- get
+  modify (+1)
+  pure i
+
+
+genMapTrie :: Int -> MapTrie Int Int
+genMapTrie n = MapTrie $ MapStep $ Map.singleton 0
+  (Just 0, Just $ MapTrie $ MapStep $ genMapTree n)
+  where
+    genMapTree :: Int -> Map.Map Int (Maybe Int, Maybe (MapTrie Int Int))
+    genMapTree n =
+      Map.unions . flip evalState 1 $
+        replicateM n $ do
+          i <- getSucc
+          pure $ Map.singleton i ( Just 0
+                                 , if n <= 1
+                                   then Nothing
+                                   else Just . MapTrie . MapStep $ genMapTree (floor $ (fromIntegral n)/2)
+                                 )
+
+genHashMapTrie :: Int -> HashMapTrie Int Int
+genHashMapTrie n =
+  HashMapTrie $ HashMapStep $ HMap.singleton 0
+    (Just 0, Just . HashMapTrie . HashMapStep $ genHashMapTree n)
+  where
+    genHashMapTree :: Int -> HMap.HashMap Int (Maybe Int, Maybe (HashMapTrie Int Int))
+    genHashMapTree n = HMap.unions $ flip evalState 1 $
+      replicateM n $ do
+        i <- getSucc
+        return $ HMap.singleton i ( Just 0
+                                  , if n <= 1
+                                    then Nothing
+                                    else Just . HashMapTrie . HashMapStep $ genHashMapTree (floor $ (fromIntegral n)/2)
+                                  )
+
+
+-- | This one is ordered largest first
+genKnuthTrie :: Int -> KnuthTrie Int Int
+genKnuthTrie n = KnuthTrie $ Fork (0, Just 0) (genKnuthForest n n) Nil
+  where
+    genKnuthForest :: Int -> Int -> KnuthForest (Int, Maybe Int)
+    genKnuthForest 0 _ = Nil
+    genKnuthForest n s = let cs = if n == 0 then Nil else genKnuthForest (floor $ (fromIntegral n)/2) (n-1)
+                             ss = if s == 0 then Nil else genKnuthForest n (s-1)
+                         in Fork (s, Just 0) cs ss
diff --git a/src/Data/Trie/Class.hs b/src/Data/Trie/Class.hs
--- a/src/Data/Trie/Class.hs
+++ b/src/Data/Trie/Class.hs
@@ -11,9 +11,9 @@
 
 import Data.Function.Syntax
 import Data.Maybe (isJust, fromMaybe)
-import Data.Monoid
 import Data.Foldable as F
 import Data.Functor.Identity (Identity (..))
+-- import Data.Map.TernaryMap as TM
 
 
 -- | Class representing tries with single-threaded insertion, deletion, and lookup.
@@ -40,6 +40,13 @@
 fromFoldable :: (Foldable f, Monoid (t s a), Trie p s t) => f (p s, a) -> t s a
 fromFoldable = F.foldr (uncurry insert) mempty
 
+
+-- * Ternary Map
+
+-- TODO
+-- instance Ord k => Trie [] k TernaryMap where
+--   lookup = TM.lookup
+--   delete = TM.delete
 
 -- * ByteString-Trie
 
diff --git a/src/Data/Trie/HashMap.hs b/src/Data/Trie/HashMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/HashMap.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE
+    GeneralizedNewtypeDeriving
+  , DeriveFunctor
+  , DeriveFoldable
+  , DeriveTraversable
+  , DeriveGeneric
+  , DeriveDataTypeable
+  , MultiParamTypeClasses
+  , FlexibleInstances
+  , FlexibleContexts
+  , TypeFamilies
+  , TupleSections
+  #-}
+
+module Data.Trie.HashMap where
+
+import Data.Trie.Class
+import Data.Monoid
+import Data.Hashable
+import Data.Maybe (fromMaybe, fromJust)
+import qualified Data.Foldable      as F
+import           Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
+import qualified Data.HashMap.Lazy  as HM
+import qualified Data.Key           as K
+import Control.Monad
+
+import Data.Data
+import GHC.Generics
+import Control.DeepSeq
+import Prelude hiding (lookup, null)
+import Test.QuickCheck
+import Test.QuickCheck.Instances ()
+
+
+-- * One Step
+
+newtype HashMapStep c p a = HashMapStep
+  { unHashMapStep :: HM.HashMap p (Maybe a, Maybe (c p a))
+  } deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data, Typeable)
+
+instance ( NFData (c p a)
+         , NFData p
+         , NFData a
+         ) => NFData (HashMapStep c p a)
+
+instance ( Arbitrary a
+         , Arbitrary p
+         , Arbitrary (c p a)
+         , Hashable p
+         , Eq p
+         ) => Arbitrary (HashMapStep c p a) where
+  arbitrary = sized go
+    where
+      go n = do
+        i <- choose (0,n)
+        xs <- replicateM i $ (,) <$> arbitrary <*> resize (floor (fromIntegral n / 2 :: Float)) arbitrary
+        return $ HashMapStep $ HM.fromList xs
+
+instance ( Hashable p
+         , Eq p
+         , Trie NonEmpty p c
+         ) => Trie NonEmpty p (HashMapStep c) where
+  lookup (p:|ps) (HashMapStep xs)
+    | F.null ps = fst =<< HM.lookup p xs
+    | otherwise = lookup (NE.fromList ps) =<< snd =<< HM.lookup p xs
+  delete (p:|ps) (HashMapStep xs)
+    | F.null ps = let mxs = snd =<< HM.lookup p xs
+                  in  HashMapStep $ HM.insert p (Nothing,mxs) xs
+    | otherwise = let (mx,mxs) = fromMaybe (Nothing,Nothing) $ HM.lookup p xs
+                  in  HashMapStep $ HM.insert p (mx, delete (NE.fromList ps) <$> mxs) xs
+
+insert :: ( Hashable p
+          , Eq p
+          , Trie NonEmpty p c
+          , Monoid (c p a)
+          ) => NonEmpty p -> a -> HashMapStep c p a -> HashMapStep c p a
+insert (p:|ps) x (HashMapStep xs)
+  | F.null ps = let mxs = snd =<< HM.lookup p xs
+                in  HashMapStep $ HM.insert p (Just x,mxs) xs
+  | otherwise = let mx  = fst =<< HM.lookup p xs
+                    xs' = fromMaybe mempty (snd =<< HM.lookup p xs)
+                in  HashMapStep $ HM.insert p (mx, Just $ Data.Trie.Class.insert (NE.fromList ps) x xs') xs
+
+
+instance ( Hashable p
+         , Eq p
+         , Monoid (c p a)
+         ) => Monoid (HashMapStep c p a) where
+  mempty = empty
+  mappend (HashMapStep xs) (HashMapStep ys) = HashMapStep $ HM.unionWith go xs ys
+    where go (mx,mxs) (my,mys) = (getLast $ Last mx <> Last my, mxs <> mys)
+
+empty :: HashMapStep c p a
+empty = HashMapStep HM.empty
+
+singleton :: Hashable p => p -> a -> HashMapStep c p a
+singleton p x = HashMapStep $ HM.singleton p (Just x, Nothing)
+
+-- * Fixpoint of Steps
+
+
+newtype HashMapTrie p a = HashMapTrie
+  { unHashMapTrie :: HashMapStep HashMapTrie p a
+  } deriving (Show, Eq, Functor, Foldable, Traversable, Monoid, Arbitrary)
+
+
+instance ( Hashable p
+         , Eq p
+         ) => Trie NonEmpty p HashMapTrie where
+  lookup ts (HashMapTrie xs) = lookup ts xs
+  delete ts (HashMapTrie xs) = HashMapTrie $ delete ts xs
+  insert ts x (HashMapTrie xs) = HashMapTrie $ Data.Trie.HashMap.insert ts x xs
+
+type instance K.Key (HashMapTrie p) = NonEmpty p
+
+instance ( Hashable p
+         , Eq p
+         ) => K.Lookup (HashMapTrie p) where
+  lookup = lookup
+
+-- * Conversion
+
+keys :: ( Hashable p
+        , Eq p
+        ) => HashMapTrie p a -> [NonEmpty p]
+keys (HashMapTrie (HashMapStep xs)) =
+  let ks = HM.keys xs
+  in F.concatMap go ks
+  where
+    go k = let (_,mxs) = fromJust $ HM.lookup k xs
+           in fmap (k :|) $ fromMaybe [] $ do xs' <- mxs
+                                              return $ NE.toList <$> keys xs'
+
+
+elems :: HashMapTrie p a -> [a]
+elems = F.toList
+
+-- * Query
+
+
+subtrie :: ( Hashable p
+           , Eq p
+           ) => NonEmpty p -> HashMapTrie p a -> Maybe (HashMapTrie p a)
+subtrie (p:|ps) (HashMapTrie (HashMapStep xs))
+  | F.null ps = snd =<< HM.lookup p xs
+  | otherwise = subtrie (NE.fromList ps) =<< snd =<< HM.lookup p xs
+
+
+-- lookupNearest ~ match
+match :: ( Hashable p
+         , Eq p
+         ) => NonEmpty p -> HashMapTrie p a -> Maybe (NonEmpty p, a, [p])
+match (p:|ps) (HashMapTrie (HashMapStep xs)) = do
+  (mx,mxs) <- HM.lookup p xs
+  let mFoundHere = (p:|[],, ps) <$> mx
+  if F.null ps
+  then mFoundHere
+  else getFirst $ First (do (pre,y,suff) <- match (NE.fromList ps) =<< mxs
+                            pure (p:|NE.toList pre, y, suff))
+               <> First mFoundHere
+
+-- | Returns a list of all the nodes along the path to the furthest point in the
+-- query, in order of the path walked from the root to the furthest point.
+matches :: ( Hashable p
+           , Eq p
+           ) => NonEmpty p -> HashMapTrie p a -> [(NonEmpty p, a, [p])]
+matches (p:|ps) (HashMapTrie (HashMapStep xs)) =
+  let (mx,mxs) = fromMaybe (Nothing,Nothing) $ HM.lookup p xs
+      foundHere = fromMaybe [] $ (\x -> [(p:|[],x,ps)]) <$> mx
+  in if F.null ps
+  then foundHere
+  else let rs = fromMaybe [] $ matches (NE.fromList ps) <$> mxs
+       in  foundHere ++ (prependAncestry <$> rs)
+  where prependAncestry (pre,x,suff) = (p:| NE.toList pre,x,suff)
+
+
+
diff --git a/src/Data/Trie/Knuth.hs b/src/Data/Trie/Knuth.hs
--- a/src/Data/Trie/Knuth.hs
+++ b/src/Data/Trie/Knuth.hs
@@ -2,6 +2,8 @@
     DeriveFunctor
   , DeriveFoldable
   , DeriveTraversable
+  , DeriveGeneric
+  , DeriveDataTypeable
   , GeneralizedNewtypeDeriving
   , FlexibleInstances
   , MultiParamTypeClasses
@@ -16,29 +18,37 @@
 
 import Data.Trie.Class
 
+import Data.Data
+import GHC.Generics
+import Control.DeepSeq
 import Test.QuickCheck
 
 
 newtype KnuthTrie s x = KnuthTrie
-  {unKnuthTrie :: KnuthForest (s, Maybe x)}
-  deriving (Show, Eq, Functor, Foldable, Traversable, Arbitrary)
+  { unKnuthTrie :: KnuthForest (s, Maybe x)
+  } deriving (Show, Eq, Functor, Foldable, Traversable, Arbitrary, Generic, Data, Typeable)
 
+instance ( NFData s
+         , NFData x
+         ) => NFData (KnuthTrie s x)
+
 instance Eq s => Trie NonEmpty s KnuthTrie where
   lookup _ (KnuthTrie Nil) = Nothing
   lookup tss@(t:|ts) (KnuthTrie (Fork (t',mx) cs ss))
-    | t == t' = if null ts then mx
+    | t == t' = if null ts
+                then mx
                 else lookup (NE.fromList ts) $ KnuthTrie cs
     | otherwise = lookup tss $ KnuthTrie ss
 
   insert (t:|ts) x (KnuthTrie Nil)
     | null ts = KnuthTrie $ Fork (t,Just x) Nil Nil
     | otherwise = let cs' = unKnuthTrie $ insert (NE.fromList ts) x $ KnuthTrie Nil
-                  in KnuthTrie $ Fork (t,Nothing) cs' Nil
+                  in  KnuthTrie $ Fork (t,Nothing) cs' Nil
   insert tss@(t:|ts) x (KnuthTrie (Fork s@(t',_) cs ss))
     | t == t' = if null ts
                 then KnuthTrie $ Fork (t',Just x) cs ss
                 else let cs' = unKnuthTrie $ insert (NE.fromList ts) x $ KnuthTrie cs
-                     in KnuthTrie $ Fork s cs' ss
+                     in  KnuthTrie $ Fork s cs' ss
     | otherwise = KnuthTrie $ Fork s cs $ unKnuthTrie $ insert tss x $ KnuthTrie ss
 
   delete _ xs@(KnuthTrie Nil) = xs
@@ -46,5 +56,5 @@
     | t == t' = if null ts
                 then KnuthTrie $ Fork (t',Nothing) cs ss
                 else let cs' = unKnuthTrie $ delete (NE.fromList ts) $ KnuthTrie cs
-                     in KnuthTrie $ Fork s cs' ss
+                     in  KnuthTrie $ Fork s cs' ss
     | otherwise = KnuthTrie $ Fork s cs $ unKnuthTrie $ delete tss $ KnuthTrie ss
diff --git a/src/Data/Trie/List.hs b/src/Data/Trie/List.hs
--- a/src/Data/Trie/List.hs
+++ b/src/Data/Trie/List.hs
@@ -2,6 +2,8 @@
     TypeFamilies
   , DeriveFunctor
   , DeriveFoldable
+  , DeriveGeneric
+  , DeriveDataTypeable
   , DeriveTraversable
   , GeneralizedNewtypeDeriving
   , FlexibleInstances
@@ -22,14 +24,21 @@
 import Data.Monoid
 import Control.Monad
 
+import Data.Data
+import GHC.Generics
+import Control.DeepSeq
 import Test.QuickCheck
-import Test.QuickCheck.Instances
+import Test.QuickCheck.Instances ()
 
 
 newtype ListTrie t x = ListTrie
   { unListTrie :: Tree (t, Maybe x)
-  } deriving (Show, Eq, Functor, Foldable, Traversable, Arbitrary)
+  } deriving (Show, Eq, Functor, Foldable, Traversable, Arbitrary, Generic, Data, Typeable)
 
+instance ( NFData t
+         , NFData x
+         ) => NFData (ListTrie t x)
+
 type instance Key (ListTrie s) = NonEmpty s
 -- TODO: Trie instance
 
@@ -60,4 +69,4 @@
                     then fmap (unListTrie . insert (NE.fromList ts) x . ListTrie) xs
                     else xs ++ [unListTrie $ insert (NE.fromList ts) x $ ListTrie $
                                   Node (head ts, Nothing) []]
-      hasHead t (Node (t',_) _) = t == t'
+      hasHead tag (Node (tag',_) _) = tag == tag'
diff --git a/src/Data/Trie/Map.hs b/src/Data/Trie/Map.hs
--- a/src/Data/Trie/Map.hs
+++ b/src/Data/Trie/Map.hs
@@ -2,6 +2,8 @@
     DeriveFunctor
   , DeriveFoldable
   , DeriveTraversable
+  , DeriveGeneric
+  , DeriveDataTypeable
   , GeneralizedNewtypeDeriving
   , TupleSections
   , TypeFamilies
@@ -19,24 +21,31 @@
 import           Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 
-import qualified Data.Set.Class as S
 import qualified Data.Key as K
 import qualified Data.Foldable as F
 import Data.Maybe
 import Data.Monoid
 import Control.Monad
 
+import Data.Data
+import GHC.Generics
+import Control.DeepSeq
 import Test.QuickCheck
-import Test.QuickCheck.Instances
+import Test.QuickCheck.Instances ()
 
 
 
 -- * One Step
 
 newtype MapStep c p a = MapStep
-  { unMapStep :: Map.Map p (Maybe a, Maybe (c p a)) }
-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
+  { unMapStep :: Map.Map p (Maybe a, Maybe (c p a))
+  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic, Data, Typeable)
 
+instance ( NFData (c p a)
+         , NFData p
+         , NFData a
+         ) => NFData (MapStep c p a)
+
 instance (Arbitrary a, Arbitrary p, Arbitrary (c p a), Ord p) => Arbitrary (MapStep c p a) where
   arbitrary = sized go
     where
@@ -50,10 +59,8 @@
 -- instead.
 instance (Ord p, Trie NonEmpty p c) => Trie NonEmpty p (MapStep c) where
   lookup (p:|ps) (MapStep xs)
-    | F.null ps = do (mx,_) <- Map.lookup p xs
-                     mx
-    | otherwise = do (_,mxs) <- Map.lookup p xs
-                     lookup (NE.fromList ps) =<< mxs
+    | F.null ps = fst =<< Map.lookup p xs
+    | otherwise = lookup (NE.fromList ps) =<< snd =<< Map.lookup p xs
   delete (p:|ps) (MapStep xs)
     | F.null ps = let mxs = snd =<< Map.lookup p xs
                   in  MapStep $ Map.insert p (Nothing,mxs) xs
@@ -68,7 +75,7 @@
 insert (p:|ps) x (MapStep xs)
   | F.null ps = let mxs = snd =<< Map.lookup p xs
                 in  MapStep $ Map.insert p (Just x,mxs) xs
-  | otherwise = let mx = fst =<< Map.lookup p xs
+  | otherwise = let mx  = fst =<< Map.lookup p xs
                     xs' = fromMaybe mempty (snd =<< Map.lookup p xs)
                 in  MapStep $ Map.insert p (mx, Just $ Data.Trie.Class.insert (NE.fromList ps) x xs') xs
 
@@ -120,10 +127,8 @@
 
 subtrie :: Ord s => NonEmpty s -> MapTrie s a -> Maybe (MapTrie s a)
 subtrie (p:|ps) (MapTrie (MapStep xs))
-  | F.null ps = do (_,mxs) <- Map.lookup p xs
-                   mxs
-  | otherwise = do (_,mxs) <- Map.lookup p xs
-                   subtrie (NE.fromList ps) =<< mxs
+  | F.null ps = snd =<< Map.lookup p xs
+  | otherwise = subtrie (NE.fromList ps) =<< snd =<< Map.lookup p xs
 
 -- lookupNearest ~ match
 match :: Ord s => NonEmpty s -> MapTrie s a -> Maybe (NonEmpty s, a, [s])
diff --git a/src/Data/Trie/Pseudo.hs b/src/Data/Trie/Pseudo.hs
--- a/src/Data/Trie/Pseudo.hs
+++ b/src/Data/Trie/Pseudo.hs
@@ -10,15 +10,9 @@
 
 import Prelude hiding (foldl, foldr, foldr1, lookup, map)
 import           Data.Foldable             hiding (all)
-import           Data.List                 (intercalate)
-import           Data.List.NonEmpty        (NonEmpty (..), fromList, toList)
+import           Data.List.NonEmpty        (NonEmpty (..), fromList)
 import qualified Data.List.NonEmpty        as NE
-import           Data.Maybe                (fromMaybe)
-import           Data.Monoid
-import qualified Data.Semigroup            as S
 
-import           Control.Applicative
-import           Control.Monad             (replicateM)
 import           Control.Arrow             (second)
 
 
@@ -49,16 +43,16 @@
                    (Just x) -> Rest pss x
                    Nothing  -> Nil
   | t == p = case (ts,ps) of
-               ([],  p':_) -> More t mx $ Rest (NE.fromList ps) y :| []
-               (t':_,  []) -> case mx of
-                                Just x  -> More p (Just y) $ Rest (NE.fromList ts) x :| []
-                                Nothing -> ys
+               ([],_) -> More t mx $ Rest (NE.fromList ps) y :| []
+               (_,[]) -> case mx of
+                           Just x  -> More p (Just y) $ Rest (NE.fromList ts) x :| []
+                           Nothing -> ys
                (t':_,p':_) -> if t' == p'
                                 then More t Nothing $
                                        assign (NE.fromList ts) mx (Rest (NE.fromList ps) y) :| []
                                 else case mx of -- disjoint
                                        Nothing  -> ys
-                                       Just x   -> More t Nothing $ NE.fromList $
+                                       Just x   -> More t Nothing $ NE.fromList
                                                      [ Rest (NE.fromList ps) y
                                                      , Rest (NE.fromList ts) x
                                                      ]
@@ -76,13 +70,13 @@
 merge xx@(Rest tss@(t:|ts) x) (Rest pss@(p:|ps) y)
   | tss == pss = Rest pss y
   | t == p = case (ts,ps) of
-               ([],p':ps') -> More t (Just x) $ Rest (NE.fromList ps) y :| []
-               (t':ts',[]) -> More t (Just y) $ Rest (NE.fromList ts) x :| []
-               (_,_)       -> More t Nothing $
-                                merge (Rest (NE.fromList ts) x)
-                                      (Rest (NE.fromList ps) y) :| []
+               ([],_) -> More t (Just x) $ Rest (NE.fromList ps) y :| []
+               (_,[]) -> More t (Just y) $ Rest (NE.fromList ts) x :| []
+               (_,_)  -> More t Nothing $
+                           merge (Rest (NE.fromList ts) x)
+                                 (Rest (NE.fromList ps) y) :| []
   | otherwise = xx
-merge xx@(More t mx xs) (More p my ys)
+merge xx@(More t _ xs) (More p my ys)
   | t == p = More p my $ NE.fromList $
                foldr go [] $ NE.toList xs ++ NE.toList ys
   | otherwise = xx
@@ -90,13 +84,13 @@
     go q [] = [q]
     go q (z:zs) | areDisjoint q z = q : z : zs
                 | otherwise = merge q z : zs
-merge xx@(More t mx xs) (Rest pss@(p:|ps) y)
+merge xx@(More t mx xs) (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 = xx
-merge xx@(Rest tss@(t:|ts) x) (More p my ys)
+merge xx@(Rest (t:|ts) x) (More p my ys)
   | t == p = case ts of
                [] -> More p (Just x) ys
                _  -> More p my $
@@ -111,15 +105,15 @@
   where
     mkMores :: (Eq t) => [t] -> PseudoTrie t a -> PseudoTrie t a
     mkMores [] trie = trie
-    mkMores (t:ts) trie = More t Nothing $
-      mkMores ts trie :| []
+    mkMores (p:ps) trie = More p Nothing $
+      mkMores ps trie :| []
 
 
 toAssocs :: PseudoTrie t a -> [(NonEmpty t, a)]
 toAssocs = go [] []
   where
     go :: [t] -> [(NonEmpty t, a)] -> PseudoTrie t a -> [(NonEmpty t, a)]
-    go depth acc Nil = acc
+    go _     acc Nil = acc
     go depth acc (Rest ts x) = (NE.fromList $ depth ++ NE.toList ts, x) : acc
     go depth acc (More t Nothing xs) =
       foldr (flip $ go $ depth ++ [t]) acc $ NE.toList xs
@@ -135,17 +129,17 @@
 lookup tss (Rest pss a)
   | tss == pss = Just a
   | otherwise = Nothing
-lookup tss@(t:|ts) (More p mx xs)
+lookup (t:|ts) (More p mx xs)
   | t == p = case ts of
                [] -> mx
-               (t':ts') -> find (hasNextTag t') xs >>= lookup (fromList ts)
+               (t':_) -> find (hasNextTag t') xs >>= lookup (fromList ts)
   | otherwise = Nothing
 
   where
     hasNextTag :: (Eq t) => t -> PseudoTrie t a -> Bool
-    hasNextTag t Nil = False
-    hasNextTag t (More p _ _) = t == p
-    hasNextTag t (Rest (p:|_) _) = t == p
+    hasNextTag _ Nil = False
+    hasNextTag tag (More tag' _ _)    = tag == tag'
+    hasNextTag tag (Rest (tag':|_) _) = tag == tag'
 
 -- | Simple test on the heads of two tries
 areDisjoint :: (Eq t) => PseudoTrie t a -> PseudoTrie t a -> Bool
@@ -165,7 +159,7 @@
                  -> PseudoTrie t c
 intersectionWith _ _ Nil = Nil
 intersectionWith _ Nil _ = Nil
-intersectionWith f (Rest tss@(t:|ts) x) (Rest pss@(p:|ps) y)
+intersectionWith f (Rest tss x) (Rest pss y)
   | tss == pss = Rest pss $ f x y
   | otherwise = Nil
 intersectionWith f (More t mx xs) (More p my ys)
@@ -176,14 +170,14 @@
                zs -> More p (f <$> mx <*> my) $ NE.fromList zs
   -- implicit root
   | otherwise = Nil
-intersectionWith f (More t mx xs) (Rest pss@(p:|ps) y)
+intersectionWith f (More t mx xs) (Rest (p:|ps) y)
   | t == p = case ps of
                [] -> case f <$> mx <*> Just y of
                      Nothing -> Nil
                      Just c  -> Rest (p :| []) c
                _  -> More p Nothing $ fmap (flip (intersectionWith f) $ Rest (fromList ps) y) xs
   | otherwise = Nil
-intersectionWith f (Rest tss@(t:|ts) x) (More p my ys)
+intersectionWith f (Rest (t:|ts) x) (More p my ys)
   | t == p = case ts of
                [] -> case f <$> Just x <*> my of
                      Nothing -> Nil
@@ -203,7 +197,7 @@
 prune = go
   where
     go Nil = Nil
-    go xx@(Rest ts x) = xx
+    go xx@(Rest _ _) = xx
     go (More t Nothing xs) =
       case cleaned xs of
         [Nil]       -> Nil
@@ -221,5 +215,5 @@
                       ys -> ys
       where
         removeNils' []       =     []
-        removeNils' (Nil:xs) =     removeNils' xs
-        removeNils' (x:xs)   = x : removeNils' xs
+        removeNils' (Nil:xs') =     removeNils' xs'
+        removeNils' (x:xs')   = x : removeNils' xs'
diff --git a/test/Data/TrieSpec.hs b/test/Data/TrieSpec.hs
--- a/test/Data/TrieSpec.hs
+++ b/test/Data/TrieSpec.hs
@@ -11,6 +11,7 @@
 import Data.Trie.List  as L
 import Data.Tree (Tree (..))
 import Data.Trie.Map   as M hiding (insert)
+import Data.Trie.HashMap as HM hiding (insert)
 import Data.Trie.Knuth as K hiding (lookup, insert, delete)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
@@ -32,6 +33,10 @@
     [ QC.testProperty "lookup after insertion should exist" lookupInsertExists_Map
     , QC.testProperty "lookup after deletion should not exist" lookupDeleteNotExists_Map
     ]
+  , testGroup "Data.Trie.HashMap"
+    [ QC.testProperty "lookup after insertion should exist" lookupInsertExists_HashMap
+    , QC.testProperty "lookup after deletion should not exist" lookupDeleteNotExists_HashMap
+    ]
   , testGroup "Data.Trie.Knuth"
     [ QC.testProperty "lookup after insertion should exist" lookupInsertExists_Knuth
     , QC.testProperty "lookup after deletion should not exist" lookupDeleteNotExists_Knuth
@@ -57,6 +62,9 @@
 lookupInsertExists_Map :: NonEmpty Int -> Int -> MapTrie Int Int -> Bool
 lookupInsertExists_Map = lookupInsertExists
 
+lookupInsertExists_HashMap :: NonEmpty Int -> Int -> HashMapTrie Int Int -> Bool
+lookupInsertExists_HashMap = lookupInsertExists
+
 lookupInsertExists_Knuth :: NonEmpty Int -> Int -> KnuthTrie Int Int -> Bool
 lookupInsertExists_Knuth = lookupInsertExists
 
@@ -74,6 +82,9 @@
 
 lookupDeleteNotExists_Map :: NonEmpty Int -> MapTrie Int Int -> Bool
 lookupDeleteNotExists_Map = lookupDeleteNotExists
+
+lookupDeleteNotExists_HashMap :: NonEmpty Int -> HashMapTrie Int Int -> Bool
+lookupDeleteNotExists_HashMap = lookupDeleteNotExists
 
 lookupDeleteNotExists_Knuth :: NonEmpty Int -> KnuthTrie Int Int -> Bool
 lookupDeleteNotExists_Knuth = lookupDeleteNotExists
diff --git a/tries.cabal b/tries.cabal
--- a/tries.cabal
+++ b/tries.cabal
@@ -1,5 +1,5 @@
 Name:                   tries
-Version:                0.0.2
+Version:                0.0.3
 Author:                 Athan Clark <athan.clark@gmail.com>
 Maintainer:             Athan Clark <athan.clark@gmail.com>
 License:                BSD3
@@ -10,59 +10,71 @@
 Build-Type:             Simple
 Category:               Data, Tree
 
+flag Lookup
+  Description:          Benchmark the lookup functions
+  Default:              False
+
 Library
   Default-Language:     Haskell2010
   HS-Source-Dirs:       src
   GHC-Options:          -Wall
   Exposed-Modules:      Data.Trie.Class
+                        Data.Trie.HashMap
                         Data.Trie.Knuth
                         Data.Trie.List
                         Data.Trie.Map
                         Data.Trie.Pseudo
-  Build-Depends:        base >= 4.6 && < 5
-                      , containers
+  Build-Depends:        base >= 4.8 && < 5
                       , bytestring
                       , bytestring-trie
-                      , semigroups
-                      , rose-trees >= 0.0.2
                       , composition
                       , composition-extra >= 2.0.0
+                      , containers
+                      , deepseq
+                      , hashable
                       , keys
+--                      , TernaryTrees
+                      , rose-trees >= 0.0.2.1
+                      , semigroups
                       , sets >= 0.0.5
+                      , unordered-containers
                       , QuickCheck
                       , quickcheck-instances
-                      , mtl
-                      , criterion
 
 Test-Suite test
   Type:                 exitcode-stdio-1.0
   Default-Language:     Haskell2010
   Hs-Source-Dirs:       src
                       , test
-  Ghc-Options:          -Wall
+  Ghc-Options:          -Wall -threaded
   Main-Is:              Spec.hs
   Other-Modules:        Data.TrieSpec
                         Data.Trie.Class
+                        Data.Trie.HashMap
                         Data.Trie.Knuth
                         Data.Trie.List
                         Data.Trie.Map
                         Data.Trie.Pseudo
   Build-Depends:        base
-                      , tries
-                      , tasty
-                      , tasty-quickcheck
-                      , QuickCheck
-                      , quickcheck-instances
-                      , containers
                       , bytestring
                       , bytestring-trie
-                      , semigroups
-                      , rose-trees
                       , composition
                       , composition-extra
+                      , deepseq
+--                      , TernaryTrees
+                      , containers
+                      , hashable
                       , keys
-                      , sets
                       , mtl
+                      , rose-trees
+                      , sets
+                      , semigroups
+                      , tries
+                      , tasty
+                      , tasty-quickcheck
+                      , unordered-containers
+                      , QuickCheck
+                      , quickcheck-instances
 
 
 Benchmark bench
@@ -70,28 +82,72 @@
   Default-Language:     Haskell2010
   Hs-Source-Dirs:       src
                       , bench
-  Ghc-Options:          -Wall
+  Ghc-Options:          -Wall -threaded
   Main-Is:              Bench.hs
   Other-Modules:        Data.Trie.Class
+                        Data.Trie.HashMap
                         Data.Trie.Knuth
                         Data.Trie.List
                         Data.Trie.Map
                         Data.Trie.Pseudo
+                        Build
   Build-Depends:        base
+                      , bytestring
+                      , bytestring-trie
+                      , composition
+                      , composition-extra
+                      , containers
+                      , deepseq
+--                      , TernaryTrees
+                      , hashable
+                      , keys
+                      , mtl
+                      , rose-trees
+                      , semigroups
+                      , sets
                       , tries
+                      , unordered-containers
+                      , QuickCheck
+                      , quickcheck-instances
                       , criterion
-                      , containers
+
+Benchmark bench-lookup
+  if flag(Lookup)
+    Buildable: True
+  else
+    Buildable: False
+  Type:                 exitcode-stdio-1.0
+  Default-Language:     Haskell2010
+  Hs-Source-Dirs:       src
+                      , bench
+  Ghc-Options:          -Wall -threaded
+  Main-Is:              BenchLookup.hs
+  Other-Modules:        Data.Trie.Class
+                        Data.Trie.HashMap
+                        Data.Trie.Knuth
+                        Data.Trie.List
+                        Data.Trie.Map
+                        Data.Trie.Pseudo
+                        Build
+  Build-Depends:        base
                       , bytestring
                       , bytestring-trie
-                      , semigroups
-                      , rose-trees
                       , composition
                       , composition-extra
+                      , containers
+                      , deepseq
+--                      , TernaryTrees
+                      , hashable
                       , keys
-                      , sets
                       , mtl
+                      , rose-trees
+                      , semigroups
+                      , sets
+                      , tries
+                      , unordered-containers
                       , QuickCheck
                       , quickcheck-instances
+                      , criterion
 
 Source-Repository head
   Type:                 git