diff --git a/identifiers.cabal b/identifiers.cabal
--- a/identifiers.cabal
+++ b/identifiers.cabal
@@ -1,5 +1,5 @@
 name:                identifiers
-version:             0.3.0.0
+version:             0.3.1.0
 synopsis:            Numeric identifiers for values.
 description:         Useful for situations where repeated-storage requirements
                      of values become too costly.
diff --git a/src/Data/TrieMap.hs b/src/Data/TrieMap.hs
--- a/src/Data/TrieMap.hs
+++ b/src/Data/TrieMap.hs
@@ -4,25 +4,40 @@
 import Data.List (foldl')
 import Prelude hiding (lookup)
 
+--                                      Deep           Wide
+data TrieMap k v  = Root              !(TrieNode k v)
+                  | ValueRoot     !v  !(TrieNode k v)
+                  | FlatRoot      !v
+                  | EmptyRoot
+                  deriving (Show, Eq)
 
-data TrieMap k v = Map !(Maybe v) [TrieNode k v] deriving (Show, Eq)
-data TrieNode k v = EmptyNode !k    [TrieNode k v]
-                  | ValueNode !k !v [TrieNode k v]
-                  | ValueEnd  !k !v
+data TrieNode k v = Node        !k    !(TrieNode k v) !(TrieNode k v)
+                  | Vertical    !k    !(TrieNode k v)
+                  | Horizontal  !k                    !(TrieNode k v)
+                  | ValueVert   !k !v !(TrieNode k v)
+                  | ValueHoriz  !k !v                 !(TrieNode k v)
+                  | ValueNode   !k !v !(TrieNode k v) !(TrieNode k v)
+                  | ValueBottom !k !v
                   deriving (Show, Eq)
 
 instance (NFData k, NFData v) => NFData (TrieMap k v) where
-    rnf (Map v ns) = rnf (v, ns)
+    rnf (Root a)        = rnf a
+    rnf (ValueRoot a b) = rnf (a, b)
+    rnf (FlatRoot a)    = rnf a
+    rnf (EmptyRoot)     = rnf ()
 
 instance (NFData k, NFData v) => NFData (TrieNode k v) where
-    rnf (EmptyNode k ns)   = rnf (k, ns)
-    rnf (ValueNode k v ns) = rnf (k, v, ns)
-    rnf (ValueEnd k v)     = rnf (k, v)
-
+    rnf (Node a b c)        = rnf (a, b, c)
+    rnf (Vertical a b)      = rnf (a, b)
+    rnf (Horizontal a b)    = rnf (a, b)
+    rnf (ValueVert a b c)   = rnf (a, b, c)
+    rnf (ValueHoriz a b c)  = rnf (a, b, c)
+    rnf (ValueNode a b c d) = rnf (a, b, c, d)
+    rnf (ValueBottom a b)   = rnf (a, b)
 
 -- | The empty TrieMap
 empty :: TrieMap k v
-empty = Map Nothing []
+empty = EmptyRoot
 
 -- | Create map from list of associations
 fromList :: Eq k => [([k], v)] -> TrieMap k v
@@ -31,73 +46,93 @@
 
 -- | Search for a value in the map
 lookup :: Eq k => TrieMap k v -> [k] -> Maybe v
-lookup (Map Nothing []) _  = Nothing
-lookup (Map v _)        [] = v
-lookup (Map _ ns)       ks = go ns ks where
-    go []                       _                        = Nothing
-    go _                        []                       = Nothing
-    go (EmptyNode j next:ns')   ks'@(k:ks'') | j == k    = go next ks''
-                                             | otherwise = go ns' ks'
-    go (ValueNode j v _:ns')    ks'@[k]      | j == k    = Just v
-                                             | otherwise = go ns' ks'
-    go (ValueNode j _ next:ns') ks'@(k:ks'') | j == k    = go next ks''
-                                             | otherwise = go ns' ks'
-    go (ValueEnd j v:ns')       ks'@[k]      | j == k    = Just v
-                                             | otherwise = go ns' ks'
-    go (ValueEnd j _:ns')       ks'@(k:_)    | j == k    = Nothing
-                                             | otherwise = go ns' ks'
+lookup (EmptyRoot)        _  = Nothing
+lookup (FlatRoot v)       [] = Just v
+lookup (FlatRoot _)       _  = Nothing
+lookup (ValueRoot v _)    [] = Just v
+lookup (ValueRoot _ next) ks = lookupNode next ks
+lookup (Root _)           [] = Nothing
+lookup (Root next)        ks = lookupNode next ks
 
+-- | Recursive lookup from nodes down (excluding root)
+lookupNode :: Eq k => TrieNode k v -> [k] -> Maybe v
+lookupNode _        [] = Nothing
+lookupNode (Node k down right) ks@(x:xs)
+    | x == k    = lookupNode down  xs
+    | otherwise = lookupNode right ks
+lookupNode (ValueNode k v down right) ks@(x:xs)
+    | null xs && x == k = Just v
+    |            x == k = lookupNode down  xs
+    | otherwise         = lookupNode right ks
+lookupNode (ValueBottom k v) (x:xs)
+    | null xs && x == k = Just v
+    | otherwise         = Nothing
+lookupNode (Vertical k down) (x:xs)
+    | null xs || x /= k = Nothing
+    | otherwise         = lookupNode down xs
+lookupNode (Horizontal k right) ks@(x:_)
+    | x /= k            = Nothing
+    | otherwise         = lookupNode right ks
+lookupNode (ValueVert k v down) (x:xs)
+    | null xs && x == k = Just v
+    |            x == k = lookupNode down xs
+    | otherwise         = Nothing
+lookupNode (ValueHoriz k v right) ks@(x:xs)
+    | null xs && x == k = Just v
+    |            x == k = Nothing
+    | otherwise         = lookupNode right ks
 
+-- | Unsafe indexing into TrieMap
 (!) :: Eq k => TrieMap k v -> [k] -> v
 m ! k | Just v <- lookup m k = v
-      | otherwise = error "oh noes!"
+      | otherwise = error "Key not found in TrieMap"
 
 -- | Insert new word into map
 insert :: Eq k => TrieMap k v -> [k] -> v -> TrieMap k v
-insert (Map Nothing ns) [] v  = Map (Just v) ns
-insert m                [] _  = m       -- Don't clobber existing values
-insert (Map v ns)       ks v' = Map v $ go ns ks where
-    go _  []        = []    -- Not sure how we got here; try to handle anyway.
-    go [] (x:[])    = [ValueEnd x v']
-    go [] (x:xs)    = [EmptyNode x (go [] xs)]
-
-    -- Last key unit vs ValueNode
-    go ns''@(n@(ValueNode j _ _):ns') xs'@[x]
-        | j == x    = ns''                          -- No clobber
-        | otherwise = n : go ns' xs'
-
-    -- Last key unit vs EmptyNode
-    go (n@(EmptyNode j next):ns') xs'@[x]
-        | j == x    = ValueNode j v' next : ns'     -- Promote to ValueNode
-        | otherwise = n : go ns' xs'
-
-    -- Last key unit vs ValueEnd
-    go ns''@(n@(ValueEnd j _):ns') xs@[x]
-        | j == x    = ns''                          -- No clobber
-        | otherwise = n : go ns' xs
-
-    -- Key unit vs ValueNode
-    go (n@(ValueNode j w next):ns') xs'@(x:xs)
-        | j == x    = ValueNode j w (go next xs) : ns'  -- Decend into node
-        | otherwise = n : go ns' xs'
-
-    -- Key unit vs EmptyNode
-    go (n@(EmptyNode j next):ns') xs'@(x:xs)
-        | j == x    = EmptyNode j (go next xs) : ns'    -- Decend into node
-        | otherwise = n : go ns' xs'
-
-    -- Key unit vs ValueEnd
-    go (n@(ValueEnd j w):ns') xs'@(x:xs)
-        | j == x    = ValueNode j w (go [] xs) : ns'    -- Promote to ValueNode
-        | otherwise = n : go ns' xs'
+insert (Root down)        [] v = ValueRoot v down
+insert (ValueRoot _ down) [] v = ValueRoot v down
+insert (FlatRoot _)       [] v = FlatRoot v
+insert EmptyRoot          [] v = FlatRoot v
+insert (Root down)        ks v = Root        $ insertNode down ks v
+insert (ValueRoot w down) ks v = ValueRoot w $ insertNode down ks v
+insert (FlatRoot w)       ks v = ValueRoot w $ createNode ks v
+insert EmptyRoot          ks v = Root        $ createNode ks v
 
+-- | Insert value into existing tree of nodes
+insertNode :: Eq k => TrieNode k v -> [k] -> v -> TrieNode k v
+insertNode _ [] _ = error "insertNode should never be called with an empty key"
+insertNode (Node k down right) ks@(x:xs) v
+    | null xs && x == k = ValueNode k v down right
+    |            x == k = Node k (insertNode down xs v) right
+    | otherwise         = Node k down $ insertNode right ks v
+insertNode (Vertical k down) ks@(x:xs) v 
+    | null xs && x == k = ValueVert k v down
+    |            x == k = Vertical k $ insertNode down xs v
+    | otherwise         = Node k down $ createNode ks v
+insertNode (Horizontal k right) ks@(x:xs) v
+    | null xs && x == k = ValueHoriz k v right
+    |            x == k = Node k (createNode xs v) right
+    | otherwise         = Horizontal k $ insertNode right ks v
+insertNode (ValueVert k w down) ks@(x:xs) v
+    | null xs && x == k = ValueVert k v down
+    |            x == k = ValueVert k w $ insertNode down xs v
+    | otherwise         = ValueNode k w down $ createNode ks v
+insertNode (ValueHoriz k w right) ks@(x:xs) v
+    | null xs && x == k = ValueHoriz k v right
+    |            x == k = ValueNode k w (createNode xs v) right
+    | otherwise         = ValueHoriz k w $ insertNode right ks v
+insertNode (ValueNode k w down right) ks@(x:xs) v
+    | null xs && x == k = ValueNode k v down right
+    |            x == k = ValueNode k w (insertNode down xs v) right
+    | otherwise         = ValueNode k w down (insertNode right ks v)
+insertNode (ValueBottom k w) ks@(x:xs) v
+    | null xs && x == k = ValueBottom k v
+    |            x == k = ValueVert k w $ createNode xs v
+    | otherwise         = ValueHoriz k w $ createNode ks v
 
-{-
-insert []                (k:[]) v           = [R k (Just v) []]
-insert []                (k:ks) v           = [R k Nothing (insert [] ks v)]
-insert (R j _ next : rs) (k:[]) v' | j == k = R j (Just v') next : rs
-insert (R j v next : rs) (k:ks) v' | j == k = R j v (insert next ks v') : rs
-insert xs                []     _           = xs
-insert (r:rows)          ks     v           = r : insert rows ks v
--}
+-- | Create node (or series of nodes) to point to value
+createNode :: Eq k => [k] -> v -> TrieNode k v
+createNode [] _ = error "createNode should never be called with an empty key"
+createNode (k:[]) v = ValueBottom k v
+createNode (k:ks) v = Vertical k $ createNode ks v