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.5.0
+Version:                0.5.1
 Author:                 Athan Clark <athan.clark@gmail.com>
 Maintainer:             Athan Clark <athan.clark@gmail.com>
 License:                BSD3
@@ -19,11 +19,16 @@
                         Data.Trie.Pred.Base.Step
                         Data.Trie.Pred.Interface
                         Data.Trie.Pred.Interface.Types
+                        Data.Trie.Pred.Mutable
+                        Data.Trie.Pred.Mutable.Morph
   Build-Depends:        base >= 4.8 && < 5
                       , composition-extra >= 2.0.0
+                      , containers
                       , hashable
+                      , hashtables
                       , mtl
                       , poly-arity >= 0.0.7
+                      , pred-set
                       , semigroups
                       , tries >= 0.0.4
                       , unordered-containers
diff --git a/src/Data/Trie/Pred/Base/Step.hs b/src/Data/Trie/Pred/Base/Step.hs
--- a/src/Data/Trie/Pred/Base/Step.hs
+++ b/src/Data/Trie/Pred/Base/Step.hs
@@ -31,11 +31,11 @@
 
 -- * Single Predicated Step
 
-data PredStep k c s a = forall r. PredStep
+data PredStep k c s a = forall r. Typeable r => PredStep
   { -- | Unique identifier for the predicate - used for combination
     predTag  :: !k
   , -- | The predicate, existentially quantified in the successful result @r@
-    predPred :: !(s -> Maybe r) 
+    predPred :: !(s -> Maybe r)
   , -- | The result function, capturing the quantified result @r@ and turning
     --   it into a top-level variable @a@.
     predData :: !(Maybe (r -> a))
@@ -65,7 +65,9 @@
                else PredStep i p mx $! delete (NE.fromList ts) xs)
       (p t)
 
-singletonPred :: Monoid (c s (r -> a)) => k -> (s -> Maybe r) -> (r -> a) -> PredStep k c s a
+singletonPred :: ( Monoid (c s (r -> a))
+                 , Typeable r
+                 ) => k -> (s -> Maybe r) -> (r -> a) -> PredStep k c s a
 singletonPred i p x = PredStep i p (Just x) mempty
 
 
diff --git a/src/Data/Trie/Pred/Interface.hs b/src/Data/Trie/Pred/Interface.hs
--- a/src/Data/Trie/Pred/Interface.hs
+++ b/src/Data/Trie/Pred/Interface.hs
@@ -90,7 +90,8 @@
 
 newtype PTBuilderT k v m a = PTBuilderT
   { runPTBuilderT :: StateT (RootedPredTrie k v) m a
-  } deriving (Functor, Applicative, Monad, MonadTrans, MonadState (RootedPredTrie k v))
+  } deriving ( Functor, Applicative, Monad, MonadTrans
+             , MonadState (RootedPredTrie k v))
 
 instance ( Monad m
          , Eq k
@@ -128,7 +129,7 @@
             -> childContent
             -> PTBuilderT k resultContent m ()
 insert !ts !vl =
-  modify' ((singleton ts vl) <>)
+  modify' (singleton ts vl <>)
 
 
 insertHere :: ( Monad m
@@ -149,7 +150,7 @@
             -> PTBuilderT k resultContent m ()
 prefix !ts cs = do
   trie <- lift (execPTBuilderT cs)
-  modify' ((extrude ts trie) <>)
+  modify' (extrude ts trie <>)
 
 
 lookup :: ( Eq k
diff --git a/src/Data/Trie/Pred/Interface/Types.hs b/src/Data/Trie/Pred/Interface/Types.hs
--- a/src/Data/Trie/Pred/Interface/Types.hs
+++ b/src/Data/Trie/Pred/Interface/Types.hs
@@ -51,6 +51,7 @@
 import qualified Data.HashMap.Lazy as HM
 import Data.Hashable
 import Data.Function.Poly
+import Data.Typeable
 
 import Data.String (IsString (..))
 
@@ -92,6 +93,7 @@
 -- | Existentially quantified case
 instance ( Eq k
          , Hashable k
+         , Typeable r
          ) => Extend (PathChunk k ('Just r)) (RootedPredTrie k (r -> a)) (RootedPredTrie k a) where
   extend (Pred i q) (RootedPredTrie mx xs) = RootedPredTrie Nothing $
     PredTrie mempty (PredSteps [PredStep i q mx xs])
diff --git a/src/Data/Trie/Pred/Mutable.hs b/src/Data/Trie/Pred/Mutable.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Pred/Mutable.hs
@@ -0,0 +1,262 @@
+{-# LANGUAGE
+    ExistentialQuantification
+  #-}
+
+module Data.Trie.Pred.Mutable where
+
+import Prelude hiding (lookup)
+import Data.Monoid
+import Data.Maybe (fromMaybe)
+import Data.Foldable (foldlM)
+import Data.Typeable
+
+import Data.List.NonEmpty hiding (insert)
+
+import           Data.HashTable.ST.Basic (HashTable)
+import qualified Data.HashTable.ST.Basic as HT
+import           Data.PredSet.Mutable (PredSet, PredKey)
+import qualified Data.PredSet.Mutable as HS
+import Control.Monad.ST
+import Data.Hashable
+
+
+-- * Tail
+
+data PredStep s k r = forall a. Typeable a => PredStep
+  { predPred :: {-# UNPACK #-} !(PredKey s k a)
+  , predData :: !(Maybe (a -> r))
+  , predSub  :: !(HashTableTrie s k (a -> r))
+  }
+
+data RawValue s k a = RawValue
+  { rawValue    :: !(Maybe a)
+  , rawChildren :: !(HashTableTrie s k a)
+  }
+
+data HashTableTrie s k a = HashTableTrie
+  { rawValues :: {-# UNPACK #-} !(HashTable s k (RawValue s k a))
+  , predPreds :: [PredStep s k a]
+  }
+
+
+new :: ST s (HashTableTrie s k a)
+new = flip HashTableTrie [] <$> HT.new
+
+insert :: ( Eq k
+          , Hashable k
+          ) => NonEmpty k
+            -> a
+            -> HashTableTrie s k a
+            -> ST s (HashTableTrie s k a)
+insert (k:|ks) x ref@(HashTableTrie raw _) =
+  case ks of
+    [] -> do
+      mx' <- HT.lookup raw k
+      case mx' of
+        Nothing -> do
+          children <- new
+          HT.insert raw k $! RawValue (Just x) children
+          pure ref
+        Just (RawValue _ children) -> do
+          HT.insert raw k $! RawValue (Just x) children
+          pure ref
+    (k':ks') -> do
+      mx' <- HT.lookup raw k
+      case mx' of
+        Nothing -> do
+          children <- new
+          children' <- insert (k':|ks') x children
+          HT.insert raw k $! RawValue Nothing children'
+          pure ref
+        Just (RawValue mx children) -> do
+          children' <- insert (k':|ks') x children
+          HT.insert raw k $! RawValue mx children'
+          pure ref
+
+
+lookup :: ( Eq k
+          , Hashable k
+          , Typeable s
+          , Typeable k
+          ) => PredSet s k
+            -> NonEmpty k
+            -> HashTableTrie s k a
+            -> ST s (Maybe a)
+lookup predSet (k:|ks) (HashTableTrie raw preds) = do
+  mx <- HT.lookup raw k
+  case mx of
+    Just (RawValue mx' children) ->
+      case ks of
+        []       -> pure mx'
+        (k':ks') -> lookup predSet (k':|ks') children
+    Nothing ->
+      let -- go :: Typeable t => Maybe t -> PredStep s k t -> ST s (Maybe t)
+          go solution@(Just _) _                          = pure solution
+          go Nothing (PredStep predKey mHandler children) = do
+            mx' <- HS.lookup predKey k predSet
+            case mx' of
+              Nothing -> pure Nothing
+              Just x  ->
+                case ks of
+                  [] ->
+                    pure $! ($ x) <$> mHandler
+                  (k':ks') -> do
+                    mf <- lookup predSet (k':|ks') children
+                    pure $! ($ x) <$> mf
+      in  foldlM go Nothing preds
+
+
+match :: ( Eq k
+         , Hashable k
+         , Typeable s
+         , Typeable k
+         ) => PredSet s k
+           -> NonEmpty k
+           -> HashTableTrie s k a
+           -> ST s (Maybe (NonEmpty k, a, [k]))
+match predSet (k:|ks) (HashTableTrie raw preds) = do
+  mLit <- goLit raw
+  case mLit of
+    Just _  -> pure mLit
+    Nothing ->
+      let go solution@(Just _) _ = pure solution
+          go Nothing pred        = goPred pred
+      in  foldlM go Nothing preds
+  where
+    goLit xs = do
+      mx' <- HT.lookup raw k
+      case mx' of
+        Nothing -> pure Nothing
+        Just (RawValue mx children) ->
+          let mFoundHere = (\x -> (k:|[], x, ks)) <$> mx
+              prependAncestry (pre,x,suff) = (k:|toList pre,x,suff)
+          in case ks of
+            [] -> pure mFoundHere
+            (k':ks') -> do
+              mFoundThere <- match predSet (k':|ks') children
+              pure $! getFirst $
+                   First (prependAncestry <$> mFoundThere)
+                <> First mFoundHere
+
+    goPred (PredStep predKey mx children) = do
+      mr' <- HS.lookup predKey k predSet
+      case mr' of
+        Nothing -> pure Nothing
+        Just r  ->
+          let mFoundHere = (\x -> (k:|[], x r, ks)) <$> mx
+              prependAncestryAndApply (pre,f,suff) =
+                (k:|toList pre,f r,suff)
+          in case ks of
+            [] -> pure mFoundHere
+            (k':ks') -> do
+              mFoundThere <- match predSet (k':|ks') children
+              pure $! getFirst $
+                   First (prependAncestryAndApply <$> mFoundThere)
+                <> First mFoundHere
+
+matches :: ( Eq k
+           , Hashable k
+           , Typeable s
+           , Typeable k
+           ) => PredSet s k
+             -> NonEmpty k
+             -> HashTableTrie s k a
+             -> ST s [(NonEmpty k, a, [k])]
+matches predSet (k:|ks) (HashTableTrie raw preds) = do
+  mLit <- goLit raw
+  case mLit of
+    Just lit -> pure lit
+    Nothing ->
+      let go solution@(Just _) _ = pure solution
+          go Nothing pred        = goPred pred
+      in  fromMaybe [] <$> foldlM go Nothing preds
+  where
+    goLit xs = do
+      mx' <- HT.lookup raw k
+      case mx' of
+        Nothing -> pure Nothing
+        Just (RawValue mx children) ->
+          let mFoundHere = (\x -> [(k:|[], x, ks)]) <$> mx
+              prependAncestry (pre,x,suff) = (k:|toList pre, x, suff)
+          in case ks of
+            [] -> pure mFoundHere
+            (k':ks') ->
+              case mFoundHere of
+                Nothing -> pure Nothing
+                Just foundHere -> do
+                  foundThere <- matches predSet (k':|ks') children
+                  pure . Just $! foundHere ++ (prependAncestry <$> foundThere)
+
+    goPred (PredStep predKey mx children) = do
+      mr <- HS.lookup predKey k predSet
+      case mr of
+        Nothing -> pure Nothing
+        Just r  ->
+          let mFoundHere = (\f -> [(k:|[],f r,ks)]) <$> mx
+              prependAncestryAndApply (pre,f,suff) =
+                (k:|toList pre,f r,suff)
+          in case ks of
+            [] -> pure mFoundHere
+            (k':ks') ->
+              case mFoundHere of
+                Nothing -> pure Nothing
+                Just foundHere -> do
+                  foundThere <- matches predSet (k':|ks') children
+                  pure . Just $! foundHere ++ (prependAncestryAndApply <$> foundThere)
+
+
+-- * Rooted
+
+data RootedHashTableTrie s k a = RootedHashTableTrie
+  { rootedBase    :: !(Maybe a)
+  , rootedSub     :: !(HashTableTrie s k a)
+  , rootedPredSet :: {-# UNPACK #-} !(PredSet s k)
+  }
+
+newR :: ST s (RootedHashTableTrie s k a)
+newR = RootedHashTableTrie Nothing <$> new <*> HS.new
+
+lookupR :: ( Eq k
+           , Hashable k
+           , Typeable s
+           , Typeable k
+           , Typeable a
+           ) => [k]
+             -> RootedHashTableTrie s k a
+             -> ST s (Maybe a)
+lookupR [] (RootedHashTableTrie mx _ _) = pure mx
+lookupR (k:ks) (RootedHashTableTrie _ xs predSet) = lookup predSet (k:|ks) xs
+
+matchR :: ( Eq k
+          , Hashable k
+          , Typeable s
+          , Typeable k
+          , Typeable a
+          ) => [k]
+            -> RootedHashTableTrie s k a
+            -> ST s (Maybe ([k],a,[k]))
+matchR [] (RootedHashTableTrie mx _ _) =
+  pure $! (\x -> ([],x,[])) <$> mx
+matchR (k:ks) (RootedHashTableTrie mx xs predSet) = do
+  mFoundThere <- match predSet (k:|ks) xs
+  pure $! getFirst $
+      First ((\(pre,x,suff) -> (toList pre,x,suff)) <$> mFoundThere)
+   <> First ((\x -> ([],x,k:ks)) <$> mx)
+
+
+matchesR :: ( Eq k
+            , Hashable k
+            , Typeable s
+            , Typeable k
+            , Typeable a
+            ) => [k]
+              -> RootedHashTableTrie s k a
+              -> ST s [([k],a,[k])]
+matchesR [] (RootedHashTableTrie mx _ _) =
+  pure $! fromMaybe [] $ (\x -> [([],x,[])]) <$> mx
+matchesR (k:ks) (RootedHashTableTrie mx xs predSet) = do
+  foundThere <- matches predSet (k:|ks) xs
+  pure $! foundHere ++ (allowRoot <$> foundThere)
+  where
+    foundHere = fromMaybe [] $ (\x -> [([],x,k:ks)]) <$> mx
+    allowRoot (pre,x,suff) = (toList pre,x,suff)
diff --git a/src/Data/Trie/Pred/Mutable/Morph.hs b/src/Data/Trie/Pred/Mutable/Morph.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Trie/Pred/Mutable/Morph.hs
@@ -0,0 +1,137 @@
+module Data.Trie.Pred.Mutable.Morph where
+
+import Data.Trie.Pred.Mutable as M
+import Data.Trie.Pred.Base as B
+import Data.Trie.Pred.Base.Step as B
+
+import Data.PredSet.Mutable as HS
+import Data.Trie.HashMap as HMT
+import           Data.HashMap.Lazy (HashMap)
+import qualified Data.HashMap.Lazy as HM
+import           Data.HashTable.ST.Basic (HashTable)
+import qualified Data.HashTable.ST.Basic as HT
+import qualified Data.Map.Strict as Map
+
+import Control.Monad.ST
+import Data.Foldable (foldlM)
+import Data.Typeable
+import Data.Dynamic
+import Data.Hashable
+import Data.Proxy
+import Data.STRef
+
+
+toMutableRooted :: ( Eq k
+                   , Hashable k
+                   , Ord k
+                   , Typeable s
+                   , Typeable k
+                   , Typeable a
+                   ) => RootedPredTrie k a
+                     -> ST s (RootedHashTableTrie s k a)
+toMutableRooted (RootedPredTrie mx xs) = do
+  predSet <- HS.new
+  xs' <- toMutable predSet xs
+  pure $! RootedHashTableTrie mx xs' predSet
+
+toMutable :: ( Eq k
+             , Hashable k
+             , Ord k
+             , Typeable s
+             , Typeable k
+             , Typeable a
+             ) => PredSet s k
+               -> PredTrie k a
+               -> ST s (HashTableTrie s k a)
+toMutable predSet xs = do
+  predRefs <- newSTRef Map.empty
+  toHashTableTrie predRefs predSet xs
+
+
+toHashTableTrie :: ( Eq k
+                   , Hashable k
+                   , Ord k
+                   , Typeable s
+                   , Typeable k
+                   , Typeable a
+                   ) => STRef s (HMap k)
+                     -> PredSet s k
+                     -> PredTrie k a
+                     -> ST s (HashTableTrie s k a)
+toHashTableTrie predRefs predSet (PredTrie (HashMapStep raw) (PredSteps preds)) = do
+  raw' <- toHashTable =<< traverse (toRawValue predRefs predSet) raw
+  preds' <- mapM (toMutablePredStep predRefs predSet) preds
+  pure (HashTableTrie raw' preds')
+
+toRawValue :: ( Eq k
+              , Hashable k
+              , Ord k
+              , Typeable s
+              , Typeable k
+              , Typeable a
+              ) => STRef s (HMap k)
+                -> PredSet s k
+                -> HashMapChildren PredTrie k a
+                -> ST s (RawValue s k a)
+toRawValue predRefs predSet (HashMapChildren mx mchildren) = do
+  children <- case mchildren of
+                Nothing -> M.new
+                Just xs -> toHashTableTrie predRefs predSet xs
+  pure (RawValue mx children)
+
+toHashTable :: ( Eq k
+               , Hashable k
+               ) => HM.HashMap k a
+                 -> ST s (HashTable s k a)
+toHashTable xs = do
+  fresh <- HT.new
+  foldlM (\() (k,v) -> HT.insert fresh k v) () (HM.toList xs)
+  pure fresh
+
+toMutablePredStep :: ( Ord k
+                     , Eq k
+                     , Hashable k
+                     , Typeable s
+                     , Typeable k
+                     , Typeable a
+                     ) => STRef s (HMap k)
+                       -> PredSet s k
+                       -> B.PredStep k PredTrie k a
+                       -> ST s (M.PredStep s k a)
+toMutablePredStep predRefs predSet (B.PredStep tag pred mx children) = do
+  predRefs' <- readSTRef predRefs
+  mPredKey <- lookupPredKey tag (pure pred) predRefs'
+  predKey  <- case mPredKey of
+                Nothing -> do predKey' <- HS.insert pred predSet
+                              writeSTRef predRefs (insertPredKey tag predKey' predRefs')
+                              pure predKey'
+                Just x  -> pure x
+  children' <- toHashTableTrie predRefs predSet children
+  pure (M.PredStep predKey mx children')
+
+
+-- Wiiiked abuse of the type system
+
+type HMap k = Map.Map k Dynamic
+
+insertPredKey :: ( Ord k'
+                 , Typeable s
+                 , Typeable k
+                 , Typeable a
+                 ) => k'
+                   -> PredKey s k a
+                   -> HMap k'
+                   -> HMap k'
+insertPredKey k pred = Map.insert k (toDyn pred)
+
+lookupPredKey :: ( Ord k'
+                 , Typeable s
+                 , Typeable k
+                 , Typeable a
+                 ) => k'
+                   -> ST s (k -> Maybe a)
+                   -> HMap k'
+                   -> ST s (Maybe (PredKey s k a))
+lookupPredKey k pred xs = do
+  pred' <- pred
+  pure $! fromDynamic =<< Map.lookup k xs