diff --git a/bench/Build.hs b/bench/Build.hs
--- a/bench/Build.hs
+++ b/bench/Build.hs
@@ -41,34 +41,35 @@
 
 
 genMapTrie :: Int -> MapTrie Int Int
-genMapTrie n = MapTrie $ MapStep $ Map.singleton 0
-  (Just 0, Just $ MapTrie $ MapStep $ genMapTree n)
+genMapTrie n = MapTrie . MapStep . Map.singleton 0 $
+  MapChildren (Just 0) $ Just . MapTrie . MapStep $ genMapTree n
   where
-    genMapTree :: Int -> Map.Map Int (Maybe Int, Maybe (MapTrie Int Int))
+    genMapTree :: Int -> Map.Map Int (MapChildren 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)
-                                 )
+          pure $ Map.singleton i $
+                   MapChildren (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)
+genHashMapTrie n = HashMapTrie $ HashMapStep $ HMap.singleton 0 $
+  HashMapChildren (Just 0) $ Just . HashMapTrie . HashMapStep $ genHashMapTree n
   where
-    genHashMapTree :: Int -> HMap.HashMap Int (Maybe Int, Maybe (HashMapTrie Int Int))
+    genHashMapTree :: Int -> HMap.HashMap Int (HashMapChildren 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)
-                                  )
+        return $ HMap.singleton i $
+                   HashMapChildren (Just 0) $
+                     if n <= 1
+                     then Nothing
+                     else Just . HashMapTrie . HashMapStep $ genHashMapTree (floor $ fromIntegral n / 2)
+
 
 
 -- | This one is ordered largest first
diff --git a/src/Data/Trie/HashMap.hs b/src/Data/Trie/HashMap.hs
--- a/src/Data/Trie/HashMap.hs
+++ b/src/Data/Trie/HashMap.hs
@@ -8,6 +8,7 @@
   , MultiParamTypeClasses
   , FlexibleInstances
   , FlexibleContexts
+  , UndecidableInstances
   , TypeFamilies
   , TupleSections
   #-}
@@ -35,8 +36,31 @@
 
 -- * One Step
 
+data HashMapChildren c p a = HashMapChildren
+  { hashMapNode     :: Maybe a
+  , hashMapChildren :: !(Maybe (c p a))
+  } deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data, Typeable)
+
+instance ( NFData (c p a)
+         , NFData p
+         , NFData a
+         ) => NFData (HashMapChildren c p a)
+
+instance ( Arbitrary a
+         , Arbitrary p
+         , Arbitrary (c p a)
+         ) => Arbitrary (HashMapChildren c p a) where
+  arbitrary = HashMapChildren <$> arbitrary <*> scale (\n -> floor $ fromIntegral n / 2) arbitrary
+
+instance ( Monoid (c p a)
+         ) => Monoid (HashMapChildren c p a) where
+  mempty = HashMapChildren Nothing Nothing
+  mappend (HashMapChildren mx mxs) (HashMapChildren my mys) =
+    HashMapChildren (getLast $ Last mx <> Last my)
+                    (mxs <> mys)
+
 newtype HashMapStep c p a = HashMapStep
-  { unHashMapStep :: HM.HashMap p (Maybe a, Maybe (c p a))
+  { unHashMapStep :: HM.HashMap p (HashMapChildren c p a)
   } deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data, Typeable)
 
 instance ( NFData (c p a)
@@ -54,7 +78,7 @@
     where
       go n = do
         i <- choose (0,n)
-        xs <- replicateM i $ (,) <$> arbitrary <*> resize (floor (fromIntegral n / 2 :: Float)) arbitrary
+        xs <- replicateM i $ (,) <$> arbitrary <*> resize (floor $ fromIntegral n / 2) arbitrary
         return $ HashMapStep $ HM.fromList xs
 
 instance ( Hashable p
@@ -62,13 +86,21 @@
          , 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
+    | F.null ps = hashMapNode
+                =<< HM.lookup p xs
+    | otherwise = lookup (NE.fromList ps)
+                =<< hashMapChildren
+                =<< 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
+    | F.null ps = let mxs = hashMapChildren =<< HM.lookup p xs
+                  in  HashMapStep $! HM.insert p (HashMapChildren Nothing $! mxs) xs
+    | otherwise = let (HashMapChildren mx mxs) =
+                        fromMaybe (HashMapChildren Nothing Nothing)
+                                  (HM.lookup p xs)
+                  in  HashMapStep $! HM.insert p
+                                       (HashMapChildren mx $!
+                                         delete (NE.fromList ps) <$> mxs)
+                                       xs
 
 insert :: ( Hashable p
           , Eq p
@@ -76,27 +108,35 @@
           , 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
+  | F.null ps = let mxs = hashMapChildren =<< HM.lookup p xs
+                in  HashMapStep $! HM.insert p
+                                     (HashMapChildren (Just x) $! mxs)
+                                     xs
+  | otherwise = let mx  = hashMapNode =<< HM.lookup p xs
+                    xs' = fromMaybe mempty $! hashMapChildren =<< HM.lookup p xs
+                in  HashMapStep $! HM.insert p
+                                     (HashMapChildren mx $
+                                       Just $! Data.Trie.Class.insert (NE.fromList ps) x xs')
+                                     xs
 
+{-# INLINEABLE insert #-}
 
 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)
+  mappend (HashMapStep xs) (HashMapStep ys) =
+    HashMapStep $ HM.unionWith (<>) xs ys
 
 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)
+singleton p x = HashMapStep $! HM.singleton p $ HashMapChildren (Just x) Nothing
 
+{-# INLINEABLE singleton #-}
+
 -- * Fixpoint of Steps
 
 
@@ -108,8 +148,8 @@
 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
+  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
@@ -126,12 +166,14 @@
         ) => HashMapTrie p a -> [NonEmpty p]
 keys (HashMapTrie (HashMapStep xs)) =
   let ks = HM.keys xs
-  in F.concatMap go ks
+  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'
+    go k = let (HashMapChildren _ mxs) = fromJust $ HM.lookup k xs
+           in  map (k :|) $ fromMaybe [] $ do
+                 xs' <- mxs
+                 return $ NE.toList <$> keys xs'
 
+{-# INLINEABLE keys #-}
 
 elems :: HashMapTrie p a -> [a]
 elems = F.toList
@@ -143,16 +185,17 @@
            , 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
+  | F.null ps = hashMapChildren =<< HM.lookup p xs
+  | otherwise = subtrie (NE.fromList ps) =<< hashMapChildren =<< HM.lookup p xs
 
+{-# INLINEABLE subtrie #-}
 
 -- 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
+  (HashMapChildren mx mxs) <- HM.lookup p xs
   let mFoundHere = (p:|[],, ps) <$> mx
   if F.null ps
   then mFoundHere
@@ -160,13 +203,15 @@
                             pure (p:|NE.toList pre, y, suff))
                <> First mFoundHere
 
+{-# INLINEABLE match #-}
+
 -- | 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
+  let (HashMapChildren mx mxs) = fromMaybe mempty $ HM.lookup p xs
       foundHere = fromMaybe [] $ (\x -> [(p:|[],x,ps)]) <$> mx
   in if F.null ps
   then foundHere
@@ -174,5 +219,6 @@
        in  foundHere ++ (prependAncestry <$> rs)
   where prependAncestry (pre,x,suff) = (p:| NE.toList pre,x,suff)
 
+{-# INLINEABLE matches #-}
 
 
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
@@ -17,12 +17,12 @@
 import Data.Trie.Class
 
 import Prelude hiding (lookup, null)
-import qualified Data.Map as Map
+import qualified Data.Map           as Map
 import           Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 
-import qualified Data.Key as K
-import qualified Data.Foldable as F
+import qualified Data.Key           as K
+import qualified Data.Foldable      as F
 import Data.Maybe
 import Data.Monoid
 import Control.Monad
@@ -37,8 +37,32 @@
 
 -- * One Step
 
+data MapChildren c p a = MapChildren
+  { mapNode     :: Maybe a
+  , mapChildren :: !(Maybe (c p a))
+  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic, Data, Typeable)
+
+instance ( NFData (c p a)
+         , NFData p
+         , NFData a
+         ) => NFData (MapChildren c p a)
+
+instance ( Arbitrary a
+         , Arbitrary p
+         , Arbitrary (c p a)
+         ) => Arbitrary (MapChildren c p a) where
+  arbitrary = MapChildren <$> arbitrary <*> scale (\n -> floor $ fromIntegral n / 2) arbitrary
+
+instance ( Monoid (c p a)
+         ) => Monoid (MapChildren c p a) where
+  mempty = MapChildren Nothing Nothing
+  mappend (MapChildren mx mxs) (MapChildren my mys) =
+    MapChildren (getLast $ Last mx <> Last my)
+                (mxs <> mys)
+
+
 newtype MapStep c p a = MapStep
-  { unMapStep :: Map.Map p (Maybe a, Maybe (c p a))
+  { unMapStep :: Map.Map p (MapChildren c p a)
   } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic, Data, Typeable)
 
 instance ( NFData (c p a)
@@ -46,26 +70,32 @@
          , NFData a
          ) => NFData (MapStep c p a)
 
-instance (Arbitrary a, Arbitrary p, Arbitrary (c p a), Ord p) => Arbitrary (MapStep c p a) where
+instance ( Arbitrary a
+         , Arbitrary p
+         , Arbitrary (c p a)
+         , Ord p
+         ) => Arbitrary (MapStep 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
+        xs <- replicateM i $ (,) <$> arbitrary <*> resize (floor $ fromIntegral n / 2) arbitrary
         return $ MapStep $ Map.fromList xs
 
 
 -- | No insertion instance - requires children nodes to be a monoid. Use @Data.Trie.Map.insert@
 -- instead.
-instance (Ord p, Trie NonEmpty p c) => Trie NonEmpty p (MapStep c) where
+instance ( Ord p
+         , Trie NonEmpty p c
+         ) => Trie NonEmpty p (MapStep c) where
   lookup (p:|ps) (MapStep xs)
-    | F.null ps = fst =<< Map.lookup p xs
-    | otherwise = lookup (NE.fromList ps) =<< snd =<< Map.lookup p xs
+    | F.null ps = mapNode =<< Map.lookup p xs
+    | otherwise = lookup (NE.fromList ps) =<< mapChildren =<< 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
-    | otherwise = let (mx,mxs) = fromMaybe (Nothing,Nothing) $ Map.lookup p xs
-                  in  MapStep $ Map.insert p (mx, delete (NE.fromList ps) <$> mxs) xs
+    | F.null ps = let mxs = mapChildren =<< Map.lookup p xs
+                  in  MapStep $! Map.insert p (MapChildren Nothing mxs) xs
+    | otherwise = let (MapChildren mx mxs) = fromMaybe (MapChildren Nothing Nothing) $! Map.lookup p xs
+                  in  MapStep $! Map.insert p (MapChildren mx $! delete (NE.fromList ps) <$> mxs) xs
 
 
 insert :: ( Ord p
@@ -73,34 +103,38 @@
           , Monoid (c p a)
           ) => NonEmpty p -> a -> MapStep c p a -> MapStep c p a
 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
-                    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
+  | F.null ps = let mxs = mapChildren =<< Map.lookup p xs
+                in  MapStep $! Map.insert p (MapChildren (Just x) mxs) xs
+  | otherwise = let mx  = mapNode =<< Map.lookup p xs
+                    xs' = fromMaybe mempty (mapChildren =<< Map.lookup p xs)
+                in  MapStep $! Map.insert p (MapChildren mx $ Just $! Data.Trie.Class.insert (NE.fromList ps) x xs') xs
 
+{-# INLINEABLE insert #-}
 
-instance (Ord s, Monoid (c s a)) => Monoid (MapStep c s a) where
+
+instance ( Ord s
+         , Monoid (c s a)
+         ) => Monoid (MapStep c s a) where
   mempty = empty
-  mappend (MapStep xs) (MapStep ys) = MapStep $ Map.unionWith go xs ys
-    where go (mx,mxs) (my,mys) = (getLast $ Last mx <> Last my, mxs <> mys)
+  mappend (MapStep xs) (MapStep ys) =
+    MapStep $ Map.unionWith (<>) xs ys
 
 empty :: MapStep c s a
 empty = MapStep Map.empty
 
 singleton :: s -> a -> MapStep c s a
-singleton p x = MapStep $ Map.singleton p (Just x, Nothing)
+singleton p x = MapStep $ Map.singleton p $ MapChildren (Just x) Nothing
 
 
 -- * Fixpoint of Steps
 
 newtype MapTrie s a = MapTrie
-  { unMapTrie :: MapStep MapTrie s a }
-  deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Monoid, Arbitrary)
+  { unMapTrie :: MapStep MapTrie s a
+  } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Monoid, Arbitrary)
 
 instance Ord s => Trie NonEmpty s MapTrie where
-  lookup ts (MapTrie xs) = lookup ts xs
-  delete ts (MapTrie xs) = MapTrie $ delete ts xs
+  lookup ts (MapTrie xs)   = lookup ts xs
+  delete ts (MapTrie xs)   = MapTrie $ delete ts xs
   insert ts x (MapTrie xs) = MapTrie $ Data.Trie.Map.insert ts x xs
 
 type instance K.Key (MapTrie s) = NonEmpty s
@@ -114,11 +148,14 @@
 -- * Conversion
 
 keys :: Ord s => MapTrie s a -> [NonEmpty s]
-keys (MapTrie (MapStep xs)) = let ks = Map.keys xs
-                              in F.concatMap go ks
-  where go k = let (_,mxs) = fromJust $ Map.lookup k xs
-               in fmap (k :|) $ fromMaybe [] $ do xs' <- mxs
-                                                  return $ NE.toList <$> keys xs'
+keys (MapTrie (MapStep xs)) =
+  let ks = Map.keys xs
+  in F.concatMap go ks
+  where
+    go k = let (MapChildren _ mxs) = fromJust $ Map.lookup k xs
+           in  fmap (k :|) $ fromMaybe [] $ do
+                 xs' <- mxs
+                 return $ NE.toList <$> keys xs'
 
 elems :: MapTrie s a -> [a]
 elems = F.toList
@@ -127,13 +164,13 @@
 
 subtrie :: Ord s => NonEmpty s -> MapTrie s a -> Maybe (MapTrie s a)
 subtrie (p:|ps) (MapTrie (MapStep xs))
-  | F.null ps = snd =<< Map.lookup p xs
-  | otherwise = subtrie (NE.fromList ps) =<< snd =<< Map.lookup p xs
+  | F.null ps = mapChildren =<< Map.lookup p xs
+  | otherwise = subtrie (NE.fromList ps) =<< mapChildren =<< Map.lookup p xs
 
 -- lookupNearest ~ match
 match :: Ord s => NonEmpty s -> MapTrie s a -> Maybe (NonEmpty s, a, [s])
 match (p:|ps) (MapTrie (MapStep xs)) = do
-  (mx,mxs) <- Map.lookup p xs
+  (MapChildren mx mxs) <- Map.lookup p xs
   let mFoundHere = do x <- mx
                       return (p:|[], x, ps)
   if F.null ps then mFoundHere
@@ -145,7 +182,9 @@
 -- query, in order of the path walked from the root to the furthest point.
 matches :: Ord s => NonEmpty s -> MapTrie s a -> [(NonEmpty s, a, [s])]
 matches (p:|ps) (MapTrie (MapStep xs)) =
-  let (mx,mxs) = fromMaybe (Nothing,Nothing) $ Map.lookup p xs
+  let (MapChildren mx mxs) =
+          fromMaybe (MapChildren Nothing Nothing) $
+            Map.lookup p xs
       foundHere = fromMaybe [] $ do x <- mx
                                     return [(p:|[],x,ps)]
   in if F.null ps then foundHere
diff --git a/tries.cabal b/tries.cabal
--- a/tries.cabal
+++ b/tries.cabal
@@ -1,5 +1,5 @@
 Name:                   tries
-Version:                0.0.3
+Version:                0.0.4
 Author:                 Athan Clark <athan.clark@gmail.com>
 Maintainer:             Athan Clark <athan.clark@gmail.com>
 License:                BSD3
