diff --git a/fixfile.cabal b/fixfile.cabal
--- a/fixfile.cabal
+++ b/fixfile.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                   fixfile
-version:                0.5.0.0
+version:                0.6.0.0
 synopsis:               File-backed recursive data structures.
 homepage:               https://github.com/revnull/fixfile
 license:                LGPL-3
@@ -40,10 +40,13 @@
   default-language:     Haskell2010
   exposed-modules:      Data.FixFile
                        ,Data.FixFile.BTree
+                       ,Data.FixFile.BTree.Light
                        ,Data.FixFile.Set
                        ,Data.FixFile.Tree23
                        ,Data.FixFile.Trie
+                       ,Data.FixFile.Trie.Light
   other-modules:        Data.FixFile.Fixed
+                       ,Data.FixFile.Null
   ghc-options:          -Wall
 
 Test-Suite test-fixfile
diff --git a/src/Data/FixFile.hs b/src/Data/FixFile.hs
--- a/src/Data/FixFile.hs
+++ b/src/Data/FixFile.hs
@@ -31,10 +31,13 @@
  -}
 
 module Data.FixFile (
-                      -- * Fixed point combinators
+                     -- * Fixed point combinators
                       Fixed(..)
                      ,Fix(..)
                      ,Stored
+                     -- * Null typeclasses
+                     ,Null(..)
+                     ,Null1(..)
                      -- * F-Algebras
                      ,CataAlg
                      ,CataMAlg
@@ -89,18 +92,20 @@
                      ,getFull
                      ) where
 
-import Prelude hiding (sequence, mapM, lookup)
+import Prelude hiding (sequence, mapM, lookup, null)
 
 import Control.Concurrent.MVar
 import Control.Exception
 import Control.Lens hiding (iso, para)
-import Control.Monad.Except
-import qualified Control.Monad.RWS as RWS
+import Control.Monad.Except hiding (mapM_)
+import qualified Control.Monad.RWS as RWS hiding (mapM_)
 import Data.Binary
-import Data.ByteString.Lazy as BSL
+import Data.ByteString as BS hiding (null, empty)
+import Data.ByteString.Lazy as BSL hiding (null, empty)
 import Data.Dynamic
 import Data.Hashable
-import Data.HashTable.IO
+import Data.HashTable.IO hiding (mapM_)
+import Data.IORef
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Monoid
@@ -111,6 +116,7 @@
 import System.IO.Unsafe
 
 import Data.FixFile.Fixed
+import Data.FixFile.Null
 
 type HashTable k v = CuckooHashTable k v
 
@@ -141,8 +147,9 @@
             return (c', val)
         _ -> return (c, val)
 
-getCachedOrStored :: Typeable f => Ptr f -> IO (f (Ptr f)) -> MVar Caches ->
-    IO (f (Ptr f))
+getCachedOrStored :: (Null1 f, Typeable f) => Ptr f -> IO (f (Ptr f)) ->
+    MVar Caches -> IO (f (Ptr f))
+getCachedOrStored (Ptr 0) _ _ = return empty1
 getCachedOrStored p m cs = do
     mval <- withCache cs (cacheLookup p)
     case mval of
@@ -165,8 +172,37 @@
 
 type Pos = Word64
 
+data WriteBuffer = WB ([BS.ByteString] -> [BS.ByteString]) Pos Pos
+
+bufferFlushSize :: Word64
+bufferFlushSize = 10485760 -- 10 MB
+
+initWB :: Handle -> IO WriteBuffer
+initWB h = do
+    hSeek h SeekFromEnd 0
+    p <- fromIntegral <$> hTell h
+    return $ WB id p p
+
+writeWB :: Binary a => a -> WriteBuffer -> (WriteBuffer, Pos, Bool)
+writeWB a (WB bsf st end) = sbs `seq` wb where
+    wb = (WB bsf' st end', end, end' - st > bufferFlushSize)
+    enc = encode a
+    len = fromIntegral $ BSL.length enc
+    len' = encode (len :: Word32)
+    sbs = BSL.toStrict (len' <> enc)
+    end' = end + 4 + fromIntegral len
+    bsf' = bsf . (sbs:)
+
+flushBuffer :: WriteBuffer -> Handle -> IO WriteBuffer
+flushBuffer (WB bsf st en) h = do
+    hSeek h SeekFromEnd 0
+    p <- fromIntegral <$> hTell h
+    when (p /= st) $ fail "WriteBuffer position failure."
+    mapM_ (BS.hPut h) (bsf [])
+    return (WB id en en)
+
 -- FFH is a FixFile Handle. This is an internal data structure.
-data FFH = FFH (MVar Handle) (MVar Caches)
+data FFH = FFH (MVar Handle) (IORef WriteBuffer) (MVar Caches)
 
 getRawBlock :: Binary a => Handle -> Pos -> IO a
 getRawBlock h p = do
@@ -174,30 +210,28 @@
     (sb :: Word32) <- decode <$> (BSL.hGet h 4)
     decode <$> BSL.hGet h (fromIntegral sb)
 
-getBlock :: (Typeable f, Binary (f (Ptr f))) => Ptr f -> FFH -> IO (f (Ptr f))
-getBlock p@(Ptr pos) (FFH mh mc) = getCachedOrStored p readFromFile mc where
+getBlock :: Fixable f => Ptr f -> FFH -> IO (f (Ptr f))
+getBlock p@(Ptr pos) (FFH mh _ mc) = getCachedOrStored p readFromFile mc where
     readFromFile = withMVar mh $ flip getRawBlock pos
 
-putRawBlock' :: Binary a => a -> Handle -> IO Pos
-putRawBlock' a h = do
-    hSeek h SeekFromEnd 0
-    p <- fromIntegral <$> hTell h
-    let enc  = encode a
-        len  = fromIntegral $ BSL.length enc
-        len' = encode (len :: Word32)
-        enc' = mappend len' enc
-    BSL.hPut h enc'
+putRawBlock :: Binary a => Bool -> a -> FFH -> IO Pos
+putRawBlock fl a (FFH mh wb _) = do
+    wb' <- readIORef wb
+    let (wb'', p, fl') = writeWB a wb'
+    if (fl' || fl)
+        then do
+            wb''' <- withMVar mh (flushBuffer wb'')
+            writeIORef wb wb'''
+        else writeIORef wb wb''
     return p
 
-putRawBlock :: Binary a => a -> FFH -> IO Pos
-putRawBlock a (FFH mh _) = withMVar mh $ putRawBlock' a
-
-putBlock :: (Typeable f, Binary (f (Ptr f))) => (f (Ptr f)) -> FFH ->
-    IO (Ptr f)
-putBlock a h@(FFH _ mc) = putRawBlock a h >>= cacheBlock . Ptr where
-    cacheBlock p = do
-        withCache_ mc (cacheInsert p a)
-        return p
+putBlock :: Fixable f => f (Ptr f) -> FFH -> IO (Ptr f)
+putBlock a h@(FFH _ _ mc) 
+    | null a = return (Ptr 0)
+    | otherwise = putRawBlock False a h >>= cacheBlock . Ptr where
+        cacheBlock p = do
+            withCache_ mc (cacheInsert p a)
+            return p
 
 {- | 
     'Stored' is a fixed-point combinator of 'f' in Transaction 's'.
@@ -217,8 +251,7 @@
 
 -- | Write the stored data to disk so that the on-disk representation 
 --   matches what is in memory.
-sync :: (Traversable f, Binary (f (Ptr f)), Typeable f) =>
-    FFH -> Stored s f -> IO (Ptr f)
+sync :: (Fixable f) => FFH -> Stored s f -> IO (Ptr f)
 sync h = commit where
     commit (Memory r) = do
         r' <- mapM commit r
@@ -243,7 +276,7 @@
     hashWithSalt x (Ptr y) = hashWithSalt x y
 
 -- | A Constraint for data that can be used with a 'Ref'
-type Fixable f = (Traversable f, Binary (f (Ptr f)), Typeable f)
+type Fixable f = (Traversable f, Binary (f (Ptr f)), Typeable f, Null1 f)
 
 {- |
     'FixTraverse' is a class based on 'Traverse' but taking an argument of kind
@@ -253,7 +286,7 @@
     -- | Given a function that maps from @a@ to @b@ over @'Fixable' g@ in the
     --   'Applicative' @f@, traverse over @t@ changing the fixed-point
     --   combinator from @a@ to @b@.
-    sequenceAFix :: Applicative f =>
+    traverseFix :: Applicative f =>
         (forall g. Fixable g => a g -> f (b g)) -> t a -> f (t b)
 
 {- | 
@@ -265,15 +298,15 @@
 type Root r = (FixTraverse r, Binary (r Ptr))
 
 readRoot :: Root r => r Ptr -> Transaction r' s (r (Stored s))
-readRoot = sequenceAFix readPtr where
+readRoot = traverseFix readPtr where
     readPtr p = withHandle $ flip readStoredLazy p
 
 writeRoot :: Root r => r (Stored s) -> Transaction r' s (r Ptr)
-writeRoot = sequenceAFix writeStored where
+writeRoot = traverseFix writeStored where
     writeStored s = withHandle $ flip sync s
 
 rootIso :: (Root r, Fixed g, Fixed h) => r g -> r h
-rootIso = runIdentity . sequenceAFix (Identity . iso)
+rootIso = runIdentity . traverseFix (Identity . iso)
 
 {- |
     A 'Ref' is a reference to a 'Functor' 'f' in the 'Fixed' instance of 'g'.
@@ -281,13 +314,13 @@
     This is an instance of 'Root' and acts to bridge between the 'Root' and
     the recursively defined data structure that is @('g' 'f')@.
 -}
-data Ref (f :: * -> *) (g :: (* -> *) -> *) = Ref { deRef :: g f }
+newtype Ref (f :: * -> *) (g :: (* -> *) -> *) = Ref { deRef :: g f }
     deriving (Generic)
 
 instance Binary (Ref f Ptr)
 
 instance Fixable f => FixTraverse (Ref f) where
-    sequenceAFix isoT (Ref a) = Ref <$> isoT a
+    traverseFix isoT (Ref a) = Ref <$> isoT a
 
 -- | Lens for accessing the value stored in a Ref
 ref :: Lens' (Ref f g) (g f)
@@ -334,8 +367,7 @@
 withHandle :: (FFH -> IO a) -> Transaction r s a
 withHandle f = Transaction $ RWS.ask >>= liftIO . f
 
-readStoredLazy :: (Traversable f, Binary (f (Ptr f)), Typeable f) =>
-    FFH -> Ptr f -> IO (Stored s f)
+readStoredLazy :: Fixable f => FFH -> Ptr f -> IO (Stored s f)
 readStoredLazy h p = do
     f <- getBlock p h
     let fcons = Cached p
@@ -383,13 +415,13 @@
     f `finally` releaseWriteLock ff
 
 readHeader :: FFH -> IO (Pos)
-readHeader (FFH mh _) = withMVar mh $ \h -> do
+readHeader (FFH mh _ _) = withMVar mh $ \h -> do
     hSeek h AbsoluteSeek 0
     decode <$> BSL.hGet h 8
 
 updateHeader :: Pos -> Transaction r s ()
 updateHeader p = do
-    withHandle $ \(FFH mh _) -> 
+    withHandle $ \(FFH mh _ _) -> 
         withMVar mh $ \h -> do
             hSeek h AbsoluteSeek 0
             BSL.hPut h (encode p)
@@ -411,11 +443,12 @@
 createFixFileHandle :: Root r =>
     r Fix -> FilePath -> Handle -> IO (FixFile r)
 createFixFileHandle initial path h = do
-    ffh <- FFH <$> newMVar h <*> newMVar M.empty
     BSL.hPut h (encode (0 :: Pos))
+    wb <- initWB h
+    ffh <- FFH <$> newMVar h <*> newIORef wb <*> newMVar M.empty
     let t = runRT $ do
             dr <- writeRoot $ rootIso initial
-            (withHandle $ putRawBlock dr) >>= updateHeader
+            (withHandle $ putRawBlock True dr) >>= updateHeader
             Transaction . RWS.tell . Last . Just $ dr
     (_,_,root') <- RWS.runRWST t ffh undefined
     let Just root = getLast root'
@@ -436,7 +469,8 @@
 openFixFileHandle :: Binary (r Ptr) => FilePath -> Handle ->
     IO (FixFile r)
 openFixFileHandle path h = do
-    ffh <- FFH <$> newMVar h <*> newMVar M.empty
+    wb <- initWB h
+    ffh <- FFH <$> newMVar h <*> newIORef wb <*> newMVar M.empty
     root <- readHeader ffh >>= getRawBlock h 
     ffhmv <- newMVar (ffh, root)
     FixFile path ffhmv <$> newMVar ()
@@ -447,7 +481,7 @@
 -}
 closeFixFile :: FixFile r -> IO ()
 closeFixFile (FixFile path tmv _) = do
-    (FFH mh _, _) <- takeMVar tmv
+    (FFH mh _ _, _) <- takeMVar tmv
     h <- takeMVar mh
     hClose h
     putMVar mh $ error (path ++ " is closed.")
@@ -482,7 +516,7 @@
         let t' = readRoot root >>= RWS.put >> t >>= save
             save a = do
                 dr <- RWS.get >>= writeRoot
-                (withHandle $ putRawBlock dr) >>= updateHeader
+                (withHandle $ putRawBlock True dr) >>= updateHeader
                 Transaction . RWS.tell . Last . Just $ dr
                 return a
         (a, root') <- RWS.evalRWST (runRT t') ffh undefined
@@ -511,7 +545,7 @@
             save l@(Left _) = return l
             save r@(Right _) = do
                 dr <- RWS.get >>= writeRoot
-                (withHandle $ putRawBlock dr) >>= updateHeader
+                (withHandle $ putRawBlock True dr) >>= updateHeader
                 Transaction . RWS.tell . Last . Just $ dr
                 return r
         (a, root') <- RWS.evalRWST (runRT t') ffh undefined
@@ -545,16 +579,22 @@
 
         BSL.hPut dh (encode (Ptr 0))
 
-        root' <- sequenceAFix (copyPtr ffh dh) root
+        wb <- initWB dh
+        wb' <- newIORef wb
+        dffh <- FFH <$> newMVar dh <*> return wb' <*> newMVar M.empty
 
-        r' <- putRawBlock' root' dh 
-        
+        root' <- traverseFix (copyPtr ffh dffh) root
+
+        r' <- putRawBlock True root' dffh 
+
         hSeek dh AbsoluteSeek 0
         BSL.hPut dh (encode r')
 
         putMVar mv mv'
 
-    copyPtr ffh h = hyloM (flip getBlock ffh) ((Ptr <$>) . flip putRawBlock' h)
+    copyPtr ffh h = hyloM
+        (flip getBlock ffh)
+        ((Ptr <$>) . flip (putRawBlock False) h)
 
 {- |
     It's potentially useful to copy the contents of a 'FixFile' to a new
diff --git a/src/Data/FixFile/BTree.hs b/src/Data/FixFile/BTree.hs
--- a/src/Data/FixFile/BTree.hs
+++ b/src/Data/FixFile/BTree.hs
@@ -17,7 +17,6 @@
 module Data.FixFile.BTree (BTree
                           ,createBTreeFile
                           ,openBTreeFile
-                          ,empty
                           ,depth
                           ,insertBTree
                           ,insertBTreeT
@@ -52,6 +51,11 @@
   | Node Word32 (V.Vector (k, a))
     deriving (Read, Show, Generic, Functor, Foldable, Traversable, Typeable)
 
+instance Null1 (BTree n k v) where
+    empty1 = Empty
+    null1 Empty = True
+    null1 _ = False
+
 instance (Binary k, Binary v, Binary a) => Binary (BTree n k v a) where
     put Empty = putWord8 0x45
     put (Value v) = putWord8 0x56 >> put v
@@ -68,14 +72,10 @@
 
 -- | Compute the depth of a 'BTree' 
 depth :: Fixed g => g (BTree n k v) -> Int
-depth = cata phi where
-    phi Empty = 0
-    phi (Value _) = 1
-    phi (Node d _) = fromIntegral $ 1 + d
-
--- | An empty 'BTree' 
-empty :: Fixed g => g (BTree n k v)
-empty = inf Empty
+depth = dep . outf where
+    dep Empty = 0
+    dep (Value _) = 1
+    dep (Node d _) = fromIntegral d
 
 value :: Fixed g => v -> g (BTree n k v)
 value = inf . Value
diff --git a/src/Data/FixFile/BTree/Light.hs b/src/Data/FixFile/BTree/Light.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/FixFile/BTree/Light.hs
@@ -0,0 +1,364 @@
+{-# LANGUAGE DeriveGeneric, DeriveFunctor, DeriveFoldable, DeriveTraversable,
+    DeriveDataTypeable, DataKinds, KindSignatures, TypeFamilies,
+    TupleSections #-}
+
+{- |
+    Module      :  Data.FixFile.BTree.Light
+    Copyright   :  (C) 2016 Rev. Johnny Healey
+    License     :  LGPL-3
+    Maintainer  :  Rev. Johnny Healey <rev.null@gmail.com>
+    Stability   :  experimental
+    Portability :  unknown
+
+    This is a BTree data type that can be used with 'FixFile'. It can be used
+    as a key-value store where the same key can correspond to multiple values.
+    It supports logarithmic insert, lookup, and delete operations. This BTree
+    embeds values in the leaf nodes instead of providing them with distinct
+    leaf nodes. It is not recommended for use with large values.
+-}
+module Data.FixFile.BTree.Light (BTree
+                                ,createBTreeFile
+                                ,openBTreeFile
+                                ,depth
+                                ,insertBTree
+                                ,insertBTreeT
+                                ,lookupBTree
+                                ,lookupBTreeT
+                                ,filterBTree
+                                ,filterBTreeT
+                                ,deleteBTree
+                                ,deleteBTreeT
+                                ,partitionBTree
+                                ,toListBTree
+                                ,fromListBTree
+                                ) where
+
+import Control.Monad.Writer
+import Data.Binary
+import Data.Dynamic
+import qualified Data.Vector as V
+import GHC.Generics
+import GHC.TypeLits
+
+import Data.FixFile
+
+{- |
+    A 'Fixed' @('BTree' n k v)@ stores a BTree of key/value pairs.
+    'n' should be a 'Nat' and will be the maximum number of elements in each
+    branch of the 'BTree'.
+-}
+data BTree (n :: Nat) k v a =
+    Empty
+  | Node Word32 (Either (V.Vector (k, v)) (V.Vector (k, a)))
+    deriving (Read, Show, Generic, Functor, Foldable, Traversable, Typeable)
+
+instance Null1 (BTree n k v) where
+    empty1 = Empty
+    null1 Empty = True
+    null1 _ = False
+
+instance (Binary k, Binary v, Binary a) => Binary (BTree n k v a) where
+    put Empty = putWord8 0x45
+    put (Node _ (Left vec)) = do
+        putWord8 0x4c
+        put (V.length vec)
+        mapM_ put vec
+    put (Node d (Right vec)) = do
+        putWord8 0x52
+        put d
+        put (V.length vec)
+        mapM_ put vec
+    get = getWord8 >>= getBTree where
+        getBTree 0x45 = return Empty
+        getBTree 0x4c = (Node 1 . Left) <$>
+            (get >>= \n -> V.replicateM n get)
+        getBTree 0x52 = Node <$> get <*>
+            (get >>= \n -> Right <$> V.replicateM n get)
+        getBTree _ = error "Can't decode into BTree"
+
+-- | Compute the depth of a 'BTree' 
+depth :: Fixed g => g (BTree n k v) -> Int
+depth = dep . outf where
+    dep Empty = 0
+    dep (Node d _) = fromIntegral d
+
+node :: Fixed g => Word32 -> V.Vector (k, g (BTree n k v)) -> g (BTree n k v)
+node d = inf . Node d . Right
+
+leaf :: Fixed g => V.Vector (k, v) -> g (BTree n k v)
+leaf = inf . Node 1 . Left
+
+-- | Create a 'FixFile' storing a @('BTree' k v)@.
+--   The initial value is 'empty'.
+createBTreeFile :: (Typeable n, Binary k, Typeable k, Binary v, Typeable v) =>
+    FilePath -> IO (FixFile (Ref (BTree n k v)))
+createBTreeFile fp = createFixFile (Ref empty) fp
+
+-- | Open a 'FixFile' storing a @('BTree' k v)@.
+openBTreeFile :: (Binary k, Typeable k, Binary v, Typeable v) =>
+    FilePath -> IO (FixFile (Ref (BTree n k v)))
+openBTreeFile = openFixFile
+
+treeNodeSize :: KnownNat n => g (BTree n k v) -> Integer
+treeNodeSize = validate . natVal . p where
+    p :: g (BTree n k v) -> Proxy n
+    p _ = Proxy
+    validate n = if n < 2
+        then error "BTree branch size must be > 1."
+        else n
+
+splitRange :: Ord k => k -> V.Vector (k, v) -> (Int, Int)
+splitRange k vec = V.foldl' rangeSum (0,0) vec where
+    rangeSum t@(i1, i2) (k', _)
+        | k' < k = (i1 `seq` i1 + 1, i2 `seq` i2 + 1)
+        | k == k' = (i1, i2 `seq` i2 + 1)
+        | otherwise = t
+
+split3 :: (Int, Int) -> V.Vector a -> (V.Vector a, V.Vector a, V.Vector a)
+split3 (s1, s2) vec = (vl, vm, vr) where
+    (vm',vr) = V.splitAt s2 vec
+    (vl, vm) = V.splitAt s1 vm'
+
+data Insert n k v g =
+    Inserted k (g (BTree n k v))
+  | Split Word32 (k, (g (BTree n k v))) (k, (g (BTree n k v)))
+
+-- | Insert the value 'v' with the key 'k' into a 'Fixed' @('BTree' k v)@.
+insertBTree :: (KnownNat n, Ord k, Fixed g) => k -> v -> g (BTree n k v) ->
+    g (BTree n k v)
+insertBTree k v t = merge . para phi $ t where
+    merge (Inserted _ x) = x
+    merge (Split d lt rt) = node (d + 1) $ V.fromList [lt, rt]
+    nodeSize = fromIntegral $ treeNodeSize t
+
+    newNode d c cs
+        | c > nodeSize =
+            let (l, r) = V.splitAt (nodeSize `div` 2) cs
+                l' = V.force l
+                r' = V.force r
+                mini = fst . V.head
+            in Split d (mini l, node d l') (mini r, node d r')
+        | otherwise = 
+            Inserted (fst $ V.head cs) (node d cs)
+
+    newLeaf c cs
+        | c > nodeSize =
+            let (l, r) = V.splitAt (nodeSize `div` 2) cs
+                l' = V.force l
+                r' = V.force r
+                mini = fst . V.head
+            in Split 1 (mini l, leaf l') (mini r, leaf r')
+        | otherwise =
+            Inserted (fst $ V.head cs) (leaf cs)
+            
+    nodes = fmap (\(a,(b,_)) -> (a, b))
+
+    phi Empty = Inserted k $ leaf $ V.singleton (k, v)
+
+    phi (Node 1 (Left vec)) =
+        let (lt, eq, gt) = split3 (splitRange k vec) vec
+            newSize = 1 + V.length vec
+        in newLeaf newSize (V.concat [lt, eq, V.singleton (k, v), gt])
+    phi (Node _ (Left _)) = error "Malformed Leaf"
+
+    phi (Node d (Right vec)) = 
+        let (lt, eq, gt) = split3 (splitRange k vec) vec
+            lt' = nodes lt
+            eq' = nodes eq
+            gt' = nodes gt
+            currSize = V.length vec
+            (c, csf) = case (V.null eq, V.null lt) of
+                (False, _) ->
+                    (V.last eq, \n -> V.concat [lt', V.init eq', n, gt'])
+                (_, False) ->
+                    (V.last lt, \n -> V.concat [V.init lt', n, gt'])
+                _ -> (V.head gt, \n -> V.concat [n, V.tail gt'])
+        in case snd (snd c) of
+            Inserted k' n' ->
+                newNode d currSize (csf $ V.singleton (k', n'))
+            Split _ ls rs ->
+                newNode d (currSize + 1) (csf $ V.fromList [ls, rs])
+
+-- | 'Transaction' version of 'insertBTree'.
+insertBTreeT :: (KnownNat n, Ord k, Binary k, Binary v) => k -> v ->
+    Transaction (Ref (BTree n k v)) s ()
+insertBTreeT k v = alterT (insertBTree k v)
+
+-- | Lookup the values stored for the key 'k' in a 'Fixed' @('BTree' k v)@.
+lookupBTree :: (Ord k, Fixed g) => k -> g (BTree n k v) -> [v]
+lookupBTree k = ($ []) . cata phi where
+    phi Empty l = l
+
+    phi (Node 1 (Left vec)) l =
+        let (_, eq, _) = split3 (splitRange k vec) vec
+        in V.foldr ((:) . snd) l eq
+    phi (Node _ (Left _)) _ = error "Malformed Leaf"
+
+    phi (Node _ (Right vec)) l =
+        let (_, eq, _) = split3 (s1 - 1, s2) vec
+            (s1, s2) = splitRange k vec
+        in V.foldr (($) . snd) l eq
+
+-- | 'Transaction' version of 'lookupBTree'.
+lookupBTreeT :: (Ord k, Binary k, Binary v) => k ->
+    Transaction (Ref (BTree n k v)) s [v]
+lookupBTreeT k = lookupT (lookupBTree k)
+
+data Deleted n k v g =
+    Deleted k (g (BTree n k v))
+  | AllDeleted
+  | UnChanged
+
+-- | Filter items from a 'Fixed' @('BTree' k v)@ for a key 'k' that match
+--   the predicate.
+filterBTree :: (Ord k, Fixed g) => k -> (v -> Bool) ->
+    g (BTree n k v) -> g (BTree n k v)
+filterBTree k f t = deleted' . para phi $ t where
+    deleted' UnChanged = t
+    deleted' AllDeleted = empty
+    deleted' (Deleted _ x) = x
+
+    nodes = fmap (\(a, (b, _)) -> (a, b))
+
+    phi Empty = UnChanged
+
+    phi (Node 1 (Left vec)) =
+        let (lt, eq, gt) = split3 (splitRange k vec) vec
+            eq' = V.filter (f . snd) eq
+            vec' = V.concat [lt, eq', gt]
+            mink = fst (V.head vec')
+        in case (V.null vec', V.length eq /= V.length eq') of
+            (True, _) -> AllDeleted
+            (_, False) -> UnChanged
+            _ -> Deleted mink $ leaf vec'
+    phi (Node _ (Left _)) = error "Malformed Leaf"
+
+    phi (Node d (Right vec)) =
+        let (lt, eq, gt) = split3 (s1 - 1, s2) vec
+            (s1, s2) = splitRange k vec
+            lt' = nodes lt
+            gt' = nodes gt
+            (eq',del) = runWriter $ do
+                res <- flip V.filterM eq $ \(_, (_, a)) ->
+                    case a of
+                        UnChanged -> return True
+                        Deleted _ _ -> tell (Any True) >> return True
+                        AllDeleted -> tell (Any True) >> return False
+                forM res $ \(nk, (n, a)) -> do
+                    case a of
+                        UnChanged -> return (nk, n)
+                        Deleted nk' a' -> return (nk', a')
+                        AllDeleted -> error "AllDeleted?" -- should be unreachable
+            vec' = V.concat [lt', eq', gt']
+            mink = fst (V.head vec')
+        in case (V.null vec', getAny del) of
+            (True, _) -> AllDeleted
+            (_, False) -> UnChanged
+            _ -> Deleted mink $ node d vec'
+
+-- | 'Transaction' version of 'filterBTree'.
+filterBTreeT :: (Ord k, Binary k, Binary v) => k -> (v -> Bool) ->
+    Transaction (Ref (BTree n k v)) s ()
+filterBTreeT k f = alterT (filterBTree k f)
+
+-- | Delete all items for key 'k' from the 'Fixed' @('BTree' k v)@.
+deleteBTree :: (Ord k, Fixed g) => k -> g (BTree n k v) -> g (BTree n k v)
+deleteBTree k = filterBTree k (const False)
+
+-- | 'Transaction' version of 'deleteBTree'.
+deleteBTreeT :: (Ord k, Binary k, Binary v) => k ->
+    Transaction (Ref (BTree n k v)) s ()
+deleteBTreeT k = alterT (deleteBTree k)
+
+data SkewDir = L | R
+
+data Parted n k v g =
+    NoPart SkewDir
+  | Parted (k, (g (BTree n k v))) (k, (g (BTree n k v)))
+
+-- | Split a 'BTree' into two two 'BTree's with keys < 'k' and keys > 'k'.
+partitionBTree :: (Ord k, Fixed g) => k -> g (BTree n k v) ->
+    (g (BTree n k v), g (BTree n k v))
+partitionBTree k t = parted . para phi $ t where
+    parted (NoPart L) = (t, empty)
+    parted (NoPart R) = (empty, t)
+    parted (Parted (_, l) (_, r)) = (l, r)
+
+    nodes = fmap (\(a, (b, _)) -> (a, b))
+
+    phi Empty = NoPart L
+
+    phi (Node 1 (Left vec)) =
+        let (lt, gte) = V.splitAt s1 vec
+            (s1, _) = splitRange k vec
+            minkl = fst (V.head lt)
+            minkr = fst (V.head gte)
+        in case (V.null lt, V.null gte) of
+            (True, _) -> NoPart R
+            (_, True) -> NoPart L
+            _ -> Parted (minkl, leaf lt) (minkr, leaf gte)
+    phi (Node _ (Left _)) = error "Malformed Leaf"
+
+    phi (Node d (Right vec)) = 
+        let (lt, eq, gt) = split3 (s1 - 1, s1) vec
+            (s1, _) = splitRange k vec
+            lt' = nodes lt
+            eq' = nodes eq
+            gt' = nodes gt
+            minkl = if V.null lt then fst (V.head eq) else fst (V.head lt)
+            (_,(_,eqa)) = V.head eq
+        in case (V.null eq, V.null gt, eqa) of
+            (True, _, _) -> NoPart R
+            (_, True, NoPart L) -> NoPart L
+            (_, _, NoPart R) -> error "Malformed BTree"
+            (_, _, NoPart L) ->
+                let minkr = fst (V.head gt')
+                    ln = node d (V.concat [lt', eq'])
+                    rn = node d (V.force gt')
+                in Parted (minkl, ln) (minkr, rn)
+            (_, _, Parted tl tr@(prk, _)) ->
+                let ln = node d (V.concat [lt', V.singleton tl])
+                    rn = node d (V.concat [V.singleton tr, gt'])
+                in Parted (minkl, ln) (prk, rn)
+
+-- | Turn a 'Fixed' @('BTree' k v)@ into a list of key value tuples.
+toListBTree :: (Ord k, Fixed g) => g (BTree n k v) -> [(k,v)]
+toListBTree t = cata phi t [] where
+    phi Empty = id
+
+    phi (Node 1 (Left vec)) = foldMap (:) vec
+    phi (Node _ (Left _)) = error "Malformed Leaf"
+
+    phi (Node _ (Right vec)) = foldMap snd vec
+
+-- | Turn a list of key value tuples into a 'Fixed' @('BTree' k v)@.
+fromListBTree :: (KnownNat n, Ord k, Fixed g) => [(k,v)] -> g (BTree n k v)
+fromListBTree = foldr (uncurry insertBTree) empty
+
+instance FixedAlg (BTree n k v) where
+    type Alg (BTree n k v) = v
+
+instance FixedSub (BTree n k v) where
+    type Sub (BTree n k v) v v' = BTree n k v'
+
+instance FixedFunctor (BTree n k v) where
+    fmapF f = cata phi where
+        phi Empty = empty
+        phi (Node 1 (Left vec)) = leaf $ fmap (fmap f) vec
+        phi (Node _ (Left _)) = error "Malformed Leaf"
+        phi (Node c (Right vec)) = node c vec
+
+instance FixedFoldable (BTree n k v) where
+    foldMapF f = cata phi where
+        phi Empty = mempty
+        phi (Node 1 (Left vec)) = foldMap (f . snd) vec
+        phi (Node _ (Left _)) = error "Malformed Leaf"
+        phi (Node _ (Right vec)) = foldMap snd vec
+
+instance FixedTraversable (BTree n k v) where
+    traverseF f = cata phi where
+        phi Empty = pure empty
+        phi (Node 1 (Left vec)) = leaf <$> traverse (\(w, a) -> (w,) <$> f a) vec 
+        phi (Node _ (Left _)) = error "Malformed Leaf"
+        phi (Node c (Right vec)) = node c <$> traverse (\(w, a) -> (w,) <$> a) vec 
+
diff --git a/src/Data/FixFile/Fixed.hs b/src/Data/FixFile/Fixed.hs
--- a/src/Data/FixFile/Fixed.hs
+++ b/src/Data/FixFile/Fixed.hs
@@ -108,6 +108,7 @@
     'cata' applies a 'CataAlg' over a fixed point of a 'Functor'.
 -}
 cata :: (Functor f, Fixed g) => CataAlg f a -> g f -> a
+{-# INLINE[1] cata #-}
 cata f = f . fmap (cata f) . outf
 
 {-|
@@ -158,6 +159,8 @@
 hylo :: Functor f => AnaAlg f a -> CataAlg f b -> a -> b
 hylo f g = hylo' where hylo' = g . fmap hylo' . f
 
+{-# RULES "hylo" forall f g a. cata g (ana f a) = hylo f g a #-}
+
 {-|
     'hyloM' is a monadic hylomorphism.
 -}
@@ -165,6 +168,8 @@
 hyloM :: (Traversable f, Monad m) =>
     AnaMAlg m f a -> CataMAlg m f b -> a -> m b
 hyloM f g = hylo' where hylo' = g <=< mapM hylo' <=< f
+
+{-# RULES "hyloM" forall f g a. anaM f a >>= cataM g = hyloM f g a #-}
 
 {-|
     'FixedAlg' is a typeclass for describing the relationship between a
diff --git a/src/Data/FixFile/Null.hs b/src/Data/FixFile/Null.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/FixFile/Null.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+
+module Data.FixFile.Null (
+                          Null1(..)
+                         ,Null(..)
+                         ) where
+
+import Data.FixFile.Fixed
+
+{-|
+    'Null' is a typeclass for representing data that can be 'empty' as well as
+    the 'null' predicate that can determine if a piece of data is 'empty'.
+ -}
+class Null f where
+    empty :: f
+    null :: f -> Bool
+
+{-|
+    'Null1' is for expressing null types of kind @(* -> *)@.
+ -}
+class Null1 f where
+    empty1 :: f a
+    null1 :: f a -> Bool
+
+instance Null1 f => Null (f a) where
+    empty = empty1
+    null = null1
+
+instance Null1 Maybe where
+    empty1 = Nothing
+    null1 Nothing = True
+    null1 _ = False
+
+instance Null1 [] where
+    empty1 = []
+    null1 [] = True
+    null1 _ = False
+
+instance (Fixed g, Null1 f) => Null (g f) where
+    empty = inf empty1
+    null = null1 . outf
+
diff --git a/src/Data/FixFile/Set.hs b/src/Data/FixFile/Set.hs
--- a/src/Data/FixFile/Set.hs
+++ b/src/Data/FixFile/Set.hs
@@ -18,7 +18,6 @@
 module Data.FixFile.Set (Set
                          ,createSetFile
                          ,openSetFile
-                         ,empty
                          ,insertSet
                          ,insertSetT
                          ,deleteSet
@@ -48,9 +47,10 @@
 
 instance (Binary i, Binary a) => Binary (Set i a)
 
--- | An empty 'Set'.
-empty :: Fixed g => g (Set i)
-empty = inf Empty
+instance Null1 (Set i) where
+    empty1 = Empty
+    null1 Empty = True
+    null1 _ = False
 
 node :: Fixed g => g (Set i) -> i -> g (Set i) -> g (Set i)
 node l i r = inf $ Node l i r
diff --git a/src/Data/FixFile/Tree23.hs b/src/Data/FixFile/Tree23.hs
--- a/src/Data/FixFile/Tree23.hs
+++ b/src/Data/FixFile/Tree23.hs
@@ -14,8 +14,6 @@
     used with 'FixFile'. It has two interfaces that are
 -}
 module Data.FixFile.Tree23 (Tree23
-                           ,empty
-                           ,null
                            ,size
                            ,depth
                            -- | * Set
@@ -79,6 +77,11 @@
   deriving (Read, Show, Eq, Ord, Generic, Functor, Foldable, Traversable,
             Typeable)
 
+instance Null1 (Tree23F k v) where
+    empty1 = Empty
+    null1 Empty = True
+    null1 _ = False
+
 {- |
     'Fixed' @('Tree23' d)@ represents a Two-Three tree. The data type 'd' should
     have data families for it's key and value. These data families are not
@@ -94,10 +97,6 @@
 instance (Binary a, Binary (TreeKey d), Binary (TreeValue d)) =>
     Binary (Tree23F (TreeKey d) (TreeValue d) a)
 
--- | An empty 'Fixed' 'Tree23'.
-empty :: Fixed g => g (Tree23 d)
-empty = inf Empty
-
 leaf :: Fixed g => TreeKey d -> TreeValue d -> g (Tree23 d)
 leaf k v = inf $ Leaf k v
 
@@ -109,12 +108,6 @@
     TreeKey d -> g (Tree23 d) -> g (Tree23 d)
 three l t1 m t2 r =
     inf $ Three l t1 m t2 r
-
--- | Predicate that returns true if there are no items in the 'Tree23'.
-null :: Fixed g => g (Tree23 d) -> Bool
-null = null' . outf where
-    null' Empty = True
-    null' _ = False
 
 -- | Number of entries in @('Tree23' g d)@.
 size :: Fixed g => g (Tree23 d) -> Int
diff --git a/src/Data/FixFile/Trie.hs b/src/Data/FixFile/Trie.hs
--- a/src/Data/FixFile/Trie.hs
+++ b/src/Data/FixFile/Trie.hs
@@ -13,7 +13,6 @@
     as a key-value store where the key is a 'ByteString' of arbitrary size.
 -}
 module Data.FixFile.Trie (Trie
-                         ,empty
                          ,freeze
                          ,createTrieFile
                          ,openTrieFile
@@ -53,6 +52,11 @@
   | Mutable (Maybe a) (M.Map Word8 a)
   deriving (Read, Show, Generic, Functor, Foldable, Traversable, Typeable)
 
+instance Null1 (Trie v) where
+    empty1 = Tail Nothing
+    null1 (Tail Nothing) = True
+    null1 _ = False
+
 instance (Binary v, Binary a) => Binary (Trie v a) where
     put (Value v) = putWord8 0 >> put v
     put (Tail a) = putWord8 1 >> put a
@@ -73,10 +77,6 @@
 
 tail :: Fixed g => Maybe (g (Trie v)) -> g (Trie v)
 tail = inf . Tail where
-
--- | An empty 'Trie'
-empty :: Fixed g => g (Trie v)
-empty = inf $ Tail Nothing
 
 string :: Fixed g => Maybe (g (Trie v)) -> BS.ByteString ->
     g (Trie v) -> g (Trie v)
diff --git a/src/Data/FixFile/Trie/Light.hs b/src/Data/FixFile/Trie/Light.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/FixFile/Trie/Light.hs
@@ -0,0 +1,351 @@
+{-# LANGUAGE DeriveGeneric, DeriveFunctor, DeriveFoldable, DeriveTraversable,
+    TypeFamilies, DeriveDataTypeable, TupleSections #-}
+
+{- |
+    Module      :  Data.FixFile.Trie
+    Copyright   :  (C) 2016 Rev. Johnny Healey
+    License     :  LGPL-3
+    Maintainer  :  Rev. Johnny Healey <rev.null@gmail.com>
+    Stability   :  experimental
+    Portability :  unknown
+
+    This is a Trie data type that can be used with 'FixFile'. It can be used
+    as a key-value store where the key is a 'ByteString' of arbitrary size.
+-}
+module Data.FixFile.Trie.Light (Trie
+                               ,freeze
+                               ,createTrieFile
+                               ,openTrieFile
+                               ,lookupTrie
+                               ,lookupTrieT
+                               ,insertTrie
+                               ,insertTrieT
+                               ,deleteTrie
+                               ,deleteTrieT
+                               ,iterateTrie
+                               ,iterateTrieT
+                               ) where
+
+import Prelude hiding (tail)
+
+import Control.Applicative hiding (empty)
+import Control.Monad
+import Data.Array
+import Data.Binary
+import qualified Data.ByteString.Lazy as BS
+import Data.Dynamic
+import qualified Data.Map as M
+import Data.Maybe
+import Data.Monoid
+import GHC.Generics
+
+import Data.FixFile
+
+-- | 'Fixed' @('Trie' v)@ is a trie mapping lazy 'ByteString's to values of
+--   type v.
+data Trie v a =
+    Tail (Maybe v)
+  | String (Maybe v) BS.ByteString a
+  | Small (Maybe v) [(Word8, a)]
+  | Big (Maybe v) (Array Word8 (Maybe a))
+  | Mutable (Maybe v) (M.Map Word8 a)
+  deriving (Read, Show, Generic, Functor, Foldable, Traversable, Typeable)
+
+instance Null1 (Trie v) where
+    empty1 = Tail Nothing
+    null1 (Tail Nothing) = True
+    null1 _ = False
+
+instance (Binary v, Binary a) => Binary (Trie v a) where
+    put (Tail a) = putWord8 1 >> put a
+    put (String m b a) = putWord8 2 >> put m >> put b >> put a
+    put (Small m l) = putWord8 3 >> put m >> put l
+    put (Big m a) = putWord8 4 >> put m >> put a
+    put m = put $ freeze' m
+    get = getWord8 >>= getTrie where
+        getTrie 1 = Tail <$> get
+        getTrie 2 = String <$> get <*> get <*> get
+        getTrie 3 = Small <$> get <*> get
+        getTrie 4 = Big <$> get <*> get
+        getTrie _ = error "Invalid Serialized Trie"
+
+tail :: Fixed g => Maybe v -> g (Trie v)
+tail = inf . Tail where
+
+string :: Fixed g => Maybe v -> BS.ByteString ->
+    g (Trie v) -> g (Trie v)
+string v k t = inf $ String v k t
+
+fill :: Fixed g => BS.ByteString -> Maybe v -> g (Trie v) -> g (Trie v)
+fill k x t = if BS.null k
+    then t
+    else string x k t
+
+small :: Fixed g => Maybe v -> [(Word8, g (Trie v))] -> g (Trie v)
+small v l = inf $ Small v l
+
+big :: Fixed g => Maybe v -> Array Word8 (Maybe (g (Trie v))) -> g (Trie v)
+big v l = inf $ Big v l
+
+mut :: Fixed g => Maybe v -> M.Map Word8 (g (Trie v)) -> g (Trie v)
+mut v l = inf $ Mutable v l
+
+bigThreshold :: Int
+bigThreshold = 20
+
+-- | 'freeze' takes a 'Trie' that has been mutated and creates a copy of it
+-- that allows for faster lookups. This happens automatically for 'Trie's that
+-- are serialized to a 'FixFile'. A 'Trie' will be automatically thawed on
+-- any node that is modified.
+freeze :: Fixed g => g (Trie v) -> g (Trie v)
+freeze = cata (inf . freeze') where
+
+freeze' :: Trie v a -> Trie v a
+freeze' (Mutable a b) = if M.size b > bigThreshold
+    then Big a $ array (minBound, maxBound) $ do
+        i <- [minBound..maxBound]
+        case M.lookup i b of
+            Nothing -> return (i, Nothing)
+            Just t -> return (i, Just t)
+    else Small a $ M.toList b
+freeze' m = m
+
+thaw :: Trie v a -> Trie v a
+thaw (Big a b) = Mutable a . M.fromList $ do
+    (i, Just v) <- assocs b
+    return (i, v)
+thaw (Small a b) = Mutable a $ M.fromList b
+thaw m = m
+
+-- | Create a 'FixFile' of @('Trie' v)@ data.
+createTrieFile :: (Binary v, Typeable v) =>
+    FilePath -> IO (FixFile (Ref (Trie v)))
+createTrieFile fp = createFixFile (Ref empty) fp
+
+-- | Open a 'FixFile' of @('Trie' v)@ data.
+openTrieFile :: (Binary v, Typeable v) =>
+    FilePath -> IO (FixFile (Ref (Trie v)))
+openTrieFile = openFixFile
+
+-- | Lookup a possible value stored in a trie for a given 'ByteString' key.
+lookupTrie :: Fixed g => BS.ByteString -> g (Trie v) -> Maybe v
+lookupTrie a b = cata phi b a where
+    term v k = guard (BS.null k) >> v
+    phi (Tail v) k = term v k
+    phi (String v s t) k = term v k <|> do
+        let (_, lt, rt) = splitKey s k
+        guard (BS.null lt)
+        t rt
+    phi (Small v l) k = term v k <|> do
+        (c, r) <- BS.uncons k
+        t <- lookup c l
+        t r
+    phi (Big v l) k = term v k <|> do
+        (c, r) <- BS.uncons k
+        t <- l ! c
+        t r
+    phi (Mutable v l) k = term v k <|> do
+        (c, r) <- BS.uncons k
+        t <- M.lookup c l
+        t r
+
+-- | 'Transaction' version of 'lookupTrie'.
+lookupTrieT :: Binary v =>
+    BS.ByteString -> Transaction (Ref (Trie v)) s (Maybe v)
+lookupTrieT k = lookupT (lookupTrie k)
+
+splitKey :: BS.ByteString -> BS.ByteString ->
+    (BS.ByteString, BS.ByteString, BS.ByteString)
+splitKey x y = case (BS.uncons x, BS.uncons y) of
+    (Nothing, Nothing) -> (BS.empty, BS.empty, BS.empty)
+    (Just (xc, xs), Just (yc, ys)) -> if xc == yc
+        then let (shared, xt, yt) = splitKey xs ys
+            in (BS.cons xc shared, xt, yt)
+        else (BS.empty, x, y)
+    _ -> (BS.empty, x, y)
+
+-- | Insert a value into a trie for the given 'ByteString' key.
+insertTrie :: Fixed g => BS.ByteString -> v -> g (Trie v) -> g (Trie v)
+insertTrie a b c = para phi c a where
+    val = Just b
+    valTail = tail val
+    phi (Tail vm) k = fill k vm valTail
+    phi (String vm s (tn, ta)) k
+        | BS.null k = string val s tn
+        | otherwise =
+            let (sh, lt, rt) = splitKey k s
+                Just (lh, ls) = BS.uncons lt
+                Just (rh, rs) = BS.uncons rt
+            in case (BS.null sh, BS.null lt, BS.null rt) of
+                (True, False, False) -> mut vm $ M.fromList
+                    [(lh, fill ls Nothing valTail), (rh, fill rs Nothing tn)]
+                (True, _, _) -> error "Invalid Key Split"
+                (_, False, False) -> string vm sh $ mut Nothing $ M.fromList
+                    [(lh, fill ls Nothing valTail), (rh, fill rs Nothing tn)]
+                (_, True, False) -> string vm sh $ string val rt tn
+                (_, False, True) -> string vm sh $ ta lt
+                (_, True, True) -> string vm s $ ta lt
+    phi x@(Big _ t) k
+        | BS.null k = big val (fmap (fmap fst) t)
+        | otherwise = phi (thaw x) k
+    phi x@(Small _ t) k
+        | BS.null k = small val (fmap (fmap fst) t)
+        | otherwise = phi (thaw x) k
+    phi (Mutable vm m) k = case BS.uncons k of
+        Nothing -> mut val (fmap fst m)
+        Just (kh, kt) -> mut vm $ case M.lookup kh m of
+            Nothing -> M.insert kh (fill kt Nothing valTail) $ fmap fst m
+            Just (_, ta) -> M.insert kh (ta kt) $ fmap fst m
+
+-- | 'Transaction' version of 'insertTrie'.
+insertTrieT :: Binary v =>
+    BS.ByteString -> v -> Transaction (Ref (Trie v)) s ()
+insertTrieT k v = alterT (insertTrie k v)
+ 
+data Deleted g v = 
+    NoDelete
+  | Deleted Bool (g (Trie v)) (Maybe (BS.ByteString, g (Trie v)))
+
+-- | Delete a value from a trie for a given 'ByteString' key.
+deleteTrie :: Fixed g => BS.ByteString -> g (Trie v) -> g (Trie v)
+deleteTrie a b = newHead $ para phi b a where
+    newHead NoDelete = b
+    newHead (Deleted True _ _) = empty
+    newHead (Deleted _ h _) = h
+    phi (Tail _) k = if BS.null k
+        then Deleted True empty Nothing
+        else NoDelete
+    phi (String vm s (tn, ta)) k
+        | BS.null k = if isJust vm
+            then Deleted False (string Nothing s tn) (Just (s, tn))
+            else NoDelete
+        | otherwise = del where
+            (_, lt, rt) = splitKey k s
+            ta' = ta lt
+            del = if BS.null rt
+                then case ta' of
+                    NoDelete -> NoDelete
+                    Deleted True _ _ -> if isNothing vm
+                        then Deleted True empty Nothing
+                        else Deleted False (tail vm) Nothing
+                    Deleted False tn' (Just (b', tn'')) ->
+                        Deleted False (string vm s tn') $
+                            Just (BS.append s b', tn'')
+                    Deleted False tn' Nothing ->
+                        Deleted False (string vm s tn') Nothing
+                else NoDelete
+    phi x@(Small vm ts) k
+        | BS.null k = case vm of
+            Nothing -> NoDelete
+            _ -> Deleted False (small Nothing (fmap (fmap fst) ts)) Nothing
+        | otherwise = phi (thaw x) k
+    phi x@(Big vm ts) k
+        | BS.null k = case vm of
+            Nothing -> NoDelete
+            _ -> Deleted False (big Nothing (fmap (fmap fst) ts)) Nothing
+        | otherwise = phi (thaw x) k
+    phi (Mutable vm ts) k
+        | BS.null k = case vm of
+            Nothing -> NoDelete
+            _ -> Deleted False (mut Nothing (fmap fst ts)) Nothing
+        | otherwise = fromJust . (<|> Just NoDelete) $ do
+            (kh, kt) <- BS.uncons k
+            (_, ta) <- M.lookup kh ts
+            return $ case ta kt of
+                Deleted True _ _ ->
+                    let ts' = fmap fst $ M.delete kh $ ts
+                        mut' = mut vm ts'
+                    in case M.size ts' of
+                        0 -> if isNothing vm
+                            then Deleted True empty Nothing
+                            else Deleted False (tail vm) Nothing
+                        _ -> Deleted False mut' Nothing
+                Deleted False dt _ ->
+                    let ts' = M.insert kh dt $ fmap fst ts
+                        mut' = mut vm ts'
+                    in Deleted False mut' Nothing
+                _ -> NoDelete
+
+-- | 'Transaction' version of 'deleteTrie'.
+deleteTrieT :: Binary v =>
+    BS.ByteString -> Transaction (Ref (Trie v)) s ()
+deleteTrieT k = alterT (deleteTrie k)
+
+-- | Iterate over a Trie for all of the 'ByteString' and value tuples for a
+-- given 'ByteString' prefix.
+iterateTrie :: Fixed g => BS.ByteString -> g (Trie v) -> [(BS.ByteString, v)]
+iterateTrie a b = cata phi b a BS.empty [] where
+    kvlist _ _ Nothing = id
+    kvlist k k' (Just v) = if BS.null k
+        then ((k', v):) else id
+    phi (Tail vm) k k' = kvlist k k' vm
+    phi (String vm s ta) k k' = kvlist k k' vm <> ta' where
+        (_, lt, rt) = splitKey k s
+        ta' = if BS.null lt || BS.null rt
+            then ta lt (BS.append k' s)
+            else mempty
+    phi (Small vm ts) k k' = kvlist k k' vm <> ts' where
+        mapKeys (xk, xv) = xv k (BS.snoc k' xk)
+        ts' = case BS.uncons k of
+            Nothing -> foldMap mapKeys ts
+            Just (i, k'') -> case lookup i ts of
+                Nothing -> mempty
+                Just xv -> xv k'' (BS.snoc k' i)
+    phi (Big vm ts) k k' = kvlist k k' vm <> ts' where
+        mapKeys (_, Nothing) = mempty
+        mapKeys (xk, Just xv) = xv k (BS.snoc k' xk)
+        ts' = case BS.uncons k of
+            Nothing -> foldMap mapKeys (assocs ts)
+            Just (i, k'') -> case ts ! i of
+                Nothing -> mempty
+                Just r -> r k'' (BS.snoc k' i) 
+    phi (Mutable vm ts) k k' = kvlist k k' vm <> ts' where
+        mapKeys (xk, xv) = xv k (BS.snoc k' xk)
+        ts' = case BS.uncons k of
+            Nothing -> foldMap mapKeys (M.assocs ts)
+            Just (i, k'') -> case M.lookup i ts of
+                Nothing -> mempty
+                Just r -> r k'' (BS.snoc k' i)
+
+-- | 'Transaction' version of 'iterateTrie'.
+iterateTrieT :: Binary v => BS.ByteString ->
+    Transaction (Ref (Trie v)) s [(BS.ByteString, v)]
+iterateTrieT k = lookupT (iterateTrie k)
+
+instance FixedAlg (Trie v) where
+    type Alg (Trie v) = v
+
+instance FixedSub (Trie v) where
+    type Sub (Trie v) v v' = Trie v'
+
+instance FixedFunctor (Trie v) where
+    fmapF f = cata phi where
+        phi (Tail v) = tail (fmap f v)
+        phi (String v b t) = string (fmap f v) b t
+        phi (Small v ts) = small (fmap f v) ts
+        phi (Big v ts) = big (fmap f v) ts
+        phi (Mutable v ts) = mut (fmap f v) ts
+
+instance FixedFoldable (Trie v) where
+    foldMapF f = cata phi where
+        mapply Nothing = mempty
+        mapply (Just v) = f v
+        phi (Tail v) = mapply v
+        phi (String v _ t) = mapply v <> t
+        phi (Small v l) = mapply v <> mconcat (snd <$> l)
+        phi (Big v a) = mapply v <> foldMap (maybe mempty id) a
+        phi (Mutable v m) = mapply v <> foldMap id m
+
+instance FixedTraversable (Trie v) where
+    traverseF f = cata phi where
+        mapply Nothing = pure Nothing
+        mapply (Just v) = Just <$> f v
+        phi (Tail v) = tail <$> mapply v
+        phi (String v b a) = string <$> mapply v <*> pure b <*> a
+        phi (Small v l) = small <$> mapply v <*>
+            traverse (\(w, a) -> (w,) <$> a) l
+        phi (Big v a) = big <$> mapply v <*> traverse tapply a where
+            tapply Nothing = pure Nothing
+            tapply (Just t) = Just <$> t
+        phi (Mutable v m) = mut <$> mapply v <*> traverse id m
+
diff --git a/tests/Tests.hs b/tests/Tests.hs
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -4,7 +4,9 @@
 import TestSet
 import TestTree23
 import TestTrie
+import TestLightTrie
 import TestBTree
+import TestLightBTree
 import TestFixFile
 
 main :: IO ()
@@ -14,7 +16,9 @@
         test23
        ,testSet
        ,testTrie
+       ,testLightTrie
        ,testBTree
+       ,testLightBTree
        ,testFixFile
     ]