diff --git a/Control/Monad/Reader/Trie.hs b/Control/Monad/Reader/Trie.hs
deleted file mode 100644
--- a/Control/Monad/Reader/Trie.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# LANGUAGE TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
-----------------------------------------------------------------------
--- |
--- Module      :  Control.Monad.Reader.Trie
--- Copyright   :  (c) Edward Kmett 2011
--- License     :  BSD3
--- 
--- Maintainer  :  ekmett@gmail.com
--- Stability   :  experimental
--- 
-----------------------------------------------------------------------
-
-module Control.Monad.Reader.Trie ( 
-  -- * A "Representable Trie"-based Reader monad transformer
-    ReaderTrieT(..)
-  , module Data.Functor.Representable.Trie
-  ) where
-
-import Control.Applicative
-import Control.Comonad
-import Control.Monad.Trans.Class
-import Control.Monad.IO.Class
-import Control.Monad.Reader.Class
-import Control.Monad.Writer.Class as Writer
-import Data.Distributive
-import Data.Functor.Bind
-import Data.Functor.Representable
-import Data.Functor.Representable.Trie
-import Data.Foldable
-import Data.Key
-import Data.Traversable
-import Data.Semigroup
-import Data.Semigroup.Foldable
-import Data.Semigroup.Traversable
-import Prelude hiding (lookup,zipWith)
-
-type instance Key (ReaderTrieT a m) = (a, Key m)
-
-newtype ReaderTrieT a m b = ReaderTrieT { runReaderTrieT :: a :->: m b } 
-
-instance (HasTrie a, Functor m) => Functor (ReaderTrieT a m) where
-  fmap f = ReaderTrieT . fmap (fmap f) . runReaderTrieT
-
-instance (HasTrie a, Apply m) => Apply (ReaderTrieT a m) where
-  ReaderTrieT ff <.> ReaderTrieT fa = ReaderTrieT ((<.>) <$> ff <.> fa)
-
-instance (HasTrie a, Applicative m) => Applicative (ReaderTrieT a m) where
-  pure = ReaderTrieT . pure . pure 
-  ReaderTrieT ff <*> ReaderTrieT fa = ReaderTrieT ((<*>) <$> ff <*> fa)
-
-instance (HasTrie a, Bind m) => Bind (ReaderTrieT a m) where
-  ReaderTrieT fm >>- f = ReaderTrieT $ tabulate (\a -> index fm a >>- flip index a . runReaderTrieT . f)
-
-instance (HasTrie a, Monad m) => Monad (ReaderTrieT a m) where
-  return = ReaderTrieT . pure . return
-  ReaderTrieT fm >>= f = ReaderTrieT $ tabulate (\a -> index fm a >>= flip index a . runReaderTrieT . f)
-
-instance (HasTrie a, Monad m) => MonadReader a (ReaderTrieT a m) where 
-  ask = ReaderTrieT (trie return)
-  local f (ReaderTrieT fm) = ReaderTrieT (tabulate (index fm . f))
-
-instance HasTrie a => MonadTrans (ReaderTrieT a) where
-  lift = ReaderTrieT . pure 
-
-instance (HasTrie a, Distributive m) => Distributive (ReaderTrieT a m) where
-  distribute = ReaderTrieT . fmap distribute . collect runReaderTrieT
-
-instance (HasTrie a, Zip m) => Zip (ReaderTrieT a m) where
-  zipWith f (ReaderTrieT m) (ReaderTrieT n) = ReaderTrieT $ zipWith (zipWith f) m n 
-
-instance (HasTrie a, ZipWithKey m) => ZipWithKey (ReaderTrieT a m) where
-  zipWithKey f (ReaderTrieT m) (ReaderTrieT n) = ReaderTrieT $ zipWithKey (\k -> zipWithKey (f . (,) k)) m n 
-
-instance (HasTrie a, Keyed m) => Keyed (ReaderTrieT a m) where
-  mapWithKey f = ReaderTrieT . mapWithKey (\k -> mapWithKey (f . (,) k)) . runReaderTrieT
-
-instance (HasTrie a, Indexable m) => Indexable (ReaderTrieT a m) where
-  index = uncurry . fmap index . untrie . runReaderTrieT
-
-instance (HasTrie a, Adjustable m) => Adjustable (ReaderTrieT a m) where
-  adjust f (a,k) = ReaderTrieT . adjust (adjust f k) a . runReaderTrieT 
-
-instance (HasTrie a, Lookup ((:->:) a), Lookup m) => Lookup (ReaderTrieT a m) where
-  lookup (k,k') (ReaderTrieT fm) = lookup k fm >>= lookup k'
-
-instance (HasTrie a, Representable m) => Representable (ReaderTrieT a m) where
-  tabulate = ReaderTrieT . trie . fmap tabulate . curry
-  
-instance (HasTrie a, Foldable m) => Foldable (ReaderTrieT a m) where
-  foldMap f = foldMap (foldMap f) . runReaderTrieT
-
-instance (HasTrie a, Foldable1 m) => Foldable1 (ReaderTrieT a m) where
-  foldMap1 f = foldMap1 (foldMap1 f) . runReaderTrieT
-
-instance (HasTrie a, FoldableWithKey m) => FoldableWithKey (ReaderTrieT a m) where
-  foldMapWithKey f = foldMapWithKey (\k -> foldMapWithKey (f . (,) k)) . runReaderTrieT
-
-instance (HasTrie a, FoldableWithKey1 m) => FoldableWithKey1 (ReaderTrieT a m) where
-  foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) k)) . runReaderTrieT 
-
-instance (HasTrie a, Traversable m) => Traversable (ReaderTrieT a m) where
-  traverse f = fmap ReaderTrieT . traverse (traverse f) . runReaderTrieT
-
-instance (HasTrie a, Traversable1 m) => Traversable1 (ReaderTrieT a m) where
-  traverse1 f = fmap ReaderTrieT . traverse1 (traverse1 f) . runReaderTrieT
-
-instance (HasTrie a, TraversableWithKey m) => TraversableWithKey (ReaderTrieT a m) where
-  traverseWithKey f = fmap ReaderTrieT . traverseWithKey (\k -> traverseWithKey (f . (,) k)) . runReaderTrieT
-
-instance (HasTrie a, TraversableWithKey1 m) => TraversableWithKey1 (ReaderTrieT a m) where
-  traverseWithKey1 f = fmap ReaderTrieT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) k)) . runReaderTrieT
-
-instance (HasTrie a, Representable m, Semigroup a, Semigroup (Key m)) => Extend (ReaderTrieT a m) where
-  extend = extendRep
-  duplicate = duplicateRep
-
-instance (HasTrie a, Representable m, Semigroup a, Semigroup (Key m), Monoid a, Monoid (Key m)) => Comonad (ReaderTrieT a m) where
-  extract = extractRep
-
-instance (HasTrie a, MonadIO m) => MonadIO (ReaderTrieT a m) where
-  liftIO = lift . liftIO 
-
-instance (HasTrie a, MonadWriter w m) => MonadWriter w (ReaderTrieT a m) where
-  tell = lift . tell
-  listen = ReaderTrieT . tabulate . fmap Writer.listen . index . runReaderTrieT
-  pass = ReaderTrieT . tabulate . fmap Writer.pass . index . runReaderTrieT
-
diff --git a/Data/Functor/Representable/Trie.hs b/Data/Functor/Representable/Trie.hs
deleted file mode 100644
--- a/Data/Functor/Representable/Trie.hs
+++ /dev/null
@@ -1,387 +0,0 @@
-{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, UndecidableInstances #-}
-{-# OPTIONS_GHC -fenable-rewrite-rules #-}
-----------------------------------------------------------------------
--- |
--- Module      :  Data.Functor.Representable.Trie
--- Copyright   :  (c) Edward Kmett 2011
--- License     :  BSD3
--- 
--- Maintainer  :  ekmett@gmail.com
--- Stability   :  experimental
--- 
-----------------------------------------------------------------------
-
-module Data.Functor.Representable.Trie
-  ( 
-  -- * Representations of polynomial functors
-    HasTrie(..)
-  -- * Memoizing functions
-  , mup, memo, memo2, memo3
-  , inTrie, inTrie2, inTrie3
-  -- * Workarounds for current GHC limitations
-  , trie, untrie
-  , (:->:)(..)
-  , Entry(..)
-  ) where
-
-import Control.Applicative
-import Control.Arrow
-import Control.Comonad
-import Control.Monad.Reader.Class
-import Control.Monad.Representable.Reader
-import Data.Bits
-import Data.Distributive
-import Data.Semigroup
-import Data.Word
-import Data.Int
-import Data.Foldable
-import Data.Function (on)
-import Data.Functor.Adjunction
-import Data.Functor.Bind
-import Data.Functor.Identity
-import Data.Functor.Representable.Trie.Bool
-import Data.Functor.Representable.Trie.Either
-import Data.Functor.Representable.Trie.List
-import Data.Key
-import qualified Data.Monoid as Monoid
-import Data.Semigroup.Foldable
-import Data.Semigroup.Traversable
-import Data.Sequence (Seq, (<|))
-import qualified Data.Sequence as Seq
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
-import Data.Traversable
-import Prelude hiding (lookup, foldr)
-
-class (Adjustable (BaseTrie a), TraversableWithKey1 (BaseTrie a), Representable (BaseTrie a)) => HasTrie a where
-  type BaseTrie a :: * -> *
-  -- projectKey . embedKey = id
-  embedKey   :: a -> Key (BaseTrie a)
-  projectKey :: Key (BaseTrie a) -> a
-{-
-  validKey   :: Key (BaseTrie a) -> Bool
-  validKey _ = True
--}
-
-newtype a :->: b = Trie { runTrie :: BaseTrie a b } 
-
-type instance Key ((:->:) a) = a
-
-data Entry a b = Entry a b
-
--- * Combinators
-
--- Matt Hellige's notation for @argument f . result g@.
--- <http://matt.immute.net/content/pointless-fun>
-(~>) :: (a' -> a) -> (b -> b') -> (a -> b) -> a' -> b'
-g ~> f = (f .) . (. g)
-
-untrie :: HasTrie t => (t :->: a) -> t -> a
-untrie = index
-
-trie :: HasTrie t => (t -> a) -> (t :->: a)
-trie = tabulate
-
-{-# RULES
-"trie/untrie" forall t. trie (untrie t) = t
-"embedKey/projectKey" forall t. projectKey (embedKey t) = t
- #-}
-
-memo :: HasTrie t => (t -> a) -> t -> a
-memo = untrie . trie
-
--- | Lift a memoizer to work with one more argument.
-mup :: HasTrie t => (b -> c) -> (t -> b) -> t -> c
-mup mem f = memo (mem . f)
-
--- | Memoize a binary function, on its first argument and then on its
--- second.  Take care to exploit any partial evaluation.
-memo2 :: (HasTrie s, HasTrie t) => (s -> t -> a) -> s -> t -> a
-memo2 = mup memo
-
--- | Memoize a ternary function on successive arguments.  Take care to
--- exploit any partial evaluation.
-memo3 :: (HasTrie r, HasTrie s, HasTrie t) => (r -> s -> t -> a) -> r -> s -> t -> a
-memo3 = mup memo2
-
--- | Apply a unary function inside of a tabulate
-inTrie 
-  :: (HasTrie a, HasTrie c) 
-  => ((a -> b) -> c -> d)
-  -> (a :->: b) -> c :->: d
-inTrie = untrie ~> trie
-
--- | Apply a binary function inside of a tabulate
-inTrie2 
-  :: (HasTrie a, HasTrie c, HasTrie e) 
-  => ((a -> b) -> (c -> d) -> e -> f)
-  -> (a :->: b) -> (c :->: d) -> e :->: f
-inTrie2 = untrie ~> inTrie
-
--- | Apply a ternary function inside of a tabulate
-inTrie3 
-  :: (HasTrie a, HasTrie c, HasTrie e, HasTrie g) 
-  => ((a -> b) -> (c -> d) -> (e -> f) -> g -> h)
-  -> (a :->: b) -> (c :->: d) -> (e :->: f) -> g :->: h
-inTrie3 = untrie ~> inTrie2
-
--- * Implementation details
-
-instance Functor (Entry a) where
-  fmap f (Entry a b) = Entry a (f b)
-
-instance HasTrie e => Lookup ((:->:)e) where
-  lookup = lookupDefault
-
-instance HasTrie e => Indexable ((:->:)e) where
-  index (Trie f) = index f . embedKey
-
-instance HasTrie e => Distributive ((:->:) e) where
-  distribute = distributeRep
-
-instance HasTrie e => Representable ((:->:) e) where
-  tabulate f = Trie $ tabulate (f . projectKey)
-
-instance HasTrie e => Adjustable ((:->:) e) where
-  adjust f k (Trie as) = Trie (adjust f (embedKey k) as)
-
-instance HasTrie e => Zip ((:->:) e)
-
-instance HasTrie e => ZipWithKey ((:->:) e) 
-
-instance HasTrie e => Adjunction (Entry e) ((:->:) e) where
-  unit = mapWithKey Entry . pure
-  counit (Entry a t) = index t a
-
-instance HasTrie a => Functor ((:->:) a) where
-  fmap f (Trie g) = Trie (fmap f g)
-
-instance HasTrie a => Keyed ((:->:) a) where
-  mapWithKey f (Trie a) = Trie (mapWithKey (f . projectKey) a)
-
-instance HasTrie a => Foldable ((:->:) a) where
-  foldMap f (Trie a) = foldMap f a
-
-instance HasTrie a => FoldableWithKey ((:->:) a) where
-  foldMapWithKey f (Trie a) = foldMapWithKey (f . projectKey) a
-
-instance HasTrie a => Traversable ((:->:) a) where
-  traverse f (Trie a) = Trie <$> traverse f a
-
-instance HasTrie a => TraversableWithKey ((:->:) a) where
-  traverseWithKey f (Trie a) = Trie <$> traverseWithKey (f . projectKey) a
-
-instance HasTrie a => Foldable1 ((:->:) a) where
-  foldMap1 f (Trie a) = foldMap1 f a
-
-instance HasTrie a => FoldableWithKey1 ((:->:) a) where
-  foldMapWithKey1 f (Trie a) = foldMapWithKey1 (f . projectKey) a
-
-instance HasTrie a => Traversable1 ((:->:) a) where
-  traverse1 f (Trie a) = Trie <$> traverse1 f a
-
-instance HasTrie a => TraversableWithKey1 ((:->:) a) where
-  traverseWithKey1 f (Trie a) = Trie <$> traverseWithKey1 (f . projectKey) a
-
-instance (HasTrie a, Eq b) => Eq (a :->: b) where
-  (==) = (==) `on` toList
-
-instance (HasTrie a, Ord b) => Ord (a :->: b) where
-  compare = compare `on` toList
-
-instance (HasTrie a, Show a, Show b) => Show (a :->: b) where 
-  showsPrec d = showsPrec d . toKeyedList
-
-instance HasTrie a => Apply ((:->:) a) where
-  (<.>) = apRep
-  a <. _ = a
-  _ .> b = b
-
-instance HasTrie a => Applicative ((:->:) a) where
-  pure a = Trie (pureRep a)
-  (<*>) = apRep
-  a <* _ = a
-  _ *> b = b
-
-instance HasTrie a => Bind ((:->:) a) where
-  Trie m >>- f = Trie (tabulate (\a -> index (runTrie (f (index m a))) a))
-  
-instance HasTrie a => Monad ((:->:) a) where
-  return a = Trie (pureRep a)
-  (>>=) = (>>-)
-  _ >> m = m
-
-instance HasTrie a => MonadReader a ((:->:) a) where
-  ask = askRep
-  local = localRep
-
--- TODO: remove dependency on HasTrie in these: 
-
-instance (HasTrie m, Semigroup m, Monoid m) => Comonad ((:->:) m) where
-  extract = flip index mempty
-
-
-instance (HasTrie m, Semigroup m) => Extend ((:->:) m) where
-  duplicate = duplicateRep
-
--- * Instances
-
-instance HasTrie () where
-  type BaseTrie () = Identity
-  embedKey = id
-  projectKey = id
-
-instance HasTrie Bool where
-  type BaseTrie Bool = BoolTrie
-  embedKey = id
-  projectKey = id
-
-instance HasTrie Any where
-  type BaseTrie Any = BoolTrie
-  embedKey = getAny
-  projectKey = Any
-
-instance HasTrie a => HasTrie (Dual a) where
-  type BaseTrie (Dual a) = BaseTrie a
-  embedKey = embedKey . getDual
-  projectKey = Dual . projectKey 
-
-instance HasTrie a => HasTrie (Sum a) where
-  type BaseTrie (Sum a) = BaseTrie a
-  embedKey = embedKey . getSum
-  projectKey = Sum . projectKey 
-
-instance HasTrie a => HasTrie (Monoid.Product a) where
-  type BaseTrie (Monoid.Product a) = BaseTrie a
-  embedKey = embedKey . Monoid.getProduct
-  projectKey = Monoid.Product . projectKey 
-
-instance (HasTrie a, HasTrie b) => HasTrie (a, b) where
-  type BaseTrie (a, b) = ReaderT (BaseTrie a) (BaseTrie b)
-  embedKey = embedKey *** embedKey
-  projectKey = projectKey *** projectKey
-
-instance (HasTrie a, HasTrie b) => HasTrie (Entry a b) where
-  type BaseTrie (Entry a b) = ReaderT (BaseTrie a) (BaseTrie b)
-  embedKey (Entry a b) = (embedKey a, embedKey b)
-  projectKey (a, b) = Entry (projectKey a) (projectKey b)
-
-instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where
-  type BaseTrie (Either a b) = EitherTrie (BaseTrie a) (BaseTrie b)
-  embedKey = embedKey +++ embedKey
-  projectKey = projectKey +++ projectKey
-
-instance HasTrie a => HasTrie (Maybe a) where
-  type BaseTrie (Maybe a) = EitherTrie Identity (BaseTrie a)
-  embedKey   = maybe (Left ()) (Right . embedKey)
-  projectKey = either (const Nothing) (Just . projectKey)
-
-instance HasTrie a => HasTrie [a] where
-  type BaseTrie [a] = ListTrie (BaseTrie a)
-  embedKey = map embedKey
-  projectKey = map projectKey
-
-instance HasTrie a => HasTrie (Seq a) where
-  type BaseTrie (Seq a) = ListTrie (BaseTrie a)
-  embedKey = foldr ((:) . embedKey) []
-  projectKey = foldr ((<|) . projectKey) (Seq.empty)
-
-instance (HasTrie k, HasTrie v) => HasTrie (Map k v) where
-  type BaseTrie (Map k v) = ListTrie (BaseTrie (k, v))
-  embedKey = foldrWithKey (\k v t -> embedKey (k,v) : t) []
-  projectKey = Map.fromDistinctAscList . map projectKey
-
-instance (HasTrie v) => HasTrie (IntMap v) where
-  type BaseTrie (IntMap v) = ListTrie (BaseTrie (Int, v))
-  embedKey = foldrWithKey (\k v t -> embedKey (k,v) : t) []
-  projectKey = IntMap.fromDistinctAscList . map projectKey
-
-  
--- | Extract bits in little-endian order
-bits :: Bits t => t -> [Bool]
-bits 0 = []
-bits x = testBit x 0 : bits (shiftR x 1)
-
--- | Convert boolean to 0 (False) or 1 (True)
-unbit :: Num t => Bool -> t
-unbit False = 0
-unbit True  = 1
-
--- | Bit list to value
-unbits :: Bits t => [Bool] -> t
-unbits [] = 0
-unbits (x:xs) = unbit x .|. shiftL (unbits xs) 1
-
-unbitsZ :: (Bits n) => (Bool,[Bool]) -> n
-unbitsZ (positive,bs) = sig (unbits bs)
- where
-   sig | positive  = id
-       | otherwise = negate
-
-bitsZ :: (Ord n, Bits n) => n -> (Bool,[Bool])
-bitsZ = (>= 0) &&& (bits . abs)
-
--- TODO: fix the show instance of this
-instance HasTrie Int where
-  type BaseTrie Int = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-
-instance HasTrie Int8 where
-  type BaseTrie Int8 = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-
-instance HasTrie Int16 where
-  type BaseTrie Int16 = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-
-instance HasTrie Int32 where
-  type BaseTrie Int32 = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-
-instance HasTrie Int64 where
-  type BaseTrie Int64 = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-
-instance HasTrie Word where
-  type BaseTrie Word = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-instance HasTrie Word8 where
-  type BaseTrie Word8 = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-instance HasTrie Word16 where
-  type BaseTrie Word16 = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-instance HasTrie Word32 where
-  type BaseTrie Word32 = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-instance HasTrie Word64 where
-  type BaseTrie Word64 = BaseTrie (Bool, [Bool])
-  embedKey = embedKey . bitsZ 
-  projectKey = unbitsZ . projectKey
-
--- TODO: fix tree to 21 bit depth
-instance HasTrie Char where
-  type BaseTrie Char = BaseTrie [Bool]
-  embedKey = bits . fromEnum
-  projectKey = toEnum . unbits
-
-instance (HasTrie a, HasTrie b, HasTrie c) => HasTrie (a,b,c) where
-  type BaseTrie (a,b,c) = BaseTrie (a,(b,c))
-  embedKey (a,b,c) = embedKey (a,(b,c))
-  projectKey p = let (a,(b,c)) = projectKey p in (a,b,c)
-
-instance (HasTrie a, HasTrie b, HasTrie c, HasTrie d) => HasTrie (a,b,c,d) where
-  type BaseTrie (a,b,c,d) = BaseTrie ((a,b),(c,d))
-  embedKey (a,b,c,d) = embedKey ((a,b),(c,d))
-  projectKey p = let ((a,b),(c,d)) = projectKey p in (a,b,c,d)
diff --git a/Data/Functor/Representable/Trie/Bool.hs b/Data/Functor/Representable/Trie/Bool.hs
deleted file mode 100644
--- a/Data/Functor/Representable/Trie/Bool.hs
+++ /dev/null
@@ -1,109 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------
--- |
--- Module      :  Data.Functor.Representable.Trie.Bool
--- Copyright   :  (c) Edward Kmett 2011
--- License     :  BSD3
--- 
--- Maintainer  :  ekmett@gmail.com
--- Stability   :  experimental
--- 
-----------------------------------------------------------------------
-
-module Data.Functor.Representable.Trie.Bool ( BoolTrie (..) ) where
-
-import Control.Applicative
-import Data.Distributive
-import Data.Functor.Representable
-import Data.Functor.Bind
-import Data.Foldable
-import Data.Traversable
-import Data.Semigroup
-import Data.Semigroup.Foldable
-import Data.Semigroup.Traversable
-import Data.Key
-import Prelude hiding (lookup)
-
--- (Bool, -) -| BoolTrie
-data BoolTrie a = BoolTrie a a deriving (Eq,Ord,Show,Read)
-
-false :: BoolTrie a -> a
-false (BoolTrie a _) = a
-
-true :: BoolTrie a -> a
-true (BoolTrie _ b) = b
-
-type instance Key BoolTrie = Bool
-
-instance Functor BoolTrie where
-  fmap f (BoolTrie a b) = BoolTrie (f a) (f b)
-  b <$ _ = pure b
-
-instance Apply BoolTrie where
-  BoolTrie a b <.> BoolTrie c d = BoolTrie (a c) (b d)
-  a <. _ = a
-  _ .> b = b
-
-instance Applicative BoolTrie where
-  pure a = BoolTrie a a
-  (<*>) = (<.>) 
-  a <* _ = a
-  _ *> b = b
-
-instance Bind BoolTrie where
-  BoolTrie a b >>- f = BoolTrie (false (f a)) (true (f b))
-
-instance Monad BoolTrie where
-  return = pure
-  BoolTrie a b >>= f = BoolTrie (false (f a)) (true (f b))
-  _ >> a = a
-
-instance Keyed BoolTrie where
-  mapWithKey f (BoolTrie a b) = BoolTrie (f False a) (f True b)
-
-instance Zip BoolTrie where
-  zipWith f (BoolTrie a b) (BoolTrie c d) = BoolTrie (f a c) (f b d)
-
-instance ZipWithKey BoolTrie where
-  zipWithKey f (BoolTrie a b) (BoolTrie c d) = BoolTrie (f False a c) (f True b d)
-
-instance Foldable BoolTrie where
-  foldMap f (BoolTrie a b) = f a `mappend` f b
-
-instance Foldable1 BoolTrie where
-  foldMap1 f (BoolTrie a b) = f a <> f b
-
-instance Traversable BoolTrie where
-  traverse f (BoolTrie a b) = BoolTrie <$> f a <*> f b
-
-instance Traversable1 BoolTrie where
-  traverse1 f (BoolTrie a b) = BoolTrie <$> f a <.> f b
-
-instance FoldableWithKey BoolTrie where
-  foldMapWithKey f (BoolTrie a b) = f False a `mappend` f True b
-
-instance FoldableWithKey1 BoolTrie where
-  foldMapWithKey1 f (BoolTrie a b) = f False a <> f True b
-
-instance TraversableWithKey BoolTrie where
-  traverseWithKey f (BoolTrie a b) = BoolTrie <$> f False a <*> f True b
-
-instance TraversableWithKey1 BoolTrie where
-  traverseWithKey1 f (BoolTrie a b) = BoolTrie <$> f False a <.> f True b
-
-instance Distributive BoolTrie where
-  distribute = distributeRep
-
-instance Indexable BoolTrie where
-  index (BoolTrie a _) False = a
-  index (BoolTrie _ b) True  = b
-
-instance Adjustable BoolTrie where
-  adjust f False (BoolTrie a b) = BoolTrie (f a) b
-  adjust f True (BoolTrie a b) = BoolTrie a (f b)
-
-instance Lookup BoolTrie where
-  lookup = lookupDefault
-
-instance Representable BoolTrie where
-  tabulate f = BoolTrie (f False) (f True)
diff --git a/Data/Functor/Representable/Trie/Either.hs b/Data/Functor/Representable/Trie/Either.hs
deleted file mode 100644
--- a/Data/Functor/Representable/Trie/Either.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------
--- |
--- Module      :  Data.Functor.Representable.Trie.Bool
--- Copyright   :  (c) Edward Kmett 2011
--- License     :  BSD3
--- 
--- Maintainer  :  ekmett@gmail.com
--- Stability   :  experimental
--- 
-----------------------------------------------------------------------
-
-module Data.Functor.Representable.Trie.Either ( 
-    EitherTrie (..) 
-  , left
-  , right
-  ) where
-
-import Control.Applicative
-import Data.Distributive
-import Data.Functor.Representable
-import Data.Functor.Bind
-import Data.Foldable
-import Data.Traversable
-import Data.Traversable.Fair
-import Data.Semigroup
-import Data.Semigroup.Foldable
-import Data.Semigroup.Traversable
-import Data.Key
-import Prelude hiding (lookup,zipWith)
-
--- the product functor would be the trie of an either, but we fair traversal
-data EitherTrie f g a = EitherTrie (f a) (g a)
-
-type instance Key (EitherTrie f g) = Either (Key f) (Key g)
-
-left :: EitherTrie f g a -> f a
-left (EitherTrie f _) = f
-
-right :: EitherTrie f g a -> g a
-right (EitherTrie _ g) = g
-
-instance (Apply f, Apply g, Semigroup s) => Semigroup (EitherTrie f g s) where
-  EitherTrie a b <> EitherTrie c d = EitherTrie ((<>) <$> a <.> c) ((<>) <$> b <.> d)
-
-instance (Applicative f, Applicative g, Monoid a) => Monoid (EitherTrie f g a) where
-  mempty = EitherTrie (pure mempty) (pure mempty)
-  EitherTrie a b `mappend` EitherTrie c d = EitherTrie (mappend <$> a <*> c) (mappend <$> b <*> d)
-
-instance (Functor f, Functor g) => Functor (EitherTrie f g) where
-  fmap f (EitherTrie fs gs) = EitherTrie (fmap f fs) (fmap f gs)
-  b <$ EitherTrie fs gs = EitherTrie (b <$ fs) (b <$ gs)
-
-instance (Apply f, Apply g) => Apply (EitherTrie f g) where
-  EitherTrie ff fg <.> EitherTrie af ag = EitherTrie (ff <.> af) (fg <.> ag)
-  a <. _ = a
-  _ .> b = b
-
-instance (Applicative f, Applicative g) => Applicative (EitherTrie f g) where
-  pure a = EitherTrie (pure a) (pure a)
-  EitherTrie ff fg <*> EitherTrie af ag = EitherTrie (ff <*> af) (fg <*> ag)
-  a <* _ = a
-  _ *> b = b
-
--- the direct implementation in terms of Bind is inefficient, using bindRep instead
-instance (Apply f, Representable f, Apply g, Representable g) => Bind (EitherTrie f g) where
-  (>>-) = bindRep
-
-instance (Representable f, Representable g) => Monad (EitherTrie f g) where
-  return = pureRep
-  (>>=) = bindRep
-  _ >> a = a
-
-instance (Keyed f, Keyed g) => Keyed (EitherTrie f g) where
-  mapWithKey f (EitherTrie fs gs) = EitherTrie (mapWithKey (f . Left) fs) (mapWithKey (f . Right) gs)
-
-instance (Zip f, Zip g) => Zip (EitherTrie f g) where
-  zipWith f (EitherTrie fs gs) (EitherTrie hs is) = EitherTrie (zipWith f fs hs) (zipWith f gs is)
-
-instance (ZipWithKey f, ZipWithKey g) => ZipWithKey (EitherTrie f g) where
-  zipWithKey f (EitherTrie fs gs) (EitherTrie hs is) = EitherTrie (zipWithKey (f . Left) fs hs) (zipWithKey (f . Right) gs is)
-
-instance (Foldable f, Foldable g) => Foldable (EitherTrie f g) where
-  foldMap f (EitherTrie fs gs) = foldMapBoth f fs gs
-
-instance (Foldable1 f, Foldable1 g) => Foldable1 (EitherTrie f g) where
-  foldMap1 f (EitherTrie fs gs) = foldMapBoth1 f fs gs
-
-instance (Traversable f, Traversable g) => Traversable (EitherTrie f g) where
-  traverse f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseBoth f fs gs
-
-instance (Traversable1 f, Traversable1 g) => Traversable1 (EitherTrie f g) where
-  traverse1 f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseBoth1 f fs gs
-
-instance (FoldableWithKey f, FoldableWithKey g) => FoldableWithKey (EitherTrie f g) where
-  foldMapWithKey f (EitherTrie fs gs) = foldMapWithKeyBoth (f . Left) (f . Right) fs gs
-
-instance (FoldableWithKey1 f, FoldableWithKey1 g) => FoldableWithKey1 (EitherTrie f g) where
-  foldMapWithKey1 f (EitherTrie fs gs) = foldMapWithKeyBoth1 (f . Left) (f . Right) fs gs
-
-instance (TraversableWithKey f, TraversableWithKey g) => TraversableWithKey (EitherTrie f g) where
-  traverseWithKey f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseWithKeyBoth (f . Left) (f . Right) fs gs
-
-instance (TraversableWithKey1 f, TraversableWithKey1 g) => TraversableWithKey1 (EitherTrie f g) where
-  traverseWithKey1 f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseWithKeyBoth1 (f . Left) (f . Right) fs gs
-
-instance (Representable f, Representable g) => Distributive (EitherTrie f g) where
-  distribute = distributeRep
-
-instance (Indexable f, Indexable g) => Indexable (EitherTrie f g) where
-  index (EitherTrie fs _) (Left  i) = index fs i
-  index (EitherTrie _ gs) (Right j) = index gs j
-
-instance (Adjustable f, Adjustable g) => Adjustable (EitherTrie f g) where
-  adjust f (Left i) (EitherTrie fs gs)  = EitherTrie (adjust f i fs) gs
-  adjust f (Right j) (EitherTrie fs gs) = EitherTrie fs (adjust f j gs)
-
-instance (Lookup f, Lookup g) => Lookup (EitherTrie f g) where
-  lookup (Left i) (EitherTrie fs _)  = lookup i fs
-  lookup (Right j) (EitherTrie _ gs) = lookup j gs
-
-instance (Representable f, Representable g) => Representable (EitherTrie f g) where
-  tabulate f = EitherTrie (tabulate (f . Left)) (tabulate (f . Right))
diff --git a/Data/Functor/Representable/Trie/List.hs b/Data/Functor/Representable/Trie/List.hs
deleted file mode 100644
--- a/Data/Functor/Representable/Trie/List.hs
+++ /dev/null
@@ -1,114 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------
--- |
--- Module      :  Data.Functor.Representable.Trie.List
--- Copyright   :  (c) Edward Kmett 2011
--- License     :  BSD3
---
--- Maintainer  :  ekmett@gmail.com
--- Stability   :  experimental
---
-----------------------------------------------------------------------
-
-module Data.Functor.Representable.Trie.List (
-    ListTrie (..)
-  , nil
-  , cons
-  ) where
-
-import Control.Applicative
-import Data.Distributive
-import Data.Functor.Representable
-import Data.Functor.Bind
-import Data.Foldable
-import Data.Traversable
-import Data.Semigroup
-import Data.Semigroup.Foldable
-import Data.Semigroup.Traversable
-import Data.Key
-import Prelude hiding (lookup,zipWith)
-
--- the f-branching stream comonad is the trie of a list
-data ListTrie f a = ListTrie a (f (ListTrie f a)) -- deriving (Eq,Ord,Show,Read)
-
-type instance Key (ListTrie f) = [Key f]
-
-nil :: ListTrie f a -> a
-nil (ListTrie x _) = x
-
-cons :: Indexable f => Key f -> ListTrie f a -> ListTrie f a
-cons a (ListTrie _ xs) = index xs a
-
-instance Functor f => Functor (ListTrie f) where
-  fmap f (ListTrie a as) = ListTrie (f a) (fmap (fmap f) as)
--- b <$ _ = pure b
-
-instance Representable f => Apply (ListTrie f) where
-  (<.>) = apRep
-  a <. _ = a
-  _ .> b = b
-
-instance Representable f => Applicative (ListTrie f) where
-  pure a = as where as = ListTrie a (pureRep as)
-  (<*>) = apRep
-  a <* _ = a
-  _ *> b = b
-
-instance Representable f => Bind (ListTrie f) where
-  (>>-) = bindRep
-
-instance Representable f => Monad (ListTrie f) where
-  return a = as where as = ListTrie a (pureRep as)
-  (>>=) = bindRep
-  _ >> a = a
-
-instance Zip f => Zip (ListTrie f) where
-  zipWith f (ListTrie a as) (ListTrie b bs) = ListTrie (f a b) (zipWith (zipWith f) as bs)
-
-instance ZipWithKey f => ZipWithKey (ListTrie f) where
-  zipWithKey f (ListTrie a as) (ListTrie b bs) = ListTrie (f [] a b) (zipWithKey (\x -> zipWithKey (f . (x:))) as bs)
-
-instance Keyed f => Keyed (ListTrie f) where
-  mapWithKey f (ListTrie a as) = ListTrie (f [] a) (mapWithKey (\x -> mapWithKey (f . (x:))) as)
-
-instance Foldable f => Foldable (ListTrie f) where
-  foldMap f (ListTrie a as) = f a `mappend` foldMap (foldMap f) as
-
-instance Foldable1 f => Foldable1 (ListTrie f) where
-  foldMap1 f (ListTrie a as) = f a <> foldMap1 (foldMap1 f) as
-
-instance Traversable f => Traversable (ListTrie f) where
-  traverse f (ListTrie a as) = ListTrie <$> f a <*> traverse (traverse f) as
-
-instance Traversable1 f => Traversable1 (ListTrie f) where
-  traverse1 f (ListTrie a as) = ListTrie <$> f a <.> traverse1 (traverse1 f) as
-
-instance FoldableWithKey f => FoldableWithKey (ListTrie f) where
-  foldMapWithKey f (ListTrie a as) = f [] a `mappend` foldMapWithKey (\x -> foldMapWithKey (f . (x:))) as
-
-instance FoldableWithKey1 f => FoldableWithKey1 (ListTrie f) where
-  foldMapWithKey1 f (ListTrie a as) = f [] a <> foldMapWithKey1 (\x -> foldMapWithKey1 (f . (x:))) as
-
-instance TraversableWithKey f => TraversableWithKey (ListTrie f) where
-  traverseWithKey f (ListTrie a as) = ListTrie <$> f [] a <*> traverseWithKey (\x -> traverseWithKey (f . (x:))) as
-
-instance TraversableWithKey1 f => TraversableWithKey1 (ListTrie f) where
-  traverseWithKey1 f (ListTrie a as) = ListTrie <$> f [] a <.> traverseWithKey1 (\x -> traverseWithKey1 (f . (x:))) as
-
-instance Representable f => Distributive (ListTrie f) where
-  distribute = distributeRep
-
-instance Indexable f => Indexable (ListTrie f) where
-  index (ListTrie x _) [] = x
-  index (ListTrie _ xs) (a:as) = index (index xs a) as
-
-instance Adjustable f => Adjustable (ListTrie f) where
-  adjust f [] (ListTrie x xs) = ListTrie (f x) xs
-  adjust f (a:as) (ListTrie x xs) = ListTrie x (adjust (adjust f as) a xs)
-
-instance Lookup f => Lookup (ListTrie f) where
-  lookup [] (ListTrie x _) = Just x
-  lookup (a:as) (ListTrie _ xs) = lookup a xs >>= lookup as
-
-instance Representable f => Representable (ListTrie f) where
-  tabulate f = ListTrie (f []) (tabulate (\x -> tabulate (f . (x:))))
diff --git a/Data/Traversable/Fair.hs b/Data/Traversable/Fair.hs
deleted file mode 100644
--- a/Data/Traversable/Fair.hs
+++ /dev/null
@@ -1,130 +0,0 @@
-module Data.Traversable.Fair 
-  ( foldMapBoth
-  , traverseBoth
-  , foldMapWithKeyBoth
-  , traverseWithKeyBoth
-  , foldMapBoth1
-  , traverseBoth1
-  , foldMapWithKeyBoth1
-  , traverseWithKeyBoth1
-  ) where
-
-import Control.Applicative
-import Control.Arrow
-import Data.Key
-import Data.Functor.Apply
-import Data.Foldable
-import Data.Traversable
-import Data.Semigroup
-import Data.Semigroup.Foldable
-import Data.Semigroup.Traversable
-import Data.List.NonEmpty as NonEmpty hiding (toList)
-
-refill :: Traversable t => t a -> [b] -> t b
-refill t l = snd (mapAccumL (\xs _ -> (Prelude.tail xs, Prelude.head xs)) l t)
-
-toNonEmptyList :: Foldable1 f => f a -> NonEmpty a
-toNonEmptyList = NonEmpty.fromList . toList
-
-toKeyedNonEmptyList :: FoldableWithKey1 f => f a -> NonEmpty (Key f, a)
-toKeyedNonEmptyList = NonEmpty.fromList . toKeyedList
-
-foldMapBoth :: (Foldable f, Foldable g, Monoid m) => (a -> m) -> f a -> g a -> m
-foldMapBoth f as bs = go (toList as) (toList bs) where
-  go [] [] = mempty
-  go xs [] = foldMap f xs
-  go [] ys = foldMap f ys
-  go (x:xs) (y:ys) = f x `mappend` f y `mappend` go xs ys
-
--- | traverse both containers, interleaving effects for fairness
-traverseBoth :: (Traversable f, Traversable g, Applicative m) => (a -> m b) -> f a -> g a -> m (f b, g b)
-traverseBoth f as bs = (refill as *** refill bs) <$> go (toList as) (toList bs)
-  where
-  go [] []         = pure ([],[])
-  go xs []         = flip (,) [] <$> traverse f xs
-  go [] ys         = (,) [] <$> traverse f ys
-  go (x:xs) (y:ys) = (\x' y' (xs',ys') -> (x':xs',y':ys')) <$> f x <*> f y <*> go xs ys
-
--- | fold both containers, interleaving results for fairness
-foldMapBoth1 :: (Foldable1 f, Foldable1 g, Semigroup m) => (a -> m) -> f a -> g a -> m
-foldMapBoth1 f as bs = go (toNonEmptyList as) (toNonEmptyList bs)
-  where
-  go (x:|[])   (y:|[])   = f x <> f y
-  go (x:|z:zs) (y:|[])   = f x <> f y <> foldMap1 f (z:|zs)
-  go (x:|[])   ys        = f x <> foldMap1 f ys
-  go (x:|z:zs) (y:|w:ws) = f x <> f y <> go (z:|zs) (w:|ws)
-
--- | traverse both containers, interleaving effects for fairness
-traverseBoth1 :: (Traversable1 f, Traversable1 g, Apply m) => (a -> m b) -> f a -> g a -> m (f b, g b)
-traverseBoth1 f as bs = (refill as *** refill bs) <$> go (toNonEmptyList as) (toNonEmptyList bs)
-  where
-  go (x:|[])   (y:|[])   = (\x' y'            -> ([x'],       [y']  )) <$> f x <.> f y
-  go (x:|z:zs) (y:|[])   = (\x' y' (x'':|xs') -> (x':x'':xs', [y']  )) <$> f x <.> f y <.> traverse1 f (z:|zs)
-  go (x:|[])   ys        = (\x' (y':|ys')     -> ([x'],       y':ys')) <$> f x <.> traverse1 f ys
-  go (x:|z:zs) (y:|w:ws) = (\x' y' (xs', ys') -> (x':xs',     y':ys')) <$> f x <.> f y <.> go (z:|zs) (w:|ws)
-
-foldMapWithKeyBoth 
-  :: (FoldableWithKey f, FoldableWithKey g, Monoid m) 
-  => (Key f -> a -> m) 
-  -> (Key g -> a -> m)
-  -> f a 
-  -> g a 
-  -> m
-foldMapWithKeyBoth f g as bs = go (toKeyedList as) (toKeyedList bs) where
-  f' = uncurry f
-  g' = uncurry g
-  go [] [] = mempty
-  go xs [] = foldMap f' xs
-  go [] ys = foldMap g' ys
-  go (x:xs) (y:ys) = f' x `mappend` g' y `mappend` go xs ys
-
--- | traverse both containers, interleaving effects for fairness
-traverseWithKeyBoth 
-  :: (TraversableWithKey f, TraversableWithKey g, Applicative m) 
-  => (Key f -> a -> m b) 
-  -> (Key g -> a -> m b) 
-  -> f a 
-  -> g a 
-  -> m (f b, g b)
-traverseWithKeyBoth f g as bs = (refill as *** refill bs) <$> go (toKeyedList as) (toKeyedList bs)
-  where
-  f' = uncurry f
-  g' = uncurry g
-  go [] []         = pure ([],[])
-  go xs []         = flip (,) [] <$> traverse f' xs
-  go [] ys         = (,) [] <$> traverse g' ys
-  go (x:xs) (y:ys) = (\x' y' (xs',ys') -> (x':xs',y':ys')) <$> f' x <*> g' y <*> go xs ys
-
--- | fold both containers, interleaving results for fairness
-foldMapWithKeyBoth1 
-  :: (FoldableWithKey1 f, FoldableWithKey1 g, Semigroup m) 
-  => (Key f -> a -> m) 
-  -> (Key g -> a -> m) 
-  -> f a 
-  -> g a 
-  -> m
-foldMapWithKeyBoth1 f g as bs = go (toKeyedNonEmptyList as) (toKeyedNonEmptyList bs)
-  where
-  f' = uncurry f
-  g' = uncurry g
-  go (x:|[])   (y:|[])   = f' x <> g' y
-  go (x:|z:zs) (y:|[])   = f' x <> g' y <> foldMap1 f' (z:|zs)
-  go (x:|[])   ys        = f' x <> foldMap1 g' ys
-  go (x:|z:zs) (y:|w:ws) = f' x <> g' y <> go (z:|zs) (w:|ws)
-
--- | traverse both containers, interleaving effects for fairness
-traverseWithKeyBoth1 
-  :: (TraversableWithKey1 f, TraversableWithKey1 g, Apply m) 
-  => (Key f -> a -> m b) 
-  -> (Key g -> a -> m b) 
-  -> f a 
-  -> g a 
-  -> m (f b, g b)
-traverseWithKeyBoth1 f g as bs = (refill as *** refill bs) <$> go (toKeyedNonEmptyList as) (toKeyedNonEmptyList bs)
-  where
-  f' = uncurry f
-  g' = uncurry g
-  go (x:|[])   (y:|[])   = (\x' y'            -> ([x'],      [y']  )) <$> f' x <.> g' y
-  go (x:|z:zs) (y:|[])   = (\x' y' (z':|zs')  -> (x':z':zs', [y']  )) <$> f' x <.> g' y <.> traverse1 f' (z:|zs)
-  go (x:|[])   ys        = (\x' (y':|ys')     -> ([x'],      y':ys')) <$> f' x <.> traverse1 g' ys
-  go (x:|z:zs) (y:|w:ws) = (\x' y' (xs', ys') -> (x':xs',    y':ys')) <$> f' x <.> g' y <.> go (z:|zs) (w:|ws)
diff --git a/Numeric/Nat/Zeroless.hs b/Numeric/Nat/Zeroless.hs
deleted file mode 100644
--- a/Numeric/Nat/Zeroless.hs
+++ /dev/null
@@ -1,225 +0,0 @@
-{-# LANGUAGE TypeFamilies, Rank2Types, TypeOperators, GADTs, EmptyDataDecls, FlexibleInstances, FlexibleContexts, UndecidableInstances  #-}
-----------------------------------------------------------------------
--- |
--- Module      :  Numeric.Nat.Zeroless
--- Copyright   :  (c) Edward Kmett 2011
--- License     :  BSD3
--- 
--- Maintainer  :  ekmett@gmail.com
--- Stability   :  experimental
--- 
--- Zeroless numbers encoded in zeroless binary numbers
-----------------------------------------------------------------------
-
-module Numeric.Nat.Zeroless
-  ( D0(..), D1(..), D2(..), (:+:), (:*:), Zeroless(..)
-  , Succ, Pred
-  , LT, GT, EQ
-  , Compare
-  , N1, N8, N16, N32, N64
-  , Nat(..), nat 
-  , Fin(..)
-  , Reverse
-  ) where
-
-import Data.Function (on)
-import Prelude hiding (lookup)
-
-infixl 7 :*:
-infixl 6 :+: 
-
--- * Type-level naturals using zeroless binary numbers
-
-data D0 = D0 -- ^ 0 
-data D1 n = D1 n -- ^ 2n + 1
-data D2 n = D2 n -- ^ 2n + 2
-
--- * useful numbers
-type N1 = D1 D0
-type N8  = D2 (D1 (D1 D0))
-type N16 = D2 (D1 (D1 (D1 D0)))
-type N32 = D2 (D1 (D1 (D1 (D1 D0))))
-type N64 = D2 (D1 (D1 (D1 (D1 (D1 D0)))))
-
--- * Successor 
-type family Succ n
-type instance Succ D0 = D1 D0
-type instance Succ (D1 n) = D2 n
-type instance Succ (D2 n) = D1 (Succ n)
-
-type family Pred n
-type instance Pred (D1 D0) = D0
-type instance Pred (D1 (D1 n)) = D2 (Pred (D1 n))
-type instance Pred (D1 (D2 n)) = D2 (D1 n)
-type instance Pred (D2 n) = D1 n
-
--- * Carry flags
-data C0
-data C1
-data C2
-
--- * Add with carry
-type family Add c n m
-type instance Add C0 D0 n = n
-type instance Add C1 D0 D0 = D1 D0
-type instance Add C2 D0 D0 = D2 D0
-type instance Add C1 D0 (D1 n) = D2 n
-type instance Add C1 D0 (D2 n) = D1 (Add C1 D0 n) 
-type instance Add C2 D0 (D1 n) = D1 (Add C1 D0 n)
-type instance Add C2 D0 (D2 n) = D2 (Add C1 D0 n)
-type instance Add C0 (D1 n) D0 = D1 n
-type instance Add C1 (D1 n) D0 = D2 n
-type instance Add C2 (D1 n) D0 = D1 (Add C1 D0 n)
-type instance Add C0 (D1 n) (D1 m) = D2 (Add C0 n m)
-type instance Add C1 (D1 n) (D1 m) = D1 (Add C1 n m)
-type instance Add C2 (D1 n) (D1 m) = D2 (Add C1 n m)
-type instance Add C0 (D1 n) (D2 m) = D1 (Add C1 n m)
-type instance Add C1 (D1 n) (D2 m) = D2 (Add C1 n m)
-type instance Add C2 (D1 n) (D2 m) = D1 (Add C2 n m)
-type instance Add C0 (D2 n) D0 = D2 n
-type instance Add C1 (D2 n) D0 = D1 (Add C1 D0 n)
-type instance Add C2 (D2 n) D0 = D2 (Add C1 D0 n)
-type instance Add C0 (D2 n) (D1 m) = D1 (Add C1 n m)
-type instance Add C1 (D2 n) (D1 m) = D2 (Add C1 n m)
-type instance Add C2 (D2 n) (D1 m) = D1 (Add C2 n m)
-type instance Add C0 (D2 n) (D2 m) = D2 (Add C1 n m)
-type instance Add C1 (D2 n) (D2 m) = D1 (Add C2 n m)
-type instance Add C2 (D2 n) (D2 m) = D2 (Add C2 n m)
-
--- * Adder
-type n :+: m = Add C0 n m
-
-data LT
-data EQ
-data GT
-
-type family   Compare' a l      r
-type instance Compare' a D0     D0     = a
-type instance Compare' a D0     (D1 r) = LT
-type instance Compare' a D0     (D2 r) = LT
-type instance Compare' a (D1 r) D0     = GT
-type instance Compare' a (D1 l) (D1 r) = Compare' a l r
-type instance Compare' a (D1 l) (D2 r) = Compare' LT l r
-type instance Compare' a (D2 l) D0     = GT
-type instance Compare' a (D2 l) (D1 r) = Compare' GT l r
-type instance Compare' a (D2 l) (D2 r) = Compare' a l r
-
-type Compare m n = Compare' EQ m n 
-
--- * Multiplier
-type family n :*: m
-type instance D0 :*: m = D0
-type instance D1 n :*: m = (n :*: m) :+: (n :*: m) :+: m
-type instance D2 n :*: m = (n :*: m) :+: (n :*: m) :+: m :+: m
-
--- * Digit Counter
-type family Digits n
-type instance Digits D0 = D0
-type instance Digits (D1 n) = Succ (Digits n)
-type instance Digits (D2 n) = Succ (Digits n)
-
-type family Reverse' n m
-type instance Reverse' m D0     = m 
-type instance Reverse' m (D1 n) = Reverse' (D1 m) n 
-type instance Reverse' m (D2 n) = Reverse' (D2 m) n
-
--- * bitwise reversal
-type Reverse n = Reverse' D0 n
-
-{-
-data Z = Z
-newtype S n = S n
-class Nat n where
-  caseNat :: forall n. ((n ~ Z) => r) -> (forall x. (n ~ (S x), Nat x) => x -> r) -> r
--}
-
--- * Class of zeroless-binary numbers
-class Zeroless n where
-  ind :: f D0 
-      -> (forall m. Zeroless m => f m -> f (D1 m)) 
-      -> (forall m. Zeroless m => f m -> f (D2 m))
-      -> f n
-  caseNat
-    :: ((n ~ D0) => r) 
-    -> (forall x. (n ~ D1 x, Zeroless x) => x -> r)
-    -> (forall x. (n ~ D2 x, Zeroless x) => x -> r)
-    -> n -> r
-
-instance Zeroless D0 where
-  ind z _ _ = z 
-  caseNat z _ _ _ = z
-
-instance Zeroless n => Zeroless (D1 n) where
-  ind z f g = f (ind z f g)
-  caseNat _ f _ (D1 x) = f x
-
-instance Zeroless n => Zeroless (D2 n) where
-  ind z f g = g (ind z f g)
-  caseNat _ _ g (D2 x) = g x
-
-class Zeroless n => Positive n
-instance Zeroless n => Positive (D1 n)
-instance Zeroless n => Positive (D2 n)
-
-newtype Nat n = Nat { fromNat :: Int }
-
-instance Zeroless n => Eq (Nat n) where
-  _ == _ = True
-
-instance Zeroless n => Ord (Nat n) where
-  compare _ _ = EQ
-
-instance Zeroless n => Show (Nat n) where
-  showsPrec d (Nat n) = showsPrec d n
-
-instance Zeroless n => Bounded (Nat n) where
-  minBound = nat
-  maxBound = nat
-
-instance Zeroless n => Enum (Nat n) where
-  fromEnum (Nat n) = n
-  toEnum _ = nat
-
-nat :: Zeroless n => Nat n 
-nat = ind (Nat 0) 
-          (Nat . (+1) . (*2) . fromNat) 
-          (Nat . (+2) . (*2) . fromNat)
-
--- * A finite number @m < n@
-newtype Fin n = Fin { fromFin :: Int } 
-
-instance Show (Fin n) where
-  showsPrec d = showsPrec d . fromFin
-
-instance Eq (Fin n) where
-  (==) = (==) `on` fromFin
-
-instance Ord (Fin n) where
-  compare = compare `on` fromFin 
-
-instance Positive n => Num (Fin n) where
-  fromInteger = toEnum . fromInteger
-  a + b = toEnum (fromFin a + fromFin b)
-  a * b = toEnum (fromFin a * fromFin b)
-  a - b = toEnum (fromFin a - fromFin b)
-  abs a = a
-  signum 0 = 0
-  signum _ = 1
-
-inFin :: (Int -> Int) -> Fin n -> Fin n
-inFin f = Fin . f . fromFin
-
-instance Positive n => Bounded (Fin n) where
-  minBound = Fin 0
-  maxBound = inFin (subtract 1) $ 
-             ind (Fin 0) 
-                 (Fin . ((+1) . (*2)) . fromFin)
-                 (Fin . ((+2) . (*2)) . fromFin)
-
-instance Positive n => Enum (Fin n) where
-  fromEnum = fromFin
-  toEnum n = r where
-    r | n < 0 = error "Fin.toEnum: negative number"
-      | Fin n <= b = Fin n `asTypeOf` b
-      | otherwise = error "Fin.toEnum: index out of range"
-    b = maxBound
diff --git a/representable-tries.cabal b/representable-tries.cabal
--- a/representable-tries.cabal
+++ b/representable-tries.cabal
@@ -1,6 +1,6 @@
 name:          representable-tries
 category:      Data Structures, Functors, Monads, Comonads
-version:       2.5
+version:       3.0
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -20,6 +20,8 @@
   location: git://github.com/ekmett/representable-tries.git
 
 library
+  hs-source-dirs: src
+
   other-extensions:
     CPP
     EmptyDataDecls
@@ -34,19 +36,19 @@
     UndecidableInstances
 
   build-depends:
+    adjunctions            == 3.0.*,
     base                   >= 4       && < 5,
+    bifunctors             == 3.0.*,
+    comonad                == 3.0.*,
+    comonad-transformers   == 3.0.*,
     containers             >= 0.3     && < 0.6,
+    distributive           >= 0.2.2   && < 0.3,
+    keys                   == 3.0.*,
     mtl                    >= 2.0.1   && < 2.2,
     transformers           >= 0.2     && < 0.4,
-    bifunctors             >= 0.1.3.1 && < 0.2,
-    comonad                >= 1.1.1.5 && < 1.2,
-    distributive           >= 0.2.2   && < 0.3,
+    representable-functors == 3.0.*,
     semigroups             >= 0.8.3.1 && < 0.9,
-    semigroupoids          >= 1.3.1.2 && < 1.4,
-    keys                   >= 2.2     && < 2.3,
-    comonad-transformers   >= 2.1.1.1 && < 2.2,
-    adjunctions            >= 2.5     && < 2.6,
-    representable-functors >= 2.5     && < 2.6
+    semigroupoids          == 3.0.*
 
   exposed-modules:
     Control.Monad.Reader.Trie
diff --git a/src/Control/Monad/Reader/Trie.hs b/src/Control/Monad/Reader/Trie.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Reader/Trie.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Reader.Trie
+-- Copyright   :  (c) Edward Kmett 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+--
+----------------------------------------------------------------------
+
+module Control.Monad.Reader.Trie (
+  -- * A "Representable Trie"-based Reader monad transformer
+    ReaderTrieT(..)
+  , module Data.Functor.Representable.Trie
+  ) where
+
+import Control.Applicative
+import Control.Comonad
+import Control.Monad.Trans.Class
+import Control.Monad.IO.Class
+import Control.Monad.Reader.Class
+import Control.Monad.Writer.Class as Writer
+import Data.Distributive
+import Data.Functor.Bind
+import Data.Functor.Extend
+import Data.Functor.Representable
+import Data.Functor.Representable.Trie
+import Data.Foldable
+import Data.Key
+import Data.Traversable
+import Data.Semigroup
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Prelude hiding (lookup,zipWith)
+
+type instance Key (ReaderTrieT a m) = (a, Key m)
+
+newtype ReaderTrieT a m b = ReaderTrieT { runReaderTrieT :: a :->: m b }
+
+instance (HasTrie a, Functor m) => Functor (ReaderTrieT a m) where
+  fmap f = ReaderTrieT . fmap (fmap f) . runReaderTrieT
+
+instance (HasTrie a, Apply m) => Apply (ReaderTrieT a m) where
+  ReaderTrieT ff <.> ReaderTrieT fa = ReaderTrieT ((<.>) <$> ff <.> fa)
+
+instance (HasTrie a, Applicative m) => Applicative (ReaderTrieT a m) where
+  pure = ReaderTrieT . pure . pure
+  ReaderTrieT ff <*> ReaderTrieT fa = ReaderTrieT ((<*>) <$> ff <*> fa)
+
+instance (HasTrie a, Bind m) => Bind (ReaderTrieT a m) where
+  ReaderTrieT fm >>- f = ReaderTrieT $ tabulate (\a -> index fm a >>- flip index a . runReaderTrieT . f)
+
+instance (HasTrie a, Monad m) => Monad (ReaderTrieT a m) where
+  return = ReaderTrieT . pure . return
+  ReaderTrieT fm >>= f = ReaderTrieT $ tabulate (\a -> index fm a >>= flip index a . runReaderTrieT . f)
+
+instance (HasTrie a, Monad m) => MonadReader a (ReaderTrieT a m) where
+  ask = ReaderTrieT (trie return)
+  local f (ReaderTrieT fm) = ReaderTrieT (tabulate (index fm . f))
+
+instance HasTrie a => MonadTrans (ReaderTrieT a) where
+  lift = ReaderTrieT . pure
+
+instance (HasTrie a, Distributive m) => Distributive (ReaderTrieT a m) where
+  distribute = ReaderTrieT . fmap distribute . collect runReaderTrieT
+
+instance (HasTrie a, Zip m) => Zip (ReaderTrieT a m) where
+  zipWith f (ReaderTrieT m) (ReaderTrieT n) = ReaderTrieT $ zipWith (zipWith f) m n
+
+instance (HasTrie a, ZipWithKey m) => ZipWithKey (ReaderTrieT a m) where
+  zipWithKey f (ReaderTrieT m) (ReaderTrieT n) = ReaderTrieT $ zipWithKey (\k -> zipWithKey (f . (,) k)) m n
+
+instance (HasTrie a, Keyed m) => Keyed (ReaderTrieT a m) where
+  mapWithKey f = ReaderTrieT . mapWithKey (\k -> mapWithKey (f . (,) k)) . runReaderTrieT
+
+instance (HasTrie a, Indexable m) => Indexable (ReaderTrieT a m) where
+  index = uncurry . fmap index . untrie . runReaderTrieT
+
+instance (HasTrie a, Adjustable m) => Adjustable (ReaderTrieT a m) where
+  adjust f (a,k) = ReaderTrieT . adjust (adjust f k) a . runReaderTrieT
+
+instance (HasTrie a, Lookup ((:->:) a), Lookup m) => Lookup (ReaderTrieT a m) where
+  lookup (k,k') (ReaderTrieT fm) = lookup k fm >>= lookup k'
+
+instance (HasTrie a, Representable m) => Representable (ReaderTrieT a m) where
+  tabulate = ReaderTrieT . trie . fmap tabulate . curry
+
+instance (HasTrie a, Foldable m) => Foldable (ReaderTrieT a m) where
+  foldMap f = foldMap (foldMap f) . runReaderTrieT
+
+instance (HasTrie a, Foldable1 m) => Foldable1 (ReaderTrieT a m) where
+  foldMap1 f = foldMap1 (foldMap1 f) . runReaderTrieT
+
+instance (HasTrie a, FoldableWithKey m) => FoldableWithKey (ReaderTrieT a m) where
+  foldMapWithKey f = foldMapWithKey (\k -> foldMapWithKey (f . (,) k)) . runReaderTrieT
+
+instance (HasTrie a, FoldableWithKey1 m) => FoldableWithKey1 (ReaderTrieT a m) where
+  foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) k)) . runReaderTrieT
+
+instance (HasTrie a, Traversable m) => Traversable (ReaderTrieT a m) where
+  traverse f = fmap ReaderTrieT . traverse (traverse f) . runReaderTrieT
+
+instance (HasTrie a, Traversable1 m) => Traversable1 (ReaderTrieT a m) where
+  traverse1 f = fmap ReaderTrieT . traverse1 (traverse1 f) . runReaderTrieT
+
+instance (HasTrie a, TraversableWithKey m) => TraversableWithKey (ReaderTrieT a m) where
+  traverseWithKey f = fmap ReaderTrieT . traverseWithKey (\k -> traverseWithKey (f . (,) k)) . runReaderTrieT
+
+instance (HasTrie a, TraversableWithKey1 m) => TraversableWithKey1 (ReaderTrieT a m) where
+  traverseWithKey1 f = fmap ReaderTrieT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) k)) . runReaderTrieT
+
+instance (HasTrie a, Representable m, Semigroup a, Semigroup (Key m)) => Extend (ReaderTrieT a m) where
+  extended = extendedRep
+  duplicated = duplicatedRep
+
+instance (HasTrie a, Representable m, Monoid a, Monoid (Key m)) => Comonad (ReaderTrieT a m) where
+  extend = extendRep
+  duplicate = duplicateRep
+  extract = extractRep
+
+instance (HasTrie a, MonadIO m) => MonadIO (ReaderTrieT a m) where
+  liftIO = lift . liftIO
+
+instance (HasTrie a, MonadWriter w m) => MonadWriter w (ReaderTrieT a m) where
+  tell = lift . tell
+  listen = ReaderTrieT . tabulate . fmap Writer.listen . index . runReaderTrieT
+  pass = ReaderTrieT . tabulate . fmap Writer.pass . index . runReaderTrieT
+
diff --git a/src/Data/Functor/Representable/Trie.hs b/src/Data/Functor/Representable/Trie.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Functor/Representable/Trie.hs
@@ -0,0 +1,388 @@
+{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, UndecidableInstances #-}
+{-# OPTIONS_GHC -fenable-rewrite-rules #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Representable.Trie
+-- Copyright   :  (c) Edward Kmett 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+--
+----------------------------------------------------------------------
+
+module Data.Functor.Representable.Trie
+  (
+  -- * Representations of polynomial functors
+    HasTrie(..)
+  -- * Memoizing functions
+  , mup, memo, memo2, memo3
+  , inTrie, inTrie2, inTrie3
+  -- * Workarounds for current GHC limitations
+  , trie, untrie
+  , (:->:)(..)
+  , Entry(..)
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Comonad
+import Control.Monad.Reader.Class
+import Control.Monad.Representable.Reader
+import Data.Bits
+import Data.Distributive
+import Data.Semigroup
+import Data.Word
+import Data.Int
+import Data.Foldable
+import Data.Function (on)
+import Data.Functor.Adjunction
+import Data.Functor.Bind
+import Data.Functor.Extend
+import Data.Functor.Identity
+import Data.Functor.Representable.Trie.Bool
+import Data.Functor.Representable.Trie.Either
+import Data.Functor.Representable.Trie.List
+import Data.Key
+import qualified Data.Monoid as Monoid
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.Sequence (Seq, (<|))
+import qualified Data.Sequence as Seq
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Traversable
+import Prelude hiding (lookup, foldr)
+
+class (Adjustable (BaseTrie a), TraversableWithKey1 (BaseTrie a), Representable (BaseTrie a)) => HasTrie a where
+  type BaseTrie a :: * -> *
+  -- projectKey . embedKey = id
+  embedKey   :: a -> Key (BaseTrie a)
+  projectKey :: Key (BaseTrie a) -> a
+{-
+  validKey   :: Key (BaseTrie a) -> Bool
+  validKey _ = True
+-}
+
+newtype a :->: b = Trie { runTrie :: BaseTrie a b }
+
+type instance Key ((:->:) a) = a
+
+data Entry a b = Entry a b
+
+-- * Combinators
+
+-- Matt Hellige's notation for @argument f . result g@.
+-- <http://matt.immute.net/content/pointless-fun>
+(~>) :: (a' -> a) -> (b -> b') -> (a -> b) -> a' -> b'
+g ~> f = (f .) . (. g)
+
+untrie :: HasTrie t => (t :->: a) -> t -> a
+untrie = index
+
+trie :: HasTrie t => (t -> a) -> (t :->: a)
+trie = tabulate
+
+{-# RULES
+"trie/untrie" forall t. trie (untrie t) = t
+"embedKey/projectKey" forall t. projectKey (embedKey t) = t
+ #-}
+
+memo :: HasTrie t => (t -> a) -> t -> a
+memo = untrie . trie
+
+-- | Lift a memoizer to work with one more argument.
+mup :: HasTrie t => (b -> c) -> (t -> b) -> t -> c
+mup mem f = memo (mem . f)
+
+-- | Memoize a binary function, on its first argument and then on its
+-- second.  Take care to exploit any partial evaluation.
+memo2 :: (HasTrie s, HasTrie t) => (s -> t -> a) -> s -> t -> a
+memo2 = mup memo
+
+-- | Memoize a ternary function on successive arguments.  Take care to
+-- exploit any partial evaluation.
+memo3 :: (HasTrie r, HasTrie s, HasTrie t) => (r -> s -> t -> a) -> r -> s -> t -> a
+memo3 = mup memo2
+
+-- | Apply a unary function inside of a tabulate
+inTrie
+  :: (HasTrie a, HasTrie c)
+  => ((a -> b) -> c -> d)
+  -> (a :->: b) -> c :->: d
+inTrie = untrie ~> trie
+
+-- | Apply a binary function inside of a tabulate
+inTrie2
+  :: (HasTrie a, HasTrie c, HasTrie e)
+  => ((a -> b) -> (c -> d) -> e -> f)
+  -> (a :->: b) -> (c :->: d) -> e :->: f
+inTrie2 = untrie ~> inTrie
+
+-- | Apply a ternary function inside of a tabulate
+inTrie3
+  :: (HasTrie a, HasTrie c, HasTrie e, HasTrie g)
+  => ((a -> b) -> (c -> d) -> (e -> f) -> g -> h)
+  -> (a :->: b) -> (c :->: d) -> (e :->: f) -> g :->: h
+inTrie3 = untrie ~> inTrie2
+
+-- * Implementation details
+
+instance Functor (Entry a) where
+  fmap f (Entry a b) = Entry a (f b)
+
+instance HasTrie e => Lookup ((:->:)e) where
+  lookup = lookupDefault
+
+instance HasTrie e => Indexable ((:->:)e) where
+  index (Trie f) = index f . embedKey
+
+instance HasTrie e => Distributive ((:->:) e) where
+  distribute = distributeRep
+
+instance HasTrie e => Representable ((:->:) e) where
+  tabulate f = Trie $ tabulate (f . projectKey)
+
+instance HasTrie e => Adjustable ((:->:) e) where
+  adjust f k (Trie as) = Trie (adjust f (embedKey k) as)
+
+instance HasTrie e => Zip ((:->:) e)
+
+instance HasTrie e => ZipWithKey ((:->:) e)
+
+instance HasTrie e => Adjunction (Entry e) ((:->:) e) where
+  unit = mapWithKey Entry . pure
+  counit (Entry a t) = index t a
+
+instance HasTrie a => Functor ((:->:) a) where
+  fmap f (Trie g) = Trie (fmap f g)
+
+instance HasTrie a => Keyed ((:->:) a) where
+  mapWithKey f (Trie a) = Trie (mapWithKey (f . projectKey) a)
+
+instance HasTrie a => Foldable ((:->:) a) where
+  foldMap f (Trie a) = foldMap f a
+
+instance HasTrie a => FoldableWithKey ((:->:) a) where
+  foldMapWithKey f (Trie a) = foldMapWithKey (f . projectKey) a
+
+instance HasTrie a => Traversable ((:->:) a) where
+  traverse f (Trie a) = Trie <$> traverse f a
+
+instance HasTrie a => TraversableWithKey ((:->:) a) where
+  traverseWithKey f (Trie a) = Trie <$> traverseWithKey (f . projectKey) a
+
+instance HasTrie a => Foldable1 ((:->:) a) where
+  foldMap1 f (Trie a) = foldMap1 f a
+
+instance HasTrie a => FoldableWithKey1 ((:->:) a) where
+  foldMapWithKey1 f (Trie a) = foldMapWithKey1 (f . projectKey) a
+
+instance HasTrie a => Traversable1 ((:->:) a) where
+  traverse1 f (Trie a) = Trie <$> traverse1 f a
+
+instance HasTrie a => TraversableWithKey1 ((:->:) a) where
+  traverseWithKey1 f (Trie a) = Trie <$> traverseWithKey1 (f . projectKey) a
+
+instance (HasTrie a, Eq b) => Eq (a :->: b) where
+  (==) = (==) `on` toList
+
+instance (HasTrie a, Ord b) => Ord (a :->: b) where
+  compare = compare `on` toList
+
+instance (HasTrie a, Show a, Show b) => Show (a :->: b) where
+  showsPrec d = showsPrec d . toKeyedList
+
+instance HasTrie a => Apply ((:->:) a) where
+  (<.>) = apRep
+  a <. _ = a
+  _ .> b = b
+
+instance HasTrie a => Applicative ((:->:) a) where
+  pure a = Trie (pureRep a)
+  (<*>) = apRep
+  a <* _ = a
+  _ *> b = b
+
+instance HasTrie a => Bind ((:->:) a) where
+  Trie m >>- f = Trie (tabulate (\a -> index (runTrie (f (index m a))) a))
+
+instance HasTrie a => Monad ((:->:) a) where
+  return a = Trie (pureRep a)
+  (>>=) = (>>-)
+  _ >> m = m
+
+instance HasTrie a => MonadReader a ((:->:) a) where
+  ask = askRep
+  local = localRep
+
+-- TODO: remove dependency on HasTrie in these:
+
+instance (HasTrie m, Monoid m) => Comonad ((:->:) m) where
+  duplicate = duplicateRep
+  extract = flip index mempty
+
+instance (HasTrie m, Semigroup m) => Extend ((:->:) m) where
+  duplicated = duplicatedRep
+
+-- * Instances
+
+instance HasTrie () where
+  type BaseTrie () = Identity
+  embedKey = id
+  projectKey = id
+
+instance HasTrie Bool where
+  type BaseTrie Bool = BoolTrie
+  embedKey = id
+  projectKey = id
+
+instance HasTrie Any where
+  type BaseTrie Any = BoolTrie
+  embedKey = getAny
+  projectKey = Any
+
+instance HasTrie a => HasTrie (Dual a) where
+  type BaseTrie (Dual a) = BaseTrie a
+  embedKey = embedKey . getDual
+  projectKey = Dual . projectKey
+
+instance HasTrie a => HasTrie (Sum a) where
+  type BaseTrie (Sum a) = BaseTrie a
+  embedKey = embedKey . getSum
+  projectKey = Sum . projectKey
+
+instance HasTrie a => HasTrie (Monoid.Product a) where
+  type BaseTrie (Monoid.Product a) = BaseTrie a
+  embedKey = embedKey . Monoid.getProduct
+  projectKey = Monoid.Product . projectKey
+
+instance (HasTrie a, HasTrie b) => HasTrie (a, b) where
+  type BaseTrie (a, b) = ReaderT (BaseTrie a) (BaseTrie b)
+  embedKey = embedKey *** embedKey
+  projectKey = projectKey *** projectKey
+
+instance (HasTrie a, HasTrie b) => HasTrie (Entry a b) where
+  type BaseTrie (Entry a b) = ReaderT (BaseTrie a) (BaseTrie b)
+  embedKey (Entry a b) = (embedKey a, embedKey b)
+  projectKey (a, b) = Entry (projectKey a) (projectKey b)
+
+instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where
+  type BaseTrie (Either a b) = EitherTrie (BaseTrie a) (BaseTrie b)
+  embedKey = embedKey +++ embedKey
+  projectKey = projectKey +++ projectKey
+
+instance HasTrie a => HasTrie (Maybe a) where
+  type BaseTrie (Maybe a) = EitherTrie Identity (BaseTrie a)
+  embedKey   = maybe (Left ()) (Right . embedKey)
+  projectKey = either (const Nothing) (Just . projectKey)
+
+instance HasTrie a => HasTrie [a] where
+  type BaseTrie [a] = ListTrie (BaseTrie a)
+  embedKey = map embedKey
+  projectKey = map projectKey
+
+instance HasTrie a => HasTrie (Seq a) where
+  type BaseTrie (Seq a) = ListTrie (BaseTrie a)
+  embedKey = foldr ((:) . embedKey) []
+  projectKey = foldr ((<|) . projectKey) (Seq.empty)
+
+instance (HasTrie k, HasTrie v) => HasTrie (Map k v) where
+  type BaseTrie (Map k v) = ListTrie (BaseTrie (k, v))
+  embedKey = foldrWithKey (\k v t -> embedKey (k,v) : t) []
+  projectKey = Map.fromDistinctAscList . map projectKey
+
+instance (HasTrie v) => HasTrie (IntMap v) where
+  type BaseTrie (IntMap v) = ListTrie (BaseTrie (Int, v))
+  embedKey = foldrWithKey (\k v t -> embedKey (k,v) : t) []
+  projectKey = IntMap.fromDistinctAscList . map projectKey
+
+
+-- | Extract bits in little-endian order
+bits :: Bits t => t -> [Bool]
+bits 0 = []
+bits x = testBit x 0 : bits (shiftR x 1)
+
+-- | Convert boolean to 0 (False) or 1 (True)
+unbit :: Num t => Bool -> t
+unbit False = 0
+unbit True  = 1
+
+-- | Bit list to value
+unbits :: Bits t => [Bool] -> t
+unbits [] = 0
+unbits (x:xs) = unbit x .|. shiftL (unbits xs) 1
+
+unbitsZ :: (Bits n) => (Bool,[Bool]) -> n
+unbitsZ (positive,bs) = sig (unbits bs)
+ where
+   sig | positive  = id
+       | otherwise = negate
+
+bitsZ :: (Ord n, Bits n) => n -> (Bool,[Bool])
+bitsZ = (>= 0) &&& (bits . abs)
+
+-- TODO: fix the show instance of this
+instance HasTrie Int where
+  type BaseTrie Int = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+
+instance HasTrie Int8 where
+  type BaseTrie Int8 = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+
+instance HasTrie Int16 where
+  type BaseTrie Int16 = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+
+instance HasTrie Int32 where
+  type BaseTrie Int32 = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+
+instance HasTrie Int64 where
+  type BaseTrie Int64 = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+
+instance HasTrie Word where
+  type BaseTrie Word = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+instance HasTrie Word8 where
+  type BaseTrie Word8 = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+instance HasTrie Word16 where
+  type BaseTrie Word16 = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+instance HasTrie Word32 where
+  type BaseTrie Word32 = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+instance HasTrie Word64 where
+  type BaseTrie Word64 = BaseTrie (Bool, [Bool])
+  embedKey = embedKey . bitsZ
+  projectKey = unbitsZ . projectKey
+
+-- TODO: fix tree to 21 bit depth
+instance HasTrie Char where
+  type BaseTrie Char = BaseTrie [Bool]
+  embedKey = bits . fromEnum
+  projectKey = toEnum . unbits
+
+instance (HasTrie a, HasTrie b, HasTrie c) => HasTrie (a,b,c) where
+  type BaseTrie (a,b,c) = BaseTrie (a,(b,c))
+  embedKey (a,b,c) = embedKey (a,(b,c))
+  projectKey p = let (a,(b,c)) = projectKey p in (a,b,c)
+
+instance (HasTrie a, HasTrie b, HasTrie c, HasTrie d) => HasTrie (a,b,c,d) where
+  type BaseTrie (a,b,c,d) = BaseTrie ((a,b),(c,d))
+  embedKey (a,b,c,d) = embedKey ((a,b),(c,d))
+  projectKey p = let ((a,b),(c,d)) = projectKey p in (a,b,c,d)
diff --git a/src/Data/Functor/Representable/Trie/Bool.hs b/src/Data/Functor/Representable/Trie/Bool.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Functor/Representable/Trie/Bool.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE TypeFamilies #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Representable.Trie.Bool
+-- Copyright   :  (c) Edward Kmett 2011
+-- License     :  BSD3
+-- 
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+-- 
+----------------------------------------------------------------------
+
+module Data.Functor.Representable.Trie.Bool ( BoolTrie (..) ) where
+
+import Control.Applicative
+import Data.Distributive
+import Data.Functor.Representable
+import Data.Functor.Bind
+import Data.Foldable
+import Data.Traversable
+import Data.Semigroup
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.Key
+import Prelude hiding (lookup)
+
+-- (Bool, -) -| BoolTrie
+data BoolTrie a = BoolTrie a a deriving (Eq,Ord,Show,Read)
+
+false :: BoolTrie a -> a
+false (BoolTrie a _) = a
+
+true :: BoolTrie a -> a
+true (BoolTrie _ b) = b
+
+type instance Key BoolTrie = Bool
+
+instance Functor BoolTrie where
+  fmap f (BoolTrie a b) = BoolTrie (f a) (f b)
+  b <$ _ = pure b
+
+instance Apply BoolTrie where
+  BoolTrie a b <.> BoolTrie c d = BoolTrie (a c) (b d)
+  a <. _ = a
+  _ .> b = b
+
+instance Applicative BoolTrie where
+  pure a = BoolTrie a a
+  (<*>) = (<.>) 
+  a <* _ = a
+  _ *> b = b
+
+instance Bind BoolTrie where
+  BoolTrie a b >>- f = BoolTrie (false (f a)) (true (f b))
+
+instance Monad BoolTrie where
+  return = pure
+  BoolTrie a b >>= f = BoolTrie (false (f a)) (true (f b))
+  _ >> a = a
+
+instance Keyed BoolTrie where
+  mapWithKey f (BoolTrie a b) = BoolTrie (f False a) (f True b)
+
+instance Zip BoolTrie where
+  zipWith f (BoolTrie a b) (BoolTrie c d) = BoolTrie (f a c) (f b d)
+
+instance ZipWithKey BoolTrie where
+  zipWithKey f (BoolTrie a b) (BoolTrie c d) = BoolTrie (f False a c) (f True b d)
+
+instance Foldable BoolTrie where
+  foldMap f (BoolTrie a b) = f a `mappend` f b
+
+instance Foldable1 BoolTrie where
+  foldMap1 f (BoolTrie a b) = f a <> f b
+
+instance Traversable BoolTrie where
+  traverse f (BoolTrie a b) = BoolTrie <$> f a <*> f b
+
+instance Traversable1 BoolTrie where
+  traverse1 f (BoolTrie a b) = BoolTrie <$> f a <.> f b
+
+instance FoldableWithKey BoolTrie where
+  foldMapWithKey f (BoolTrie a b) = f False a `mappend` f True b
+
+instance FoldableWithKey1 BoolTrie where
+  foldMapWithKey1 f (BoolTrie a b) = f False a <> f True b
+
+instance TraversableWithKey BoolTrie where
+  traverseWithKey f (BoolTrie a b) = BoolTrie <$> f False a <*> f True b
+
+instance TraversableWithKey1 BoolTrie where
+  traverseWithKey1 f (BoolTrie a b) = BoolTrie <$> f False a <.> f True b
+
+instance Distributive BoolTrie where
+  distribute = distributeRep
+
+instance Indexable BoolTrie where
+  index (BoolTrie a _) False = a
+  index (BoolTrie _ b) True  = b
+
+instance Adjustable BoolTrie where
+  adjust f False (BoolTrie a b) = BoolTrie (f a) b
+  adjust f True (BoolTrie a b) = BoolTrie a (f b)
+
+instance Lookup BoolTrie where
+  lookup = lookupDefault
+
+instance Representable BoolTrie where
+  tabulate f = BoolTrie (f False) (f True)
diff --git a/src/Data/Functor/Representable/Trie/Either.hs b/src/Data/Functor/Representable/Trie/Either.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Functor/Representable/Trie/Either.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE TypeFamilies #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Representable.Trie.Bool
+-- Copyright   :  (c) Edward Kmett 2011
+-- License     :  BSD3
+-- 
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+-- 
+----------------------------------------------------------------------
+
+module Data.Functor.Representable.Trie.Either ( 
+    EitherTrie (..) 
+  , left
+  , right
+  ) where
+
+import Control.Applicative
+import Data.Distributive
+import Data.Functor.Representable
+import Data.Functor.Bind
+import Data.Foldable
+import Data.Traversable
+import Data.Traversable.Fair
+import Data.Semigroup
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.Key
+import Prelude hiding (lookup,zipWith)
+
+-- the product functor would be the trie of an either, but we fair traversal
+data EitherTrie f g a = EitherTrie (f a) (g a)
+
+type instance Key (EitherTrie f g) = Either (Key f) (Key g)
+
+left :: EitherTrie f g a -> f a
+left (EitherTrie f _) = f
+
+right :: EitherTrie f g a -> g a
+right (EitherTrie _ g) = g
+
+instance (Apply f, Apply g, Semigroup s) => Semigroup (EitherTrie f g s) where
+  EitherTrie a b <> EitherTrie c d = EitherTrie ((<>) <$> a <.> c) ((<>) <$> b <.> d)
+
+instance (Applicative f, Applicative g, Monoid a) => Monoid (EitherTrie f g a) where
+  mempty = EitherTrie (pure mempty) (pure mempty)
+  EitherTrie a b `mappend` EitherTrie c d = EitherTrie (mappend <$> a <*> c) (mappend <$> b <*> d)
+
+instance (Functor f, Functor g) => Functor (EitherTrie f g) where
+  fmap f (EitherTrie fs gs) = EitherTrie (fmap f fs) (fmap f gs)
+  b <$ EitherTrie fs gs = EitherTrie (b <$ fs) (b <$ gs)
+
+instance (Apply f, Apply g) => Apply (EitherTrie f g) where
+  EitherTrie ff fg <.> EitherTrie af ag = EitherTrie (ff <.> af) (fg <.> ag)
+  a <. _ = a
+  _ .> b = b
+
+instance (Applicative f, Applicative g) => Applicative (EitherTrie f g) where
+  pure a = EitherTrie (pure a) (pure a)
+  EitherTrie ff fg <*> EitherTrie af ag = EitherTrie (ff <*> af) (fg <*> ag)
+  a <* _ = a
+  _ *> b = b
+
+-- the direct implementation in terms of Bind is inefficient, using bindRep instead
+instance (Apply f, Representable f, Apply g, Representable g) => Bind (EitherTrie f g) where
+  (>>-) = bindRep
+
+instance (Representable f, Representable g) => Monad (EitherTrie f g) where
+  return = pureRep
+  (>>=) = bindRep
+  _ >> a = a
+
+instance (Keyed f, Keyed g) => Keyed (EitherTrie f g) where
+  mapWithKey f (EitherTrie fs gs) = EitherTrie (mapWithKey (f . Left) fs) (mapWithKey (f . Right) gs)
+
+instance (Zip f, Zip g) => Zip (EitherTrie f g) where
+  zipWith f (EitherTrie fs gs) (EitherTrie hs is) = EitherTrie (zipWith f fs hs) (zipWith f gs is)
+
+instance (ZipWithKey f, ZipWithKey g) => ZipWithKey (EitherTrie f g) where
+  zipWithKey f (EitherTrie fs gs) (EitherTrie hs is) = EitherTrie (zipWithKey (f . Left) fs hs) (zipWithKey (f . Right) gs is)
+
+instance (Foldable f, Foldable g) => Foldable (EitherTrie f g) where
+  foldMap f (EitherTrie fs gs) = foldMapBoth f fs gs
+
+instance (Foldable1 f, Foldable1 g) => Foldable1 (EitherTrie f g) where
+  foldMap1 f (EitherTrie fs gs) = foldMapBoth1 f fs gs
+
+instance (Traversable f, Traversable g) => Traversable (EitherTrie f g) where
+  traverse f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseBoth f fs gs
+
+instance (Traversable1 f, Traversable1 g) => Traversable1 (EitherTrie f g) where
+  traverse1 f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseBoth1 f fs gs
+
+instance (FoldableWithKey f, FoldableWithKey g) => FoldableWithKey (EitherTrie f g) where
+  foldMapWithKey f (EitherTrie fs gs) = foldMapWithKeyBoth (f . Left) (f . Right) fs gs
+
+instance (FoldableWithKey1 f, FoldableWithKey1 g) => FoldableWithKey1 (EitherTrie f g) where
+  foldMapWithKey1 f (EitherTrie fs gs) = foldMapWithKeyBoth1 (f . Left) (f . Right) fs gs
+
+instance (TraversableWithKey f, TraversableWithKey g) => TraversableWithKey (EitherTrie f g) where
+  traverseWithKey f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseWithKeyBoth (f . Left) (f . Right) fs gs
+
+instance (TraversableWithKey1 f, TraversableWithKey1 g) => TraversableWithKey1 (EitherTrie f g) where
+  traverseWithKey1 f (EitherTrie fs gs) = uncurry EitherTrie <$> traverseWithKeyBoth1 (f . Left) (f . Right) fs gs
+
+instance (Representable f, Representable g) => Distributive (EitherTrie f g) where
+  distribute = distributeRep
+
+instance (Indexable f, Indexable g) => Indexable (EitherTrie f g) where
+  index (EitherTrie fs _) (Left  i) = index fs i
+  index (EitherTrie _ gs) (Right j) = index gs j
+
+instance (Adjustable f, Adjustable g) => Adjustable (EitherTrie f g) where
+  adjust f (Left i) (EitherTrie fs gs)  = EitherTrie (adjust f i fs) gs
+  adjust f (Right j) (EitherTrie fs gs) = EitherTrie fs (adjust f j gs)
+
+instance (Lookup f, Lookup g) => Lookup (EitherTrie f g) where
+  lookup (Left i) (EitherTrie fs _)  = lookup i fs
+  lookup (Right j) (EitherTrie _ gs) = lookup j gs
+
+instance (Representable f, Representable g) => Representable (EitherTrie f g) where
+  tabulate f = EitherTrie (tabulate (f . Left)) (tabulate (f . Right))
diff --git a/src/Data/Functor/Representable/Trie/List.hs b/src/Data/Functor/Representable/Trie/List.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Functor/Representable/Trie/List.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE TypeFamilies #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Representable.Trie.List
+-- Copyright   :  (c) Edward Kmett 2011
+-- License     :  BSD3
+--
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+--
+----------------------------------------------------------------------
+
+module Data.Functor.Representable.Trie.List (
+    ListTrie (..)
+  , nil
+  , cons
+  ) where
+
+import Control.Applicative
+import Data.Distributive
+import Data.Functor.Representable
+import Data.Functor.Bind
+import Data.Foldable
+import Data.Traversable
+import Data.Semigroup
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.Key
+import Prelude hiding (lookup,zipWith)
+
+-- the f-branching stream comonad is the trie of a list
+data ListTrie f a = ListTrie a (f (ListTrie f a)) -- deriving (Eq,Ord,Show,Read)
+
+type instance Key (ListTrie f) = [Key f]
+
+nil :: ListTrie f a -> a
+nil (ListTrie x _) = x
+
+cons :: Indexable f => Key f -> ListTrie f a -> ListTrie f a
+cons a (ListTrie _ xs) = index xs a
+
+instance Functor f => Functor (ListTrie f) where
+  fmap f (ListTrie a as) = ListTrie (f a) (fmap (fmap f) as)
+-- b <$ _ = pure b
+
+instance Representable f => Apply (ListTrie f) where
+  (<.>) = apRep
+  a <. _ = a
+  _ .> b = b
+
+instance Representable f => Applicative (ListTrie f) where
+  pure a = as where as = ListTrie a (pureRep as)
+  (<*>) = apRep
+  a <* _ = a
+  _ *> b = b
+
+instance Representable f => Bind (ListTrie f) where
+  (>>-) = bindRep
+
+instance Representable f => Monad (ListTrie f) where
+  return a = as where as = ListTrie a (pureRep as)
+  (>>=) = bindRep
+  _ >> a = a
+
+instance Zip f => Zip (ListTrie f) where
+  zipWith f (ListTrie a as) (ListTrie b bs) = ListTrie (f a b) (zipWith (zipWith f) as bs)
+
+instance ZipWithKey f => ZipWithKey (ListTrie f) where
+  zipWithKey f (ListTrie a as) (ListTrie b bs) = ListTrie (f [] a b) (zipWithKey (\x -> zipWithKey (f . (x:))) as bs)
+
+instance Keyed f => Keyed (ListTrie f) where
+  mapWithKey f (ListTrie a as) = ListTrie (f [] a) (mapWithKey (\x -> mapWithKey (f . (x:))) as)
+
+instance Foldable f => Foldable (ListTrie f) where
+  foldMap f (ListTrie a as) = f a `mappend` foldMap (foldMap f) as
+
+instance Foldable1 f => Foldable1 (ListTrie f) where
+  foldMap1 f (ListTrie a as) = f a <> foldMap1 (foldMap1 f) as
+
+instance Traversable f => Traversable (ListTrie f) where
+  traverse f (ListTrie a as) = ListTrie <$> f a <*> traverse (traverse f) as
+
+instance Traversable1 f => Traversable1 (ListTrie f) where
+  traverse1 f (ListTrie a as) = ListTrie <$> f a <.> traverse1 (traverse1 f) as
+
+instance FoldableWithKey f => FoldableWithKey (ListTrie f) where
+  foldMapWithKey f (ListTrie a as) = f [] a `mappend` foldMapWithKey (\x -> foldMapWithKey (f . (x:))) as
+
+instance FoldableWithKey1 f => FoldableWithKey1 (ListTrie f) where
+  foldMapWithKey1 f (ListTrie a as) = f [] a <> foldMapWithKey1 (\x -> foldMapWithKey1 (f . (x:))) as
+
+instance TraversableWithKey f => TraversableWithKey (ListTrie f) where
+  traverseWithKey f (ListTrie a as) = ListTrie <$> f [] a <*> traverseWithKey (\x -> traverseWithKey (f . (x:))) as
+
+instance TraversableWithKey1 f => TraversableWithKey1 (ListTrie f) where
+  traverseWithKey1 f (ListTrie a as) = ListTrie <$> f [] a <.> traverseWithKey1 (\x -> traverseWithKey1 (f . (x:))) as
+
+instance Representable f => Distributive (ListTrie f) where
+  distribute = distributeRep
+
+instance Indexable f => Indexable (ListTrie f) where
+  index (ListTrie x _) [] = x
+  index (ListTrie _ xs) (a:as) = index (index xs a) as
+
+instance Adjustable f => Adjustable (ListTrie f) where
+  adjust f [] (ListTrie x xs) = ListTrie (f x) xs
+  adjust f (a:as) (ListTrie x xs) = ListTrie x (adjust (adjust f as) a xs)
+
+instance Lookup f => Lookup (ListTrie f) where
+  lookup [] (ListTrie x _) = Just x
+  lookup (a:as) (ListTrie _ xs) = lookup a xs >>= lookup as
+
+instance Representable f => Representable (ListTrie f) where
+  tabulate f = ListTrie (f []) (tabulate (\x -> tabulate (f . (x:))))
diff --git a/src/Data/Traversable/Fair.hs b/src/Data/Traversable/Fair.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Traversable/Fair.hs
@@ -0,0 +1,130 @@
+module Data.Traversable.Fair 
+  ( foldMapBoth
+  , traverseBoth
+  , foldMapWithKeyBoth
+  , traverseWithKeyBoth
+  , foldMapBoth1
+  , traverseBoth1
+  , foldMapWithKeyBoth1
+  , traverseWithKeyBoth1
+  ) where
+
+import Control.Applicative
+import Control.Arrow
+import Data.Key
+import Data.Functor.Apply
+import Data.Foldable
+import Data.Traversable
+import Data.Semigroup
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.List.NonEmpty as NonEmpty hiding (toList)
+
+refill :: Traversable t => t a -> [b] -> t b
+refill t l = snd (mapAccumL (\xs _ -> (Prelude.tail xs, Prelude.head xs)) l t)
+
+toNonEmptyList :: Foldable1 f => f a -> NonEmpty a
+toNonEmptyList = NonEmpty.fromList . toList
+
+toKeyedNonEmptyList :: FoldableWithKey1 f => f a -> NonEmpty (Key f, a)
+toKeyedNonEmptyList = NonEmpty.fromList . toKeyedList
+
+foldMapBoth :: (Foldable f, Foldable g, Monoid m) => (a -> m) -> f a -> g a -> m
+foldMapBoth f as bs = go (toList as) (toList bs) where
+  go [] [] = mempty
+  go xs [] = foldMap f xs
+  go [] ys = foldMap f ys
+  go (x:xs) (y:ys) = f x `mappend` f y `mappend` go xs ys
+
+-- | traverse both containers, interleaving effects for fairness
+traverseBoth :: (Traversable f, Traversable g, Applicative m) => (a -> m b) -> f a -> g a -> m (f b, g b)
+traverseBoth f as bs = (refill as *** refill bs) <$> go (toList as) (toList bs)
+  where
+  go [] []         = pure ([],[])
+  go xs []         = flip (,) [] <$> traverse f xs
+  go [] ys         = (,) [] <$> traverse f ys
+  go (x:xs) (y:ys) = (\x' y' (xs',ys') -> (x':xs',y':ys')) <$> f x <*> f y <*> go xs ys
+
+-- | fold both containers, interleaving results for fairness
+foldMapBoth1 :: (Foldable1 f, Foldable1 g, Semigroup m) => (a -> m) -> f a -> g a -> m
+foldMapBoth1 f as bs = go (toNonEmptyList as) (toNonEmptyList bs)
+  where
+  go (x:|[])   (y:|[])   = f x <> f y
+  go (x:|z:zs) (y:|[])   = f x <> f y <> foldMap1 f (z:|zs)
+  go (x:|[])   ys        = f x <> foldMap1 f ys
+  go (x:|z:zs) (y:|w:ws) = f x <> f y <> go (z:|zs) (w:|ws)
+
+-- | traverse both containers, interleaving effects for fairness
+traverseBoth1 :: (Traversable1 f, Traversable1 g, Apply m) => (a -> m b) -> f a -> g a -> m (f b, g b)
+traverseBoth1 f as bs = (refill as *** refill bs) <$> go (toNonEmptyList as) (toNonEmptyList bs)
+  where
+  go (x:|[])   (y:|[])   = (\x' y'            -> ([x'],       [y']  )) <$> f x <.> f y
+  go (x:|z:zs) (y:|[])   = (\x' y' (x'':|xs') -> (x':x'':xs', [y']  )) <$> f x <.> f y <.> traverse1 f (z:|zs)
+  go (x:|[])   ys        = (\x' (y':|ys')     -> ([x'],       y':ys')) <$> f x <.> traverse1 f ys
+  go (x:|z:zs) (y:|w:ws) = (\x' y' (xs', ys') -> (x':xs',     y':ys')) <$> f x <.> f y <.> go (z:|zs) (w:|ws)
+
+foldMapWithKeyBoth 
+  :: (FoldableWithKey f, FoldableWithKey g, Monoid m) 
+  => (Key f -> a -> m) 
+  -> (Key g -> a -> m)
+  -> f a 
+  -> g a 
+  -> m
+foldMapWithKeyBoth f g as bs = go (toKeyedList as) (toKeyedList bs) where
+  f' = uncurry f
+  g' = uncurry g
+  go [] [] = mempty
+  go xs [] = foldMap f' xs
+  go [] ys = foldMap g' ys
+  go (x:xs) (y:ys) = f' x `mappend` g' y `mappend` go xs ys
+
+-- | traverse both containers, interleaving effects for fairness
+traverseWithKeyBoth 
+  :: (TraversableWithKey f, TraversableWithKey g, Applicative m) 
+  => (Key f -> a -> m b) 
+  -> (Key g -> a -> m b) 
+  -> f a 
+  -> g a 
+  -> m (f b, g b)
+traverseWithKeyBoth f g as bs = (refill as *** refill bs) <$> go (toKeyedList as) (toKeyedList bs)
+  where
+  f' = uncurry f
+  g' = uncurry g
+  go [] []         = pure ([],[])
+  go xs []         = flip (,) [] <$> traverse f' xs
+  go [] ys         = (,) [] <$> traverse g' ys
+  go (x:xs) (y:ys) = (\x' y' (xs',ys') -> (x':xs',y':ys')) <$> f' x <*> g' y <*> go xs ys
+
+-- | fold both containers, interleaving results for fairness
+foldMapWithKeyBoth1 
+  :: (FoldableWithKey1 f, FoldableWithKey1 g, Semigroup m) 
+  => (Key f -> a -> m) 
+  -> (Key g -> a -> m) 
+  -> f a 
+  -> g a 
+  -> m
+foldMapWithKeyBoth1 f g as bs = go (toKeyedNonEmptyList as) (toKeyedNonEmptyList bs)
+  where
+  f' = uncurry f
+  g' = uncurry g
+  go (x:|[])   (y:|[])   = f' x <> g' y
+  go (x:|z:zs) (y:|[])   = f' x <> g' y <> foldMap1 f' (z:|zs)
+  go (x:|[])   ys        = f' x <> foldMap1 g' ys
+  go (x:|z:zs) (y:|w:ws) = f' x <> g' y <> go (z:|zs) (w:|ws)
+
+-- | traverse both containers, interleaving effects for fairness
+traverseWithKeyBoth1 
+  :: (TraversableWithKey1 f, TraversableWithKey1 g, Apply m) 
+  => (Key f -> a -> m b) 
+  -> (Key g -> a -> m b) 
+  -> f a 
+  -> g a 
+  -> m (f b, g b)
+traverseWithKeyBoth1 f g as bs = (refill as *** refill bs) <$> go (toKeyedNonEmptyList as) (toKeyedNonEmptyList bs)
+  where
+  f' = uncurry f
+  g' = uncurry g
+  go (x:|[])   (y:|[])   = (\x' y'            -> ([x'],      [y']  )) <$> f' x <.> g' y
+  go (x:|z:zs) (y:|[])   = (\x' y' (z':|zs')  -> (x':z':zs', [y']  )) <$> f' x <.> g' y <.> traverse1 f' (z:|zs)
+  go (x:|[])   ys        = (\x' (y':|ys')     -> ([x'],      y':ys')) <$> f' x <.> traverse1 g' ys
+  go (x:|z:zs) (y:|w:ws) = (\x' y' (xs', ys') -> (x':xs',    y':ys')) <$> f' x <.> g' y <.> go (z:|zs) (w:|ws)
diff --git a/src/Numeric/Nat/Zeroless.hs b/src/Numeric/Nat/Zeroless.hs
new file mode 100644
--- /dev/null
+++ b/src/Numeric/Nat/Zeroless.hs
@@ -0,0 +1,225 @@
+{-# LANGUAGE TypeFamilies, Rank2Types, TypeOperators, GADTs, EmptyDataDecls, FlexibleInstances, FlexibleContexts, UndecidableInstances  #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Numeric.Nat.Zeroless
+-- Copyright   :  (c) Edward Kmett 2011
+-- License     :  BSD3
+-- 
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+-- 
+-- Zeroless numbers encoded in zeroless binary numbers
+----------------------------------------------------------------------
+
+module Numeric.Nat.Zeroless
+  ( D0(..), D1(..), D2(..), (:+:), (:*:), Zeroless(..)
+  , Succ, Pred
+  , LT, GT, EQ
+  , Compare
+  , N1, N8, N16, N32, N64
+  , Nat(..), nat 
+  , Fin(..)
+  , Reverse
+  ) where
+
+import Data.Function (on)
+import Prelude hiding (lookup)
+
+infixl 7 :*:
+infixl 6 :+: 
+
+-- * Type-level naturals using zeroless binary numbers
+
+data D0 = D0 -- ^ 0 
+data D1 n = D1 n -- ^ 2n + 1
+data D2 n = D2 n -- ^ 2n + 2
+
+-- * useful numbers
+type N1 = D1 D0
+type N8  = D2 (D1 (D1 D0))
+type N16 = D2 (D1 (D1 (D1 D0)))
+type N32 = D2 (D1 (D1 (D1 (D1 D0))))
+type N64 = D2 (D1 (D1 (D1 (D1 (D1 D0)))))
+
+-- * Successor 
+type family Succ n
+type instance Succ D0 = D1 D0
+type instance Succ (D1 n) = D2 n
+type instance Succ (D2 n) = D1 (Succ n)
+
+type family Pred n
+type instance Pred (D1 D0) = D0
+type instance Pred (D1 (D1 n)) = D2 (Pred (D1 n))
+type instance Pred (D1 (D2 n)) = D2 (D1 n)
+type instance Pred (D2 n) = D1 n
+
+-- * Carry flags
+data C0
+data C1
+data C2
+
+-- * Add with carry
+type family Add c n m
+type instance Add C0 D0 n = n
+type instance Add C1 D0 D0 = D1 D0
+type instance Add C2 D0 D0 = D2 D0
+type instance Add C1 D0 (D1 n) = D2 n
+type instance Add C1 D0 (D2 n) = D1 (Add C1 D0 n) 
+type instance Add C2 D0 (D1 n) = D1 (Add C1 D0 n)
+type instance Add C2 D0 (D2 n) = D2 (Add C1 D0 n)
+type instance Add C0 (D1 n) D0 = D1 n
+type instance Add C1 (D1 n) D0 = D2 n
+type instance Add C2 (D1 n) D0 = D1 (Add C1 D0 n)
+type instance Add C0 (D1 n) (D1 m) = D2 (Add C0 n m)
+type instance Add C1 (D1 n) (D1 m) = D1 (Add C1 n m)
+type instance Add C2 (D1 n) (D1 m) = D2 (Add C1 n m)
+type instance Add C0 (D1 n) (D2 m) = D1 (Add C1 n m)
+type instance Add C1 (D1 n) (D2 m) = D2 (Add C1 n m)
+type instance Add C2 (D1 n) (D2 m) = D1 (Add C2 n m)
+type instance Add C0 (D2 n) D0 = D2 n
+type instance Add C1 (D2 n) D0 = D1 (Add C1 D0 n)
+type instance Add C2 (D2 n) D0 = D2 (Add C1 D0 n)
+type instance Add C0 (D2 n) (D1 m) = D1 (Add C1 n m)
+type instance Add C1 (D2 n) (D1 m) = D2 (Add C1 n m)
+type instance Add C2 (D2 n) (D1 m) = D1 (Add C2 n m)
+type instance Add C0 (D2 n) (D2 m) = D2 (Add C1 n m)
+type instance Add C1 (D2 n) (D2 m) = D1 (Add C2 n m)
+type instance Add C2 (D2 n) (D2 m) = D2 (Add C2 n m)
+
+-- * Adder
+type n :+: m = Add C0 n m
+
+data LT
+data EQ
+data GT
+
+type family   Compare' a l      r
+type instance Compare' a D0     D0     = a
+type instance Compare' a D0     (D1 r) = LT
+type instance Compare' a D0     (D2 r) = LT
+type instance Compare' a (D1 r) D0     = GT
+type instance Compare' a (D1 l) (D1 r) = Compare' a l r
+type instance Compare' a (D1 l) (D2 r) = Compare' LT l r
+type instance Compare' a (D2 l) D0     = GT
+type instance Compare' a (D2 l) (D1 r) = Compare' GT l r
+type instance Compare' a (D2 l) (D2 r) = Compare' a l r
+
+type Compare m n = Compare' EQ m n 
+
+-- * Multiplier
+type family n :*: m
+type instance D0 :*: m = D0
+type instance D1 n :*: m = (n :*: m) :+: (n :*: m) :+: m
+type instance D2 n :*: m = (n :*: m) :+: (n :*: m) :+: m :+: m
+
+-- * Digit Counter
+type family Digits n
+type instance Digits D0 = D0
+type instance Digits (D1 n) = Succ (Digits n)
+type instance Digits (D2 n) = Succ (Digits n)
+
+type family Reverse' n m
+type instance Reverse' m D0     = m 
+type instance Reverse' m (D1 n) = Reverse' (D1 m) n 
+type instance Reverse' m (D2 n) = Reverse' (D2 m) n
+
+-- * bitwise reversal
+type Reverse n = Reverse' D0 n
+
+{-
+data Z = Z
+newtype S n = S n
+class Nat n where
+  caseNat :: forall n. ((n ~ Z) => r) -> (forall x. (n ~ (S x), Nat x) => x -> r) -> r
+-}
+
+-- * Class of zeroless-binary numbers
+class Zeroless n where
+  ind :: f D0 
+      -> (forall m. Zeroless m => f m -> f (D1 m)) 
+      -> (forall m. Zeroless m => f m -> f (D2 m))
+      -> f n
+  caseNat
+    :: ((n ~ D0) => r) 
+    -> (forall x. (n ~ D1 x, Zeroless x) => x -> r)
+    -> (forall x. (n ~ D2 x, Zeroless x) => x -> r)
+    -> n -> r
+
+instance Zeroless D0 where
+  ind z _ _ = z 
+  caseNat z _ _ _ = z
+
+instance Zeroless n => Zeroless (D1 n) where
+  ind z f g = f (ind z f g)
+  caseNat _ f _ (D1 x) = f x
+
+instance Zeroless n => Zeroless (D2 n) where
+  ind z f g = g (ind z f g)
+  caseNat _ _ g (D2 x) = g x
+
+class Zeroless n => Positive n
+instance Zeroless n => Positive (D1 n)
+instance Zeroless n => Positive (D2 n)
+
+newtype Nat n = Nat { fromNat :: Int }
+
+instance Zeroless n => Eq (Nat n) where
+  _ == _ = True
+
+instance Zeroless n => Ord (Nat n) where
+  compare _ _ = EQ
+
+instance Zeroless n => Show (Nat n) where
+  showsPrec d (Nat n) = showsPrec d n
+
+instance Zeroless n => Bounded (Nat n) where
+  minBound = nat
+  maxBound = nat
+
+instance Zeroless n => Enum (Nat n) where
+  fromEnum (Nat n) = n
+  toEnum _ = nat
+
+nat :: Zeroless n => Nat n 
+nat = ind (Nat 0) 
+          (Nat . (+1) . (*2) . fromNat) 
+          (Nat . (+2) . (*2) . fromNat)
+
+-- * A finite number @m < n@
+newtype Fin n = Fin { fromFin :: Int } 
+
+instance Show (Fin n) where
+  showsPrec d = showsPrec d . fromFin
+
+instance Eq (Fin n) where
+  (==) = (==) `on` fromFin
+
+instance Ord (Fin n) where
+  compare = compare `on` fromFin 
+
+instance Positive n => Num (Fin n) where
+  fromInteger = toEnum . fromInteger
+  a + b = toEnum (fromFin a + fromFin b)
+  a * b = toEnum (fromFin a * fromFin b)
+  a - b = toEnum (fromFin a - fromFin b)
+  abs a = a
+  signum 0 = 0
+  signum _ = 1
+
+inFin :: (Int -> Int) -> Fin n -> Fin n
+inFin f = Fin . f . fromFin
+
+instance Positive n => Bounded (Fin n) where
+  minBound = Fin 0
+  maxBound = inFin (subtract 1) $ 
+             ind (Fin 0) 
+                 (Fin . ((+1) . (*2)) . fromFin)
+                 (Fin . ((+2) . (*2)) . fromFin)
+
+instance Positive n => Enum (Fin n) where
+  fromEnum = fromFin
+  toEnum n = r where
+    r | n < 0 = error "Fin.toEnum: negative number"
+      | Fin n <= b = Fin n `asTypeOf` b
+      | otherwise = error "Fin.toEnum: index out of range"
+    b = maxBound