diff --git a/Data/TrieMap.hs b/Data/TrieMap.hs
--- a/Data/TrieMap.hs
+++ b/Data/TrieMap.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts, UnboxedTuples #-}
 
 module Data.TrieMap (
 	-- * Map type
@@ -36,6 +36,7 @@
 	unionWithKey,
 	unionMaybeWith,
 	unionMaybeWithKey,
+	symmetricDifference,
 	-- ** Difference
 	difference,
 	differenceWith,
@@ -88,16 +89,6 @@
 	-- * Submap
 	isSubmapOf,
 	isSubmapOfBy,
-	-- * Indexed
-	predecessor,
-	lookupWithIndex,
-	successor,
-	neighborhood,
-	lookupIndex,
-	predecessorAt,
-	lookupAt,
-	successorAt,
-	neighborhoodAt,	
 	-- * Min/Max
 	findMin,
 	findMax,
@@ -120,23 +111,15 @@
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Applicative
 import Data.TrieMap.Rep
-import Data.TrieMap.Rep.Instances
-import Data.TrieMap.Modifiers
--- import Data.TrieMap.ReverseMap
+import Data.TrieMap.Rep.Instances ()
 import Data.TrieMap.Sized
-import Data.TrieMap.CPair
 
 import Control.Applicative hiding (empty)
 import Control.Arrow
 import Control.Monad
 import Data.Maybe hiding (mapMaybe)
 import Data.Monoid(Monoid(..), First(..), Last(..))
--- import Data.Foldable
--- import Data.Traversable
 
--- import Generics.MultiRec.Base
--- import Data.TrieMap.Regular.Base
--- import Data.TrieMap.Regular.Sized
 import GHC.Exts (build)
 
 import Prelude hiding (lookup, foldr, null, map, filter, reverse)
@@ -154,31 +137,52 @@
 	mempty = empty
 	mappend = union
 
--- newtype Elem a k = Elem {getElem :: a}
+-- | The empty map.
 empty :: TKey k => TMap k a
 empty = TMap emptyM
 
+-- | A map with a single element.
 singleton :: TKey k => k -> a -> TMap k a
 singleton k a = insert k a empty
 
+-- | Is the map empty?
 null :: TKey k => TMap k a -> Bool
 null (TMap m) = nullM m
 
+-- | Lookup the value at a key in the map.
+-- 
+-- The function will return the corresponding value as @('Just' value)@, or 'Nothing' if the key isn't in the map.
 lookup :: TKey k => k -> TMap k a -> Maybe a
 lookup k (TMap m) = getElem <$> lookupM (toRep k) m
 
+-- | The expression @('findWithDefault' def k map)@ returns the value at key @k@ or returns default value @def@
+-- when the key is not in the map.
 findWithDefault :: TKey k => a -> k -> TMap k a -> a
 findWithDefault a = fromMaybe a .: lookup
 
+-- | Find the value at a key. Calls 'error' when the element can not be found.
 (!) :: TKey k => TMap k a -> k -> a
 m ! k = fromMaybe (error "Element not found") (lookup k m)
 
+-- | The expression @('alter' f k map)@ alters the value @x@ at @k@, or absence thereof. 
+-- 'alter' can be used to insert, delete, or update a value in a 'TMap'. In short:
+-- @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
 alter :: TKey k => (Maybe a -> Maybe a) -> k -> TMap k a -> TMap k a
 alter f k (TMap m) = TMap (alterM elemSize (fmap Elem . f . fmap getElem) (toRep k) m)
 
+extract :: (TKey k, MonadPlus m) => (k -> a -> m (x, Maybe a)) -> TMap k a -> m (x, TMap k a)
+extract f m = unwrapMonad (extractA (WrapMonad .: f) m)
+
 -- | Projects information out of, and modifies or deletes, an individual association pair, 
 -- alternating over all associations in the map.
 -- 
+-- If @assocs m == [(k1, a1), ..., (kn, an)]@, then
+-- 
+-- > extract f m = let upd k (x, maybeA) = (x, alter (const maybeA) k m) in
+-- >   (upd k1 <$> f kn an) <|> ... <|> (upd kn <$> f kn an)
+-- 
+-- This generalizes a large number of operations, including
+-- 
 -- > minViewWithKey == getFirst (extract (\ k a -> return ((k, a), Nothing)))
 -- > updateMaxWithKey f m == maybe m snd (getLast (extract (\ k a -> return ((), f k a)) m))
 -- 
@@ -187,21 +191,8 @@
 -- > getFirst (extract (\ k a -> if p k a then return ((k, a), Nothing) else mzero) m)
 -- 
 -- finds and removes the first association pair satisfying the predicate |p|.
-
-extract :: (TKey k, MonadPlus m) => (k -> a -> m (x, Maybe a)) -> TMap k a -> m (x, TMap k a)
-extract f m = unwrapMonad (extractA (WrapMonad .: f) m)
-
--- | Generalization of 'extract' for 'Alternative' functors.
 extractA :: (TKey k, Alternative f) => (k -> a -> f (x, Maybe a)) -> TMap k a -> f (x, TMap k a)
-extractA f (TMap m) = pairFromC <$> fmap TMap <$> extractM elemSize (\ k (Elem a) -> fmap (\ (x, y) -> x `cP` (Elem <$> y)) (f (fromRep k) a)) m
-
--- | Like 'extract', but does not modify the map.
-about :: (TKey k, MonadPlus m) => (k -> a -> m x) -> TMap k a -> m x
-about f = unwrapMonad . aboutA (WrapMonad .: f)
-
--- | Generalization of 'about' for 'Alternative' functors.
-aboutA :: (TKey k, Alternative f) => (k -> a -> f x) -> TMap k a -> f x
-aboutA f = fst <.> extractA (\ k a -> flip (,) Nothing <$> f k a)
+extractA f (TMap m) = fmap TMap <$> extractM elemSize (\ k (Elem a) -> fmap (fmap (fmap Elem)) (f (fromRep k) a)) m
 
 insert :: TKey k => k -> a -> TMap k a -> TMap k a
 insert = insertWith const
@@ -292,7 +283,7 @@
 	f' k (Elem a) (Elem b) = Elem <$> f (fromRep k) a b
 
 difference, (\\) :: TKey k => TMap k a -> TMap k b -> TMap k a
-difference = differenceWith (\ x _ -> Nothing)
+difference = differenceWith (\ _ _ -> Nothing)
 
 (\\) = difference
 
@@ -345,17 +336,16 @@
 
 mapEitherWithKey :: TKey k => (k -> a -> Either b c) -> TMap k a -> (TMap k b, TMap k c)
 mapEitherWithKey f (TMap m) = case mapEitherM elemSize elemSize f' m of
-	(mL, mR) -> (TMap mL, TMap mR) 
+	(# mL, mR #) -> (TMap mL, TMap mR) 
 	where	f' k (Elem a) = case f (fromRep k) a of
-			Left b	-> (Just (Elem b), Nothing)
-			Right c	-> (Nothing, Just (Elem c))
+			Left b	-> (# Just (Elem b), Nothing #)
+			Right c	-> (# Nothing, Just (Elem c) #)
 
 mapMaybe :: TKey k => (a -> Maybe b) -> TMap k a -> TMap k b
 mapMaybe = mapMaybeWithKey . const
 
 mapMaybeWithKey :: TKey k => (k -> a -> Maybe b) -> TMap k a -> TMap k b
-mapMaybeWithKey f (TMap m) = TMap (snd (mapEitherM elemSize elemSize f' m)) where
-	f' k (Elem a) = (Nothing, Elem <$> f (fromRep k) a)
+mapMaybeWithKey f (TMap m) = TMap (mapMaybeM elemSize (\ k (Elem a) -> Elem <$> f (fromRep k) a) m)
 
 partition :: TKey k => (a -> Bool) -> TMap k a -> (TMap k a, TMap k a)
 partition = partitionWithKey . const
@@ -375,8 +365,8 @@
 
 splitLookup :: TKey k => k -> TMap k a -> (TMap k a, Maybe a, TMap k a)
 splitLookup k (TMap m) = case splitLookupM elemSize f (toRep k) m of
-	(mL, x, mR) -> (TMap mL, x, TMap mR) 
-	where	f (Elem x) = (Nothing, Just x, Nothing)
+	(# mL, x, mR #) -> (TMap mL, x, TMap mR) 
+	where	f (Elem x) = (# Nothing, Just x, Nothing #)
 
 isSubmapOf :: (TKey k, Eq a) => TMap k a -> TMap k a -> Bool
 isSubmapOf = isSubmapOfBy (==)
@@ -409,54 +399,5 @@
 notMember :: TKey k => k -> TMap k a -> Bool
 notMember = not .: member
 
--- showMap :: (TKey k, Show (TrieMap (Rep k) (Elem a) (Rep k))) => TMap k a -> String
--- showMap (TMap m) = show m
-
--- | @'predecessor' k a@ returns the index, key, and value of the immediate predecessor of @k@ in the map.  
--- The predecessor is the element with the largest key @< k@.
-predecessor :: TKey k => k -> TMap k a -> Maybe (Int, k, a)
-predecessor k m = fst3 (neighborhood k m)
-
-lookupIndex :: TKey k => k -> TMap k a -> Maybe Int
-lookupIndex k m = fst3 <$> lookupWithIndex k m 
-
-fst3 (a, b, c) = a
-snd3 (a, b, c) = b
-thd3 (a, b, c) = c
-
-findIndex :: TKey k => k -> TMap k a -> Int
-k `findIndex`  m = fromMaybe (error "element is not in the map") (k `lookupIndex` m)
-
-lookupWithIndex :: TKey k => k -> TMap k a -> Maybe (Int, k, a)
-lookupWithIndex k m = snd3 (neighborhood k m)
-
-successor :: TKey k => k -> TMap k a -> Maybe (Int, k, a)
-successor k m = thd3 (neighborhood k m)
-
-neighborhood :: TKey k => k -> TMap k a -> (Maybe (Int, k, a), Maybe (Int, k, a), Maybe (Int, k, a))
-neighborhood k (TMap m) = case lookupIxM elemSize (toRep k) m of
-		(pr, x, su) -> (fix <$> getLast pr, fix <$> x, fix <$> getFirst su)
-	where	fix (Asc i k (Elem a)) = (i, fromRep k, a)
-
-predecessorAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)
-predecessorAt k m = fst3 (neighborhoodAt k m)
-
-lookupAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)
-lookupAt k m = snd3 (neighborhoodAt k m)
-
-successorAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)
-successorAt k m = thd3 (neighborhoodAt k m)
-
-neighborhoodAt :: TKey k => Int -> TMap k a -> (Maybe (Int, k, a), Maybe (Int, k, a), Maybe (Int, k, a))
-neighborhoodAt i (TMap m) = case assocAtM elemSize i m of
-		(pr, x, su) -> (fix <$> getLast pr, fix <$> x, fix <$> getFirst su)
-	where	fix (Asc i k (Elem a)) = (i, fromRep k, a)
-
 keysSet :: TKey k => TMap k a -> TSet k
-keysSet = TSet . map (const ())
-
--- reverseMap :: TKey k => TMap k a -> TMap (Rev k) a
--- reverseMap (TMap m) = TMap (reverse m)
-
--- unReverseMap :: TKey k => TMap (Rev k) a -> TMap k a
--- unReverseMap (TMap m) = TMap (unreverse m)
+keysSet m = TSet (() <$ m)
diff --git a/Data/TrieMap/Applicative.hs b/Data/TrieMap/Applicative.hs
--- a/Data/TrieMap/Applicative.hs
+++ b/Data/TrieMap/Applicative.hs
@@ -3,13 +3,11 @@
 module Data.TrieMap.Applicative where
 
 import Control.Applicative
-import Control.Arrow
 import Control.Monad
 
 import Data.Monoid hiding (Dual)
 
 newtype Id a = Id {unId :: a}
-newtype WM w m a = WM {runWM :: m (w, a)}
 
 instance Functor First where
 	fmap f (First m) = First (fmap f m)
@@ -25,20 +23,6 @@
 	return = Last . return
 	Last m >>= k = Last (m >>= getLast . k)
 
-instance Functor m => Functor (WM w m) where
-	fmap f (WM x) = WM (fmap (second f) x)
-
-instance (Applicative m, Monoid w) => Applicative (WM w m) where
-	pure x = WM (pure (mempty, x))
-	WM f <*> WM x = WM (fmap (\ (fW, ff) (xW, xx) -> (fW `mappend` xW, ff xx)) f <*> x)
-
-instance (Alternative m, Monoid w) => Alternative (WM w m) where
-	empty = WM empty
-	WM a <|> WM b = WM (a <|> b)
-
-write :: (Functor m, Monoid w) => w -> WM w m a -> WM w m a
-write w (WM m) = WM (fmap (\ (v, xx) -> (v `mappend` w, xx)) m)
-
 instance Applicative Id where
 	pure = Id
 	Id f <*> Id x = Id (f x)
@@ -54,13 +38,6 @@
 	mzero = mempty
 	mplus = mappend
 
--- instance Monad First where
--- 	return x = First (Just x)
--- 	First Nothing >>= _ = First Nothing
--- 	First (Just x) >>= k = k x
--- 
--- instance Monad Last
-
 (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
 (f .: g) x y = f (g x y)
 
@@ -69,9 +46,6 @@
 
 (<.:>) :: Functor f => (c -> d) -> (a -> b -> f c) -> a -> b -> f d
 (f <.:> g) x y = f <$> g x y
-{-
-(<|>) :: MonadPlus m => m a -> m a -> m a
-(<|>) = mplus-}
 
 instance Applicative First where
 	pure = return
@@ -96,7 +70,7 @@
 
 instance Applicative f => Applicative (Dual f) where
 	pure = Dual . pure
-	Dual f <*> Dual x = Dual (flip ($) <$> x <*> f)
+	Dual f <*> Dual x = Dual (f <*> x)
 
 instance Alternative f => Alternative (Dual f) where
 	empty = Dual empty
diff --git a/Data/TrieMap/CPair.hs b/Data/TrieMap/CPair.hs
deleted file mode 100644
--- a/Data/TrieMap/CPair.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-
-module Data.TrieMap.CPair where
-
-newtype CPair a b = CP (forall r . (a -> b -> r) -> r)
-
-pairFromC :: CPair a b -> (a, b)
-pairFromC (CP k) = k (,)
-
-pairToC :: (a, b) -> CPair a b
-pairToC p = CP (\ k -> uncurry k p)
-
-instance Functor (CPair a) where
-	fmap f (CP k) = CP (\ g -> k (\ x -> g x . f))
-
-on1st :: (a -> b) -> CPair a c -> CPair b c
-on1st f (CP k) = CP (\ g -> k (g . f))
-
-on2nd :: (b -> c) -> CPair a b -> CPair a c
-on2nd f (CP k) = CP (\ g -> k (\ x -> g x . f))
-
-cP :: a -> b -> CPair a b
-x `cP` y = CP (\ k -> k x y)
-
-cpFst :: CPair a b -> a
-cpFst = cpUncurry const
-
-cpSnd :: CPair a b -> b
-cpSnd = cpUncurry (flip const)
-
-cpUncurry :: (a -> b -> r) -> CPair a b -> r
-cpUncurry f (CP k) = k f
-
-cpCurry :: (CPair a b -> r) -> a -> b -> r
-cpCurry f a b = f (a `cP` b)
diff --git a/Data/TrieMap/Class.hs b/Data/TrieMap/Class.hs
--- a/Data/TrieMap/Class.hs
+++ b/Data/TrieMap/Class.hs
@@ -1,9 +1,8 @@
-{-# LANGUAGE FlexibleInstances, TypeFamilies, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
 
-module Data.TrieMap.Class (TMap(..), TSet (..), TKey, TKeyT, Rep, TrieMap, TrieKey) where
+module Data.TrieMap.Class (TMap(..), TSet (..), TKey, Rep, TrieMap, TrieKey) where
 
 import Data.TrieMap.TrieKey
-import Data.TrieMap.OrdMap
 import Data.TrieMap.Rep
 import Data.TrieMap.Sized
 
@@ -11,25 +10,14 @@
 import Data.Foldable
 import Data.Traversable
 
--- import Generics.MultiRec.Base
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Regular.Sized
-
 import Prelude hiding (foldr)
 
 newtype TMap k a = TMap {getTMap :: TrieMap (Rep k) (Elem a)}
 newtype TSet a = TSet (TMap a ())
 
-class (Repr k, TrieKey (Rep k) (TrieMap (Rep k))) => TKey k
--- 	toRep :: k -> Rep k
--- 	fromRep :: Rep k -> k
-
-instance (Repr k, TrieKey (Rep k) (TrieMap (Rep k))) => TKey k
-
-class (ReprT f, TrieKeyT (RepT f) (TrieMapT (RepT f))) => TKeyT f
+class (Repr k, TrieKey (Rep k)) => TKey k
 
-instance (ReprT f, TrieKeyT (RepT f) (TrieMapT (RepT f))) => TKeyT f
+instance (Repr k, TrieKey (Rep k)) => TKey k
 
 instance TKey k => Functor (TMap k) where
 	fmap = fmapDefault
@@ -38,8 +26,4 @@
 	foldr f z (TMap m) = foldWithKeyM (\ _ (Elem a) -> f a) m z
 
 instance TKey k => Traversable (TMap k) where
-	traverse = trv
-
--- 	traverse f (TMap m) = TMap <$> traverseWithKeyM (\ _ (K0 a) -> K0 <$> f a) m
-trv :: (Applicative f, TKey k) => (a -> f b) -> TMap k a -> f (TMap k b)
-trv f (TMap m) = TMap <$> traverseWithKeyM elemSize (\ _ (Elem a) -> Elem <$> f a) m
+	traverse f (TMap m) = TMap <$> traverseWithKeyM elemSize (\ _ (Elem a) -> Elem <$> f a) m
diff --git a/Data/TrieMap/Class/Instances.hs b/Data/TrieMap/Class/Instances.hs
--- a/Data/TrieMap/Class/Instances.hs
+++ b/Data/TrieMap/Class/Instances.hs
@@ -1,115 +1,16 @@
-{-# LANGUAGE FlexibleInstances, TemplateHaskell, CPP, Rank2Types, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}
-
 module Data.TrieMap.Class.Instances where
 
-import Data.TrieMap.Class
-import Data.TrieMap.TrieKey
-import Data.TrieMap.Rep
-import Data.TrieMap.Rep.TH
-import Data.TrieMap.Rep.Instances
-import Data.TrieMap.Sized
-import Data.TrieMap.RadixTrie()
-import Data.TrieMap.MultiRec.Instances
-import Data.TrieMap.IntMap
-import Data.TrieMap.OrdMap
-import Data.TrieMap.ReverseMap
-import Data.TrieMap.ProdMap
-import Data.TrieMap.UnionMap
-import Data.TrieMap.Class
-import Data.TrieMap.Modifiers
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Instances
--- import Data.TrieMap.UnionMap()
+import Data.TrieMap.Class ()
+import Data.TrieMap.TrieKey ()
+import Data.TrieMap.Rep ()
+import Data.TrieMap.Rep.Instances ()
+import Data.TrieMap.Representation ()
+import Data.TrieMap.Sized ()
+import Data.TrieMap.RadixTrie ()
+import Data.TrieMap.IntMap ()
+import Data.TrieMap.OrdMap ()
+import Data.TrieMap.ReverseMap ()
+import Data.TrieMap.ProdMap ()
+import Data.TrieMap.UnionMap ()
 import Data.TrieMap.UnitMap()
-import Data.TrieMap.Key
-
-import Data.Bits
-import Data.Char
-import Data.Complex
-import Data.Either
-import Data.Foldable
-import Data.Int 
-import Data.List hiding (foldr)
-import Data.Word
-import Data.Array.IArray
-import Data.Map(Map)
-import Data.Set(Set)
-
-import Prelude hiding (foldr)
-
-#if __GLASGOW_HASKELL__
-import GHC.Exts (build)
-#else
-
-build :: (forall b . (a -> b -> b) -> b -> b) -> [a]
-build f = f (:) []
-#endif
-{-
-instance TKey k => TKey [k] where
-	type Rep [k] = L I0 (Rep k)
-	toRep = map toRep
-	fromRep = map fromRep-}
-
--- instance TKey Int
--- instance TKey Double
--- instance TKey Char
--- instance TKey Bool
--- instance TKey Word
--- instance TKey Int32
--- instance TKey Word32
--- instance TKey Word16
--- instance TKey Word8
--- instance TKey Int8
--- instance TKey Int16
--- instance TKey Word64
--- instance TKey Int64
--- instance TKey ()
--- instance TKey a => TKeyT ((,) a)
--- instance (TKey a, TKey b) => TKey (a, b)
--- instance (TKey a, TKey b) => TKeyT ((,,) a b)
--- instance (TKey a, TKey b, TKey c) => TKey (a, b, c)
--- instance (TKey a, TKey b, TKey c) => TKeyT ((,,,) a b c)
--- instance (TKey a, TKey b, TKey c, TKey d) => TKey (a, b, c, d)
--- instance TKey a => TKey (I0 a)
--- instance TKeyT I0
--- instance TKey (U0 a)
--- instance TKeyT U0
--- instance TKey a => TKey (K0 a b)
--- instance TKey a => TKeyT (K0 a)
--- instance TKeyT f => TKeyT (L f)
--- instance (TKeyT f, TKey a) => TKey (L f a)
--- instance (Functor f, TKeyT f, TKeyT g) => TKeyT (f `O` g)
--- instance (TKeyT f, TKeyT g, TKey a) => TKey ((f `O` g) a)
--- instance (TKeyT f, TKeyT g) => TKeyT (f :*: g)
--- instance (TKeyT f, TKeyT g, TKey a) => TKey ((f :*: g) a)
--- instance (TKey a, TKey b) => TKey (Either a b)
--- instance TKey a => TKeyT (Either a)
--- instance TKey a => TKey [a]
--- instance TKeyT []
--- instance TKey a => TKey (Maybe a)
--- instance TKeyT Maybe
--- instance (TKey k, TKey a) => TKey (TMap k a)
--- instance TKey k => TKeyT (TMap k)
--- instance TKeyT Set
--- instance TKeyT Rev
--- instance TKey a => TKey (Rev a)
--- instance TKey a => TKey (Set a)
--- instance TKey k => TKeyT (Map k)
--- instance (TKey k, TKey a) => TKey (Map k a)
--- instance (TKey i, Ix i) => TKeyT (Array i)
--- instance (TKey i, Ix i, TKey e) => TKey (Array i e)
-
-type instance RepT (TMap k) = L (K0 (Rep k) :*: I0)
-type instance Rep (TMap k a) = RepT (TMap k) (Rep a)
-
--- instance (Repr k, TrieKey (Rep k) (TrieMap (Rep k))) => TKey k
--- instance (ReprT f, TrieKeyT (RepT f) (TrieMapT (RepT f))) => TKeyT f
-
-instance TKey k => ReprT (TMap k) where
-	toRepTMap f (TMap m) = List (foldWithKeyM (\ k (Elem a) xs -> (K0 k :*: I0 (f a)):xs) m [])
-	fromRepTMap f (List xs) = TMap (fromDistAscListM (const 1) [(k, Elem (f a)) | (K0 k :*: I0 a) <- xs])
-{-
-instance (TKey k, Repr a) => Repr (TMap k a) where
-	toRep = toRepTMap toRep
-	fromRep = fromRepTMap fromRep-}
+import Data.TrieMap.Key ()
diff --git a/Data/TrieMap/IntMap.hs b/Data/TrieMap/IntMap.hs
--- a/Data/TrieMap/IntMap.hs
+++ b/Data/TrieMap/IntMap.hs
@@ -1,135 +1,67 @@
-{-# LANGUAGE TemplateHaskell, TypeOperators, UndecidableInstances, BangPatterns, Rank2Types, CPP, MagicHash, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples, BangPatterns, TypeFamilies, PatternGuards, MagicHash, CPP #-}
 
 module Data.TrieMap.IntMap () where
 
 import Data.TrieMap.TrieKey
--- import Data.TrieMap.MultiRec.Base
--- import Data.TrieMap.Applicative
 import Data.TrieMap.Sized
-import Data.TrieMap.CPair
--- import Data.TrieMap.ReverseMap
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.TH
 
 import Control.Applicative (Applicative(..), Alternative(..), (<$>))
-import Control.Arrow
-import Control.Monad (MonadPlus(..))
 
 import Data.Bits
-import Data.Maybe
-import Data.Monoid
+import Data.Maybe hiding (mapMaybe)
 import Data.Word
--- import Data.Int
 
--- #if __GLASGOW_HASKELL__ >= 503
--- import GHC.Exts ( Word(..), Int(..), shiftRL# )
--- #elif __GLASGOW_HASKELL__
--- import Word
--- import GlaExts ( Word(..), Int(..), shiftRL# )
--- #else
--- import Data.Word
--- #endif
-
 import Prelude hiding (lookup, null, foldl, foldr)
 
-type Nat = Word32
+#include "MachDeps.h"
+#if WORD_SIZE_IN_BITS == 32
+import GHC.Prim
+import GHC.Word
 
-data WordMap a = Nil
-              | Tip {-# UNPACK #-} !Size {-# UNPACK #-} !Key (a)
-              | Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(WordMap a) !(WordMap a) 
-		deriving (Show)
--- data IntMap a = IMap (WordMap a) (WordMap a)
-type instance TrieMap Word32 = WordMap
--- type instance TrieMap Int32 = IntMap
+complement32 (W32# w#) = W32# (not# w#)
+#elif WORD_SIZE_IN_BITS > 32
+complement32 = xor (bit 32 - 1)
+#else
+import GHC.Prim
+import GHC.IntWord32
+complement32 (W32# w#) = W32# (not32# w#)
+#endif
+complement32 :: Word32 -> Word32
 
+{-# RULES
+	"complement/Word32" complement = complement32
+	#-}
+
+type Nat = Word32
+
 type Prefix = Word32
 type Mask   = Word32
 type Key    = Word32
 type Size   = Int
 
--- type instance RepT WordMap = FamT KeyFam (HFix (U :+: (K Size :*: K Key :*: X) :+:
--- 				(K Size :*: K Prefix :*: K Mask :*: A0 :*: A0)))
--- type instance Rep (WordMap a) = RepT WordMap (Rep a)
--- 
--- -- $(genRepT [d|
---    instance ReprT WordMap where
--- 	toRepT = FamT . toFix where
--- 		toFix = HIn . toFix'
--- 		toFix' Nil = L U
--- 		toFix' (Tip s kx x) = R (L (K s :*: K kx :*: X x))
--- 		toFix' (Bin s p m l r) = R (R (K s :*: K p :*: K m :*: A0 (toFix l) :*: A0 (toFix r)))
--- 	fromRepT (FamT m) = fromFix m where
--- 		fromFix (HIn x) = fromFix' x
--- 		fromFix' L{} = Nil
--- 		fromFix' (R (L (K s :*: K kx :*: X x))) = Tip s kx x
--- 		fromFix' (R (R (K s :*: K p :*: K m :*: A0 l :*: A0 r))) = Bin s p m (fromFix l) (fromFix r) |])
-
-instance TrieKey Word32 WordMap where
+instance TrieKey Word32 where
+	data TrieMap Word32 a = Nil
+              | Tip {-# UNPACK #-} !Size {-# UNPACK #-} !Key a
+              | Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(TrieMap Word32 a) !(TrieMap Word32 a) 
 	emptyM = Nil
+	singletonM = singleton
 	nullM = null
 	sizeM _ = size
 	lookupM = lookup
-	lookupIxM s = lookupIx s 0
-	assocAtM s = assocAt s 0
--- 	updateAtM s r = updateAt s r 0
 	alterM = alter
 	alterLookupM = alterLookup
 	traverseWithKeyM = traverseWithKey
 	foldWithKeyM = foldr
 	foldlWithKeyM = foldl
+	mapMaybeM = mapMaybe
 	mapEitherM = mapEither
 	splitLookupM = splitLookup
 	unionM = unionWithKey
 	isectM = intersectionWithKey
 	diffM = differenceWithKey
 	extractM s f = extract s f
--- 	extractMinM s f = First . minViewWithKey s f
--- 	extractMaxM s f = Last . maxViewWithKey s f
--- 	alterMinM = updateMinWithKey
--- 	alterMaxM = updateMaxWithKey
 	isSubmapM = isSubmapOfBy
 
-{-instance TrieKey Int32 IntMap where
-	emptyM = IMap Nil Nil
-	nullM (IMap mN mP) = nullM mN && nullM mP
-	sizeM s (IMap mN mP) = sizeM s mN + sizeM s mP
-	lookupM k (IMap mN mP)
-		| k < 0		= lookupM (fromIntegral (-k)) mN
-		| otherwise	= lookupM (fromIntegral k) mP
-	lookupIxM s k (IMap mN mP)
-		| k < 0		= do	(i, v) <- lookupIx' 0 s (fromIntegral (-k)) mN
-					return (sizeM s mN - 1 - i, v)
-		| otherwise	= do	(i, v) <- lookupIxM s (fromIntegral k) mP
-					return (i + sizeM s mN, v)
-	assocAtM s i (IMap mN mP)
-		| i < sN, (i', k, a) <- assocAt' s i mN
-			= (i', - fromIntegral k, a)
-		| (i', k, a) <-assocAtM s (i - sN) mP
-			= (i' + sN, fromIntegral k, a)
-		where	sN = sizeM s mN
-	updateAtM s f i (IMap mN mP)
-		| i < sN	= updateAtM s (\ i' k -> f i' (- fromIntegral k)) (sN - 1 - i) mN `IMap` mP
-		| otherwise	= mN `IMap` updateAtM s (\ i' k -> f (i' + sN) (fromIntegral k)) (i - sN) mP
-		where	sN = sizeM s mN
-	alterM s f k (IMap mN mP)
-		| k < 0		= alterM s f (fromIntegral (- k)) mN `IMap` mP
-		| otherwise	= mN `IMap` alterM s f (fromIntegral k) mP
-	traverseWithKeyM s f (IMap mN mP) =
-		IMap <$> traverseWithKeyM s (\ k -> f (- fromIntegral k)) mN <*>
-			traverseWithKeyM s (f . fromIntegral) mP
-	foldWithKeyM f (IMap mN mP) =
-		foldlWithKeyM (\ k -> flip (f (- fromIntegral k))) mN . foldWithKeyM (f . fromIntegral) mP
-	foldlWithKeyM f (IMap mN mP) =
-		foldlWithKeyM (f . fromIntegral) mP . foldWithKeyM (\ k -> flip (f (- fromIntegral k))) mN
-	mapEitherM s1 s2 f (IMap mN mP) = (IMap mNL mPL, IMap mNR mPR)
-		where	(mNL, mNR) = mapEitherM s1 s2 (\ k -> f (- fromIntegral k)) mN
-			(mPL, mPR) = mapEitherM s1 s2 (f . fromIntegral) mP
-	splitLookupM s f k (IMap mN mP)
-		| k < 0, (mNL, ans, mNR) <- splitLookupM s ((\ (l, x, r) -> (r, x, l)) . f) (fromIntegral (-k)) mN
-			= (IMap mNR emptyM, ans, IMap mNL mP)
-		| (mPL, ans, mPR) <- splitLookupM s f (fromIntegral k) mP
-			= (IMap mN mPL, ans, IMap emptyM mPR)-}
-
 natFromInt :: Word32 -> Nat
 natFromInt = id
 
@@ -148,132 +80,105 @@
 -- #endif
 
 
-size :: WordMap a -> Int
+size :: TrieMap Word32 a -> Int
 size Nil = 0
 size (Tip s _ _) = s
 size (Bin s _ _ _ _) = s
 
-null :: WordMap a -> Bool
+null :: TrieMap Word32 a -> Bool
 null Nil = True
 null _ = False
 
-lookup :: Nat -> WordMap a -> Maybe (a)
+lookup :: Nat -> TrieMap Word32 a -> Maybe a
 lookup k (Bin _ _ m l r) = lookup k (if zeroN k m then l else r)
 lookup k (Tip _ kx x)
 	| k == kx	= Just x
 lookup _ _ = Nothing
 
-
-assocAt :: Sized a -> Int -> Int -> WordMap a -> IndexPos Key a
-assocAt s !i0 !i (Bin _ _ _ l r)
-	| i < sl, (lb, x, ub) <- assocAt s i0 i l
-		= (lb, x, ub <|> fst <$> First (minViewWithKey s (\ k a -> (Asc (i0 + size l) k a, Just a)) r))
-	| (lb, x, ub) <- assocAt s (i0 + sl) (i - sl) r
-		= (fst <$> Last (maxViewWithKey s (\ k a -> (Asc (i0 + size l - s a) k a, Just a)) l) <|> lb, x, ub)
-	where	sl = size l
-assocAt _ i0 _ (Tip _ k x) = (mzero, return (Asc i0 k x), mzero)
-assocAt _ _ _ _ = (mzero, mzero, mzero)
-
-updateAt :: Sized a -> Round -> Int -> (Int -> Key -> a -> Maybe (a)) -> Int -> WordMap a -> WordMap a
-updateAt s True !i0 f !i t = case t of
-	Bin _ p m l r -> let sl = size l in
-		if i < sl then bin p m (updateAt s True i0 f i l) r 
-			else bin p m l (updateAt s True (i0 + sl) f (i - sl) r)
-	Tip _ kx x -> singletonMaybe s kx (f i0 kx x)
-	_	-> t
-updateAt s False !i0 f !i t = case t of
-	Bin sz p m l r -> let {sl = size l; mI = maxIx l} in
-		if i < mI then bin p m (updateAt s False i0 f i l) r
-			else bin p m l (updateAt s False (i0 + sl) f (i - sl) r)
-	Tip _ kx x -> singletonMaybe s kx (f i0 kx x)
-	_	-> t
-	where	maxIx m = maybe (size m) fst (maxViewWithKey s (\ _ a -> (size m - s a, Just a)) m)
-
-lookupIx :: Sized a -> Int -> Nat -> WordMap a -> IndexPos Nat a
-lookupIx s !i k t = case t of
-	Bin _ _ m l r
-		| zeroN k m, (lb, x, ub) <- lookupIx s i k l
-			-> (lb, x, ub <|> fst <$> First (minViewWithKey s (\ k a -> (Asc (i + size l) k a, Just a)) r))
-		| (lb, x, ub) <- lookupIx s (i + size l) k r
-			-> (fst <$> Last (maxViewWithKey s (\ k a -> (Asc (i + size l - s a) k a, Just a)) l) <|> lb, x, ub)
-	Tip _ kx x
-		| k == kx	-> (mzero, return (Asc i kx x), mzero)
-	_ -> (mzero, mzero, mzero)
-
-singleton :: Sized a -> Key -> a -> WordMap a
+singleton :: Sized a -> Key -> a -> TrieMap Word32 a
 singleton s k a = Tip (s a) k a
 
-singletonMaybe :: Sized a -> Key -> Maybe (a) -> WordMap a
+singletonMaybe :: Sized a -> Key -> Maybe a -> TrieMap Word32 a
 singletonMaybe s k = maybe Nil (singleton s k)
 
-alter :: Sized a -> (Maybe (a) -> Maybe (a)) -> Key -> WordMap a -> WordMap a
+alter :: Sized a -> (Maybe a -> Maybe a) -> Key -> TrieMap Word32 a -> TrieMap Word32 a
 alter s f k t = case t of
-	Bin sz p m l r
+	Bin _ p m l r
 		| nomatch k p m	-> join k (singletonMaybe s k (f Nothing)) p t
 		| zero k m	-> bin p m (alter s f k l) r
 		| otherwise	-> bin p m l (alter s f k r)
-	Tip sz ky y
+	Tip _ ky y
 		| k == ky	-> singletonMaybe s k (f (Just y))
 		| Just x <- f Nothing
 				-> join k (Tip (s x) k x) ky t
-		| otherwise	-> Tip sz ky y
+		| otherwise	-> t
 	Nil	-> singletonMaybe s k (f Nothing)
 
-alterLookup :: Sized a -> (Maybe a -> CPair x (Maybe a)) -> Key -> WordMap a -> CPair x (WordMap a)
+alterLookup :: Sized a -> (Maybe a -> (# x, Maybe a #)) -> Key -> TrieMap Word32 a -> (# x, TrieMap Word32 a #)
 alterLookup s f k t = case t of
-	Bin sz p m l r
+	Bin _ p m l r
 		| nomatch k p m
-			-> fmap (\ v -> join k (singletonMaybe s k v) p t) (f Nothing)
+			-> onUnboxed (\ v -> join k (singletonMaybe s k v) p t) f Nothing
 		| zero k m
-			-> fmap (\ l' -> bin p m l' r) (alterLookup s f k l)
+			-> onUnboxed (\ l' -> bin p m l' r) (alterLookup s f k) l
 		| otherwise
-			-> fmap (\ r' -> bin p m l r') (alterLookup s f k r)
-	Tip sz ky y
-		| k == ky	-> singletonMaybe s k <$> f (Just y)
-		| otherwise	-> fmap (\ v -> join k (singletonMaybe s k v) ky t) (f Nothing)
-	Nil	-> singletonMaybe s k <$> f Nothing
+			-> onUnboxed (\ r' -> bin p m l r') (alterLookup s f k) r
+	Tip _ ky y
+		| k == ky	-> onUnboxed (singletonMaybe s k) f (Just y)
+		| otherwise	-> onUnboxed (\ v -> join k (singletonMaybe s k v) ky t) f Nothing
+	Nil	-> onUnboxed (singletonMaybe s k) f Nothing
 
-traverseWithKey :: Applicative f => Sized b -> (Key -> a -> f (b)) -> WordMap a -> f (WordMap b)
+traverseWithKey :: Applicative f => Sized b -> (Key -> a -> f b) -> TrieMap Word32 a -> f (TrieMap Word32 b)
 traverseWithKey s f t = case t of
 	Nil		-> pure Nil
 	Tip _ kx x	-> singleton s kx <$> f kx x
 	Bin _ p m l r	-> bin p m <$> traverseWithKey s f l <*> traverseWithKey s f r
 
-foldr :: (Key -> a -> b -> b) -> WordMap a -> b -> b
+foldr :: (Key -> a -> b -> b) -> TrieMap Word32 a -> b -> b
 foldr f t
   = case t of
       Bin _ _ _ l r -> foldr f l . foldr f r
       Tip _ k x     -> f k x
       Nil         -> id
 
-foldl :: (Key -> b -> a -> b) -> WordMap a -> b -> b
+foldl :: (Key -> b -> a -> b) -> TrieMap Word32 a -> b -> b
 foldl f t
   = case t of
       Bin _ _ _ l r -> foldl f r . foldl f l
       Tip _ k x     -> flip (f k) x
       Nil         -> id
 
-mapEither :: Sized b -> Sized c -> EitherMap Key (a) (b) (c) ->
-	WordMap a -> (WordMap b, WordMap c)
-mapEither _ _ _ Nil = (Nil, Nil)
-mapEither s1 s2 f (Bin _ p m l r) = case (mapEither s1 s2 f l, mapEither s1 s2 f r) of
-	((lL, lR), (rL, rR)) -> (bin p m lL rL, bin p m lR rR)
-mapEither s1 s2 f (Tip _ kx x) = (singletonMaybe s1 kx *** singletonMaybe s2 kx) (f kx x)
+mapMaybe :: Sized b -> (Key -> a -> Maybe b) -> TrieMap Word32 a -> TrieMap Word32 b
+mapMaybe s f (Bin _ p m l r)	= bin p m (mapMaybe s f l) (mapMaybe s f r)
+mapMaybe s f (Tip _ kx x)	= singletonMaybe s kx (f kx x)
+mapMaybe _ _ _			= Nil
 
-splitLookup :: Sized a -> SplitMap (a) x -> Key -> WordMap a -> (WordMap a ,Maybe x,WordMap a)
-splitLookup s f k t
-  = case t of
-      Bin _ p m l r
-        | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)
-        | zero k m  -> let (lt,found,gt) = splitLookup s f k l in (lt,found,union s gt r)
-        | otherwise -> let (lt,found,gt) = splitLookup s f k r in (union s l lt,found,gt)
-      Tip _ ky y 
-        | k>ky      -> (t,Nothing,Nil)
-        | k<ky      -> (Nil,Nothing,t)
-        | otherwise -> singletonMaybe s k `sides` f y
-      Nil -> (Nil,Nothing,Nil)
+mapEither :: Sized b -> Sized c -> EitherMap Key a b c ->
+	TrieMap Word32 a -> (# TrieMap Word32 b, TrieMap Word32 c #)
+mapEither s1 s2 f (Bin _ p m l r) 
+	| (# lL, lR #) <- mapEither s1 s2 f l, (# rL, rR #) <- mapEither s1 s2 f r
+				= (# bin p m lL rL, bin p m lR rR #)
+mapEither s1 s2 f (Tip _ kx x)	= both (singletonMaybe s1 kx) (singletonMaybe s2 kx) (f kx) x
+mapEither _ _ _ _		= (# Nil, Nil #)
 
-union :: Sized a -> WordMap a -> WordMap a -> WordMap a
+splitLookup :: Sized a -> SplitMap a x -> Key -> TrieMap Word32 a -> (# TrieMap Word32 a ,Maybe x,TrieMap Word32 a #)
+splitLookup s f k t@(Bin _ p m l r)
+        | nomatch k p m = if k>p then (# t,Nothing,Nil #) else (# Nil,Nothing,t #)
+        | zero k m, (# lt, found, gt #) <- splitLookup s f k l
+        		= (# lt,found,union s gt r #)
+        | (# lt, found, gt #) <- splitLookup s f k r 
+        		= (# union s l lt,found,gt #)
+splitLookup s f k t@(Tip _ ky y)
+        | k>ky		= (# t,Nothing,Nil #)
+        | k<ky		= (# Nil,Nothing,t #)
+        | otherwise	= sides (singletonMaybe s k) f y
+splitLookup _ _ _ _	= (# Nil,Nothing,Nil #)
+
+union :: Sized a -> TrieMap Word32 a -> TrieMap Word32 a -> TrieMap Word32 a
+union _ Nil t       = t
+union _ t Nil       = t
+union s (Tip _ k x) t = alter s (const (Just x)) k t
+union s t (Tip _ k x) = alter s (Just . fromMaybe x) k t  -- right bias
 union s t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = union1
   | shorter m2 m1  = union2
@@ -287,12 +192,12 @@
     union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2
             | zero p1 m2        = bin p2 m2 (union s t1 l2) r2
             | otherwise         = bin p2 m2 l2 (union s t1 r2)
-union s (Tip _ k x) t = alter s (const (Just x)) k t
-union s t (Tip _ k x) = alter s (Just . fromMaybe x) k t  -- right bias
-union _ Nil t       = t
-union _ t Nil       = t
 
-unionWithKey :: Sized a -> UnionFunc Key (a) -> WordMap a -> WordMap a -> WordMap a
+unionWithKey :: Sized a -> UnionFunc Key a -> TrieMap Word32 a -> TrieMap Word32 a -> TrieMap Word32 a
+unionWithKey _ _ Nil t  = t
+unionWithKey _ _ t Nil  = t
+unionWithKey s f (Tip _ k x) t = alter s (maybe (Just x) (f k x)) k t
+unionWithKey s f t (Tip _ k x) = alter s (maybe (Just x) (flip (f k) x)) k t
 unionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = union1
   | shorter m2 m1  = union2
@@ -306,12 +211,14 @@
     union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2
             | zero p1 m2        = bin p2 m2 (unionWithKey s f t1 l2) r2
             | otherwise         = bin p2 m2 l2 (unionWithKey s f t1 r2)
-unionWithKey s f (Tip _ k x) t = alter s (maybe (Just x) (f k x)) k t
-unionWithKey s f t (Tip _ k x) = alter s (maybe (Just x) (flip (f k) x)) k t
-unionWithKey _ _ Nil t  = t
-unionWithKey _ _ t Nil  = t
 
-intersectionWithKey :: Sized c -> IsectFunc Key (a) (b) (c) -> WordMap a -> WordMap b -> WordMap c
+intersectionWithKey :: Sized c -> IsectFunc Key a b c -> TrieMap Word32 a -> TrieMap Word32 b -> TrieMap Word32 c
+intersectionWithKey _ _ Nil _ = Nil
+intersectionWithKey _ _ _ Nil = Nil
+intersectionWithKey s f (Tip _ k x) t2
+  = singletonMaybe s k (lookup (natFromInt k) t2 >>= f k x)
+intersectionWithKey s f t1 (Tip _ k y) 
+  = singletonMaybe s k (lookup (natFromInt k) t1 >>= flip (f k) y)
 intersectionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = intersection1
   | shorter m2 m1  = intersection2
@@ -326,14 +233,12 @@
                   | zero p1 m2        = intersectionWithKey s f t1 l2
                   | otherwise         = intersectionWithKey s f t1 r2
 
-intersectionWithKey s f (Tip _ k x) t2
-  = singletonMaybe s k (lookup (natFromInt k) t2 >>= f k x)
-intersectionWithKey s f t1 (Tip _ k y) 
-  = singletonMaybe s k (lookup (natFromInt k) t1 >>= flip (f k) y)
-intersectionWithKey _ _ Nil _ = Nil
-intersectionWithKey _ _ _ Nil = Nil
-
-differenceWithKey :: Sized a -> (Key -> a -> b -> Maybe (a)) -> WordMap a -> WordMap b -> WordMap a
+differenceWithKey :: Sized a -> (Key -> a -> b -> Maybe a) -> TrieMap Word32 a -> TrieMap Word32 b -> TrieMap Word32 a
+differenceWithKey _ _ Nil _       = Nil
+differenceWithKey _ _ t Nil       = t
+differenceWithKey s f t1@(Tip _ k x) t2 
+  = maybe t1 (singletonMaybe s k . f k x) (lookup (natFromInt k) t2)
+differenceWithKey s f t (Tip _ k y) = alter s (>>= flip (f k) y) k t
 differenceWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = difference1
   | shorter m2 m1  = difference2
@@ -348,82 +253,24 @@
                 | zero p1 m2        = differenceWithKey s f t1 l2
                 | otherwise         = differenceWithKey s f t1 r2
 
-differenceWithKey s f t1@(Tip _ k x) t2 
-  = maybe t1 (singletonMaybe s k . f k x) (lookup (natFromInt k) t2)
-differenceWithKey _ _ Nil _       = Nil
-differenceWithKey s f t (Tip _ k y) = alter s (>>= flip (f k) y) k t
-differenceWithKey _ _ t Nil       = t
-
-isSubmapOfBy :: LEq (a) (b) -> LEq (WordMap a) (WordMap b)
+isSubmapOfBy :: LEq a b -> LEq (TrieMap Word32 a) (TrieMap Word32 b)
 isSubmapOfBy (<=) t1@(Bin _ p1 m1 l1 r1) (Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = False
   | shorter m2 m1  = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy (<=) t1 l2
                                                       else isSubmapOfBy (<=) t1 r2)                     
   | otherwise      = (p1==p2) && isSubmapOfBy (<=) l1 l2 && isSubmapOfBy (<=) r1 r2
-isSubmapOfBy _         (Bin _ _ _ _ _) _ = False
-isSubmapOfBy (<=) (Tip _ k x) t     = maybe False (x <=) (lookup (natFromInt k) t)
-isSubmapOfBy _         Nil _           = True
-
-extract :: Alternative f => Sized a -> (Key -> a -> f (CPair x (Maybe a))) -> WordMap a -> f (CPair x (WordMap a))
-extract s f t = case t of
-	Bin _ p m l r -> fmap (\ l' -> bin p m l' r) <$> extract s f l
-				<|> fmap (bin p m l) <$> extract s f r
-	Tip _ k x -> fmap (singletonMaybe s k) <$> f k x
-	Nil -> empty
-
-maxViewWithKey, minViewWithKey :: Sized a -> (Key -> a -> (x, Maybe a)) -> WordMap a -> Maybe (x, WordMap a)
-maxViewWithKey s f t
-    = case t of
-        Bin _ p m l r         -> let (result, t') = maxViewUnsigned s f r in Just (result, bin p m l t')
-        Tip _ k y -> let (result, x) = f k y in Just (result, singletonMaybe s k x)
-        Nil -> Nothing
-
-maxViewUnsigned, minViewUnsigned :: Sized a -> (Key -> a -> (x, Maybe a)) -> WordMap a -> (x, WordMap a)
-maxViewUnsigned s f t 
-    = case t of
-        Bin _ p m l r -> let (result,t') = maxViewUnsigned s f r in (result,bin p m l t')
-        Tip _ k y -> let (result, x) = f k y in (result, singletonMaybe s k x)
-        Nil -> error "maxViewUnsigned Nil"
-
-minViewWithKey s f t
-    = case t of
-        Bin _ p m l r -> let (result, t') = minViewUnsigned s f l in Just (result, bin p m t' r)
-        Tip _ k y -> let (result, x) = f k y in Just (result, singletonMaybe s k x)
-        Nil -> Nothing
-
-minViewUnsigned s f t 
-    = case t of
-        Bin _ p m l r -> let (result,t') = minViewUnsigned s f l in (result,bin p m t' r)
-        Tip _ k y -> let (result, x) = f k y in (result, singletonMaybe s k x)
-        Nil -> error "minViewUnsigned Nil"
-
-updateMinWithKey :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a
-updateMinWithKey s f t
-    = case t of
-        Bin _ p m l r         -> let t' = updateMinWithKeyUnsigned s f l in bin p m t' r
-        Tip _ k y -> singletonMaybe s k (f k y)
-        Nil -> Nil
-
-updateMinWithKeyUnsigned :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a
-updateMinWithKeyUnsigned s f t
-    = case t of
-        Bin _ p m l r -> let t' = updateMinWithKeyUnsigned s f l in bin p m t' r
-        Tip _ k y -> singletonMaybe s k (f k y)
-        Nil -> Nil
-
-updateMaxWithKey :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a
-updateMaxWithKey s f t
-    = case t of
-        Bin _ p m l r         -> let t' = updateMaxWithKeyUnsigned s f r in bin p m l t'
-        Tip _ k y -> singletonMaybe s k (f k y)
-        Nil -> Nil
+isSubmapOfBy _		(Bin _ _ _ _ _) _
+	= False
+isSubmapOfBy (<=)	(Tip _ k x) t
+	= maybe False (x <=) (lookup (natFromInt k) t)
+isSubmapOfBy _		Nil _
+	= True
 
-updateMaxWithKeyUnsigned :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a
-updateMaxWithKeyUnsigned s f t
-    = case t of
-        Bin _ p m l r -> let t' = updateMaxWithKeyUnsigned s f r in bin p m l t'
-        Tip _ k y -> singletonMaybe s k (f k y)
-        Nil -> Nil
+extract :: Alternative f => Sized a -> (Key -> a -> f (x, Maybe a)) -> TrieMap Word32 a -> f (x, TrieMap Word32 a)
+extract s f (Bin _ p m l r)	= 
+	fmap (\ l' -> bin p m l' r) <$> extract s f l <|> fmap (bin p m l) <$> extract s f r
+extract s f (Tip _ k x)		= fmap (singletonMaybe s k) <$> f k x
+extract _ _ _			= empty
 
 mask :: Key -> Mask -> Prefix
 mask i m
@@ -462,10 +309,14 @@
       x2 -> case (x2 .|. shiftRL x2 4) of
        x3 -> case (x3 .|. shiftRL x3 8) of
         x4 -> case (x4 .|. shiftRL x4 16) of
+#if WORD_SIZE_IN_BITS > 32
          x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms
           x6 -> (x6 `xor` (shiftRL x6 1))
+#else
+	 x5 -> x5 `xor` shiftRL x5 1
+#endif
 
-join :: Prefix -> WordMap a -> Prefix -> WordMap a -> WordMap a
+join :: Prefix -> TrieMap Word32 a -> Prefix -> TrieMap Word32 a -> TrieMap Word32 a
 join p1 t1 p2 t2
   | zero p1 m = bin p m t1 t2
   | otherwise = bin p m t2 t1
@@ -473,7 +324,7 @@
     m = branchMask p1 p2
     p = mask p1 m
 
-bin :: Prefix -> Mask -> WordMap a -> WordMap a -> WordMap a
+bin :: Prefix -> Mask -> TrieMap Word32 a -> TrieMap Word32 a -> TrieMap Word32 a
 bin _ _ l Nil = l
 bin _ _ Nil r = r
 bin p m l r   = Bin (size l + size r) p m l r
diff --git a/Data/TrieMap/Key.hs b/Data/TrieMap/Key.hs
--- a/Data/TrieMap/Key.hs
+++ b/Data/TrieMap/Key.hs
@@ -1,37 +1,27 @@
 {-# LANGUAGE TypeFamilies, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
 
-module Data.TrieMap.Key where
+module Data.TrieMap.Key (Key(..)) where
 
 import Control.Applicative
-import Control.Arrow ((***))
 import Data.TrieMap.Class
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Rep
-
-newtype Key k = Key {getKey :: k}
-newtype KeyMap k a = KeyMap {getKeyMap :: TrieMap (Rep k) a}
-
-instance (TKey k) => Eq (Key k) where
-	Key k1 == Key k2 = toRep k1 == toRep k2
-
-instance (TKey k) => Ord (Key k) where
-	Key k1 `compare` Key k2 = compare (toRep k1) (toRep k2)
-
-type instance TrieMap (Key k) = KeyMap k
+import Data.TrieMap.Modifiers
 
-instance TKey k => TrieKey (Key k) (KeyMap k) where
+instance TKey k => TrieKey (Key k) where
+	newtype TrieMap (Key k) a = KeyMap (TrieMap (Rep k) a)
 	emptyM = KeyMap emptyM
+	singletonM s (Key k) a = KeyMap (singletonM s (toRep k) a)
 	nullM (KeyMap m) = nullM m
 	lookupM (Key k) (KeyMap m) = lookupM (toRep k) m
-	lookupIxM s (Key k) (KeyMap m) = onKey (Key . fromRep) (lookupIxM s (toRep k) m)
-	assocAtM s i (KeyMap m) = onKey (Key . fromRep) (assocAtM s i m)
 	alterM s f (Key k) (KeyMap m) = KeyMap (alterM s f (toRep k) m)
-	alterLookupM s f (Key k) (KeyMap m) = KeyMap <$> alterLookupM s f (toRep k) m
+	alterLookupM s f (Key k) (KeyMap m) = onUnboxed KeyMap (alterLookupM s f (toRep k)) m
 	traverseWithKeyM s f (KeyMap m) = KeyMap <$> traverseWithKeyM s (f . Key . fromRep) m
 	foldWithKeyM f (KeyMap m) = foldWithKeyM (f . Key . fromRep) m
 	foldlWithKeyM f (KeyMap m) = foldlWithKeyM (f . Key . fromRep) m
-	mapEitherM s1 s2 f (KeyMap m) = (KeyMap *** KeyMap) (mapEitherM s1 s2 (f . Key . fromRep) m)
-	splitLookupM s f (Key k) (KeyMap m) = KeyMap `sides` splitLookupM s f (toRep k) m
+	mapMaybeM s f (KeyMap m) = KeyMap (mapMaybeM s (f . Key . fromRep) m)
+	mapEitherM s1 s2 f (KeyMap m) = both KeyMap KeyMap (mapEitherM s1 s2 (f . Key . fromRep)) m
+	splitLookupM s f (Key k) (KeyMap m) = sides KeyMap (splitLookupM s f (toRep k)) m
 	unionM s f (KeyMap m1) (KeyMap m2) = KeyMap (unionM s (f . Key . fromRep) m1 m2)
 	isectM s f (KeyMap m1) (KeyMap m2) = KeyMap (isectM s (f . Key . fromRep) m1 m2)
 	diffM s f (KeyMap m1) (KeyMap m2) = KeyMap (diffM s (f . Key . fromRep) m1 m2)
diff --git a/Data/TrieMap/Modifiers.hs b/Data/TrieMap/Modifiers.hs
--- a/Data/TrieMap/Modifiers.hs
+++ b/Data/TrieMap/Modifiers.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies #-}
 module Data.TrieMap.Modifiers where
 
+import Data.TrieMap.Rep
+
 newtype Ordered a = Ord {unOrd :: a} deriving (Eq, Ord)
 newtype Rev k = Rev {getRev :: k} deriving (Eq)
 instance Ord k => Ord (Rev k) where
@@ -10,3 +13,20 @@
 
 instance Functor Rev where
 	fmap f (Rev a) = Rev (f a)
+
+newtype Key k = Key {getKey :: k}
+
+instance (Repr k, Eq (Rep k)) => Eq (Key k) where
+	Key k1 == Key k2 = toRep k1 == toRep k2
+
+instance (Repr k, Ord (Rep k)) => Ord (Key k) where
+	Key k1 `compare` Key k2 = toRep k1 `compare` toRep k2
+	Key k1 <= Key k2 = toRep k1 <= toRep k2
+	Key k1 < Key k2 = toRep k1 < toRep k2
+	Key k1 >= Key k2 = toRep k1 >= toRep k2
+	Key k1 > Key k2 = toRep k1 > toRep k2
+
+instance Repr k => Repr (Key k) where
+	type Rep (Key k) = Rep k
+	toRep (Key k) = toRep k
+	fromRep = Key . fromRep
diff --git a/Data/TrieMap/MultiRec.hs b/Data/TrieMap/MultiRec.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Data.TrieMap.MultiRec (HTrieKeyT, HTrieKey, HTrieMapT, HTrieMap, Family(..), HOrd(..)) where
-
-import Data.TrieMap.MultiRec.Class
-import Data.TrieMap.MultiRec.FamMap
-import Data.TrieMap.MultiRec.Eq
-import Data.TrieMap.MultiRec.Base
-import Data.TrieMap.MultiRec.Ord
diff --git a/Data/TrieMap/MultiRec/Base.hs b/Data/TrieMap/MultiRec/Base.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/Base.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, ExistentialQuantification, KindSignatures, FlexibleInstances, MultiParamTypeClasses #-}
-
-module Data.TrieMap.MultiRec.Base (module Generics.MultiRec.Base, module Generics.MultiRec.HFix, {-A0(..), X(..), -}Family(..)) where --, FamT(..), KeyFam(..), FunctorT (..), breakEither) where
-
--- import Data.TrieMap.TriseKey
-
--- import Generics.MultiRec
-import Generics.MultiRec.Base
-import Generics.MultiRec.HFix
-
--- import Control.Applicative
-
--- newtype A f (r :: * -> *) ix = A {unA :: f r ix}
--- newtype A0 (r :: * -> *) ix = A0 {unA0 :: r ix}
--- newtype R (r1 :: * -> *) (r :: * -> *) ix = Rec {unRec :: r1 (r ix)}
--- newtype X (r :: * -> *) ix = X {unX :: ix}
-newtype Family (phi :: * -> *) ix = F {unF :: ix}
-
--- data KeyFam k = TrieKey k (TrieMap k) => KF
--- newtype FamT (phi :: * -> *) f ix = FamT (f ix)
-
--- instance TrieKey k (TrieMap k) => El KeyFam k where
--- 	proof = KF
-
--- instance HFunctor phi f => HFunctor phi (A f) where
--- 	hmapA f pf (A x) = A <$> hmapA f pf x
-
--- instance HFunctor phi A0 where
--- 	hmapA f pf (A0 x) = A0 <$> f pf x
-
--- instance HEq phi f => HEq phi (A f) where
--- 	heq f pf (A x) (A y) = heq f pf x y
-
--- instance HEq phi A0 where
--- 	heq f pf (A0 x) (A0 y) = f pf x y
-{-
-class FunctorT f where
-	fmapp :: Functor r => (a -> b) -> f r a -> f r b
-
--- instance FunctorT (FamT phi) where
--- 	fmapp f (FamT x) = FamT (fmap f x)
-
-instance Functor (Family phi) where
-	fmap f (F x) = F (f x)
-
--- instance Functor f => Functor (FamT phi f) where
--- 	fmap = fmapp
-
--- instance FunctorT (K k) where
--- 	fmapp = fmap
-
-instance Functor (K k r) where
-	fmap f (K a) = K a
-
-instance FunctorT (I ix) where
-	fmapp = fmap
-
-instance Functor (I ix r) where
-	fmap f (I a) = I a
-
-instance FunctorT U where
-	fmapp f U = U 
-
-instance Functor (U r) where
-	fmap f U = U
-
-instance (FunctorT f, FunctorT g) => FunctorT (f :*: g) where	
-	fmapp f (x :*: y) = fmapp f x :*: fmapp f y
-
-instance (Functor (f r), Functor (g r)) => Functor ((f :*: g) r) where
-	fmap f (x :*: y) = fmap f x :*: fmap f y
-
-instance (FunctorT f, FunctorT g) => FunctorT (f :+: g) where
-	fmapp f (L l) = L (fmapp f l)
-	fmapp f (R r) = R (fmapp f r)
-
-instance (Functor (f r), Functor (g r)) => Functor ((f :+: g) r) where
-	fmap f (L l) = L (fmap f l)
-	fmap f (R r) = R (fmap f r)
-
--- instance FunctorT f => FunctorT (A f) where
--- 	fmapp f (A x) = A (fmapp f x)
-
--- instance FunctorT A0 where
--- 	fmapp f (A0 x) = A0 (fmap f x)
-
--- instance (FunctorT f, Functor r) => Functor (A f r) where
--- 	fmap = fmapp
-
--- instance Functor r => Functor (A0 r) where
--- 	fmap = fmapp
-
--- instance FunctorT X where
--- 	fmapp = fmap
-
--- instance Functor (X r) where
--- 	fmap f (X x) = X (f x)
-
-instance FunctorT f => Functor (HFix f) where
-	fmap f (HIn x) = HIn (fmapp f x)
--}
-
-breakEither :: [((f :+: g) r ix, a)] -> ([(f r ix, a)], [(g r ix, a)])
-breakEither = foldr breakEither' ([], []) where
-	breakEither' (L k, a) (xs, ys) = ((k, a):xs, ys)
-	breakEither' (R k, a) (xs, ys) = (xs, (k, a):ys)
diff --git a/Data/TrieMap/MultiRec/Class.hs b/Data/TrieMap/MultiRec/Class.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/Class.hs
+++ /dev/null
@@ -1,179 +0,0 @@
-{-# LANGUAGE TypeOperators, Rank2Types, FunctionalDependencies, FlexibleContexts, KindSignatures, TypeFamilies, MultiParamTypeClasses #-}
-
-module Data.TrieMap.MultiRec.Class where
-
--- import Data.TrieMap.Regular.Class
-import Data.TrieMap.CPair
-import Data.TrieMap.MultiRec.Sized
--- import Data.TrieMap.MultiRec.Eq
-import Data.TrieMap.MultiRec.Ord
--- import Data.TrieMap.Regular.Ord
-import Data.TrieMap.MultiRec.Base
--- import Data.TrieMap.MultiRec.KeyFam
-import Data.TrieMap.TrieKey
-import Data.TrieMap.Applicative
-
-import Control.Applicative
--- import Data.Monoid
--- import Generics.MultiRec.Eq
-
-type family HTrieMapT (phi :: * -> *) (f :: (* -> *) -> * -> *) :: (* -> *) -> * -> * -> *
-type family HTrieMap (phi :: * -> *) (r :: * -> *) :: * -> * -> *
-
-class HOrd phi f => HTrieKeyT (phi :: * -> *) (f :: (* -> *) -> * -> *) m | m -> phi f where
-	emptyH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r ix a
-	nullH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r ix a -> Bool
-	sizeH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> m r ix a -> Int
-	lookupH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> f r ix -> m r ix a -> Maybe a
-	lookupIxH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> f r ix -> m r ix a -> IndexPos (f r ix) a
-	assocAtH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> Int -> m r ix a -> IndexPos (f r ix) a
--- 	updateAtH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
--- 		phi ix -> HSized phi a -> Round -> (Int -> f r ix -> a -> Maybe a) -> Int -> m r ix a -> m r ix a
-	alterH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> f r ix -> m r ix a -> m r ix a
-	alterLookupH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>
-		phi ix -> HSized phi a -> (Maybe a -> CPair x (Maybe a)) -> f r ix ->
-			m r ix a -> CPair x (m r ix a)
--- 	{-# SPECIALIZE traverseWithKeyH :: HTrieKey phi r (HTrieMap phi r) =>
--- 		phi ix -> HSized phi b -> (f r ix -> ix a -> Id b) -> m r ix a -> Id (m r ix b) #-}
-	traverseWithKeyH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r), Applicative t) =>
-		phi ix -> HSized phi b -> (f r ix -> a -> t b) -> m r ix a -> t (m r ix b)
-	foldWithKeyH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		phi ix -> (f r ix -> a -> b -> b) -> m r ix a -> b -> b
-	foldlWithKeyH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>
-		phi ix -> (f r ix -> b -> a -> b) -> m r ix a -> b -> b
-	mapEitherH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> 
-		HSized phi b -> HSized phi c -> EitherMap (f r ix) a b c -> m r ix a -> (m r ix b, m r ix c)
-	splitLookupH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		phi ix -> HSized phi a -> SplitMap a x -> f r ix ->
-			m r ix a -> (m r ix a, Maybe x, m r ix a)
-	unionH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		phi ix -> HSized phi a -> UnionFunc (f r ix) a ->
-			m r ix a -> m r ix a -> m r ix a
-	isectH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		phi ix -> HSized phi c -> IsectFunc (f r ix) a b c -> m r ix a -> m r ix b -> m r ix c
-	diffH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>
-		phi ix -> HSized phi a -> DiffFunc (f r ix) a b -> m r ix a -> m r ix b -> m r ix a
-	extractH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r), Alternative t) =>
-		phi ix -> HSized phi a -> ExtractFunc t (m r ix a) (f r ix) a x
--- 	extractMinH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
--- 		phi ix -> HSized phi a -> ExtractFunc (f r ix) First a (m r ix a) x
--- 	extractMaxH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
--- 		phi ix -> HSized phi a -> ExtractFunc (f r ix) Last a (m r ix a) x
--- 	alterMinT:: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
--- 		phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> First (m r ix a)
--- 	alterMaxH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
--- 		phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> Last (m r ix a)
-	isSubmapH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		phi ix -> LEq a b -> LEq (m r ix a) (m r ix b)
-	fromListH, fromAscListH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		phi ix -> HSized phi a -> (f r ix -> a -> a -> a ) -> [(f r ix, a )] -> m r ix a
-	fromDistAscListH :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		phi ix -> HSized phi a -> [(f r ix, a )] -> m r ix a
-	sizeH pf s m = foldWithKeyH pf (\ _ x n -> s x + n) m 0
-	fromListH pf s f = foldr (\ (k, a) -> alterH pf s (Just . maybe a (f k a)) k) (emptyH pf)
-	fromAscListH = fromListH
-	fromDistAscListH pf s = fromAscListH pf s (const const)
-
-class HOrd0 phi r => HTrieKey (phi :: * -> *) (r :: * -> *) m | m -> phi r where
-	empty0 :: m ~ HTrieMap phi r => phi ix -> m ix a
-	null0 :: m ~ HTrieMap phi r => phi ix -> m ix a -> Bool
-	size0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> m ix a -> Int
-	lookup0 :: m ~ HTrieMap phi r => phi ix -> r ix -> m ix a -> Maybe a
-	lookupIx0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> r ix -> m ix a -> IndexPos (r ix) a
-	assocAt0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Int -> m ix a -> IndexPos (r ix) a
-	alter0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> r ix -> m ix a -> m ix a
-	alterLookup0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> (Maybe a -> CPair z (Maybe a))
-				-> r ix -> m ix a -> CPair z (m ix a)
-	extract0 :: (m ~ HTrieMap phi r, Alternative t) => phi ix -> HSized phi a ->
-		ExtractFunc t (m ix a) (r ix) a x
-	traverseWithKey0 :: (m ~ HTrieMap phi r, Applicative t) => phi ix -> HSized phi b ->
-		(r ix -> a -> t b) -> m ix a -> t (m ix b)
-	foldWithKey0 :: m ~ HTrieMap phi r => phi ix -> (r ix -> a -> b -> b) -> m ix a -> b -> b
-	foldlWithKey0 :: m ~ HTrieMap phi r => phi ix -> (r ix -> b -> a -> b) -> m ix a -> b -> b
-	mapEither0 :: m ~ HTrieMap phi r => phi ix -> HSized phi b -> HSized phi c -> EitherMap (r ix) a b c -> m ix a -> (m ix b, m ix c)
-	splitLookup0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> SplitMap a x ->
-		r ix -> m ix a -> (m ix a, Maybe x, m ix a)
-	union0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> UnionFunc (r ix) a ->
-		m ix a -> m ix a -> m ix a
-	isect0 :: m ~ HTrieMap phi r => phi ix -> HSized phi c -> IsectFunc (r ix) a b c->
-		m ix a -> m ix b -> m ix c
-	diff0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> DiffFunc (r ix) a b ->
-		m ix a -> m ix b -> m ix a
-	isSubmap0 :: m ~ HTrieMap phi r => phi ix -> LEq a b -> LEq (m ix a) (m ix b)
-	fromList0, fromAscList0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> (r ix -> a -> a -> a) -> [(r ix, a)] -> m ix a
-	fromDistAscList0 :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> [(r ix, a)] -> m ix a
-	
-
--- class HOrd0 phi r => HTrieKey (phi :: * -> *) (r :: * -> *) m | m -> phi r where
--- 	emptyH :: m ~ HTrieMap phi r => phi ix -> m ix a
--- 	nullH :: m ~ HTrieMap phi r => phi ix -> m ix a -> Bool
--- 	sizeH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> m ix a -> Int
--- 	lookupH :: m ~ HTrieMap phi r => phi ix -> r ix -> m ix a -> Maybe a
--- 	alterH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> r ix -> m ix a -> m ix a
--- 	lookupIxH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> r ix -> m ix a -> IndexPos (r ix) a
--- 	assocAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Int -> m ix a -> IndexPos (r ix) a
--- -- 	updateAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Round -> (Int -> r ix -> a -> Maybe a) -> Int -> m ix a -> m ix a
--- 	{-# SPECIALIZE traverseWithKeyH :: phi ix -> (r ix -> ix a -> Id b) ->
--- 		m ix a -> Id (m ix b) #-}
--- 	traverseWithKeyH :: (m ~ HTrieMap phi r, Applicative f) => 
--- 		phi ix -> HSized phi b -> (r ix -> a -> f b) -> m ix a -> f (m ix b)
--- 	foldWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> a -> b -> b) -> m ix a -> b -> b
--- 	foldlWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> b -> a -> b) -> m ix a -> b -> b
--- 	mapEitherH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi b -> HSized phi c ->
--- 		EitherMap (r ix) a b c -> m ix a -> (m ix b, m ix c)
--- 	splitLookupH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> SplitMap a x -> r ix -> m ix a ->
--- 				(m ix a, Maybe x, m ix a)
--- 	unionH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> UnionFunc (r ix) a -> m ix a -> m ix a
--- 			-> m ix a
--- 	isectH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi c -> IsectFunc (r ix) a b c ->
--- 			m ix a -> m ix b -> m ix c
--- 	diffH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> DiffFunc (r ix) a b ->
--- 			m ix a -> m ix b -> m ix a
--- 	extractH :: (m ~ HTrieMap phi r, Alternative t) =>
--- 		phi ix -> HSized phi a -> ExtractFunc t (m ix a) (r ix) a x
--- -- 	extractMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) First a (m ix a) x
--- -- 	extractMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) Last a (m ix a) x
--- -- 	alterMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> Maybe a) ->
--- -- 		m ix a -> First (m ix a)
--- -- 	alterMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> Maybe a) ->
--- -- 		m ix a -> Last (m ix a)
--- 	isSubmapH :: m ~ HTrieMap phi r => 
--- 		phi ix -> LEq a b -> LEq (m ix a) (m ix b)
--- 	fromListH, fromAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> a -> a) ->
--- 		[(r ix, a)] -> m ix a
--- 	fromDistAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> [(r ix, a)] -> m ix a
--- 	sizeH pf s m = foldWithKeyH pf (\ _ x n -> s x + n) m 0
--- 	fromListH pf s f = foldr (\ (k, a) -> alterH pf s (Just . maybe a (f k a)) k) (emptyH pf)
--- 	fromAscListH = fromListH
--- 	fromDistAscListH pf s = fromAscListH pf s (const const)
--- 
--- mapWithKeyH :: (HTrieKeyT phi f (HTrieMapT phi f), HTrieKey phi r (HTrieMap phi r)) =>
--- 	phi ix -> HSized phi b -> (f r ix -> a -> b ) -> HTrieMapT phi f r ix a -> HTrieMapT phi f r ix b
--- mapWithKeyT pf s f m = unId (traverseWithKeyT pf s (Id .: f) m)
--- 
--- mapWithKeyH :: (HTrieKey phi r (HTrieMap phi r), HTrieKeyT phi f (HTrieMapT phi f)) =>
--- 	phi ix -> HSized phi b -> (r ix -> a -> b) -> HTrieMapT phi f r ix a -> HTrieMapT phi f r ix b
-mapWithKeyH pf s f m = unId (traverseWithKeyH pf s (Id .: f) m)
--- 
-guardNullH :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r)) => 
-	phi ix -> m r ix a -> Maybe (m r ix a)
-guardNullH pf m
-	| nullH pf m	= Nothing
-	| otherwise	= Just m
--- 
--- -- alterMaxT, alterMinH :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r)) =>
--- -- 	phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> m r ix a
--- -- alterMaxT pf s f m = maybe m snd $ getLast (extractMaxT pf s (\ k a -> ((), f k a)) m)
--- -- alterMinT pf s f m = maybe m snd $ getFirst (extractMinT pf s (\ k a -> ((), f k a)) m)
--- 
-aboutH :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r), Alternative t) =>
-	phi ix -> (f r ix -> a -> t z) -> m r ix a -> t z
-aboutH pf f m = cpFst <$> extractH pf (const 0) (\ k a -> fmap (flip cP Nothing) (f k a)) m
-
-breakEither :: [((f :+: g) r ix, a)] -> ([(f r ix, a)], [(g r ix, a)])
-breakEither [] = ([], [])
-breakEither ((L k, a):xs) = case breakEither xs of
-	(ys, zs) -> ((k, a):ys, zs)
-breakEither ((R k, a):xs) = case breakEither xs of
-	(ys, zs) -> (ys, (k, a):zs)
diff --git a/Data/TrieMap/MultiRec/ConstMap.hs b/Data/TrieMap/MultiRec/ConstMap.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/ConstMap.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-{-# LANGUAGE TemplateHaskell, KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
-
-module Data.TrieMap.MultiRec.ConstMap () where
-
-import Data.TrieMap.MultiRec.Class
--- import Data.TrieMap.MultiRec.Eq
--- import Data.TrieMap.MultiRec.Sized
--- import Data.TrieMap.MultiRec.KeyFam
--- import Data.TrieMap.Applicative
-import Data.TrieMap.TrieKey
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.TH
-
-import Control.Applicative
-import Control.Arrow
-import Control.Monad
-
--- import Data.Maybe
--- import Data.Foldable
-import Generics.MultiRec
-
-newtype KMap (phi :: * -> *) m (r :: * -> *) ix a = KMap (m a)
-type instance HTrieMapT phi (K k) = KMap phi (TrieMap k)
--- type instance HTrieMap phi (K k r) = HTrieMapT phi (K k) r
-
--- type instance RepT (KMap phi m r ix) = RepT m
--- type instance Rep (KMap phi m r ix a) = RepT m (Rep a)
--- 
--- -- $(genRepT [d|
---    instance ReprT m => ReprT (KMap phi m r ix) where
--- 	toRepT (KMap m) = toRepT m
--- 	fromRepT = KMap . fromRepT |])
-
-instance TrieKey k m => HTrieKeyT phi (K k) (KMap phi m) where
-	emptyH _ = KMap emptyM
-	nullH _ (KMap m) = nullM m
-	lookupH _ (K k) (KMap m) = lookupM k m
-	lookupIxH _ s (K k) (KMap m) = onKey K (lookupIxM s k m)
-	assocAtH _ s i (KMap m) = onKey K (assocAtM s i m)
-	alterH _ s f (K k) (KMap m) = KMap (alterM s f k m)
-	alterLookupH _ s f (K k) (KMap m) = KMap <$> alterLookupM s f k m
-	traverseWithKeyH _ s f (KMap m) = KMap <$> traverseWithKeyM s (f . K) m
-	foldWithKeyH _ f (KMap m) = foldWithKeyM (f . K) m
-	foldlWithKeyH _ f (KMap m) = foldlWithKeyM (f . K) m
-	mapEitherH _ s1 s2 f (KMap m) = (KMap *** KMap) (mapEitherM s1 s2 (f . K) m)
-	splitLookupH _ s f (K k) (KMap m) = KMap `sides` splitLookupM s f k m
-	unionH _ s f (KMap m1) (KMap m2) = KMap (unionM s (f . K) m1 m2)
-	isectH _ s f (KMap m1) (KMap m2) = KMap (isectM s (f . K) m1 m2)
-	diffH _ s f (KMap m1) (KMap m2) = KMap (diffM s (f . K) m1 m2)
-	extractH _ s f (KMap m) = fmap KMap <$> extractM s (f . K) m
-	isSubmapH _ (<=) (KMap m1) (KMap m2) = isSubmapM (<=) m1 m2
diff --git a/Data/TrieMap/MultiRec/Eq.hs b/Data/TrieMap/MultiRec/Eq.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/Eq.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances #-}
-
-module Data.TrieMap.MultiRec.Eq where
-
--- import Data.TrieMap.MultiRec.Base
--- import Generics.MultiRec.HFix
-import Generics.MultiRec.Eq
--- import Data.TrieMap.Regular.Eq
-
--- class HEq phi r where
--- 	heqH :: phi ix -> r ix -> r ix -> Bool
-
--- class EqFam phi where
--- 	eqF :: phi ix -> (ix -> ix -> Bool)
-
-class HEq0 phi r where
-	heq0 :: phi ix -> r ix -> r ix -> Bool
-
-heqT :: (HEq phi f, HEq0 phi r) => phi ix -> f r ix -> f r ix -> Bool
-heqT = heq heq0
-{-
-heqT :: (HEq phi f, HEq0 phi r) => phi ix -> f r ix -> f r ix -> Bool
-heqT = heq heqH
-
-instance Eq k => HEq0 phi (K k r) where
-	heqH _ (K x) (K y) = x == y-}
-{-
-instance HEq0 phi r => HEq0 phi (A0 r) where
-	heqH pf (A0 x) (A0 y) = heqH pf x y-}
-
--- instance (HEq phi f, HEq0 phi r) => HEq0 phi (A f r) where
--- 	heqH pf (A x) (A y) = heqT pf x y
-
--- instance (El phi xi, HEq0 phi r) => HEq0 phi (I xi r) where
--- 	heqH pf (I x) (I y) = heqH (proofOn pf) x y where
--- 		proofOn :: El phi xi => phi ix -> phi xi
--- 		proofOn _ = proof
--- 
--- instance HEq0 phi (U r) where
--- 	heqH _ _ _ = True
--- 
--- instance (HEq phi f, HEq phi g, HEq0 phi r) => HEq0 phi ((f :*: g) r) where
--- 	heqH pf (x1 :*: y1) (x2 :*: y2) = heqT pf x1 x2 && heqT pf y1 y2
--- 
--- instance (HEq phi f, HEq phi g, HEq0 phi r) => HEq0 phi ((f :+: g) r) where
--- 	heqH pf (L x) (L y) = heqT pf x y
--- 	heqH pf (R x) (R y) = heqT pf x y
--- 	heqH _ _ _ = False
--- 
--- instance (HEq phi f, HEq0 phi r) => HEq0 phi ((f :>: ix) r) where
--- 	heqH pf (Tag x) (Tag y) = heqT pf x y
--- 
--- instance HEq phi f => HEq0 phi (HFix f) where
--- 	heqH pf (HIn x) (HIn y) = heqT pf x y
diff --git a/Data/TrieMap/MultiRec/FamMap.hs b/Data/TrieMap/MultiRec/FamMap.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/FamMap.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-{-# LANGUAGE PatternGuards, TypeFamilies, MultiParamTypeClasses, Rank2Types, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
-
-module Data.TrieMap.MultiRec.FamMap () where
-
-import Data.TrieMap.MultiRec.Class
-import Data.TrieMap.MultiRec.Eq
-import Data.TrieMap.MultiRec.Ord
-import Data.TrieMap.MultiRec.Sized
-import Data.TrieMap.MultiRec.Base
--- import Data.TrieMap.Sized
--- import Data.TrieMap.Applicative
-import Data.TrieMap.TrieKey
--- import qualified Data.TrieMap.Regular.Class as Reg
-
-import Control.Applicative
-import Control.Arrow
-
--- import Data.Maybe
--- import Data.Foldable
--- import Data.Sequence ((|>))
--- import qualified Data.Sequence as Seq
-
-import Generics.MultiRec
-
-newtype FamMap (phi :: * -> *) m ix a = FamMap (m (Family phi) ix a)
-type instance HTrieMap phi (Family phi) = FamMap phi (HTrieMapT phi (PF phi))
-type instance TrieMap (Family phi ix) = FamMap phi (HTrieMapT phi (PF phi)) ix
-
-to' :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> PF phi (Family phi) ix -> Family phi ix
-to' pf = F . to pf . hmap (\ _ (F x) -> I0 x) pf
-
-push :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> (Family phi ix -> a) -> PF phi (Family phi) ix -> a
-push pf f = f . to' pf
-
-from' :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> Family phi ix -> PF phi (Family phi) ix
-from' pf (F x) = hmap (const (F . unI0)) pf (from pf x)
-
-from'' :: (Fam phi, HFunctor phi (PF phi), El phi ix) => Family phi ix -> PF phi (Family phi) ix
-from'' = from' proof
-
-instance (Fam phi, HFunctor phi (PF phi), HEq phi (PF phi)) => HEq0 phi (Family phi) where
-	heq0 pf a b = heqT pf (from' pf a) (from' pf b)
-
-instance (Fam phi, HFunctor phi (PF phi), HOrd phi (PF phi)) => HOrd0 phi (Family phi) where
-	compare0 pf a b = hcompare pf (from' pf a) (from' pf b)
-
-instance (Fam phi, HFunctor phi (PF phi), HEq phi (PF phi), El phi ix) => Eq (Family phi ix) where
-	a == b = heq0 (prove a) a b where
-		prove :: El phi ix => Family phi ix -> phi ix
-		prove _ = proof
-
-instance (Fam phi, HFunctor phi (PF phi), HOrd phi (PF phi), El phi ix) => Ord (Family phi ix) where
-	compare a b = compare0 (prove a) a b where
-		prove :: El phi ix => Family phi ix -> phi ix
-		prove _ = proof
-
-instance (Fam phi, HFunctor phi (PF phi), HTrieKeyT phi (PF phi) m) => HTrieKey phi (Family phi) (FamMap phi m) where
-	empty0 pf = FamMap (emptyH pf)
-	null0 pf (FamMap m) = nullH pf m 
-	size0 pf s (FamMap m) = sizeH pf s m
-	lookup0 pf k (FamMap m) = lookupH pf (from' pf k) m
-	lookupIx0 pf s k (FamMap m) = onKey (to' pf) (lookupIxH pf s (from' pf k) m)
-	assocAt0 pf s i (FamMap m) = onKey (to' pf) (assocAtH pf s i m)
-	alter0 pf s f k (FamMap m) = FamMap (alterH pf s f (from' pf k) m)
-	extract0 pf s f (FamMap m) = fmap FamMap <$> extractH pf s (push pf f) m
-	alterLookup0 pf s f k (FamMap m) = FamMap <$> alterLookupH pf s f (from' pf k) m
-	traverseWithKey0 pf s f (FamMap m) = FamMap <$> traverseWithKeyH pf s (push pf f) m
-	foldWithKey0 pf f (FamMap m) = foldWithKeyH pf (push pf f) m
-	foldlWithKey0 pf f (FamMap m) = foldlWithKeyH pf (push pf f) m
-	mapEither0 pf s1 s2 f (FamMap m) = (FamMap *** FamMap) (mapEitherH pf s1 s2 (push pf f) m)
-	splitLookup0 pf s f k (FamMap m) = FamMap `sides` splitLookupH pf s f (from' pf k) m
-	union0 pf s f (FamMap m1) (FamMap m2) = FamMap (unionH pf s (push pf f) m1 m2)
-	isect0 pf s f (FamMap m1) (FamMap m2) = FamMap (isectH pf s (push pf f) m1 m2)
-	diff0 pf s f (FamMap m1) (FamMap m2) = FamMap (diffH pf s (push pf f) m1 m2)
-	isSubmap0 pf (<=) (FamMap m1) (FamMap m2) = isSubmapH pf (<=) m1 m2
-	fromList0 pf s f xs = FamMap (fromListH pf s (push pf f) [(from' pf k, a) | (k, a) <- xs])
-	fromAscList0 pf s f xs = FamMap (fromAscListH pf s (push pf f) [(from' pf k, a) | (k, a) <- xs])
-	fromDistAscList0 pf s xs = FamMap (fromDistAscListH pf s [(from' pf k, a) | (k, a) <- xs])
-
-instance (Fam phi, HFunctor phi (PF phi), El phi ix, HTrieKeyT phi (PF phi) m) => TrieKey (Family phi ix) (FamMap phi m ix) where
-	emptyM = empty0 proof
-	nullM = null0 proof
-	sizeM = size0 proof
-	lookupM = lookup0 proof
-	lookupIxM = lookupIx0 proof
-	assocAtM = assocAt0 proof
-	alterM = alter0 proof
-	alterLookupM = alterLookup0 proof
-	extractM = extract0 proof
-	traverseWithKeyM = traverseWithKey0 proof
-	foldWithKeyM = foldWithKey0 proof
-	foldlWithKeyM = foldlWithKey0 proof
-	mapEitherM = mapEither0 proof
-	splitLookupM = splitLookup0 proof
-	unionM = union0 proof
-	isectM = isect0 proof
-	diffM = diff0 proof
-	isSubmapM = isSubmap0 proof
-	fromListM = fromList0 proof
-	fromAscListM = fromAscList0 proof
-	fromDistAscListM = fromDistAscList0 proof
diff --git a/Data/TrieMap/MultiRec/IMap.hs b/Data/TrieMap/MultiRec/IMap.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/IMap.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, Rank2Types, TypeFamilies, FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses #-}
-
-module Data.TrieMap.MultiRec.IMap () where
-
-import Data.TrieMap.MultiRec.Class
-import Data.TrieMap.MultiRec.Sized
--- import Data.TrieMap.MultiRec.KeyFam
--- import Data.TrieMap.MultiRec.TT
--- import Data.TrieMap.Rep.TT
--- import Data.TrieMap.Rep
-import Data.TrieMap.TrieKey
-
-import Control.Applicative
-import Control.Arrow
-
-import Generics.MultiRec
-
-newtype IMap phi xi r ix a = IMap (HTrieMap phi r xi a)
-type instance HTrieMapT phi (I xi) = IMap phi xi
--- type instance TTrieMap phi (I xi r) = TTrieMapH phi (I xi) r
-
--- type instance RepH (IMap phi xi r ix) = RepH (TTrieMap phi r xi)
--- type instance Rep (IMap phi xi r ix a) = RepH (IMap phi xi r ix) (Rep a)
--- 
--- -- $(genRepH [d|
---   instance ReprH (TTrieMap phi r xi) => ReprH (IMap phi xi r ix) where
--- 	toRepH (IMap m) = toRepH m
--- 	fromRepH = IMap . fromRepH |] )
-
-instance (El phi xi) => HTrieKeyT phi (I xi) (IMap phi xi) where
-	emptyH _ = IMap (empty0 proof)
-	nullH _ (IMap m) = null0 proof m
-	sizeH _ s (IMap m) = size0 proof s m
-	lookupH _ (I k) (IMap m) = lookup0 proof k m
-	lookupIxH _ s (I k) (IMap m) = onKey I (lookupIx0 proof s k m)
-	assocAtH _ s i (IMap m) = onKey I (assocAt0 proof s i m)
--- 	updateAtH _ s r f i (IMap m) = IMap (updateAtH proof s r (\ i' -> f i' . I) i m)
-	alterH _ s f (I k) (IMap m) = IMap (alter0 proof s f k m)
-	alterLookupH _ s f (I k) (IMap m) = IMap <$> alterLookup0 proof s f k m
-	traverseWithKeyH _ s f (IMap m) = IMap <$> traverseWithKey0 proof s (f . I) m
-	foldWithKeyH _ f (IMap m) = foldWithKey0 proof (f . I) m
-	foldlWithKeyH _ f (IMap m) = foldlWithKey0 proof (f . I) m
-	mapEitherH _ s1 s2 f (IMap m) = (IMap *** IMap) (mapEither0 proof s1 s2 (f . I) m)
-	splitLookupH pf s f (I k) (IMap m) = IMap `sides` splitLookup0 proof s (f) k m
-	unionH pf s f (IMap m1) (IMap m2) = IMap (union0 proof s (f . I) m1 m2)
-	isectH pf s f (IMap m1) (IMap m2) = IMap (isect0 proof s (f . I) m1 m2)
-	diffH pf s f (IMap m1) (IMap m2) = IMap (diff0 proof s (f . I) m1 m2)
-	extractH pf s f (IMap m) = fmap IMap <$> extract0 proof s (f . I) m
--- 	extractMinH pf s f (IMap m) = second IMap <$> extractMinH proof s (f . I) m
--- 	extractMaxH pf s f (IMap m) = second IMap <$> extractMaxH proof s (f . I) m
--- 	alterMinH pf s f (IMap m) = IMap <$> alterMinH proof s (f . I) m
--- 	alterMaxH pf s f (IMap m) = IMap <$> alterMaxH proof s (f . I) m
-	isSubmapH pf (<=) (IMap m1) (IMap m2) = isSubmap0 proof (<=) m1 m2 
-	fromListH _ s f xs = IMap (fromList0 proof s (f . I) [(k, a) | (I k, a) <- xs])
-	fromAscListH _ s f xs = IMap (fromAscList0 proof s (f . I) [(k, a) | (I k, a) <- xs])
-	fromDistAscListH _ s xs = IMap (fromDistAscList0 proof s [(k, a) | (I k, a) <- xs]) 
diff --git a/Data/TrieMap/MultiRec/Instances.hs b/Data/TrieMap/MultiRec/Instances.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/Instances.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module Data.TrieMap.MultiRec.Instances where
-
-import Data.TrieMap.MultiRec.ProdMap
-import Data.TrieMap.MultiRec.IMap
-import Data.TrieMap.MultiRec.UnionMap
-import Data.TrieMap.MultiRec.TagMap
-import Data.TrieMap.MultiRec.ConstMap
-import Data.TrieMap.MultiRec.UnitMap
-import Data.TrieMap.MultiRec.FamMap
--- import Data.TrieMap.MultiRec.AppMap
--- import Data.TrieMap.MultiRec.XMap
--- import Data.TrieMap.MultiRec.FixMap
diff --git a/Data/TrieMap/MultiRec/Ord.hs b/Data/TrieMap/MultiRec/Ord.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/Ord.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-{-# LANGUAGE FlexibleInstances, TypeOperators, MultiParamTypeClasses, Rank2Types, GADTs #-}
-
-module Data.TrieMap.MultiRec.Ord where
-
-import Data.TrieMap.MultiRec.Eq
-import Data.TrieMap.MultiRec.Base
-import Data.TrieMap.Regular.Ord
-import Generics.MultiRec
-
-import Data.Monoid
-
--- type Comparator a = a -> a -> Ordering
-
-class HEq phi f => HOrd phi f where
-	compareH :: (forall ix . phi ix -> Comparator (r ix)) -> phi ix -> Comparator (f r ix)
-
-class HEq0 phi r => HOrd0 phi r where
-	compare0 :: phi ix -> Comparator (r ix)
-
-hcompare :: (HOrd phi f, HOrd0 phi r) => phi ix -> Comparator (f r ix)
-hcompare = compareH compare0
-
-instance Ord k => HOrd phi (K k) where
-	compareH _ _ (K a) (K b) = compare a b
-
-instance El phi xi => HOrd phi (I xi) where
-	compareH cmp _ (I a) (I b) = cmp proof a b
-
-instance (HOrd phi f, HOrd phi g) => HOrd phi (f :*: g) where
-	compareH cmp pf (x1 :*: y1) (x2 :*: y2) = compareH cmp pf x1 x2 `mappend` compareH cmp pf y1 y2
-
-instance (HOrd phi f, HOrd phi g) => HOrd phi (f :+: g) where
-	compareH cmp pf a b = case (a, b) of
-		(L a, L b) -> compareH cmp pf a b
-		(R a, R b) -> compareH cmp pf a b
-		(L _, R _) -> LT
-		_	   -> GT
-
-instance HOrd phi f => HOrd phi (f :>: ix) where
-	compareH cmp pf (Tag a) (Tag b) = compareH cmp pf a b
-
-instance HOrd phi U where
-	compareH _ _ _ _ = EQ
-
--- hcompare :: (HOrd phi f, HOrd0 phi r) => phi ix -> Comparator (f r ix)
--- hcompare = compareH compareH0
--- 
--- class HEq0 phi r => HOrd0 phi r where
--- 	compareH0 :: phi ix -> Comparator (r ix)
--- 
--- -- instance HOrd0 phi r => HOrd0 phi (A0 r) where
--- -- 	compareH0 pf (A0 a) (A0 b) = compareH0 pf a b
--- 
--- -- instance (HOrd phi f, HOrd0 phi r) => HOrd0 phi (A f r) where
--- -- 	compareH0 pf (A a) (A b) = hcompare pf a b
--- 
--- -- instance HOrd phi A0 where
--- -- 	compareH cmp pf (A0 a) (A0 b) = cmp pf a b
--- 
--- instance Ord k => HOrd phi (K k) where
--- 	compareH _ = compareH0
--- 
--- instance Ord k => HOrd0 phi (K k r) where
--- 	compareH0 _ (K a) (K b) = compare a b
--- 
--- instance El phi xi => HOrd phi (I xi) where
--- 	compareH cmp _ (I a) (I b) = cmp proof a b
--- 
--- instance (El phi xi, HOrd0 phi r) => HOrd0 phi (I xi r) where
--- 	compareH0 = hcompare
--- 
--- instance HOrd phi U where
--- 	compareH _ = compareH0
--- 
--- instance HOrd0 phi (U r) where
--- 	compareH0 _ _ _ = EQ
--- 
--- instance (HOrd phi f, HOrd phi g) => HOrd phi (f :*: g) where
--- 	compareH cmp pf (x1 :*: y1) (x2 :*: y2) = compareH cmp pf x1 x2 `mappend` compareH cmp pf y1 y2
--- 
--- instance (HOrd phi f, HOrd phi g, HOrd0 phi r) => HOrd0 phi ((f :*: g) r) where
--- 	compareH0 = hcompare
--- 
--- instance (HOrd phi f, HOrd phi g) => HOrd phi (f :+: g) where
--- 	compareH cmp pf x y = case (x, y) of
--- 		(L x, L y) -> compareH cmp pf x y
--- 		(R x, R y) -> compareH cmp pf x y
--- 		(L _, R _) -> LT
--- 		(R _, L _) -> GT
--- 
--- instance (HOrd phi f, HOrd phi g, HOrd0 phi r) => HOrd0 phi ((f :+: g) r) where
--- 	compareH0 = hcompare
--- 
--- instance HOrd phi f => HOrd phi (f :>: ix) where
--- 	compareH cmp pf (Tag a) (Tag b) = compareH cmp pf a b
--- 
--- instance (HOrd phi f, HOrd0 phi r) => HOrd0 phi ((f :>: ix) r) where
--- 	compareH0 pf (Tag a) (Tag b) = hcompare pf a b
--- 
--- instance HOrd phi f => HOrd0 phi (HFix f) where
--- 	compareH0 pf (HIn a) (HIn b) = hcompare pf a b
diff --git a/Data/TrieMap/MultiRec/ProdMap.hs b/Data/TrieMap/MultiRec/ProdMap.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/ProdMap.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-{-# LANGUAGE PatternGuards, TemplateHaskell, TypeOperators, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}
-
-module Data.TrieMap.MultiRec.ProdMap () where
-
-import Data.TrieMap.MultiRec.Class
-import Data.TrieMap.MultiRec.Eq
--- import Data.TrieMap.MultiRec.Ord
-import Data.TrieMap.MultiRec.Sized
--- import Data.TrieMap.MultiRec.TH
--- import Data.TrieMap.Regular.Eq
--- import Data.TrieMap.Regular.Ord
--- import Data.TrieMap.Regular.Base (O(..))
-import Data.TrieMap.Applicative
-import Data.TrieMap.TrieKey
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.TH
-
-import Control.Applicative
-import Control.Arrow
-
-import Data.Maybe
-import Data.Monoid
-import Data.Foldable
-import Data.Sequence ((|>))
-import qualified Data.Sequence as Seq
-
-import Generics.MultiRec
-
-newtype ProdMap (phi :: * -> *) f g (r :: * -> *) ix a = PMap (HTrieMapT phi f r ix (HTrieMapT phi g r ix a))
-type instance HTrieMapT phi (f :*: g) = ProdMap phi f g--(HTrieMapT phi f) (HTrieMapT phi g)
--- type instance HTrieMap phi ((f :*: g) r) = HTrieMapT phi (f :*: g) r
-
--- type instance RepH (ProdMap phi f g r ix) = RepH (HTrieMapT phi f r ix) `O` RepH (HTrieMapT phi g r ix)
--- type instance Rep (ProdMap phi f g r ix a) = RepH (ProdMap phi f g r ix) (Rep a)
-
--- -- $(genRepH [d|
--- 	instance (ReprH (HTrieMapT phi f r ix), ReprH (HTrieMapT phi g r ix)) =>
--- 			ReprH (ProdMap phi f g r ix) where
--- 		toRepH (PMap m) = O (fmap toRepH (toRepH m))
--- 		fromRepH (O m) = PMap (fromRepH (fmap fromRepH m)) |] )
-
-maxIx :: (HTrieKeyT phi f (HTrieMapT phi f), HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> 
-		HTrieMapT phi f r ix a -> Int
-maxIx pf s m = fromMaybe (sizeH pf s m) (getFirst (aboutH pf (\ _ a -> return (sizeH pf s m - s a)) m))
-
-instance (HTrieKeyT phi f (HTrieMapT phi f), HTrieKeyT phi g (HTrieMapT phi g)) => 
-	HTrieKeyT phi (f :*: g) (ProdMap phi f g) where
-	emptyH = PMap . emptyH
-	nullH pf (PMap m) = nullH pf m
-	sizeH pf s (PMap m) = sizeH pf (sizeH pf s) m
-	lookupH pf (a :*: b) (PMap m) = lookupH pf a m >>= lookupH pf b
-	lookupIxH pf s (a :*: b) (PMap m) = case lookupIxH pf (sizeH pf s) a m of
-		(lb, x, rb) -> let lookupX = do	Asc i a' m' <- x
-						let (lb', x', rb') = lookupIxH pf s b m'
-						let f = onIndexA (i +) . onKeyA (a' :*:)
-						return (f <$> lb', f <$> x', f <$> rb')
-		   in 	((do	Asc iA aL mL <- lb
-				fmap (onIndexA (iA +) . onKeyA (aL :*:)) (getLast pf s mL)) <|>
-			 (do	(lb', _, _) <- Last lookupX
-				lb'),
-			 (do	(_, x', _) <- lookupX
-				x'),
-			 (do	(_, _, rb') <- First lookupX
-				rb') <|>
-			 (do	Asc iA aR mR <- rb
-			  	fmap (onIndexA (iA +) . onKeyA (aR :*:)) (getFirst pf s mR)))
-		where 	getLast pf s m = aboutH pf (\ k a -> return (Asc (sizeH pf s m - s a) k a)) m
-			getFirst pf s m = aboutH pf (\ k a -> return (Asc 0 k a)) m
-	assocAtH pf s i (PMap m) = case assocAtH pf (sizeH pf s) i m of
-		(lb, x, rb) -> let lookupX = do	Asc i' a' m' <- x
-						let (lb', x', rb') = assocAtH pf s (i - i') m'
-						let f = onIndexA (i' +) . onKeyA (a' :*:)
-						return (f <$> lb', f <$> x', f <$> rb')
-			in ((do	Asc iA aL mL <- lb
-				fmap (onIndexA (iA +) . onKeyA (aL :*:)) (getLast pf s mL)) <|>
-			    (do	(lb', _, _) <- Last lookupX
-			    	lb'),
-			    (do	(_, x', _) <- lookupX
-			    	x'),
-			    (do	(_, _, rb') <- First lookupX
-			    	rb') <|>
-			    (do	Asc iA aR mR <- rb
-			    	fmap (onIndexA (iA +) . onKeyA (aR :*:)) (getFirst pf s mR)))
-		where 	getLast pf s m = aboutH pf (\ k a -> return (Asc (sizeH pf s m - s a) k a)) m
-			getFirst pf s m = aboutH pf (\ k a -> return (Asc 0 k a)) m
--- 	updateAtH pf s r f i (PMap m) = PMap (updateAtH pf (sizeH pf s) r g i m) where
--- 		g iA a m 
--- 			| i >= iA && i <= iA + maxIx pf s m
--- 					= (guardNullH pf . updateAtH pf s r (\ iB b -> f (iA + iB) (a :*: b)) (i - iA)) m
--- 				| i < iA
--- 					= guardNullH pf $
--- 						alterMaxH pf s (\ b v -> f (iA + sizeH pf s m - s v) (a :*: b) v) m
--- 				| otherwise
--- 					= guardNullH pf $ alterMinH pf s (f iA . (a :*:)) m
-	alterH pf s f (a :*: b) (PMap m) = PMap (alterH pf (sizeH pf s) (guardNullH pf . g) a m) where
-		g = alterH pf s f b . fromMaybe (emptyH pf)
-	alterLookupH pf s f (a :*: b) (PMap m) = PMap <$> alterLookupH pf (sizeH pf s) g a m where
-		g = fmap (guardNullH pf) . alterLookupH pf s f b . fromMaybe (emptyH pf)
-	traverseWithKeyH pf s f (PMap m) = 
-		PMap <$> traverseWithKeyH pf (sizeH pf s) (\ a -> traverseWithKeyH pf s (\ b -> f (a :*: b))) m
-	foldWithKeyH pf f (PMap m) =
-		foldWithKeyH pf (\ a -> foldWithKeyH pf (\ b -> f (a :*: b))) m
-	foldlWithKeyH pf f (PMap m) =
-		foldlWithKeyH pf (\ a -> flip (foldlWithKeyH pf (\ b -> f (a :*: b)))) m
-	mapEitherH pf s1 s2 f (PMap m) = (PMap *** PMap) (mapEitherH pf (sizeH pf s1) (sizeH pf s2) g m) where
-		g a = (guardNullH pf *** guardNullH pf) . mapEitherH pf s1 s2 (\ b -> f (a :*: b))
-	splitLookupH pf s f (a :*: b) (PMap m) = PMap `sides` splitLookupH pf (sizeH pf s) g a m where
-		g = sides (guardNullH pf) . splitLookupH pf s f b
-	unionH pf s f (PMap m1) (PMap m2) = PMap (unionH pf (sizeH pf s) g m1 m2) where
-		g a = guardNullH pf .: unionH pf s (\ b -> f (a :*: b))
-	isectH pf s f (PMap m1) (PMap m2) = PMap (isectH pf (sizeH pf s) g m1 m2) where
-		g a = guardNullH pf .: isectH pf s (\ b -> f (a :*: b))
-	diffH pf s f (PMap m1) (PMap m2) = PMap (diffH pf (sizeH pf s) g m1 m2) where
-		g a = guardNullH pf .: diffH pf s (\ b -> f (a :*: b))
-	extractH pf s f (PMap m) = fmap PMap <$> extractH pf (sizeH pf s) g m where
-		g a = fmap (guardNullH pf) <.> extractH pf s (\ b -> f (a :*: b))
--- 	extractMinH pf s f (PMap m) = second PMap <$> extractMinH pf (sizeH pf s) g m where 
--- 			g a m1 = fromJust $ getFirst $ second (guardNullH pf) <$> extractMinH pf s (f . (a :*:)) m1
--- 		extractMaxH pf s f (PMap m) = second PMap <$> extractMaxH pf (sizeH pf s) g m where 
--- 			g a m1 = fromJust $ getLast $ second (guardNullH pf) <$> extractMaxH pf s (f . (a :*:)) m1
--- 		alterMinH pf s f (PMap m) = PMap (alterMinH pf (sizeH pf s) g m) where
--- 			g a = guardNullH pf . alterMinH pf s (\ b -> f (a :*: b))
--- 		alterMaxH pf s f (PMap m) = PMap (alterMaxH pf (sizeH pf s) g m) where
--- 			g a = guardNullH pf . alterMaxH pf s (\ b -> f (a :*: b))
-	isSubmapH pf (<=) (PMap m1) (PMap m2) = isSubmapH pf (isSubmapH pf (<=)) m1 m2
-	fromListH pf s f xs = PMap (mapWithKeyH pf (sizeH pf s) (\ a -> fromListH pf s (\ b -> f (a :*: b)))
-				(fromListH pf (const 1) (\ _ (xs) (ys) -> (xs ++ ys))
-					[(a, ts) | (a, ts) <- breakFst pf xs]))
-	fromAscListH pf s f xs = PMap (fromDistAscListH pf (sizeH pf s)
-		[(a, fromAscListH pf s (\ b -> f (a :*: b)) ts) | (a, ts) <- breakFst pf xs])
-	fromDistAscListH pf s xs = PMap (fromDistAscListH pf (sizeH pf s)
-		[(a, fromDistAscListH pf s ts) | (a, ts) <- breakFst pf xs])
-
-breakFst :: (HEq phi f, HEq0 phi r) => phi ix -> [((f :*: g) r ix, a)] -> [(f r ix, [(g r ix, a)])]
-breakFst pf [] = []
-breakFst pf ((a :*: b, x):xs) = breakFst' a (Seq.singleton (b, x)) xs where
-	breakFst' a0 ts ((a :*: b, x):xs)
-		| heqT pf a0 a
-				= breakFst' a0 (ts |> (b, x)) xs
-		| otherwise	= (a0, toList ts):breakFst' a (Seq.singleton (b,x)) xs
-	breakFst' a ts [] = [(a, toList ts)]
diff --git a/Data/TrieMap/MultiRec/Sized.hs b/Data/TrieMap/MultiRec/Sized.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/Sized.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE Rank2Types, KindSignatures #-}
-
-module Data.TrieMap.MultiRec.Sized where
-
--- import Data.TrieMap.Sized
--- 
--- class HSized phi r where
--- 	hGetSize :: phi ix -> r ix -> Int
--- 
--- newtype ElF phi r ix = ElF (r ix)
--- 
--- instance (HSized phi r, El phi ix) => Sized (ElF phi r) where
--- 	getSize (ElF x) = hGetSize proof x
-
-type HSized (phi :: * -> *) a = a -> Int
-
-newtype Elem a = Elem {getElem :: a}
-
-sizeElem :: HSized phi (Elem a)
-sizeElem _ = 1
diff --git a/Data/TrieMap/MultiRec/TagMap.hs b/Data/TrieMap/MultiRec/TagMap.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/TagMap.hs
+++ /dev/null
@@ -1,137 +0,0 @@
-{-# LANGUAGE TemplateHaskell, Rank2Types, TypeOperators, KindSignatures, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, GADTs, MultiParamTypeClasses #-}
-
-module Data.TrieMap.MultiRec.TagMap () where
-
-import Data.TrieMap.MultiRec.Class
-import Data.TrieMap.MultiRec.Eq
-import Data.TrieMap.MultiRec.Sized
-import Data.TrieMap.CPair
--- import Data.TrieMap.MultiRec.TH
--- import Data.TrieMap.Applicative
-import Data.TrieMap.TrieKey
--- import Data.TrieMap.Rep
-
-import Control.Applicative
-import Control.Arrow
-import Control.Monad
-
-import Data.Maybe
--- import Data.Monoid
--- import Data.Foldable
-import Generics.MultiRec
-
-data TagF a ix xi where
-	TagF :: a -> TagF a ix ix
-
-unTagF :: TagF a ix xi -> a
-unTagF (TagF x) = x
-
-newtype TagMap (phi :: * -> *) f ix (r :: * -> *) xi a = TagMap (HTrieMapT phi f r xi (TagF a ix xi))
-type instance HTrieMapT phi (f :>: ix) = TagMap phi f ix
--- type instance HTrieMap phi ((f :>: ix) r) = HTrieMapT phi (f :>: ix) r
-
--- type instance RepT (TagMap phi f ix r xi) = RepT (HTrieMapT phi f r xi)
--- type instance Rep (TagMap phi f ix r xi a) = RepT (HTrieMapT phi f r xi) (Rep a)
-
--- instance (ReprT (HTrieMapT phi f r xi), ix ~ xi) => ReprT (TagMap phi f ix r xi) where
--- 	toRepT (TagMap m) = fmap unTagF (toRepT m)
--- 	fromRepT = TagMap . fromRepT . fmap TagF
--- 
--- instance (ReprT (HTrieMapT phi f r xi), ix ~ xi, Repr a) => Repr (TagMap phi f ix r xi a) where
--- 	toRep (TagMap m) = fmap (toRep . unTagF) (toRepT m)
--- 	fromRep = TagMap . fromRepT . fmap (TagF . fromRep)
-
-combineTag :: IsectFunc ((f :>: ix) r xi) (a) (b) (c) ->
-	IsectFunc (f r xi) (TagF a ix xi) (TagF b ix xi) (TagF c ix xi)
-combineTag f k (TagF a) (TagF b) = TagF <$> f (Tag k) a b
-
-mapTag :: Functor t => ((f :>: ix) r xi -> a -> t (b)) -> f r xi -> TagF a ix xi -> t (TagF b ix xi)
-mapTag f k (TagF a) = TagF <$> f (Tag k) a
-
-sizeTag :: HSized phi a -> HSized phi (TagF a ix xi)
-sizeTag s (TagF x) = s x
-
-restructure :: HTrieKeyT phi f (HTrieMapT phi f) =>
-	((f r ix, TagF a xi ix), HTrieMapT phi f r ix (TagF a xi ix)) -> (((f :>: xi) r ix, a), TagMap phi f xi r ix a)
-restructure ((k, TagF a), m) = ((Tag k, a), TagMap m)
-
-restructure' :: Applicative t => ((f :>: xi) r ix -> a -> t (CPair x (Maybe a))) -> f r ix -> TagF a xi ix -> t (CPair x (Maybe (TagF a xi ix)))
-restructure' f k (TagF a) = fmap (fmap TagF) <$> f (Tag k) a
-
-retag :: (f r ix, TagF a xi ix) -> ((f :>: xi) r ix, a)
-retag (k, TagF a) = (Tag k, a)
-
-instance (HTrieKeyT phi f (HTrieMapT phi f)) => HTrieKeyT phi (f :>: ix) (TagMap phi m ix) where
-	emptyH = TagMap . emptyH
-	nullH pf (TagMap m) = nullH pf m
-	sizeH pf s (TagMap m) = sizeH pf (sizeTag s) m
-	lookupH pf (Tag k) (TagMap m) = unTagF <$> lookupH pf k m
-	lookupIxH pf s (Tag k) (TagMap m) = onValue retag (lookupIxH pf (sizeTag s) k m)
-	assocAtH pf s i (TagMap m) = onValue retag (assocAtH pf (sizeTag s) i m) 
--- 	updateAtT pf s r f i (TagMap m) = TagMap (updateAtT pf (sizeTag s) r (f' f) i m) where
--- 		f' :: (Int -> (f :>: xi) r ix -> a -> Maybe (a)) -> Int -> f r ix -> TagF a xi ix -> Maybe (TagF a xi ix)
--- 		f' f i k (TagF a) = TagF <$> f i (Tag k) a
-	alterH pf s f (Tag k) (TagMap m) = TagMap (alterH pf (sizeTag s) (fmap TagF . f . fmap unTagF) k m)
-	alterLookupH pf s f (Tag k) (TagMap m) = TagMap <$> alterLookupH pf (sizeTag s) (fmap (fmap TagF) . f . fmap unTagF) k m
-	traverseWithKeyH pf s f (TagMap m) = TagMap <$> traverseWithKeyH pf (sizeTag s) (mapTag f) m where
-		f' :: Applicative t => ((f :>: ix) r xi -> a -> t (b )) -> f r xi -> TagF a ix xi -> t (TagF b ix xi)
-		f' f k (TagF a) = TagF <$> f (Tag k) a
-	foldWithKeyH pf f (TagMap m) = foldWithKeyH pf (f' f) m where
-		f' :: ((f :>: ix) r xi -> a -> b -> b) -> f r xi -> TagF a ix xi -> b -> b
-		f' f k (TagF a) = f (Tag k) a
-	foldlWithKeyH pf f (TagMap m) = foldlWithKeyH pf (f' f) m where
-		f' :: ((f :>: ix) r xi -> b -> a -> b) -> f r xi -> b -> TagF a ix xi -> b
-		f' f k z (TagF a) = f (Tag k) z a
-	mapEitherH pf s1 s2 f (TagMap m) = (TagMap *** TagMap) (mapEitherH pf (sizeTag s1) (sizeTag s2) (f' f) m) where
-		f' :: EitherMap ((f :>: ix) r xi) (a ) (b) (c) -> EitherMap (f r xi) (TagF a ix xi) (TagF b ix xi) (TagF c ix xi)
-		f' f k (TagF a) = (fmap TagF *** fmap TagF) (f (Tag k) a)
-	splitLookupH pf s f (Tag k) (TagMap m) = TagMap `sides` splitLookupH pf (sizeTag s) (f' f) k m where
-		f' :: SplitMap (a) x -> SplitMap (TagF a xi ix) x
-		f' f (TagF a) = fmap TagF `sides` f a
-	unionH pf s f (TagMap m1) (TagMap m2) = TagMap (unionH pf (sizeTag s) (combineTag f) m1 m2) 
-	isectH pf s f (TagMap m1) (TagMap m2) = TagMap (isectH pf (sizeTag s) (combineTag f) m1 m2)
-	diffH pf s f (TagMap m1) (TagMap m2) = TagMap (diffH pf (sizeTag s) (combineTag f) m1 m2)
--- 	extractMinT pf s f (TagMap m) = second TagMap <$> extractMinT pf (sizeTag s) (restructure' f) m
--- 	extractMaxT pf s f (TagMap m) = second TagMap <$> extractMaxT pf (sizeTag s) (restructure' f) m
-	extractH pf s f (TagMap m) = fmap TagMap <$> extractH pf (sizeTag s) (restructure' f) m
--- 	alterMinT pf s f (TagMap m) = TagMap <$> alterMinT pf (sizeTag s) (mapTag f) m
--- 	alterMaxT pf s f (TagMap m) = TagMap <$> alterMaxT pf (sizeTag s) (mapTag f) m
-	isSubmapH pf (<=) (TagMap m1) (TagMap m2) = isSubmapH pf (le (<=)) m1 m2 where
-		le :: LEq a b -> LEq (TagF a xi ix) (TagF b xi ix)
-		le (<=) (TagF a) (TagF b) = a <= b
-	fromListH pf s f xs = TagMap (fromListH pf (sizeTag s) (f' f) [(k, TagF a) | (Tag k, a) <- xs]) where
-		f' :: ((f :>: ix) r xi -> a -> a -> a) -> f r xi -> TagF a ix xi -> TagF a ix xi -> TagF a ix xi
-		f' f k (TagF a) (TagF b) = TagF (f (Tag k) a b)
-	fromAscListH pf s f xs = TagMap (fromAscListH pf (sizeTag s) (f' f) [(k, TagF a) | (Tag k, a) <- xs]) where
-		f' :: ((f :>: ix) r xi -> a -> a -> a ) -> f r xi -> TagF a ix xi -> TagF a ix xi -> TagF a ix xi
-		f' f k (TagF a) (TagF b) = TagF (f (Tag k) a b)
-	fromDistAscListH pf s xs = TagMap (fromDistAscListH pf (sizeTag s) (map f xs)) where
-		f :: ((f :>: ix) r xi, a) -> (f r xi, TagF a ix xi)
-		f (Tag k, a) = (k, TagF a)
-{-
-instance (HTrieKeyT phi f m, m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		HTrieKey phi ((f :>: ix) r) (TagMap phi f ix r) where
-	emptyH = emptyT
-	nullH = nullT
-	sizeH = sizeT
-	lookupH = lookupT
-	lookupIxH = lookupIxT
-	assocAtH = assocAtT
-	updateAtH = updateAtT
-	alterH = alterT
-	traverseWithKeyH = traverseWithKeyT
-	foldWithKeyH = foldWithKeyT
-	foldlWithKeyH = foldlWithKeyT
-	mapEitherH = mapEitherT
-	splitLookupH = splitLookupT
-	unionH = unionT
-	isectH = isectT
-	diffH = diffT
-	alterMinH = alterMinT
-	alterMaxH = alterMaxT
-	extractMinH = extractMinT
-	extractMaxH = extractMaxT
-	isSubmapH = isSubmapT
-	fromListH = fromListT
-	fromAscListH = fromAscListT
-	fromDistAscListH = fromDistAscListT-}
diff --git a/Data/TrieMap/MultiRec/UnionMap.hs b/Data/TrieMap/MultiRec/UnionMap.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/UnionMap.hs
+++ /dev/null
@@ -1,116 +0,0 @@
-{-# LANGUAGE TemplateHaskell, TypeFamilies, KindSignatures, FlexibleContexts, FlexibleInstances, UndecidableInstances, PatternGuards, MultiParamTypeClasses, TypeOperators #-}
-
-module Data.TrieMap.MultiRec.UnionMap () where
-
-import Data.TrieMap.MultiRec.Class
--- import Data.TrieMap.MultiRec.Eq
--- import Data.TrieMap.MultiRec.Base
--- import Data.TrieMap.Applicative
-import Data.TrieMap.TrieKey
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.TH
--- import Data.TrieMap.MultiRec.TH
--- import qualified Data.TrieMap.Regular.Base as Reg
-
-import Control.Applicative
--- import Control.Arrow
-import Control.Monad
-
--- import Data.Maybe
--- import Data.Monoid
--- import Data.Foldable
-import Generics.MultiRec
-
-import Prelude hiding (foldr)
-
-data UnionMap (phi :: * -> *) f g (r :: * -> *) ix a = HTrieMapT phi f r ix a :&: HTrieMapT phi g r ix a
-type instance HTrieMapT phi (f :+: g) = UnionMap phi f g--HTrieMap phi (f r) :*: HTrieMap phi (g r)
--- type instance HTrieMap phi ((f :+: g) r) = HTrieMapH phi (f :+: g) r
-
--- type instance RepH (UnionMap phi f g r ix) = (Reg.:*:) (RepH (HTrieMapH phi f r ix)) (RepH (HTrieMapH phi g r ix))
--- type instance Rep (UnionMap phi f g r ix a) = RepH (UnionMap phi f g r ix) (Rep a)
-
--- -- $(genRepH [d|
---     instance (ReprH (HTrieMapH phi f r ix), ReprH (HTrieMapH phi g r ix)) => ReprH (UnionMap phi f g r ix) where
--- 	toRepH (m1 :&: m2) = (Reg.:*:) (toRepH m1) (toRepH m2)
--- 	fromRepH ((Reg.:*:) m1 m2) = fromRepH m1 :&: fromRepH m2
--- 	|])
-
-instance (HTrieKeyT phi f (HTrieMapT phi f), HTrieKeyT phi g (HTrieMapT phi g)) => HTrieKeyT phi (f :+: g) (UnionMap phi f g) where
-	emptyH = liftM2 (:&:) emptyH emptyH
-	nullH pf (m1 :&: m2) = nullH pf m1 && nullH pf m2
-	sizeH pf s (m1 :&: m2) = sizeH pf s m1 + sizeH pf s m2
-	lookupH pf k (m1 :&: m2)
-		| L k <- k	= lookupH pf k m1
-		| R k <- k	= lookupH pf k m2
-	lookupIxH pf s k (m1 :&: m2)
-		| L k <- k	= case onKey L (lookupIxH pf s k m1) of
-			(lb, x, ub) -> (lb, x, ub <|> ((onKeyA R . onIndexA (+ sizeH pf s m1)) <$> getMin pf s m2))
-		| R k <- k	= case onIndex (sizeH pf s m1 +) (onKey R (lookupIxH pf s k m2)) of
-			(lb, x, ub) -> ((onKeyA L <$> getMax pf s m1) <|> lb, x, ub)
-			where	getMin pf s m = aboutH pf (\ k a -> return $ Asc 0 k a) m
-				getMax pf s m = aboutH pf (\ k a -> return $ Asc (sizeH pf s m - s a) k a) m
-	assocAtH pf s i (m1 :&: m2)
-		| i < s1	= case onKey L (assocAtH pf s i m1) of
-			(lb, x, ub) -> (lb, x, ub <|> ((onKeyA R . onIndexA (+ s1)) <$> getMin pf s m2))
-		| otherwise	= case onKey R (onIndex (s1 +) (assocAtH pf s (i - s1) m2)) of
-			(lb, x, ub) -> ((onKeyA L <$> getMax pf s m1) <|> lb, x, ub)
-		where	getMin pf s m = aboutH pf (\ k a -> return $ Asc 0 k a) m
-			getMax pf s m = aboutH pf (\ k a -> return $ Asc (sizeH pf s m - s a) k a) m
-			s1 = sizeH pf s m1
-{-	updateAtH pf s r f i (m1 :&: m2)
-		| not r && i >= lastIx m1
-			= m1 :&: updateAtH pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2
-		| i < s1
-			= updateAtH pf s r (\ i' -> f i' . L) i m1 :&: m2
-		| otherwise
-			= m1 :&: updateAtH pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2
-		where	s1 = sizeH pf s m1
-			lastIx m = case extractMaxH pf s (\ _ v -> (v, Just v)) m of
-				Last (Just (v, _)) -> sizeH pf s m - s v
-				_			-> sizeH pf s m-}
-	alterH pf s f k (m1 :&: m2)
-		| L k <- k	= alterH pf s f k m1 :&: m2
-		| R k <- k	= m1 :&: alterH pf s f k m2
-	alterLookupH pf s f k (m1 :&: m2)
-		| L k <- k	= fmap (:&: m2) (alterLookupH pf s f k m1)
-		| R k <- k	= fmap (m1 :&:) (alterLookupH pf s f k m2)
-	traverseWithKeyH pf s f (m1 :&: m2)
-		= (:&:) <$> traverseWithKeyH pf s (f . L) m1 <*> traverseWithKeyH pf s (f . R) m2
-	foldWithKeyH pf f (m1 :&: m2) 
-		= foldWithKeyH pf (f . L) m1 . foldWithKeyH pf (f . R) m2
-	foldlWithKeyH pf f (m1 :&: m2)
-		= foldlWithKeyH pf (f . R) m2 . foldlWithKeyH pf (f . L) m1
-	mapEitherH pf s1 s2 f (m1 :&: m2) = case (mapEitherH pf s1 s2 (f . L) m1, mapEitherH pf s1 s2 (f . R) m2) of
-		((m1L, m1R), (m2L, m2R)) -> (m1L :&: m2L, m1R :&: m2R)
-	splitLookupH pf s f k0 (m1 :&: m2)
-		| L k <- k0, (m1L, x, m1R) <- splitLookupH pf s f k m1
-			= (m1L :&: emptyH pf, x, m1R :&: m2)
-		| R k <- k0, (m2L, x, m2R) <- splitLookupH pf s f k m2
-			= (m1 :&: m2L, x, emptyH pf :&: m2R)
-	unionH pf s f (m11 :&: m12) (m21 :&: m22)
-		= unionH pf s (f . L) m11 m21 :&: unionH pf s (f . R) m12 m22
-	isectH pf s f (m11 :&: m12) (m21 :&: m22)
-		= isectH pf s (f . L) m11 m21 :&: isectH pf s (f . R) m12 m22
-	diffH pf s f (m11 :&: m12) (m21 :&: m22)
-		= diffH pf s (f . L) m11 m21 :&: diffH pf s (f . R) m12 m22
-	extractH pf s f (m1 :&: m2) = fmap (:&: m2) <$> extractH pf s (f . L) m1 <|>
-		fmap (m1 :&:) <$> extractH pf s (f . R) m2
--- 	extractMinH pf s f (m1 :&: m2) = second (:&: m2) <$> extractMinH pf s (f . L) m1 <|>
--- 		second (m1 :&:) <$> extractMinH pf s (f . R) m2
--- 	extractMaxH pf s f (m1 :&: m2) = second (:&: m2) <$> extractMaxH pf s (f . L) m1 <|>
--- 		second (m1 :&:) <$> extractMaxH pf s (f . R) m2
--- 	alterMinH pf s f (m1 :&: m2)
--- 		| nullH pf m1	= m1 :&: alterMinH pf s (f . R) m2
--- 		| otherwise	= alterMinH pf s (f . L) m1 :&: m2
--- 	alterMaxH pf s f (m1 :&: m2)
--- 		| nullH pf m2	= alterMaxH pf s (f . L) m1 :&: m2
--- 		| otherwise	= m1 :&: alterMaxH pf s (f . R) m2
-	isSubmapH pf (<=) (m11 :&: m12) (m21 :&: m22)
-		= isSubmapH pf (<=) m11 m21 && isSubmapH pf (<=) m12 m22
-	fromListH pf s f xs = case breakEither xs of
-		(ys, zs) -> fromListH pf s (f . L) ys :&: fromListH pf s (f . R) zs
-	fromAscListH pf s f xs = case breakEither xs of
-		(ys, zs) -> fromAscListH pf s (f . L) ys :&: fromAscListH pf s (f . R) zs
-	fromDistAscListH pf s xs = case breakEither xs of
-		(ys, zs) -> fromDistAscListH pf s ys :&: fromDistAscListH pf s zs
diff --git a/Data/TrieMap/MultiRec/UnitMap.hs b/Data/TrieMap/MultiRec/UnitMap.hs
deleted file mode 100644
--- a/Data/TrieMap/MultiRec/UnitMap.hs
+++ /dev/null
@@ -1,68 +0,0 @@
-{-# LANGUAGE UndecidableInstances, TemplateHaskell, KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
-
-module Data.TrieMap.MultiRec.UnitMap () where
-
-import Data.TrieMap.MultiRec.Class
-import Data.TrieMap.MultiRec.Eq
-import Data.TrieMap.Applicative
-import Data.TrieMap.TrieKey
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.Instances
--- import Data.TrieMap.Rep.TH
-
-import Control.Applicative
-import Control.Arrow
--- import Control.Monad
-
-import Data.Maybe
-import Data.Monoid
-import Data.Foldable
-import Data.Traversable
-import Generics.MultiRec
-
-import Prelude hiding (foldr, foldl)
-
-newtype UMap (phi :: * -> *) (r :: * -> *) ix a = UMap (Maybe a)
-type instance HTrieMapT phi U = UMap phi
--- type instance HTrieMap phi (U r) = UMap phi r
-
--- type instance RepT (UMap phi r ix) = RepT Maybe
--- type instance Rep (UMap phi r ix a) = RepT Maybe (Rep a)
--- 
--- -- $(genRepT [d|
---   instance ReprT (UMap phi r ix) where
--- 	toRepT (UMap m) = toRepT m
--- 	fromRepT = UMap . fromRepT |])
-
-instance HTrieKeyT phi U (UMap phi) where
-	emptyH _ = UMap Nothing
-	nullH _ (UMap m) = isNothing m
-	sizeH _ s (UMap m) = maybe 0 s m
-	lookupH _ _ (UMap m) = m
-	lookupIxH _ _ _ (UMap m) = (mempty, Asc 0 U <$> m, mempty)
-	assocAtH _ _ _ (UMap m) = (mempty, Asc 0 U <$> m, mempty)
--- 	updateAtH _ s r f i (UMap m)
--- 		| r == (i >= 0)
--- 			= UMap (m >>= f 0 U)
--- 		| otherwise
--- 			= UMap m
-	alterH _ _ f _ (UMap m) = UMap (f m)
-	alterLookupH _ _ f _ (UMap m) = UMap <$> f m
-	traverseWithKeyH _ _ f (UMap m) = UMap <$> traverse (f U) m
-	foldWithKeyH _ f (UMap m) z = foldr (f U) z m
-	foldlWithKeyH _ f (UMap m) z = foldl (f U) z m
-	mapEitherH _ _ _ f (UMap m) = (UMap *** UMap) (maybe (Nothing, Nothing) (f U) m)
-	splitLookupH _ _ f _ (UMap m) = UMap `sides` maybe (Nothing, Nothing, Nothing) f m
-	unionH _ _ f (UMap m1) (UMap m2) = UMap (unionMaybe (f U) m1 m2)
-	isectH _ _ f (UMap m1) (UMap m2) = UMap (isectMaybe (f U) m1 m2)
-	diffH _ _ f (UMap m1) (UMap m2) = UMap (diffMaybe (f U) m1 m2)
-	extractH _ _ f (UMap m) = maybe empty (fmap UMap <.> f U) m
--- 	extractMinH _ _ f (UMap m) = fmap (second UMap . f U) (First m)
--- 	extractMaxH _ _ f (UMap m) = fmap (second UMap . f U) (Last m)
--- 	alterMinH _ _ f (UMap m) = (UMap . f U) <$> (First m)
--- 	alterMaxH _ _ f (UMap m) = (UMap . f U) <$> (Last m)
-	isSubmapH _ _ (UMap Nothing) _ = True
-	isSubmapH _ (<=) (UMap m1) (UMap m2) = subMaybe (<=) m1 m2
-	fromListH _ _ f xs = UMap (foldr (\ (_, a) -> Just . maybe a (f U a)) Nothing xs)
-	fromAscListH = fromListH
-	fromDistAscListH _ _ xs = UMap (fmap snd (listToMaybe xs))
diff --git a/Data/TrieMap/OrdMap.hs b/Data/TrieMap/OrdMap.hs
--- a/Data/TrieMap/OrdMap.hs
+++ b/Data/TrieMap/OrdMap.hs
@@ -1,146 +1,55 @@
-{-# LANGUAGE UndecidableInstances, TemplateHaskell, FlexibleContexts, TypeOperators, Rank2Types, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples, TypeFamilies, PatternGuards #-}
 
 module Data.TrieMap.OrdMap () where
 
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Sized
--- import Data.TrieMap.Applicative
 import Data.TrieMap.Modifiers
-import Data.TrieMap.CPair
--- import Data.TrieMap.MultiRec.Base
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.TH
 
 import Control.Applicative (Applicative(..), Alternative(..), (<$>))
--- import Control.Arrow
 import Control.Monad hiding (join)
 
--- import Data.Monoid
--- import Data.Maybe
--- import Data.Map
--- import qualified Data.Map as Map
--- import Data.Traversable
-
 import Prelude hiding (lookup)
 
-data OrdMap k a = Tip 
-              | Bin {-# UNPACK #-} !Int k (a) !(OrdMap k a) !(OrdMap k a) 
-
-type instance TrieMap (Ordered k) = OrdMap k
-
--- type instance RepT (OrdMap k) = FamT KeyFam (HFix (U :+: (K Int :*: K k :*: X :*: A0 :*: A0)))
--- type instance Rep (OrdMap k a) = RepT (OrdMap k) (Rep a)
-
--- -- $(genRepT [d|
---    instance ReprT (OrdMap k) where
--- 	toRepT = FamT . toFix where
--- 		toFix Tip = HIn (L U)
--- 		toFix (Bin s kx x l r) = HIn (R (K s :*: K kx :*: X x :*: A0 (toFix l) :*: A0 (toFix r)))
--- 	fromRepT (FamT x) = fromFix x where
--- 		fromFix (HIn L{}) = Tip
--- 		fromFix (HIn (R (K s :*: K kx :*: X x :*: A0 l :*: A0 r)))
--- 			= Bin s kx x (fromFix l) (fromFix r) |])
+type OrdMap k = TrieMap (Ordered k)
 
-instance Ord k => TrieKey (Ordered k) (OrdMap k) where
+instance Ord k => TrieKey (Ordered k) where
+	data TrieMap (Ordered k) a = Tip 
+              | Bin {-# UNPACK #-} !Int k a !(OrdMap k a) !(OrdMap k a) 
 	emptyM = Tip
+	singletonM s (Ord k) = singleton s k
 	nullM Tip = True
 	nullM _ = False
 	sizeM _ = size
 	lookupM (Ord k) = lookup k
-	lookupIxM s (Ord k) = onKey Ord . lookupIx s 0 k
-	assocAtM s i = onKey Ord . assocAt s 0 i
--- 	updateAtM s r f = updateAt s 0 r (\ i -> f i . Ord)
 	alterM s f (Ord k) = alter s f k
 	alterLookupM s f (Ord k) = alterLookup s f k
 	traverseWithKeyM s f = traverseWithKey s (f . Ord)
 	foldWithKeyM f = foldrWithKey (f . Ord)
 	foldlWithKeyM f = foldlWithKey (f . Ord)
+	mapMaybeM s f = mapMaybe s (f . Ord)
 	mapEitherM s1 s2 f = mapEither s1 s2 (f . Ord)
-	extractM s f m = extract s (f . Ord) m
--- 	extractMinM _ _ Tip = mzero
--- 	extractMinM s f m = return (deleteFindMin s (f . Ord) m)
--- 	extractMaxM _ _ Tip = mzero
--- 	extractMaxM s f m = return (deleteFindMax s (f . Ord) m)
--- 	alterMinM s f = updateMin s (f . Ord)
--- 	alterMaxM s f = updateMax s (f . Ord)
+	extractM s f = extract s (f . Ord)
 	splitLookupM s f (Ord k) = splitLookup s f k
 	isSubmapM = isSubmap
 	fromAscListM s f xs = fromAscList s (f . Ord) [(k, a) | (Ord k, a) <- xs]
 	fromDistAscListM s xs = fromDistinctAscList s [(k, a) | (Ord k, a) <- xs]
-	unionM s f m1 m2 = case (m1, m2) of
-		(Tip, _) -> m2
-		(_, Tip) -> m1
-		_	 -> hedgeUnionWithKey s (f . Ord) (const LT) (const GT) m1 m2
+	unionM _ _ Tip m2 = m2
+	unionM _ _ m1 Tip = m1
+	unionM s f m1 m2 = hedgeUnionWithKey s (f . Ord) (const LT) (const GT) m1 m2
 	isectM s f = isect s (f . Ord)
-	diffM s f m1 m2 = case (m1, m2) of
-		(Tip, _) -> Tip
-		(_, Tip) -> m1
-		_	 -> hedgeDiffWithKey s (f . Ord) (const LT) (const GT) m1 m2
+	diffM _ _ Tip _ = Tip
+	diffM _ _ m1 Tip = m1
+	diffM s f m1 m2 = hedgeDiffWithKey s (f . Ord) (const LT) (const GT) m1 m2
 
-lookup :: Ord k => k -> OrdMap k a -> Maybe (a)
-lookup k Tip = Nothing
+lookup :: Ord k => k -> OrdMap k a -> Maybe a
 lookup k (Bin _ k' v l r) = case compare k k' of
 	LT	-> lookup k l
 	EQ	-> Just v
 	GT	-> lookup k r
-
-lookupIx :: Ord k => Sized a -> Int -> k -> OrdMap k a -> IndexPos k a
-lookupIx _ i _ _ | i `seq` False = undefined
-lookupIx _ _ _ Tip = (mzero, mzero, mzero)
-lookupIx s i k (Bin sz kx x l r) = case compare k kx of
-	LT	-> case lookupIx s i k l of
-		(lb, ans, ub) -> (lb, ans, ub <|> return (Asc (i + size l) kx x))
-	EQ	-> (extractMax (\ k v -> Asc (i + size l - s v) k v) l,
-			return (Asc (i + size l) kx x),
-		    extractMin (Asc (i + sz - size r)) r)
-	GT	-> case lookupIx s (i + sz - size r) k r of
-		(lb, ans, ub) -> (return (Asc (i + size l) kx x) <|> lb, ans, ub)
-	where	extractMin f Tip = mzero
-		extractMin f b = return (fst $ deleteFindMin s (\ k x -> (f k x, Just x)) b)
-		extractMax f Tip = mzero
-		extractMax f b = return (fst $ deleteFindMax s (\ k x -> (f k x, Just x)) b)
-
-assocAt :: Sized a -> Int -> Int -> OrdMap k a -> IndexPos k a
-assocAt _ i0 i _ | i0 `seq` i `seq` False = undefined
-assocAt _ _ _ Tip = (mzero, mzero, mzero)
-assocAt s i0 i (Bin sz k a l r)
-	| i < sL, (lb, ans, ub) <- assocAt s i0 i l
-			= (lb, ans, ub <|> return (Asc (i0 + size l) k a))
-	| i < sK	= (extractMax (\ k v -> Asc (i0 + sL - s v) k v) l,
-				return (Asc (i0 + sL) k a),
-			   extractMin (Asc sK) r)
-	| (lb, ans, ub) <- assocAt s (i0 + sK) (i - sK) r
-			= (return (Asc (i0 + sL) k a) <|> lb, ans, ub)
-	where	sL = size l
-		sK = sz - size r
-		extractMin f Tip = mzero
-		extractMin f b = return (fst $ deleteFindMin s (\ k x -> (f k x, Just x)) b)
-		extractMax f Tip = mzero
-		extractMax f b = return (fst $ deleteFindMax s (\ k x -> (f k x, Just x)) b)
-
-updateAt :: Sized a -> Int -> Round -> (Int -> k -> a -> Maybe (a)) -> Int -> OrdMap k a -> OrdMap k a
-updateAt _ i0 _ _ i _ | i0 `seq` i `seq` False = undefined
-updateAt _ _ _ _ _ Tip = Tip
-updateAt s i0 True f i (Bin sz k a l r)
-	| i < sL	= balance s k a (updateAt s i0 True f i l) r
-	| i < sK	= case f (i0 + sL) k a of
-		Nothing	-> glue s l r
-		Just a'	-> bin s k a' l r
-	| otherwise	= balance s k a l (updateAt s (i0 + sK) True f (i - sK) r)
-	where	sL = size l
-		sK = sz - size r 
-updateAt s i0 False f i (Bin sz k a l r)
-	| i < maxIxL	= balance s k a (updateAt s i0 False f i l) r
-	| i <= sL	= case f (i0 + sL) k a of
-		Nothing	-> glue s l r
-		Just a' -> bin s k a' l r
-	| otherwise	= balance s k a l (updateAt s (i0 + sK) False f (i - sK) r)
-	where	sL = size l
-		maxIxL = case l of	Tip	-> 0
-					_ 	-> fst (deleteFindMax s (\ _ a -> (size l - s a, Just a)) l)
-		sK = sz - size r
+lookup _ _ = Nothing
 
-alter :: Ord k => Sized a -> (Maybe (a) -> Maybe (a)) -> k -> OrdMap k a -> OrdMap k a
+alter :: Ord k => Sized a -> (Maybe a -> Maybe a) -> k -> OrdMap k a -> OrdMap k a
 alter s f k Tip = case f Nothing of
 	Nothing	-> Tip
 	Just x	-> singleton s k x
@@ -151,71 +60,60 @@
 		Just x'	-> balance s k x' l r
 	GT	-> balance s kx x l (alter s f k r)
 
-alterLookup :: Ord k => Sized a -> (Maybe a -> CPair z (Maybe a)) -> k -> OrdMap k a -> CPair z (OrdMap k a)
-alterLookup s f k Tip = maybe Tip (singleton s k) <$> f Nothing
+alterLookup :: Ord k => Sized a -> (Maybe a -> (# z, Maybe a #)) -> k -> OrdMap k a -> (# z, OrdMap k a #)
+alterLookup s f k Tip = onUnboxed (maybe Tip (singleton s k)) f Nothing
 alterLookup s f k (Bin _ kx x l r) = case compare k kx of
-	LT -> fmap (\ l' -> balance s kx x l' r) (alterLookup s f k l)
-	EQ -> maybe (glue s l r) (\ x' -> balance s k x' l r) <$> f (Just x)
-	GT -> fmap (\ r' -> balance s kx x l r') (alterLookup s f k r)
+	LT -> onUnboxed (\ l' -> balance s kx x l' r) (alterLookup s f k) l
+	EQ -> onUnboxed (maybe (glue s l r) (\ x' -> balance s k x' l r)) f (Just x)
+	GT -> onUnboxed (balance s kx x l) (alterLookup s f k) r
 
 singleton :: Sized a -> k -> a -> OrdMap k a
 singleton s k a = Bin (s a) k a Tip Tip
 
-traverseWithKey :: Applicative f => Sized b -> (k -> a -> f (b)) -> OrdMap k a -> f (OrdMap k b)
-traverseWithKey s f Tip = pure Tip
+traverseWithKey :: Applicative f => Sized b -> (k -> a -> f b) -> OrdMap k a -> f (OrdMap k b)
+traverseWithKey _ _ Tip = pure Tip
 traverseWithKey s f (Bin _ k a l r) = balance s k <$> f k a <*> traverseWithKey s f l <*> traverseWithKey s f r
 
 foldrWithKey :: (k -> a -> b -> b) -> OrdMap k a -> b -> b
-foldrWithKey f Tip = id
+foldrWithKey _ Tip = id
 foldrWithKey f (Bin _ k a l r) = foldrWithKey f l . f k a . foldrWithKey f r
 
 foldlWithKey :: (k -> b -> a -> b) -> OrdMap k a -> b -> b
-foldlWithKey f Tip = id
+foldlWithKey _ Tip = id
 foldlWithKey f (Bin _ k a l r) = foldlWithKey f r . flip (f k) a . foldlWithKey f l
 
-mapEither :: Ord k => Sized b -> Sized c -> EitherMap k (a) (b) (c) ->
-	OrdMap k a -> (OrdMap k b, OrdMap k c)
-mapEither s1 s2 f m = case m of
-	Tip	-> (Tip, Tip)
-	Bin _ k a l r -> case (f k a, mapEither s1 s2 f l, mapEither s1 s2 f r) of
-		((aL, aR), (lL, lR), (rL, rR)) ->
-			(joinMaybe s1 k aL lL rL, joinMaybe s2 k aR lR rR)
-
-updateMin :: Ord k => Sized a -> (k -> a -> Maybe (a)) -> OrdMap k a -> OrdMap k a
-updateMin s f m = case m of
-	Tip	-> Tip
-	Bin _ k a Tip r -> case f k a of
-		Nothing -> r
-		Just a'	-> insertMin s k a' r
-	Bin _ k a l r	-> balance s k a (updateMin s f l) r
+mapMaybe :: Ord k => Sized b -> (k -> a -> Maybe b) -> OrdMap k a -> OrdMap k b
+mapMaybe _ _ Tip = Tip
+mapMaybe s f (Bin _ k a l r) = joinMaybe s k (f k a) (mapMaybe s f l) (mapMaybe s f r)
 
-updateMax :: Ord k => Sized a -> (k -> a -> Maybe (a)) -> OrdMap k a -> OrdMap k a
-updateMax s f m = case m of
-	Tip	-> Tip
-	Bin _ k a l Tip	-> case f k a of
-		Nothing	-> l
-		Just a'	-> insertMax s k a' l
-	Bin _ k a l r	-> balance s k a l (updateMax s f r)
+mapEither :: Ord k => Sized b -> Sized c -> EitherMap k a b c ->
+	OrdMap k a -> (# OrdMap k b, OrdMap k c #)
+mapEither _ _ _ Tip = (# Tip, Tip #)
+mapEither s1 s2 f (Bin _ k a l r) 
+  | (# aL, aR #) <- f k a,
+    (# lL, lR #) <- mapEither s1 s2 f l,
+    (# rL, rR #) <- mapEither s1 s2 f r
+	    = (# joinMaybe s1 k aL lL rL, joinMaybe s2 k aR lR rR #)
 
-splitLookup :: Ord k => Sized a -> SplitMap (a) x -> k -> OrdMap k a -> (OrdMap k a, Maybe x, OrdMap k a)
+splitLookup :: Ord k => Sized a -> SplitMap a x -> k -> OrdMap k a -> (# OrdMap k a, Maybe x, OrdMap k a #)
 splitLookup s f k m = case m of
-	Tip	-> (Tip, Nothing, Tip)
+	Tip	-> (# Tip, Nothing, Tip #)
 	Bin _ kx x l r -> case compare k kx of
 		LT	-> case splitLookup s f k l of
-			(lL, ans, lR) -> (lL, ans, join s kx x lR r)
+			(# lL, ans, lR #) -> (# lL, ans, join s kx x lR r #)
 		EQ	-> case f x of
-			(xL, ans, xR) -> (maybe l (\ xL -> insertMax s kx xL l) xL, ans,
-						maybe r (\ xR -> insertMin s kx xR r) xR)
+			(# xL, ans, xR #) -> (# maybe l (\ xL -> insertMax s kx xL l) xL, ans,
+						maybe r (\ xR -> insertMin s kx xR r) xR #)
 		GT	-> case splitLookup s f k r of
-			(rL, ans, rR) -> (join s kx x l rL, ans, rR)
+			(# rL, ans, rR #) -> (# join s kx x l rL, ans, rR #)
 
-isSubmap :: Ord k => LEq (a) (b) -> LEq (OrdMap k a) (OrdMap k b)
-isSubmap (<=) Tip _ = True
-isSubmap (<=) _ Tip = False
-isSubmap (<=) (Bin _ kx x l r) t = case found of
-	Nothing	-> False
-	Just y	-> x <= y && isSubmap (<=) l lt && isSubmap (<=) r gt
-	where	(lt, found, gt) = splitLookup (const 1) (\ x -> (Nothing, Just x, Nothing)) kx t
+isSubmap :: Ord k => LEq a b -> LEq (OrdMap k a) (OrdMap k b)
+isSubmap _ Tip _ = True
+isSubmap _ _ Tip = False
+isSubmap (<=) (Bin _ kx x l r) t = case splitLookup (const 1) (\ x -> (# Nothing, Just x, Nothing #)) kx t of
+	(# lt, found, gt #)	-> case found of
+	  Nothing	-> False
+	  Just y	-> x <= y && isSubmap (<=) l lt && isSubmap (<=) r gt
 
 fromAscList :: Eq k => Sized a -> (k -> a -> a -> a) -> [(k, a)] -> OrdMap k a
 fromAscList s f xs = fromDistinctAscList s (combineEq xs) where
@@ -223,7 +121,7 @@
 	combineEq [] = []
 	
 	combineEq' z [] = [z]
-	combineEq' z@(kz, zz) (x@(kx, xx):xs)
+	combineEq' (kz, zz) (x@(kx, xx):xs)
 		| kz == kx	= combineEq' (kx, f kx xx zz) xs
 		| otherwise	= (kz,zz):combineEq' x xs
 
@@ -247,7 +145,7 @@
     buildB l k x c r zs     = c (bin s k x l r) zs
 
 hedgeUnionWithKey :: Ord k
-                  => Sized a -> (k -> a -> a -> Maybe (a))
+                  => Sized a -> (k -> a -> a -> Maybe a)
                   -> (k -> Ordering) -> (k -> Ordering)
                   -> OrdMap k a -> OrdMap k a -> OrdMap k a
 hedgeUnionWithKey _ _ _     _     t1 Tip
@@ -300,18 +198,16 @@
       GT -> trimLookupLo lo cmphi r
       EQ -> (Just (kx,x),trim (compare lo) cmphi r)
 
-isect :: Ord k => Sized c -> IsectFunc k (a) (b) (c) -> OrdMap k a -> OrdMap k b -> OrdMap k c
-isect s f Tip _ = Tip
-isect s f _ Tip = Tip
-isect s f t1@(Bin _ k1 x1 l1 r1) t2@(Bin _ k2 x2 l2 r2) =
-	let	(lt, found, gt) = splitLookup (const 1) (\ x -> (Nothing, Just x, Nothing)) k2 t1
-		tl		= isect s f lt l2
-		tr		= isect s f gt r2
+isect :: Ord k => Sized c -> IsectFunc k a b c -> OrdMap k a -> OrdMap k b -> OrdMap k c
+isect s f t1@Bin{} (Bin _ k2 x2 l2 r2)
+  | (# lt, found, gt #) <- splitLookup (const 1) (\ x -> (# Nothing, Just x, Nothing #)) k2 t1
+  	= let	tl	= isect s f lt l2
+		tr	= isect s f gt r2
 	 in joinMaybe s k2 (found >>= \ x1' -> f k2 x1' x2) tl tr
-
+isect _ _ _ _ = Tip
 
 hedgeDiffWithKey :: Ord k
-                 => Sized a -> (k -> a -> b -> Maybe (a))
+                 => Sized a -> (k -> a -> b -> Maybe a)
                  -> (k -> Ordering) -> (k -> Ordering)
                  -> OrdMap k a -> OrdMap k b -> OrdMap k a
 hedgeDiffWithKey _ _ _     _     Tip _
@@ -332,7 +228,7 @@
     tl          = hedgeDiffWithKey s f cmplo cmpkx lt l
     tr          = hedgeDiffWithKey s f cmpkx cmphi gt r
 
-joinMaybe :: Ord k => Sized a -> k -> Maybe (a) -> OrdMap k a -> OrdMap k a -> OrdMap k a
+joinMaybe :: Ord k => Sized a -> k -> Maybe a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 joinMaybe s kx = maybe (merge s) (join s kx)
 
 join :: Ord k => Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a
@@ -380,12 +276,13 @@
   | size l > size r = let (f,l') = deleteFindMax s (\ k a -> (balance s k a, Nothing)) l in f l' r
   | otherwise       = let (f,r') = deleteFindMin s (\ k a -> (balance s k a, Nothing)) r in f l r'
 
-extract :: Alternative t => Sized a -> (k -> a -> t (CPair z (Maybe a))) -> OrdMap k a -> t (CPair z (OrdMap k a))
+extract :: Alternative t => Sized a -> (k -> a -> t (z, Maybe a)) -> OrdMap k a -> t (z, OrdMap k a)
 extract s f t = case t of
 	Bin _ k x l r -> 
 		fmap (\ l' -> balance s k x l' r) <$> extract s f l <|>
 		fmap (maybe (glue s l r) (\ x' -> balance s k x' l r))  <$> f k x <|>
 		fmap (balance s k x l) <$> extract s f r
+	Tip	-> empty
 
 deleteFindMin :: Sized a -> (k -> a -> (x, Maybe a)) -> OrdMap k a -> (x, OrdMap k a)
 deleteFindMin s f t 
diff --git a/Data/TrieMap/ProdMap.hs b/Data/TrieMap/ProdMap.hs
--- a/Data/TrieMap/ProdMap.hs
+++ b/Data/TrieMap/ProdMap.hs
@@ -1,113 +1,49 @@
-{-# LANGUAGE FlexibleContexts, UndecidableInstances, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE UnboxedTuples, TupleSections, PatternGuards, TypeFamilies #-}
 
 module Data.TrieMap.ProdMap () where
 
 import Data.TrieMap.TrieKey
--- import Data.TrieMap.Sized
 import Data.TrieMap.Applicative
-import Data.TrieMap.Regular.Class
--- import Data.TrieMap.Regular.TH
 
 import Control.Applicative
-import Control.Arrow
 
 import Data.Maybe
-import Data.Monoid
 import Data.Foldable
 
-import Data.Sequence (Seq, (|>))
+import Data.Sequence ((|>))
 import qualified Data.Sequence as Seq
 
-newtype PMap m1 k2 a = PMap (m1 (TrieMap k2 a))
-type instance TrieMapT ((,) a) = PMap (TrieMap a)
-type instance TrieMap (a, b) = PMap (TrieMap a) b
--- type instance TrieMap (a, b) = PMap (TrieMap a) (TrieMap b)
-
-instance (TrieKey a m, TrieKey b (TrieMap b)) => TrieKey (a, b) (PMap m b) where
-	emptyM = emptyT
-	nullM = nullT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
-
-instance TrieKey k1 m1 => TrieKeyT ((,) k1) (PMap m1) where
-	emptyT = PMap emptyM
-	nullT (PMap m) = nullM m
-	sizeT s (PMap m) = sizeM (sizeM s) m
-	lookupT (k1, k2) (PMap m) = lookupM k1 m >>= lookupM k2
-	lookupIxT s (a, b) (PMap m) = case lookupIxM (sizeM s) a m of
-		(lb, x, ub) -> let lookupX = do	Asc i1 a' m' <- x
-						return (onIndex (i1 +) (onKey ((,) a') (lookupIxM s b m')))
-			in ((do	Asc iL aL mL <- lb
-				aboutM (\ bL v -> return (Asc (iL + sizeM s mL - s v) (aL, bL) v)) mL) <|>
-			    (do	(lb', _, _) <- Last lookupX
-			    	lb'),
-			    (do	(_, x', _) <- lookupX
-			    	x'),
-			    (do	(_, _, ub') <- First lookupX
-			    	ub') <|>
-			    (do	Asc iU aU mU <- ub
-			    	aboutM (\ bU -> return . Asc iU (aU, bU)) mU))
-	assocAtT s i (PMap m) = case assocAtM (sizeM s) i m of
-		(lb, x, ub) -> let lookupX = do	Asc i1 a' m' <- x
-						return (onIndex (i1 +) (onKey ((,) a') (assocAtM s (i - i1) m')))
-			in ((do	Asc iL aL mL <- lb
-				aboutM (\ bL v -> return (Asc (iL + sizeM s mL - s v) (aL, bL) v)) mL) <|>
-			    (do	(lb', _, _) <- Last lookupX
-			    	lb'),
-			    (do	(_, x', _) <- lookupX
-			    	x'),
-			    (do	(_, _, ub') <- First lookupX
-			    	ub') <|>
-			    (do	Asc iU aU mU <- ub
-			    	aboutM (\ bU -> return . Asc iU (aU, bU)) mU))
--- 	updateAtM
-	alterT s f (a, b) (PMap m) = PMap (alterM (sizeM s) g a m) where
+instance (TrieKey k1, TrieKey k2) => TrieKey (k1, k2) where
+	newtype TrieMap (k1, k2) a = PMap (TrieMap k1 (TrieMap k2 a))
+	emptyM = PMap emptyM
+	singletonM s (k1, k2) a = PMap (singletonM (sizeM s) k1 (singletonM s k2 a))
+	nullM (PMap m) = nullM m
+	sizeM s (PMap m) = sizeM (sizeM s) m
+	lookupM (k1, k2) (PMap m) = lookupM k1 m >>= lookupM k2
+	alterM s f (a, b) (PMap m) = PMap (alterM (sizeM s) g a m) where
 		g = guardNullM . alterM s f b . fromMaybe emptyM
-	alterLookupT s f (a, b) (PMap m) = PMap <$> alterLookupM (sizeM s) g a m where
-		g = fmap guardNullM . alterLookupM s f b . fromMaybe emptyM
-	traverseWithKeyT s f (PMap m) = PMap <$> traverseWithKeyM (sizeM s) (\ a -> traverseWithKeyM s (\ b -> f (a, b))) m
-	foldWithKeyT f (PMap m) = foldWithKeyM (\ a -> foldWithKeyM (\ b -> f (a, b))) m
-	foldlWithKeyT f (PMap m) = foldlWithKeyM (\ a -> flip (foldlWithKeyM (\ b -> f (a, b)))) m
-	mapEitherT s1 s2 f (PMap m) = (PMap *** PMap) (mapEitherM (sizeM s1) (sizeM s2) g m) where
-		g a = (guardNullM *** guardNullM) . mapEitherM s1 s2 (\ b -> f (a, b))
-	splitLookupT s f (a, b) (PMap m) = PMap `sides` splitLookupM (sizeM s) g a m where
-		g = sides guardNullM . splitLookupM s f b
-	isSubmapT (<=) (PMap m1) (PMap m2) = isSubmapM (isSubmapM (<=)) m1 m2
-	unionT s f (PMap m1) (PMap m2) = PMap (unionM (sizeM s) (\ a -> guardNullM .: unionM s (\ b -> f (a, b))) m1 m2)
-	isectT s f (PMap m1) (PMap m2) = PMap (isectM (sizeM s) (\ a -> guardNullM .: isectM s (\ b -> f (a, b))) m1 m2)
-	diffT s f (PMap m1) (PMap m2) = PMap (diffM (sizeM s) (\ a -> guardNullM .: diffM s (\ b -> f (a, b))) m1 m2)
-	extractT s f (PMap m) = fmap PMap <$> extractM (sizeM s) g m where
-		g a = fmap guardNullM <.> extractM s (\ b -> f (a, b))
--- 	extractMinT s f (PMap m) = second PMap <$> extractMinM (sizeM s) g m where
--- 		g a = second guardNullM . fromJust . getFirst . extractMinM s (\ b -> f (a, b))
--- 	extractMaxT s f (PMap m) = second PMap <$> extractMaxM (sizeM s) g m where
--- 		g a = second guardNullM . fromJust . getLast . extractMaxM s (\ b -> f (a, b))
-	fromListT s f xs = PMap (mapWithKeyM (sizeM s) (\ a -> fromListM s (\ b -> f (a, b)))
+	alterLookupM s f (a, b) (PMap m) = onUnboxed PMap (alterLookupM (sizeM s) g a) m where
+		g (Just m) = onUnboxed guardNullM (alterLookupM s f b) m
+		g _ = onUnboxed guardNullM (alterLookupM s f b) emptyM
+	traverseWithKeyM s f (PMap m) = PMap <$> traverseWithKeyM (sizeM s) (\ a -> traverseWithKeyM s (f . (a,))) m
+	foldWithKeyM f (PMap m) = foldWithKeyM (\ a -> foldWithKeyM (f . (a,))) m
+	foldlWithKeyM f (PMap m) = foldlWithKeyM (\ a -> flip (foldlWithKeyM (f . (a,)))) m
+	mapMaybeM s f (PMap m) = PMap (mapMaybeM (sizeM s) g m) where
+		g a = guardNullM . mapMaybeM s (f . (a,))
+	mapEitherM s1 s2 f (PMap m) = both PMap PMap (mapEitherM (sizeM s1) (sizeM s2) g) m where
+		g a m = both guardNullM guardNullM (mapEitherM s1 s2 (f . (a,))) m
+	splitLookupM s f (a, b) (PMap m) = sides PMap (splitLookupM (sizeM s) g a) m where
+		g = sides guardNullM (splitLookupM s f b)
+	isSubmapM (<=) (PMap m1) (PMap m2) = isSubmapM (isSubmapM (<=)) m1 m2
+	unionM s f (PMap m1) (PMap m2) = PMap (unionM (sizeM s) (\ a -> guardNullM .: unionM s (f . (a,))) m1 m2)
+	isectM s f (PMap m1) (PMap m2) = PMap (isectM (sizeM s) (\ a -> guardNullM .: isectM s (f . (a,))) m1 m2)
+	diffM s f (PMap m1) (PMap m2) = PMap (diffM (sizeM s) (\ a -> guardNullM .: diffM s (f . (a,))) m1 m2)
+	extractM s f (PMap m) = fmap PMap <$> extractM (sizeM s) g m where
+		g a = fmap guardNullM <.> extractM s (f . (a,))
+	fromListM s f xs = PMap (mapWithKeyM (sizeM s) (\ a -> fromListM s (f . (a,)))
 		(fromListM (const 1) (const (++)) (breakFst xs)))
-	fromAscListT s f xs = PMap (fromDistAscListM (sizeM s)
-		[(a, fromAscListM s (\ b -> f (a, b)) ys) | (a, ys) <- breakFst xs])
-
---    aboutMin :: TrieKey k (TrieMap k) => Sized a -> (k -> a -> x) -> TrieMap k a -> First x
---    aboutMin s f m = fst <$> extractMinM s (\ k a -> (f k a, Nothing)) m
--- 
---    aboutMax :: TrieKey k (TrieMap k) => Sized a -> (k -> a -> x) -> TrieMap k a -> Last x
---    aboutMax s f m = fst <$> extractMaxM s (\ k a -> (f k a, Nothing)) m
+	fromAscListM s f xs = PMap (fromDistAscListM (sizeM s)
+		[(a, fromAscListM s (f . (a,)) ys) | (a, ys) <- breakFst xs])
 
 breakFst :: Eq k1 => [((k1, k2), a)] -> [(k1, [(k2, a)])]
 breakFst [] = []
@@ -116,8 +52,3 @@
 		| a == a'	= breakFst' a' (vs |> (b', v')) xs
 		| otherwise	= (a, toList vs):breakFst' a' (Seq.singleton (b', v')) xs
 	breakFst' a vs [] = [(a, toList vs)]
-	{-
-guardNullM :: TrieKey k (TrieMap k) => TrieMap k a -> Maybe (TrieMap k a)
-guardNullM m 
-	| nullM m	= Nothing
-	| otherwise	= Just m-}
diff --git a/Data/TrieMap/RadixTrie.hs b/Data/TrieMap/RadixTrie.hs
--- a/Data/TrieMap/RadixTrie.hs
+++ b/Data/TrieMap/RadixTrie.hs
@@ -1,20 +1,15 @@
-{-# LANGUAGE TemplateHaskell, FlexibleContexts, TypeFamilies, MultiParamTypeClasses, PatternGuards #-}
+{-# LANGUAGE BangPatterns, UnboxedTuples, TupleSections, TypeFamilies, PatternGuards, UnboxedTuples #-}
 
 module Data.TrieMap.RadixTrie () where
 
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Sized
 import Data.TrieMap.Applicative
-import Data.TrieMap.CPair
-import Data.TrieMap.Regular.Class
--- import Data.TrieMap.Regular.TH
 
 import Control.Applicative
-import Control.Arrow
 import Control.Monad
 
 import Data.Maybe
-import Data.Monoid
 import Data.Foldable
 import Data.Traversable
 
@@ -22,58 +17,35 @@
 
 data Edge k m a = Edge {-# UNPACK #-} !Int [k] (Maybe a) (m (Edge k m a))
 type Edge' k a = Edge k (TrieMap k) a
-type MEdge k m a = Maybe (Edge k m a)
 type MEdge' k a = Maybe (Edge' k a)
 
-newtype RadixTrie k a = Radix (MEdge' k a)
-
-type instance TrieMapT [] = RadixTrie
-type instance TrieMap [k] = RadixTrie k
-
 edgeSize :: Edge k m a -> Int
 edgeSize (Edge sz _ _ _) = sz
 
-instance TrieKey k (TrieMap k) => TrieKey [k] (RadixTrie k) where
-	emptyM = emptyT
-	nullM = nullT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
-
-instance TrieKeyT [] RadixTrie where
-	emptyT = Radix Nothing
-	nullT (Radix m) = isNothing m
-	sizeT _ (Radix m) = maybe 0 edgeSize m
-	lookupT ks (Radix m) = m >>= lookup ks
-	alterT s f ks (Radix m) = Radix (alter s f ks m)
-	alterLookupT s f ks (Radix m) = Radix <$> alterLookupE s f ks m
-	traverseWithKeyT s f (Radix m) = Radix <$> traverse (traverseE s f) m
-	extractT s f (Radix m) = maybe empty (fmap Radix <.> extractE s f) m
-	foldWithKeyT f (Radix m) z = foldr (foldE f) z m
-	foldlWithKeyT f (Radix m) z = foldl (foldlE f) z m
-	mapEitherT s1 s2 f (Radix m) = (Radix *** Radix) (maybe (Nothing, Nothing) (mapEitherE s1 s2 f) m)
-	unionT s f (Radix m1) (Radix m2) = Radix (unionMaybe (unionE s f) m1 m2)
-	isectT s f (Radix m1) (Radix m2) = Radix (isectMaybe (isectE s f) m1 m2)
-	diffT s f (Radix m1) (Radix m2) = Radix (diffMaybe (diffE s f) m1 m2)
-	lookupIxT s ks (Radix m) = maybe (empty, empty, empty) (lookupIxE s 0 ks) m
-	isSubmapT (<=) (Radix m1) (Radix m2) = subMaybe (isSubmapE (<=)) m1 m2
-	splitLookupT s f ks (Radix m) = Radix `sides` maybe (Nothing, Nothing, Nothing) (splitLookupE s f ks) m
-	assocAtT s i (Radix m) = maybe (empty, empty, empty) (assocAtE s 0 i) m
+instance TrieKey k =>  TrieKey [k] where
+	newtype TrieMap [k] a = Radix (MEdge' k a)
+	emptyM = Radix Nothing
+	singletonM s ks a = Radix (Just (Edge (s a) ks (Just a) emptyM))
+	nullM (Radix m) = isNothing m
+	sizeM _ (Radix m) = maybe 0 edgeSize m
+	lookupM ks (Radix m) = m >>= lookup ks
+	alterM s f ks (Radix m) = Radix (alter s f ks m)
+	alterLookupM s f ks (Radix m) = onUnboxed Radix (alterLookupE s f ks) m
+	traverseWithKeyM s f (Radix m) = Radix <$> traverse (traverseE s f) m
+	extractM s f (Radix m) = maybe empty (fmap Radix <.> extractE s f) m
+	foldWithKeyM f (Radix m) z = foldr (foldE f) z m
+	foldlWithKeyM f (Radix m) z = foldl (foldlE f) z m
+	mapMaybeM s f (Radix m) = Radix (m >>= mapMaybeE s f)
+	mapEitherM _ _ _ (Radix Nothing) = (# emptyM, emptyM #)
+	mapEitherM s1 s2 f (Radix (Just m)) = both Radix Radix (mapEitherE s1 s2 f) m
+	unionM s f (Radix m1) (Radix m2) = Radix (unionMaybe (unionE s f) m1 m2)
+	isectM s f (Radix m1) (Radix m2) = Radix (isectMaybe (isectE s f) m1 m2)
+	diffM s f (Radix m1) (Radix m2) = Radix (diffMaybe (diffE s f) m1 m2)
+-- 	lookupIxM s ks (Radix m) = maybe (empty, empty, empty) (lookupIxE s 0 ks) m
+	isSubmapM (<=) (Radix m1) (Radix m2) = subMaybe (isSubmapE (<=)) m1 m2
+	splitLookupM _ _ _ (Radix Nothing) = (# emptyM, Nothing, emptyM #)
+	splitLookupM s f ks (Radix (Just e)) = sides Radix (splitLookupE s f ks) e
+-- 	assocAtM s i (Radix m) = maybe (empty, empty, empty) (assocAtE s 0 i) m
   
 cat :: [k] -> Edge' k a -> Edge' k a
 ks `cat` Edge sz ls v ts = Edge sz (ks ++ ls) v ts
@@ -81,21 +53,21 @@
 cons :: k -> Edge' k a -> Edge' k a
 k `cons` Edge sz ks v ts = Edge sz (k:ks) v ts
 
-edge :: TrieKey k (TrieMap k) => Sized a -> [k] -> Maybe a -> TrieMap k (Edge' k a) -> Edge' k a
+edge :: TrieKey k =>  Sized a -> [k] -> Maybe a -> TrieMap k (Edge' k a) -> Edge' k a
 edge s ks v ts = Edge (maybe 0 s v + sizeM edgeSize ts) ks v ts
 
-singleMaybe :: TrieKey k (TrieMap k) => Sized a -> [k] -> Maybe a -> MEdge' k a
+singleMaybe :: TrieKey k => Sized a -> [k] -> Maybe a -> MEdge' k a
 singleMaybe s ks v = do	v <- v
 			return (edge s ks (Just v) emptyM)
 
-compact :: TrieKey k (TrieMap k) => Edge' k a -> MEdge' k a
-compact e@(Edge sz ks Nothing ts) = case assocsM ts of
+compact :: TrieKey k => Edge' k a -> MEdge' k a
+compact e@(Edge _ ks Nothing ts) = case assocsM ts of
 	[]	-> Nothing
 	[(l, e')] -> compact (ks `cat` (l `cons` e'))
 	_	-> Just e
 compact e = Just e
 
-lookup :: (Eq k, TrieKey k (TrieMap k)) => [k] -> Edge' k a -> Maybe a
+lookup :: (Eq k, TrieKey k) => [k] -> Edge' k a -> Maybe a
 lookup ks (Edge _ ls v ts) = match ks ls where
 	match (k:ks) (l:ls)
 		| k == l = match ks ls
@@ -103,11 +75,10 @@
 	match [] [] = v
 	match _ _ = Nothing
 
-alter :: (TrieKey k (TrieMap k)) => Sized a -> (Maybe a -> Maybe a) -> [k] -> MEdge' k a -> MEdge' k a
+alter :: TrieKey k => Sized a -> (Maybe a -> Maybe a) -> [k] -> MEdge' k a -> MEdge' k a
 alter s f ks0 Nothing = singleMaybe s ks0 (f Nothing)
 alter s f ks0 (Just e@(Edge sz ls0 v ts)) = match 0 ks0 ls0 where
-	match i _ _ | i `seq` False = undefined
-	match i (k:ks) (l:ls) = case compare k l of
+	match !i (k:ks) (l:ls) = case compare k l of
 	      LT | Just v' <- f Nothing	
 		      -> Just $ let sv = s v' in Edge (sv + sz) (take i ls0) Nothing (fromDistAscListM edgeSize
 					[(k, Edge sv ks (Just v') emptyM), (l, Edge sz ls v ts)])
@@ -125,57 +96,59 @@
 		= compact (edge s ls0 (f v) ts)
 	match _ _ _ = Just e
 
-alterLookupE :: TrieKey k (TrieMap k) => Sized a -> (Maybe a -> CPair z (Maybe a)) -> [k] -> MEdge' k a -> CPair z (MEdge' k a)
-alterLookupE s f ks Nothing = singleMaybe s ks <$> f Nothing
+alterLookupE :: TrieKey k => Sized a -> (Maybe a -> (# z, Maybe a #)) -> [k] -> MEdge' k a -> (# z, MEdge' k a #)
+alterLookupE s f ks Nothing = onUnboxed (singleMaybe s ks) f Nothing
 alterLookupE s f ks0 (Just e@(Edge sz ls0 v0 ts0)) = match 0 ks0 ls0 where
-      match i _ _ | i `seq` False = undefined
-      match i (k:ks) (l:ls) = case compare k l of
-	      LT	-> fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $
+      match !i (k:ks) (l:ls) = case compare k l of
+	      LT	-> onUnboxed (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $
 				      fromDistAscListM edgeSize [(k, Edge sv ks (Just v') emptyM), (l, Edge sz ls v0 ts0)]))
-			      (f Nothing)
-	      GT	-> fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $
+			      f Nothing
+	      GT	-> onUnboxed (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $
 				      fromDistAscListM edgeSize [(l, Edge sz ls v0 ts0), (k, Edge sv ks (Just v') emptyM)]))
-			      (f Nothing)
+			      f Nothing
 	      EQ	-> match (i+1) ks ls
-      match _ (k:ks) [] = fmap (compact . edge s ls0 v0) (alterLookupM edgeSize g k ts0) where
+      match _ (k:ks) [] = onUnboxed (compact . edge s ls0 v0) (alterLookupM edgeSize g k) ts0 where
 	      g = alterLookupE s f ks
-      match _ [] (l:ls) = fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sv + sz) ks0 (Just v') (singletonM edgeSize l (Edge sz ls v0 ts0))))
-			      (f Nothing)
-      match _ [] [] = fmap (\ v' -> compact $ edge s ls0 v' ts0) (f v0)
+      match _ [] (l:ls) = onUnboxed (Just . maybe e (\ v' -> let sv = s v' in 
+					Edge (sv + sz) ks0 (Just v') (singletonM edgeSize l (Edge sz ls v0 ts0))))
+			      f Nothing
+      match _ [] [] = onUnboxed (\ v' -> compact $ edge s ls0 v' ts0) f v0
 
-traverseE :: (Applicative f, TrieKey k (TrieMap k)) => Sized b -> ([k] -> a -> f b) -> Edge' k a -> f (Edge' k b)
+traverseE :: (Applicative f, TrieKey k) => Sized b -> ([k] -> a -> f b) -> Edge' k a -> f (Edge' k b)
 traverseE s f (Edge _ ks v ts)
 	= edge s ks <$> traverse (f ks) v <*> traverseWithKeyM edgeSize g ts 
 	where	g l = traverseE s (\ ls -> f (ks ++ l:ls))
 
-extractE :: (Alternative f, TrieKey k (TrieMap k)) => Sized a -> ([k] -> a -> f (CPair x (Maybe a))) -> Edge' k a -> f (CPair x (MEdge' k a))
+extractE :: (Alternative f, TrieKey k) => Sized a -> ([k] -> a -> f (x, Maybe a)) -> Edge' k a -> f (x, MEdge' k a)
 extractE s f (Edge _ ks v ts) = case v of
 	Nothing	-> rest
 	Just v	-> fmap (\ v' -> compact (edge s ks v' ts)) <$> f ks v <|> rest
 	where	rest = fmap (compact . edge s ks v) <$> extractM edgeSize g ts
 	     	g l = extractE s (\ ls -> f (ks ++ l:ls))
 
-aboutE :: (Alternative f, TrieKey k (TrieMap k)) => ([k] -> a -> f x) -> Edge' k a -> f x
-aboutE f = cpFst <.> extractE (const 0) (\ k a -> fmap (flip cP Nothing) (f k a))
-
-foldE :: TrieKey k (TrieMap k) => ([k] -> a -> b -> b) -> Edge' k a -> b -> b
+foldE :: TrieKey k => ([k] -> a -> b -> b) -> Edge' k a -> b -> b
 foldE f (Edge _ ks v ts) z = foldr (f ks) (foldWithKeyM g ts z) v where
 	g l = foldE (\ ls -> f (ks ++ l:ls))
 
-foldlE :: TrieKey k (TrieMap k) => ([k] -> b -> a -> b) -> b -> Edge' k a -> b 
+foldlE :: TrieKey k => ([k] -> b -> a -> b) -> b -> Edge' k a -> b 
 foldlE f z (Edge _ ks v ts) = foldlWithKeyM g ts (foldl (f ks) z v) where
 	g l = foldlE (\ ls -> f (ks ++ l:ls))
 
-mapEitherE :: TrieKey k (TrieMap k) => Sized b -> Sized c -> ([k] -> a -> (Maybe b, Maybe c)) -> Edge' k a ->
-	(MEdge' k b, MEdge' k c)
-mapEitherE s1 s2 f (Edge _ ks v ts) = (compact *** compact) (edge s1 ks vL tsL, edge s2 ks vR tsR)
-	where	(vL, vR) = maybe (Nothing, Nothing) (f ks) v
-	     	(tsL, tsR) = mapEitherM edgeSize edgeSize (\ l -> mapEitherE s1 s2 (\ ls -> f (ks ++ l:ls))) ts
+mapMaybeE :: TrieKey k => Sized b -> ([k] -> a -> Maybe b) -> Edge' k a -> MEdge' k b
+mapMaybeE s f (Edge _ ks v ts) = compact (edge s ks (v >>= f ks)
+	(mapMaybeM edgeSize (\ l -> mapMaybeE s (\ ls -> f (ks ++ l:ls))) ts))
 
-unionE :: TrieKey k (TrieMap k) => Sized a -> ([k] -> a -> a -> Maybe a) -> Edge' k a -> Edge' k a -> MEdge' k a
-unionE s f eK@(Edge szK ks0 vK tsK) eL@(Edge szL ls0 vL tsL) = match 0 ks0 ls0 where
-	match i _ _ | i `seq` False = undefined
-	match i (k:ks) (l:ls) = case compare k l of
+mapEitherE :: TrieKey k => Sized b -> Sized c -> ([k] -> a -> (# Maybe b, Maybe c #)) -> Edge' k a ->
+	(# MEdge' k b, MEdge' k c #)
+mapEitherE s1 s2 f (Edge _ ks v ts) = case mapEitherM edgeSize edgeSize (\ l -> mapEitherE s1 s2 (\ ls -> f (ks ++ l:ls))) ts of
+  (# tsL, tsR #) -> case v of
+       Nothing	-> (# compact (edge s1 ks Nothing tsL), compact (edge s2 ks Nothing tsR) #)
+       Just v	-> case f ks v of
+		      (# vL, vR #) -> (# compact (edge s1 ks vL tsL), compact (edge s2 ks vR tsR) #)
+
+unionE :: TrieKey k => Sized a -> ([k] -> a -> a -> Maybe a) -> Edge' k a -> Edge' k a -> MEdge' k a
+unionE s f (Edge szK ks0 vK tsK) (Edge szL ls0 vL tsL) = match 0 ks0 ls0 where
+	match !i (k:ks) (l:ls) = case compare k l of
 	      EQ -> match (i+1) ks ls
 	      LT -> Just $ Edge (szK + szL) (take i ks0) Nothing (fromDistAscListM edgeSize 
 		      [(k, Edge szK ks vK tsK), (l, Edge szL ls vL tsL)])
@@ -190,8 +163,8 @@
 	match _ [] [] = compact (edge s ls0 (unionMaybe (f ls0) vK vL) (unionM edgeSize g tsK tsL)) where
 		g x = unionE s (\ xs -> f (ls0 ++ x:xs))
 
-isectE :: TrieKey k (TrieMap k) => Sized c -> ([k] -> a -> b -> Maybe c) -> Edge' k a -> Edge' k b -> MEdge' k c
-isectE s f eK@(Edge szK ks0 vK tsK) eL@(Edge szL ls0 vL tsL) = match ks0 ls0 where
+isectE :: TrieKey k => Sized c -> ([k] -> a -> b -> Maybe c) -> Edge' k a -> Edge' k b -> MEdge' k c
+isectE s f (Edge szK ks0 vK tsK) (Edge szL ls0 vL tsL) = match ks0 ls0 where
 	match (k:ks) (l:ls)
 		| k == l	= match ks ls
 	match (k:ks) [] = do	eL' <- lookupM k tsL
@@ -202,8 +175,8 @@
 		g x = isectE s (\ xs -> f (ks0 ++ x:xs))
 	match _ _ = Nothing
 
-diffE :: TrieKey k (TrieMap k) => Sized a -> ([k] -> a -> b -> Maybe a) -> Edge' k a -> Edge' k b -> MEdge' k a
-diffE s f eK@(Edge szK ks0 vK tsK) eL@(Edge szL ls0 vL tsL) = match ks0 ls0 where
+diffE :: TrieKey k => Sized a -> ([k] -> a -> b -> Maybe a) -> Edge' k a -> Edge' k b -> MEdge' k a
+diffE s f eK@(Edge szK ks0 vK tsK) (Edge szL ls0 vL tsL) = match ks0 ls0 where
 	match (k:ks) (l:ls)
 		| k == l	= match ks ls
 	match (k:ks) []
@@ -216,33 +189,9 @@
 		g x = diffE s (\ xs -> f (ks0 ++ x:xs))
 	match _ _ = Just eK
 
-lookupIxE :: TrieKey k (TrieMap k) => Sized a -> Int -> [k] -> Edge' k a -> IndexPos [k] a
-lookupIxE s i ks e@(Edge sz ls v ts) = match ks ls where
-	match (k:ks) (l:ls) = case compare k l of
-		LT	-> (empty, empty, aboutE (return .: Asc i) e)
-		EQ	-> match ks ls
-		GT	-> (aboutE (\ k a -> return (Asc (i + sz - s a) k a)) e, empty, empty)
-	match (k:ks) [] = let sv = maybe 0 s v in case onIndex (i + sv +) (lookupIxM edgeSize k ts) of
-		(lb, x, ub) -> let lookupX = do	Asc i' k' e' <- x
-						return $ onKey (\ ks' -> ls ++ k':ks') $
-							lookupIxE s i' ks e'
-			in ((do v <- Last v
-				return (Asc i ls v)) <|>
-			    (do Asc iL kL eL <- lb
-				aboutE (\ ksL vL -> return $ Asc (iL + edgeSize eL - s vL) (ls ++ kL:ksL) vL) eL) <|>
-			    (do (lb', _, _) <- Last lookupX
-				lb'),
-			    (do (_, x', _) <- lookupX
-				x'),
-			    (do (_, _, ub') <- First lookupX
-				ub') <|>
-			    (do Asc iU kU eU <- ub
-				aboutE (\ ksU -> return . Asc iU (ls ++ kU:ksU)) eU))
-	match [] (l:ls) = (empty, empty, aboutE (return .: Asc i) e)
-	match [] [] = (empty, Asc i ls <$> v, aboutM (\ x -> aboutE (\ xs -> return . Asc (i + maybe 0 s v) (ls ++ x:xs))) ts)
 
-isSubmapE :: TrieKey k (TrieMap k) => LEq a b -> LEq (Edge' k a) (Edge' k b)
-isSubmapE (<=) (Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where
+isSubmapE :: TrieKey k => LEq a b -> LEq (Edge' k a) (Edge' k b)
+isSubmapE (<=) (Edge szK ks vK tsK) (Edge _ ls vL tsL) = match ks ls where
 	match (k:ks) (l:ls)
 		| k == l	= match ks ls
 	match (k:ks) []
@@ -251,39 +200,18 @@
 	match [] [] = subMaybe (<=) vK vL && isSubmapM (isSubmapE (<=)) tsK tsL
 	match _ _ = False
 
-splitLookupE :: TrieKey k (TrieMap k) => Sized a -> (a -> (Maybe a, Maybe x, Maybe a)) -> [k] -> Edge' k a ->
-	(MEdge' k a, Maybe x, MEdge' k a)
+splitLookupE :: TrieKey k => Sized a -> (a -> (# Maybe a, Maybe x, Maybe a #)) -> [k] -> Edge' k a ->
+	(# MEdge' k a, Maybe x, MEdge' k a #)
 splitLookupE s f ks e@(Edge _ ls v ts) = match ks ls where
 	match (k:ks) (l:ls) = case compare k l of
-		LT	-> (Nothing, Nothing, Just e)
-		GT	-> (Just e, Nothing, Nothing)
+		LT	-> (# Nothing, Nothing, Just e #)
+		GT	-> (# Just e, Nothing, Nothing #)
 		EQ	-> match ks ls
 	match (k:ks) [] = case splitLookupM edgeSize g k ts of
-		(tsL, x, tsR) -> (compact (edge s ls v tsL), x, compact (edge s ls Nothing tsR))
-		where	g = splitLookupE s f ks
-	match [] (l:ls) = (Nothing, Nothing, Just e)
-	match [] [] = (singleMaybe s ls vL, x, compact (edge s ls vR ts))
-		where	(vL, x, vR) = maybe (Nothing, Nothing, Nothing) f v
-
-assocAtE :: TrieKey k (TrieMap k) => Sized a -> Int -> Int -> Edge' k a -> IndexPos [k] a
-assocAtE _ i0 i _ | i0 `seq` i `seq` False = undefined
-assocAtE s i0 i (Edge sz ks v ts) = let sv = maybe 0 s v in case assocAtM edgeSize (i - sv) ts of
-	(lb, x, ub) -> let lookupX = do Asc i' l e' <- x
-					return (onKey (\ ls -> ks ++ l:ls) (assocAtE s (i0 + sv + i') (i - i') e'))
-		in ((do	v <- Last v
-			guard (i >= sv)
-			return (Asc i0 ks v)) <|>
-		      (do	Asc iL lL eL <- lb
-				aboutE (\ ls vL -> return (Asc (i0 + iL + sv + edgeSize eL - s vL) (ks ++ lL:ls) vL)) eL) <|>
-		      (do	(lb', _, _) <- Last lookupX
-				lb'),
-		      (do	v <- v
-				guard (i >= 0 && i < sv)
-				return (Asc i0 ks v)) <|> 
-		      (do	(_, x', _) <- lookupX
-				x'),
-		      (do	(_, _, ub') <- First lookupX
-				ub') <|>
-		      (do	v <- First v
-				guard (i < 0)
-				return (Asc i0 ks v)))
+	    (# tsL, x, tsR #) -> (# compact (edge s ls v tsL), x, compact (edge s ls Nothing tsR) #)
+	  where	g = splitLookupE s f ks
+	match [] (_:_) = (# Nothing, Nothing, Just e #)
+	match [] [] = case v of
+	    Nothing	-> (# Nothing, Nothing, compact (edge s ls Nothing ts) #)
+	    Just v	-> case f v of
+		(# vL, x, vR #)	-> (# singleMaybe s ls vL, x, compact (edge s ls vR ts) #)
diff --git a/Data/TrieMap/Regular.hs b/Data/TrieMap/Regular.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Data.TrieMap.Regular (TrieMapT, TrieKeyT, module Data.TrieMap.Regular.Base, EqT(..), Comparator, OrdT (..){-, K0 (..), I0 (..), U(..), (:*:)(..), (:+:)(..), L(..), Fix(..)-}) where
-
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Ord
-import Data.TrieMap.Regular.Eq
diff --git a/Data/TrieMap/Regular/Base.hs b/Data/TrieMap/Regular/Base.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/Base.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-{-# LANGUAGE FlexibleContexts, TypeFamilies, TypeOperators #-}
-
-module Data.TrieMap.Regular.Base where
-
--- import Data.TrieMap.TrieKey
-
-newtype K0 a r = K0 {unK0 :: a} deriving (Show)
-newtype I0 r = I0 {unI0 :: r} deriving (Show)
-data U0 r = U0 deriving (Show)
-data (f :*: g) r = f r :*: g r deriving (Show)
-data (f :+: g) r = L (f r) | R (g r) deriving (Show)
-newtype L f r = List [f r] deriving (Show)
-newtype (f `O` g) r = O (f (g r))
-newtype Reg r = Reg {unReg :: r} deriving (Show)
-
-newtype Fix f = In {out :: f (Fix f)}
-
-type family PF a :: * -> *
-
-instance (Functor f, Functor g) => Functor (f `O` g) where
-	fmap f (O x) = O (fmap (fmap f) x)
-
-class Regular a where
-	from :: a -> PF a a
-	to :: PF a a -> a
-
-type instance PF (K0 a r) = K0 a
-type instance PF (I0 r) = I0
-type instance PF (U0 r) = U0
-type instance PF ((f :*: g) r) = PF (f r) :*: PF (g r)
-type instance PF ((f :+: g) r) = PF (f r) :+: PF (g r)
-type instance PF (Fix f) = f
-type instance PF [a] = L (PF a)
-type instance PF (L f a) = L (PF (f a))
--- type instance PF Bool = K Bool
--- type instance PF Int = K Int
--- type instance PF Char = K Char
--- type instance PF 
-
-instance Functor (K0 a) where
-	fmap _ (K0 a) = K0 a
-
-instance Functor I0 where
-	fmap f (I0 a) = I0 (f a)
-
-instance Functor U0 where
-	fmap _ U0 = U0
-
-instance Functor f => Functor (L f) where
-	fmap f (List xs) = List (map (fmap f) xs)
-
-instance (Functor f, Functor g) => Functor (f :*: g) where
-	fmap f (x :*: y) = fmap f x :*: fmap f y
-
-instance (Functor f, Functor g) => Functor (f :+: g) where
-	fmap f (L x) = L (fmap f x)
-	fmap f (R x) = R (fmap f x)
-
-from' :: (Functor (PF a), Regular a) => Reg a -> PF a (Reg a)
-from' (Reg a) = fmap Reg (from a)
-
-to' :: (Functor (PF a), Regular a) => PF a (Reg a) -> Reg a
-to' = Reg . to . fmap unReg
-
-infixr 7 :*:
-infixr 6 :+:
-
-partEithers :: [((f :+: g) r, a)] -> ([(f r, a)], [(g r, a)])
-partEithers = foldr part ([], []) where
-	part (L k, a) (xs, ys) = ((k, a):xs, ys)
-	part (R k, a) (xs, ys) = (xs, (k, a):ys)
diff --git a/Data/TrieMap/Regular/Class.hs b/Data/TrieMap/Regular/Class.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/Class.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-{-# LANGUAGE Rank2Types, FlexibleContexts, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-}
-
-module Data.TrieMap.Regular.Class where
-
-import Data.TrieMap.Sized
-import Data.TrieMap.Applicative
-import Data.TrieMap.TrieKey
--- import Data.TrieMap.Regular.Eq
-import Data.TrieMap.Regular.Ord
-import Data.TrieMap.CPair
-
--- import Data.Monoid
-
-import Control.Applicative
-
-type family TrieMapT (f :: * -> *) :: * -> * -> *
-
-class OrdT f => TrieKeyT (f :: * -> *) (m :: * -> * -> *) | m -> f, f -> m where
-	emptyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => m k a
-	nullT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => m k a -> Bool
-	sizeT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> m k a -> Int
-	lookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => f k -> m k a -> Maybe (a)
-	lookupIxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> f k -> m k a -> IndexPos (f k) a
-	assocAtT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> Int -> m k a -> IndexPos (f k) a
--- 	updateAtT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> Round -> (Int -> f k -> a -> Maybe (a)) -> Int -> m k a -> m k a
-	alterT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (Maybe (a) -> Maybe (a)) -> f k -> m k a -> m k a
-	alterLookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (Maybe a -> CPair x (Maybe a)) -> f k -> m k a -> CPair x (m k a)
-	traverseWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k), Applicative t) => 
-		Sized b -> (f k -> a -> t (b)) -> m k a -> t (m k b)
-	foldWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => 
-		(f k -> a -> b -> b) -> m k a -> b -> b
-	foldlWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) =>
-		(f k -> b -> a -> b) -> m k a -> b -> b
-	mapEitherT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => 
-		Sized b -> Sized c -> EitherMap (f k) (a) (b) (c) -> m k a -> (m k b, m k c)
-	splitLookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> SplitMap (a) x -> f k ->
-		m k a -> (m k a, Maybe x, m k a)
-	unionT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> UnionFunc (f k) (a) ->
-		m k a -> m k a -> m k a
-	isectT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized c -> IsectFunc (f k) (a) (b) (c) ->
-		m k a -> m k b -> m k c
-	diffT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> DiffFunc (f k) (a) (b) ->
-		m k a -> m k b -> m k a
-	extractT :: (TrieMapT f ~ m, TrieKey k (TrieMap k), Alternative t) => 
-		Sized a -> ExtractFunc t (m k a) (f k) a x
--- 	extractMinT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> ExtractFunc (f k) First a (m k a) x
--- 	extractMaxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> ExtractFunc (f k) Last a (m k a) x
--- 	alterMinT, alterMaxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (f k -> a -> Maybe (a)) ->
--- 		m k a -> m k a
-	isSubmapT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => LEq (a) (b) -> LEq (m k a) (m k b)
-	fromListT, fromAscListT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (f k -> a -> a -> a) ->
-		[(f k, a)] -> m k a
-	fromDistAscListT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> [(f k, a)] -> m k a
-	fromListT s f = foldr (\ (k, a) -> alterT s (Just . maybe a (f k a)) k) emptyT
-	fromAscListT = fromListT
-	fromDistAscListT s = fromAscListT s (const const)
--- 	alterLookupT s f k m = fmap (\ v' -> alterT s (const v') k m) (f (lookupT k m))
-	alterT s f k m = cpSnd (alterLookupT s (cP () . f) k m)
--- 	updateAtT s f i m = case assocAtT s i m of
--- 		(i, k, a) -> alterT s (const (f i k a)) k m
-
--- mapWithKeyT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
--- 	Sized b -> (f k -> a -> b) -> TrieMapT f k a -> TrieMapT f k b
--- mapWithKeyT s f m = unId (traverseWithKeyT s (\ k a -> Id (f k a)) m)
-
-guardNullT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a -> Maybe (TrieMapT f k a)
-guardNullT m
-	| nullT m	= Nothing
-	| otherwise	= Just m
-
-assocsT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a -> [(f k, a)]
-assocsT m = foldWithKeyT (\ k a -> ((k, a):)) m []
-
-singletonT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> f k -> a -> TrieMapT f k a
-singletonT s k a = alterT s (const (Just a)) k emptyT
-
-mapWithKeyT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 
-	Sized b -> (f k -> a -> b) -> TrieMapT f k a -> TrieMapT f k b
-mapWithKeyT s f m = unId (traverseWithKeyT s (Id .: f) m)
-
-aboutT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) =>
-	(f k -> a -> t z) -> TrieMapT f k a -> t z
-aboutT f m = cpFst <$> extractT (const 0) (\ k a -> fmap (flip cP Nothing) (f k a)) m
-
-{-alterMinT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
-	Sized a -> (f k -> a -> Maybe a) -> TrieMapT f k a -> TrieMapT f k a
-alterMinT s f m = maybe m snd (getFirst (extractMinT s (\ k a -> ((), f k a)) m))
-
-alterMaxT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
-	Sized a -> (f k -> a -> Maybe a) -> TrieMapT f k a -> TrieMapT f k a-}
--- alterMaxT s f m = maybe m snd (getLast (extractMaxT s (\ k a -> ((), f k a)) m))
diff --git a/Data/TrieMap/Regular/CompMap.hs b/Data/TrieMap/Regular/CompMap.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/CompMap.hs
+++ /dev/null
@@ -1,135 +0,0 @@
-{-# LANGUAGE TemplateHaskell, PatternGuards, UndecidableInstances, FlexibleContexts, TypeOperators, TypeFamilies, MultiParamTypeClasses #-}
-
-module Data.TrieMap.Regular.CompMap () where
-
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Ord
-import Data.TrieMap.Regular.Eq
--- import Data.TrieMap.Regular.TH
-import Data.TrieMap.TrieKey
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.TH
-
-import Control.Applicative
-import Control.Arrow
-
-import Prelude hiding (lookup)
-
-newtype CompMap m g k a = CMap (m (App g k) a)
-newtype App f a = A {unA :: f a}
-newtype AppMap m k a = AMap (m k a)
-
-type instance TrieMapT (App f) = AppMap (TrieMapT f)
-type instance TrieMap (App f r) = AppMap (TrieMapT f) r
-type instance TrieMapT (f `O` g) = CompMap (TrieMapT f) g
-type instance TrieMap ((f `O` g) r) = CompMap (TrieMapT f) g r
-
-instance EqT f => EqT (App f) where
-	eqT0 (==) (A a) (A b) = eqT0 (==) a b
-
-instance OrdT f => OrdT (App f) where
-	compareT0 cmp (A a) (A b) = compareT0 cmp a b
-
-instance (EqT f, Eq r) => Eq (App f r) where
-	(==) = eqT
-
-instance (OrdT f, Ord g) => Ord (App f g) where
-	compare = compareT
-
-instance (TrieKeyT f m, Functor f, TrieKeyT g (TrieMapT g), TrieKey k (TrieMap k)) => 
-		TrieKey ((f `O` g) k) (CompMap m g k) where
-	emptyM = emptyT
-	nullM = nullT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
-
-
-instance (TrieKeyT f m, Functor f, TrieKeyT g (TrieMapT g)) => TrieKeyT (f `O` g) (CompMap m g) where
-	emptyT = CMap emptyT
-	nullT (CMap m) = nullT m
-	sizeT s (CMap m) = sizeT s m
-	lookupT (O x) (CMap m) = lookupT (A <$> x) m
-	lookupIxT s (O x) (CMap m) = onKey (O . fmap unA) (lookupIxT s (A <$> x) m)
-	assocAtT s i (CMap m) = onKey (O . fmap unA) (assocAtT s i m)
--- 	updateAtT s r f i (CMap m)
--- 		= CMap (updateAtT s r (\ i' -> f i' . O . fmap unA) i m)
-	alterT s f (O x) (CMap m) = CMap (alterT s f (A <$> x) m)
-	alterLookupT s f (O x) (CMap m) = CMap <$> alterLookupT s f (A <$> x) m
-	traverseWithKeyT s f (CMap m) = CMap <$> traverseWithKeyT s (f . O . fmap unA) m
-	foldWithKeyT f (CMap m) = foldWithKeyT (f . O . fmap unA) m
-	foldlWithKeyT f (CMap m) = foldlWithKeyT (f . O . fmap unA) m
-	mapEitherT s1 s2 f (CMap m) = (CMap *** CMap) (mapEitherT s1 s2 (f . O . fmap unA) m)
-	splitLookupT s f (O k) (CMap m) = CMap `sides` splitLookupT s f (A <$> k) m
-	isSubmapT (<=) (CMap m1) (CMap m2) = isSubmapT (<=) m1 m2
-	extractT s f (CMap m) = fmap CMap <$> extractT s (f . O . fmap unA) m
--- 	extractMinT s f (CMap m) = second CMap <$> extractMinT s (f . O . fmap unA) m
--- 	extractMaxT s f (CMap m) = second CMap <$> extractMaxT s (f . O . fmap unA) m
--- 	alterMinT s f (CMap m) = CMap (alterMinT s (f . O . fmap unA) m)
--- 	alterMaxT s f (CMap m) = CMap (alterMaxT s (f . O . fmap unA) m)
-	unionT s f (CMap m1) (CMap m2) = CMap (unionT s (f . O . fmap unA) m1 m2)
-	isectT s f (CMap m1) (CMap m2) = CMap (isectT s (f . O . fmap unA) m1 m2)
-	diffT s f (CMap m1) (CMap m2) = CMap (diffT s (f . O . fmap unA) m1 m2)
-
-instance (TrieKeyT f m, TrieKey k (TrieMap k)) => TrieKey (App f k) (AppMap m k) where
-	emptyM = emptyT
-	nullM = nullT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
-
-instance TrieKeyT f m => TrieKeyT (App f) (AppMap m) where
-	emptyT = AMap emptyT
-	nullT (AMap m) = nullT m
-	sizeT s (AMap m) = sizeT s m
-	lookupT (A k) (AMap m) = lookupT k m
-	lookupIxT s (A k) (AMap m) = onKey A (lookupIxT s k m)
-	assocAtT s i (AMap m) = onKey A (assocAtT s i m)
--- 	updateAtT s r f i (AMap m) = AMap (updateAtT s r (\ i' -> f i' . A) i m)
-	alterT s f (A k) (AMap m) = AMap (alterT s f k m)
-	alterLookupT s f (A k) (AMap m) = AMap <$> alterLookupT s f k m
-	traverseWithKeyT s f (AMap m) = AMap <$> traverseWithKeyT s (f . A) m
-	foldWithKeyT f (AMap m) = foldWithKeyT (f . A) m
-	foldlWithKeyT f (AMap m) = foldlWithKeyT (f . A) m
-	mapEitherT s1 s2 f (AMap m) = (AMap *** AMap) (mapEitherT s1 s2 (f . A) m)
-	splitLookupT s f (A k) (AMap m) = AMap `sides` splitLookupT s f k m
-	extractT s f (AMap m) = fmap AMap <$> extractT s (f . A) m
--- 	extractMinT s f (AMap m) = second AMap <$> extractMinT s (f . A) m
--- 	extractMaxT s f (AMap m) = second AMap <$> extractMaxT s (f . A) m
--- 	alterMinT s f (AMap m) = AMap (alterMinT s (f . A) m)
--- 	alterMaxT s f (AMap m) = AMap (alterMaxT s (f . A) m)
-	unionT s f (AMap m1) (AMap m2) = AMap (unionT s (f . A) m1 m2)
-	isectT s f (AMap m1) (AMap m2) = AMap (isectT s (f . A) m1 m2)
-	diffT s f (AMap m1) (AMap m2) = AMap (diffT s (f . A) m1 m2)
-	isSubmapT (<=) (AMap m1) (AMap m2) = isSubmapT (<=) m1 m2
diff --git a/Data/TrieMap/Regular/ConstMap.hs b/Data/TrieMap/Regular/ConstMap.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/ConstMap.hs
+++ /dev/null
@@ -1,73 +0,0 @@
-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, UndecidableInstances #-}
-
-module Data.TrieMap.Regular.ConstMap() where
-
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.TrieKey
-
-import Control.Applicative
-import Control.Arrow
-import Control.Monad
-
--- import Data.Monoid
-
-newtype KMap m k a = KMap (m a)
-type instance TrieMapT (K0 a) = KMap (TrieMap a)
-type instance TrieMap (K0 a r) = TrieMapT (K0 a) r
-
-instance (TrieKey k m, m ~ TrieMap k) => TrieKey (K0 k r) (KMap m r) where
-	emptyM = KMap emptyM
-	nullM (KMap m) = nullM m
-	sizeM s (KMap m) = sizeM s m
-	lookupM (K0 k) (KMap m) = lookupM k m
-	lookupIxM s (K0 k) (KMap m) = onKey K0 (lookupIxM s k m)
-	assocAtM s i (KMap m) = onKey K0 (assocAtM s i m)
--- 	updateAtM s r f i (KMap m) = KMap (updateAtM s r (\ i -> f i . K0) i m)
-	alterM s f (K0 k) (KMap m) = KMap (alterM s f k m)
-	alterLookupM s f (K0 k) (KMap m) = KMap <$> alterLookupM s f k m
-	traverseWithKeyM s f (KMap m) = KMap <$> traverseWithKeyM s (f . K0) m
-	foldWithKeyM f (KMap m) = foldWithKeyM (f . K0) m
-	foldlWithKeyM f (KMap m) = foldlWithKeyM (f . K0) m
-	mapEitherM s1 s2 f (KMap m) = (KMap *** KMap) (mapEitherM s1 s2 (f . K0) m)
-	splitLookupM s f (K0 k) (KMap m) = KMap `sides` splitLookupM s f k m
-	unionM s f (KMap m1) (KMap m2) = KMap (unionM s (f . K0) m1 m2)
-	isectM s f (KMap m1) (KMap m2) = KMap (isectM s (f . K0) m1 m2)
-	diffM s f (KMap m1) (KMap m2) = KMap (diffM s (f . K0) m1 m2)
-	extractM s f (KMap m) = fmap KMap <$> extractM s (f . K0) m
--- 	extractMinM s f (KMap m) = second KMap <$> extractMinM s (f . K0) m
--- 	extractMaxM s f (KMap m) = second KMap <$> extractMaxM s (f . K0) m
--- 	alterMinM s f (KMap m) = KMap (alterMinM s (f . K0) m) 
--- 	alterMaxM s f (KMap m) = KMap (alterMaxM s (f . K0) m)
-	isSubmapM (<=) (KMap m1) (KMap m2) = isSubmapM (<=) m1 m2
-	fromListM s f xs = KMap (fromListM s (f . K0) [(k, a) | (K0 k, a) <- xs])
-	fromAscListM s f xs = KMap (fromAscListM s (f . K0) [(k, a) | (K0 k, a) <- xs])
-	fromDistAscListM s xs = KMap (fromDistAscListM s [(k, a) | (K0 k, a) <- xs])
-
-instance (TrieKey k m, m ~ TrieMap k) => TrieKeyT (K0 k) (KMap m) where
-	emptyT = emptyM
-	nullT = nullM
-	sizeT = sizeM
-	lookupT = lookupM
-	lookupIxT = lookupIxM
-	assocAtT = assocAtM
--- 	updateAtT = updateAtM
-	alterT = alterM
-	alterLookupT = alterLookupM
-	traverseWithKeyT = traverseWithKeyM
-	foldWithKeyT = foldWithKeyM
-	foldlWithKeyT = foldlWithKeyM
-	mapEitherT = mapEitherM
-	splitLookupT = splitLookupM
-	unionT = unionM
-	isectT = isectM
-	diffT = diffM
-	extractT = extractM
--- 	extractMinT = extractMinM
--- 	extractMaxT = extractMaxM
--- 	alterMinT = alterMinM
--- 	alterMaxT = alterMaxM
-	isSubmapT = isSubmapM
-	fromListT = fromListM
-	fromAscListT = fromAscListM
-	fromDistAscListT = fromDistAscListM
diff --git a/Data/TrieMap/Regular/Eq.hs b/Data/TrieMap/Regular/Eq.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/Eq.hs
+++ /dev/null
@@ -1,90 +0,0 @@
-{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeOperators #-}
-
-module Data.TrieMap.Regular.Eq where
-
-import Data.TrieMap.Regular.Base
--- import Data.TrieMap.MultiRec.Base(Family(..))
--- import Data.TrieMap.MultiRec.Eq(HEq0(..))
-import Data.TrieMap.Modifiers
-
-class EqT f where
-	eqT0 :: (a -> a -> Bool) -> f a -> f a -> Bool
-
-eqT :: (EqT f, Eq a) => f a -> f a -> Bool
-eqT = eqT0 (==)
-
--- instance EqT (Family phi) where
--- 	eqT0 (==) (F a) (F b) = a == b
-
-instance Eq a => EqT (K0 a) where
-	eqT0 _ (K0 a) (K0 b) = a == b
-
-instance EqT I0 where
-	eqT0 (==) (I0 a) (I0 b) = a == b
-
-instance EqT [] where
-	eqT0 (==) = eqT' where
-		eqT' (a:as) (b:bs) = a == b && eqT' as bs
-		eqT' [] [] = True
-
-eqT' _ _ = False
-
-instance (EqT f, EqT g) => EqT (f :*: g) where
-	eqT0 (==) (x1 :*: y1) (x2 :*: y2) = eqT0 (==) x1 x2 && eqT0 (==) y1 y2
-
-instance (EqT f, EqT g) => EqT (f :+: g) where
-	eqT0 (==) a b = case (a, b) of
-		(L a, L b) -> eqT0 (==) a b
-		(R a, R b) -> eqT0 (==) a b
-		_	   -> False
-
-instance EqT U0 where
-	eqT0 _ _ _ = True
-
-instance EqT f => EqT (L f) where
-	eqT0 (==) (List xs) (List ys) = eqT' xs ys where
-		eqT0' = eqT0 (==)
-		eqT' (a:as) (b:bs) = eqT0' a b && eqT' as bs
-		eqT' [] [] = True
-		eqT' _ _ = False
-
-instance (Regular a, Functor (PF a), EqT (PF a)) => Eq (Reg a) where
-	a == b = eqT (from' a) (from' b)
-
-instance (EqT f, Eq r) => Eq (L f r) where
-	(==) = eqT
-
-instance (EqT f, EqT g, Eq r) => Eq ((f :*: g) r) where
-	(==) = eqT
-
-instance (EqT f, EqT g, Eq r) => Eq ((f :+: g) r) where
-	(==) = eqT
-
-instance (EqT f, EqT g) => EqT (f `O` g) where
-	eqT0 (==) (O x) (O y) = eqT0 (eqT0 (==)) x y
-
-instance (EqT f, EqT g, Eq r) => Eq ((f `O` g) r) where
-	(==) = eqT
-
-instance Eq a => Eq (K0 a r) where
-	K0 a == K0 b = a == b
-
-instance Eq r => Eq (I0 r) where
-	I0 a == I0 b = a == b
-
-instance Eq (U0 r) where
-	_ == _ = True
-
-instance Eq a => EqT ((,) a) where
-	eqT0 (=#=) (a, b) (c, d) = a == c && b =#= d
-
-instance Eq a => EqT (Either a) where
-	eqT0 _ (Left a) (Left b) = a == b
-	eqT0 (==) (Right a) (Right b) = a == b
-	eqT0 _ _ _ = False
-
-instance EqT Ordered where
-	eqT0 (==) (Ord x) (Ord y) = x == y
-
-instance EqT Rev where
-	eqT0 (==) (Rev x) (Rev y) = y == x
diff --git a/Data/TrieMap/Regular/IdMap.hs b/Data/TrieMap/Regular/IdMap.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/IdMap.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-{-# LANGUAGE FlexibleContexts, TypeFamilies, MultiParamTypeClasses #-}
-
-module Data.TrieMap.Regular.IdMap where
-
-import Data.TrieMap.TrieKey
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Regular.Class
-
-import Control.Applicative
-import Control.Arrow
-import Control.Monad
-
-newtype IMap k a = IMap (TrieMap k a)
-type instance TrieMapT I0 = IMap
-type instance TrieMap (I0 k) = IMap k
-
-instance TrieKeyT I0 IMap where
-	emptyT = IMap emptyM
-	nullT (IMap m) = nullM m
-	sizeT s (IMap m) = sizeM s m
-	lookupT (I0 k) (IMap m) = lookupM k m
-	lookupIxT s (I0 k) (IMap m) = onKey I0 (lookupIxM s k m)
-	assocAtT s i (IMap m) = onKey I0 (assocAtM s i m)
--- 	updateAtT s r f i (IMap m) = IMap (updateAtM s r (\ i -> f i . I0) i m)
-	alterT s f (I0 k) (IMap m) = IMap (alterM s f k m)
-	alterLookupT s f (I0 k) (IMap m) = IMap <$> alterLookupM s f k m
-	traverseWithKeyT s f (IMap m) = IMap <$> traverseWithKeyM s (f . I0) m
-	foldWithKeyT f (IMap m) = foldWithKeyM (f . I0) m
-	foldlWithKeyT f (IMap m) = foldlWithKeyM (f . I0) m
-	mapEitherT s1 s2 f (IMap m) = (IMap *** IMap) (mapEitherM s1 s2 (f . I0) m)
-	splitLookupT s f (I0 k) (IMap m) = IMap `sides` splitLookupM s f k m
-	unionT s f (IMap m1) (IMap m2) = IMap (unionM s (f . I0) m1 m2)
-	isectT s f (IMap m1) (IMap m2) = IMap (isectM s (f . I0) m1 m2)
-	diffT s f (IMap m1) (IMap m2) = IMap (diffM s (f . I0) m1 m2)
-	extractT s f (IMap m) = fmap IMap <$> extractM s (f . I0) m
--- 	extractMinT s f (IMap m) = second IMap <$> extractMinM s (f . I0) m
--- 	extractMaxT s f (IMap m) = second IMap <$> extractMaxM s (f . I0) m
--- 	alterMinT s f (IMap m) = IMap (alterMinM s (f . I0) m)
--- 	alterMaxT s f (IMap m) = IMap (alterMaxM s (f . I0) m)
-	isSubmapT (<=) (IMap m1) (IMap m2) = isSubmapM (<=) m1 m2
-	fromListT s f xs = IMap (fromListM s (f . I0) [(k, a) | (I0 k, a) <- xs])
-	fromAscListT s f xs = IMap (fromAscListM s (f . I0) [(k, a) | (I0 k, a) <- xs])
-	fromDistAscListT s xs = IMap (fromDistAscListM s [(k, a) | (I0 k, a) <- xs])
-
-instance TrieKey k (TrieMap k) => TrieKey (I0 k) (IMap k) where
-	emptyM = emptyT
-	nullM = nullT
-	sizeM = sizeT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
--- 	updateAtM = updateAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
--- 	extractMinM = extractMinT
--- 	extractMaxM = extractMaxT
--- 	alterMinM = alterMinT 
--- 	alterMaxM = alterMaxT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
diff --git a/Data/TrieMap/Regular/Instances.hs b/Data/TrieMap/Regular/Instances.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/Instances.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Data.TrieMap.Regular.Instances where
-
-import Data.TrieMap.Regular.UnitMap
-import Data.TrieMap.Regular.ConstMap
-import Data.TrieMap.Regular.ProdMap
-import Data.TrieMap.Regular.UnionMap
-import Data.TrieMap.Regular.RadixTrie
-import Data.TrieMap.Regular.IdMap
-import Data.TrieMap.Regular.RegMap
-import Data.TrieMap.Regular.CompMap
-import Data.TrieMap.Regular.Rep
diff --git a/Data/TrieMap/Regular/Ord.hs b/Data/TrieMap/Regular/Ord.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/Ord.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, FlexibleContexts, TypeOperators #-}
-
-module Data.TrieMap.Regular.Ord where
-
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Regular.Eq
--- import Data.TrieMap.MultiRec.Base(Family(..))
--- import Data.TrieMap.MultiRec.Ord(HOrd0(..))
--- import Data.TrieMap.TrieKey
-import Data.TrieMap.Modifiers
-import Data.Monoid
-
-type Comparator a = a -> a -> Ordering
-
-class EqT f => OrdT f where
-	compareT0 :: Comparator a -> Comparator (f a)
-
-compareT :: (OrdT f, Ord a) => Comparator (f a)
-compareT = compareT0 compare
-
--- instance HOrd0 KeyFam r => OrdT (FamT KeyFam r) where
-
--- instance OrdT (Family phi) where
--- 	compareT0 cmp (F a) (F b) = cmp a b
-
-instance Ord a => OrdT (K0 a) where
-	compareT0 _ (K0 a) (K0 b) = compare a b
-
-instance Ord a => Ord (K0 a r) where
-	compare (K0 a) (K0 b) = compare a b
-
-instance OrdT I0 where
-	compareT0 cmp (I0 a) (I0 b) = cmp a b
-
-instance Ord r => Ord (I0 r) where
-	compare = compareT
-
-instance (OrdT f, OrdT g) => OrdT (f :*: g) where
-	compareT0 cmp (x1 :*: y1) (x2 :*: y2) = compareT0 cmp x1 x2 `mappend` compareT0 cmp y1 y2
-
-instance (OrdT f, OrdT g, Ord r) => Ord ((f :*: g) r) where
-	compare = compareT
-
-instance (OrdT f, OrdT g) => OrdT (f `O` g) where
-	compareT0 cmp (O x) (O y) = compareT0 (compareT0 cmp) x y
-
-instance (OrdT f, OrdT g, Ord r) => Ord ((f `O` g) r) where
-	compare = compareT
-
-instance (OrdT f, OrdT g) => OrdT (f :+: g) where
-	compareT0 cmp x y = case (x, y) of
-		(L x, L y)	-> compareT0 cmp x y
-		(R x, R y)	-> compareT0 cmp x y
-		(L _, R _)	-> LT
-		(R _, L _)	-> GT
-
-instance (OrdT f, OrdT g, Ord r) => Ord ((f :+: g) r) where
-	compare = compareT
-
-instance OrdT U0 where
-	compareT0 _ = compare
-
-instance Ord (U0 r) where
-	compare _ _ = EQ
-
-instance OrdT f => OrdT (L f) where
-	compareT0 cmp (List xs) (List ys) = compareT0' xs ys where
-		cmpT' = compareT0 cmp
-		compareT0' (x:xs) (y:ys) = cmpT' x y `mappend` compareT0' xs ys
-		compareT0' [] [] = EQ
-		compareT0' [] _ = LT
-		compareT0' _ [] = GT
-
-instance (OrdT f, Ord r) => Ord (L f r) where
-	compare = compareT
-
-instance OrdT [] where
-	compareT0 cmp = cmpT' where
-		cmpT' (x:xs) (y:ys) = cmp x y `mappend` cmpT' xs ys
-		cmpT' [] [] = EQ
-		cmpT' [] _ = LT
-		cmpT' _ [] = GT
-
-instance (Regular a, Functor (PF a), OrdT (PF a)) => Ord (Reg a) where
-	compare a b = compareT (from' a) (from' b)
-
-instance Ord a => OrdT ((,) a) where
-	compareT0 cmp (a, b) (c, d) = compare a c `mappend` cmp b d
-	
-instance Ord a => OrdT (Either a) where
-	compareT0 cmp x y = case (x, y) of
-		(Left a, Left b) -> compare a b
-		(Right a, Right b) -> cmp a b
-		(Left{}, Right{}) -> LT
-		(Right{}, Left{}) -> GT
-
-instance OrdT Rev where
-	compareT0 cmp (Rev x) (Rev y) = cmp y x
-
-instance OrdT Ordered where
-	compareT0 cmp (Ord x) (Ord y) = cmp x y
diff --git a/Data/TrieMap/Regular/ProdMap.hs b/Data/TrieMap/Regular/ProdMap.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/ProdMap.hs
+++ /dev/null
@@ -1,138 +0,0 @@
-{-# LANGUAGE TemplateHaskell, PatternGuards, TypeFamilies, MultiParamTypeClasses, FlexibleContexts,  TypeOperators, UndecidableInstances #-}
-
-module Data.TrieMap.Regular.ProdMap() where
-
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Regular.Eq
-import Data.TrieMap.TrieKey
-import Data.TrieMap.Applicative
-import Data.TrieMap.Sized
--- import Data.TrieMap.Regular.TH
-
-import Control.Applicative
-import Control.Arrow
-
-import Data.Maybe
-import Data.Monoid
-import Data.Sequence (Seq, (|>))
-import qualified Data.Sequence as Seq
-import Data.Foldable
-
-newtype PMap m1 (m2 :: * -> * -> *) k a = PMap (m1 k (m2 k a))
-type instance TrieMapT (f :*: g) = PMap (TrieMapT f) (TrieMapT g)
-type instance TrieMap ((f :*: g) r) = TrieMapT (f :*: g) r
-
-lastIx :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> TrieMapT f k a -> Int
-lastIx s m = fromMaybe (sizeT s m) (getLast (aboutT (\ _ a -> return $ sizeT s m - s a) m))
-
---maybe (sizeT s m) fst (getLast (extractMaxT s (\ _ a -> (sizeT s m - s a, Just a)) m))
-
-instance (TrieKeyT f m1, TrieKeyT g m2, TrieKey k (TrieMap k)) =>
-	TrieKey ((f :*: g) k) (PMap m1 m2 k) where
-	emptyM = emptyT
-	nullM = nullT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
-
-instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :*: g) (PMap m1 m2) where
-	emptyT = PMap emptyT
-	nullT (PMap m) = nullT m
-	sizeT s (PMap m) = sizeT (sizeT s) m
-	lookupT (a :*: b) (PMap m) = lookupT a m >>= lookupT b
-	lookupIxT s (a :*: b) (PMap m) = case lookupIxT (sizeT s) a m of
-		(lb, x, ub) -> let lookupX = do	Asc i' a' m' <- x
-						let (lb', x', ub') = lookupIxT s b m'
-						let f = onKeyA (a' :*:) . onIndexA (i' +)
-						return (f <$> lb', f <$> x', f <$> ub')
-			in ((do	Asc iL aL mL <- lb
-				fmap (onKeyA (aL :*:) . onIndexA (iL +)) (getMax s mL)) <|>
-			    (do	(lb', _, _) <- Last lookupX
-			    	lb'),
-			    (do	(_, x', _) <- lookupX
-			    	x'),
-			    (do	(_, _, ub') <- First lookupX
-			    	ub') <|>
-			    (do Asc iR aR mR <- ub
-			    	fmap (onKeyA (aR :*:) . onIndexA (iR +)) (getMin s mR))) 
-		where	getMin s m = aboutT (\ k a -> return (Asc 0 k a)) m
-			getMax s m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m
-	assocAtT s i (PMap m) = case assocAtT (sizeT s) i m of
-		(lb, x, ub) -> let lookupX = do	Asc i' a' m' <- x
-						let (lb', x', ub') = assocAtT s (i - i') m'
-						let f = onKeyA (a' :*:) . onIndexA (i' +)
-						return (f <$> lb', f <$> x', f <$> ub')
-			in ((do	Asc iL aL mL <- lb
-				fmap (onKeyA (aL :*:) . onIndexA (iL +)) (getMax mL)) <|>
-			    (do	(lb', _, _) <- Last lookupX
-			    	lb'),
-			    (do	(_, x', _) <- lookupX
-			    	x'),
-			    (do	(_, _, ub') <- First lookupX
-			    	ub') <|>
-			    (do	Asc iR aR mR <- ub
-			    	fmap (onKeyA (aR :*:) . onIndexA (iR +)) (getMin mR)))
-		where	getMin m = aboutT (\ k a -> return (Asc 0 k a)) m
-			getMax m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m
--- 	updateAtT s r f i (PMap m) = PMap (updateAtT (sizeT s) r g i m) where
--- 		g iA a m'
--- 			| not r && i < iA
--- 				= guardNullT (alterMinT s (f iA . (a :*:)) m')
--- 			| r && i >= iA + lastIx s m'
--- 				= guardNullT (alterMaxT s (f (lastIx s m') . (a :*:)) m')
--- 			| otherwise
--- 				= guardNullT (updateAtT s r (\ i' -> f (iA + i') . (a :*:)) (i - iA) m')
-	alterT s f (a :*: b) (PMap m) = PMap (alterT (sizeT s) g a m) where
-		g = guardNullT . alterT s f b . fromMaybe emptyT
-	alterLookupT s f (a :*: b) (PMap m) = PMap <$> alterLookupT (sizeT s) g a m where
-		g = fmap guardNullT . alterLookupT s f b . fromMaybe emptyT
-	traverseWithKeyT s f (PMap m) = PMap <$> traverseWithKeyT (sizeT s) g m where
-		g a = traverseWithKeyT s (\ b -> f (a :*: b))
-	foldWithKeyT f (PMap m) = foldWithKeyT g m where
-		g a = foldWithKeyT (\ b -> f (a :*: b))
-	foldlWithKeyT f (PMap m) = foldlWithKeyT g m where
-		g a z m = foldlWithKeyT (\ b -> f (a :*: b)) m z
-	mapEitherT s1 s2 f (PMap m) = (PMap *** PMap) (mapEitherT (sizeT s1) (sizeT s2) g m) where
-		g a = (guardNullT *** guardNullT) . mapEitherT s1 s2 (\ b -> f (a :*: b))
-	splitLookupT s f (a :*: b) (PMap m) = PMap `sides` splitLookupT (sizeT s) g a m where
-		g = sides guardNullT . splitLookupT s f b
-	unionT s f (PMap m1) (PMap m2) = PMap (unionT (sizeT s) (\ a -> guardNullT .: unionT s (\ b -> f (a :*: b))) m1 m2)
-	isectT s f (PMap m1) (PMap m2) = PMap (isectT (sizeT s) (\ a -> guardNullT .: isectT s (\ b -> f (a :*: b))) m1 m2)
-	diffT s f (PMap m1) (PMap m2) = PMap (diffT (sizeT s) (\ a -> guardNullT .: diffT s (\ b -> f (a :*: b))) m1 m2)
-	extractT s f (PMap m) = fmap PMap <$> extractT (sizeT s) g m where
-		g a = fmap guardNullT <.> extractT s (\ b -> f (a :*: b))
--- 	extractMinT s f (PMap m) = second PMap <$> extractMinT (sizeT s) g m where
--- 		g a = second guardNullT . fromJust . getFirst . extractMinT s (f . (a :*:))
--- 	extractMaxT s f (PMap m) = second PMap <$> extractMaxT (sizeT s) g m where
--- 		g a = second guardNullT . fromJust . getLast . extractMaxT s (f . (a :*:))
--- 	alterMinT s f (PMap m) = PMap (alterMinT (sizeT s) (\ a -> guardNullT . alterMinT s (\ b -> f (a :*: b))) m)
--- 	alterMaxT s f (PMap m) = PMap (alterMaxT (sizeT s) (\ a -> guardNullT . alterMaxT s (\ b -> f (a :*: b))) m)
-	isSubmapT (<=) (PMap m1) (PMap m2) = isSubmapT (isSubmapT (<=)) m1 m2 
-	fromListT s f xs = PMap (mapWithKeyT (sizeT s) (\ a -> fromListT s (\ b -> f (a :*: b))) 
-		(fromListT (const 1) (const (++)) (breakFst xs)))
-	fromAscListT s f xs = PMap (fromDistAscListT (sizeT s)
-		[(a, fromAscListT s (\ b -> f (a :*: b)) ys) | (a, ys) <- breakFst xs])
-	
-breakFst :: (EqT f, Eq k) => [((f :*: g) k, a)] -> [(f k, [(g k, a)])]
-breakFst [] = []
-breakFst ((a :*: b, v):xs) = breakFst' a (Seq.singleton (b, v)) xs where
-   	breakFst' a vs ((a' :*: b', v):xs)
-		| a `eqT` a'	= breakFst' a (vs |> (b', v)) xs
-		| otherwise	= (a, toList vs):breakFst' a' (Seq.singleton (b', v)) xs
-	breakFst' a vs [] = [(a, toList vs)]
diff --git a/Data/TrieMap/Regular/RadixTrie.hs b/Data/TrieMap/Regular/RadixTrie.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/RadixTrie.hs
+++ /dev/null
@@ -1,417 +0,0 @@
-{-# LANGUAGE TemplateHaskell, Rank2Types, PatternGuards, FlexibleContexts, TypeFamilies, UndecidableInstances, MultiParamTypeClasses #-}
-
-module Data.TrieMap.Regular.RadixTrie () where
-
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Regular.Ord
-import Data.TrieMap.Regular.Eq
--- import Data.TrieMap.Regular.TH
-import Data.TrieMap.Sized
-import Data.TrieMap.TrieKey
-import Data.TrieMap.Applicative
-import Data.TrieMap.CPair
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.TH
--- import qualified Data.TrieMap.MultiRec.Base as MR
-
-import Control.Arrow
-import Control.Applicative
-import Control.Monad
-
-import Data.Maybe
-import Data.Monoid
-import Data.Foldable
-import Data.Traversable
-
-import Prelude hiding (foldr, foldl)
-
-data Edge f (m :: * -> * -> *) k a = Edge {-# UNPACK #-} !Int [f k] (Maybe (a)) (m k (Edge f m k a))
-type Edge' f k a = Edge f (TrieMapT f) k a
-type MEdge f k m a = Maybe (Edge f m k a)
-type MEdge' f k a = Maybe (Edge' f k a)
-
--- type instance PF (Edge f m k a) = (K0 (L f k) :*: K0 (Maybe (a)) :*: L (K0 k :*: I0) :*: K0 Int)
--- type instance (RadixTrie f k a) = U0 :+: PF (Edge f m k a)
-
--- instance (TrieKeyT f m, m ~ TrieMapT f, TrieKey k (TrieMap k)) => Regular (Edge f m k a) where
--- 	from (Edge n ks v ts) = K0 (List ks) :*: K0 v :*: 
-
-newtype RadixTrie f k a = Radix (MEdge' f k a)
--- newtype K0 a b = K0 a
-
-type instance TrieMapT (L f) = RadixTrie f
-type instance TrieMap (L f r) = RadixTrie f r
-
-edgeSize :: Sized (Edge f m k a)
-edgeSize (Edge s _ _ _) = s
-
-edge :: (TrieKeyT f m, m ~ TrieMapT f, TrieKey k (TrieMap k)) => Sized a -> [f k] -> Maybe (a) -> m k (Edge f m k a) -> Edge f m k a
-edge s ks v ts = Edge (maybe 0 s v + sizeT edgeSize ts) ks v ts
-
-instance (OrdT f, TrieKeyT f m, m ~ TrieMapT f) => TrieKeyT (L f) (RadixTrie f) where
-	emptyT = Radix Nothing
-	nullT (Radix m) = isNothing m
-	sizeT _ (Radix m) = maybe 0 edgeSize m
-	lookupT (List ks) (Radix m) = m >>= lookupE ks
-	lookupIxT s (List ks) (Radix m) = maybe (mzero, mzero, mzero) (onKey List . lookupIxE s 0 ks) m
-	assocAtT s i (Radix m) = maybe (mzero, mzero, mzero) (onKey List . assocAtE s 0 i) m
--- 	updateAtT s r f i (Radix m) = Radix (m >>= updateAtE s r (\ i' -> f i' . List) i)
-	alterT s f (List ks) (Radix m) = Radix (maybe (singletonME s ks (f Nothing)) (alterE s f ks) m)
-	alterLookupT s f (List ks) (Radix m) = Radix <$> maybe (singletonME s ks <$> f Nothing) (alterLookupE s f ks) m
-	traverseWithKeyT s f (Radix m) = Radix <$> traverse (traverseE s (f . List)) m
-	foldWithKeyT f (Radix m) z = foldr (foldE (f . List)) z m
-	foldlWithKeyT f (Radix m) z = foldr (foldlE (f . List)) z m
-	mapEitherT s1 s2 f (Radix m) = (Radix *** Radix) (maybe (Nothing, Nothing) (mapEitherE s1 s2 (f . List)) m)
-	splitLookupT s f (List ks) (Radix m) = Radix `sides` maybe (Nothing, Nothing, Nothing) (splitLookupE s f ks) m
-	unionT s f (Radix m1) (Radix m2) = Radix (unionMaybe (unionE s (f . List)) m1 m2)
-	isectT s f (Radix m1) (Radix m2) = Radix (isectMaybe (isectE s (f . List)) m1 m2)
-	diffT s f (Radix m1) (Radix m2) = Radix (diffMaybe (diffE s (f . List)) m1 m2)
-	extractT s f (Radix m) = maybe empty (fmap Radix <.> extractE s (f . List)) m
--- -- 	extractMinT s f (Radix m) = First m >>= fmap (second Radix) . extractMinE s (f . List)
--- 	extractMaxT s f (Radix m) = Last m >>= fmap (second Radix) . extractMaxE s (f . List)
--- 	alterMinT s f (Radix m) = Radix (m >>= alterMinE s (f . List))
--- 	alterMaxT s f (Radix m) = Radix (m >>= alterMaxE s (f . List))
-	isSubmapT (<=) (Radix m1) (Radix m2) = subMaybe (isSubEdge (<=)) m1 m2
-	fromListT s f xs = Radix (fromListE s (f . List) [(ks, a) | (List ks, a) <- xs])
-	fromAscListT s f xs = Radix (fromAscListE s (f . List) [(ks, a) | (List ks, a) <- xs])
-
-instance (OrdT f, TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieKey (L f k) (RadixTrie f k) where
-	emptyM = emptyT
-	nullM = nullT
-	sizeM = sizeT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
--- 	updateAtM = updateAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
--- 	extractMinM = extractMinT
--- 	extractMaxM = extractMaxT
--- 	alterMinM = alterMinT
--- 	alterMaxM = alterMaxT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
-
--- instance (Ord k, TrieKey k m) => TrieKey [k] (RadixTrie k m) where
--- 	emptyM = Radix Nothing
--- 	nullM (Radix m) = isNothing m
--- 	lookupM ks (Radix m) = m >>= lookupE ks
--- 	alterM f ks (Radix m) = Radix (maybe (singletonME ks (f Nothing)) (alterE f ks) m)
--- 	traverseWithKeyM f (Radix m) = Radix <$> traverse (traverseE f) m
--- 	foldWithKeyM f (Radix m) z = foldr (foldE f) z m
--- 	mapEitherM f (Radix m) = (Radix *** Radix) (maybe (Nothing, Nothing) (mapEitherE f) m)
--- 	splitLookupM f ks (Radix m) = Radix `sides` maybe (Nothing, Nothing, Nothing) (splitLookupE f ks) m
--- 	unionM f (Radix m1) (Radix m2) = Radix (unionMaybe (unionE f) m1 m2)
--- 	isectM f (Radix m1) (Radix m2) = Radix (isectMaybe (isectE f) m1 m2)
--- 	diffM f (Radix m1) (Radix m2) = Radix (diffMaybe (diffE f) m1 m2)
--- 	extractMinM (Radix m) = First m >>= fmap (fmap Radix) . extractMinE
--- 	extractMaxM (Radix m) = Last m >>= fmap (fmap Radix) . extractMaxE
--- 	alterMinM f (Radix m) = Radix (m >>= alterMinE f)
--- 	alterMaxM f (Radix m) = Radix (m >>= alterMaxE f)
--- 	isSubmapM (<=) (Radix m1) (Radix m2) = subMaybe (isSubEdge (<=)) m1 m2
--- 	fromListM = Radix .: fromListE
--- 	fromAscListM = Radix .: fromAscListE
-
-compact :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Edge' f k a -> MEdge' f k a
-compact e@(Edge s ks Nothing ts) = case assocsT ts of
-	[]	-> Nothing
-	[~(k, e'@(Edge s' ls v ts'))]
-		-> e' `seq` compact (Edge s' (ks ++ k:ls) v ts')
-	_	-> Just e
-compact e = Just e
-
-cons :: f k -> Edge' f k a -> Edge' f k a
-l `cons` Edge s ls v ts = Edge s (l:ls) v ts
-
-cat :: [f k] -> Edge' f k a -> Edge' f k a
-ks `cat` Edge s ls v ts = Edge s (ks ++ ls) v ts
-
-singletonME :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> [f k] -> Maybe (a) -> MEdge' f k a
-singletonME s ks = fmap (\ v -> Edge (s v) ks (Just v) emptyT)
-
-lookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => [f k] -> Edge' f k a -> Maybe (a)
-lookupE ks (Edge _ ls v ts) = match ks ls where
-	match (k:ks) (l:ls)
-		| k `eqT` l	= match ks ls
-	match (k:ks) [] = do	e' <- lookupT k ts
-				lookupE ks e'
-	match [] [] = v
-	match _ _ = Nothing
-
-alterE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 
-	Sized a -> (Maybe (a) -> Maybe (a)) -> [f k] -> Edge' f k a -> MEdge' f k a
-alterE s f ks0 e@(Edge sz ls0 v0 ts0) = match 0 ks0 ls0 where
-	match i _ _ | i `seq` False = undefined
-	match i (k:ks) (l:ls)
-		| k `eqT` l	= match (i+1) ks ls
-		| Just v <- f Nothing
-				= Just (Edge (sz + s v) (take i ls0) Nothing 
-					(fromListT edgeSize (const const) [(k, Edge (s v) ks (Just v) emptyT), 
-						(l, Edge sz ls v0 ts0)]))
-	match _ (k:ks) [] = compact $ edge s ls0 v0 $ alterT edgeSize g k ts0 where
-		g = maybe (singletonME s ks (f Nothing)) (alterE s f ks)
-	match _ [] (l:ls)
-		| Just v <- f Nothing
-			= Just (Edge (sz + s v) ks0 (Just v) (singletonT edgeSize l (Edge sz ls v0 ts0)))
-	match _ [] [] = compact (edge s ls0 (f v0) ts0)
-	match _ _ _ = Just e
-
-alterLookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
-	Sized a -> (Maybe a -> CPair x (Maybe a)) -> [f k] -> Edge' f k a -> CPair x (MEdge' f k a)
-alterLookupE s f ks0 e@(Edge sz ls0 v0 ts0) = match 0 ks0 ls0 where
-	match i _ _ | i `seq` False = undefined
-	match i (k:ks) (l:ls) = case compareT k l of
-		LT -> fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $ 
-				fromDistAscListT edgeSize [(k, Edge sv ks (Just v') emptyT), (l, Edge sz ls v0 ts0)]))
-			(f Nothing)
-		GT -> fmap (Just . maybe e (\ v' -> let sv = s v' in Edge (sz + sv) (take i ls0) Nothing $ 
-				fromDistAscListT edgeSize [(l, Edge sz ls v0 ts0), (k, Edge sv ks (Just v') emptyT)]))
-			(f Nothing)
-		EQ	-> match (i+1) ks ls
-	match _ (k:ks) [] = fmap (compact . edge s ls0 v0) (alterLookupT edgeSize g k ts0) where
-		g = maybe (singletonME s ks <$> f Nothing) (alterLookupE s f ks)
-	match _ [] (l:ls) = fmap (Just . maybe e (\ v' -> Edge (sz + s v') ks0 (Just v') (singletonT edgeSize l (Edge sz ls v0 ts0))))
-				(f Nothing)
-	match _ [] [] = fmap (\ v' -> compact (edge s ls0 v' ts0)) (f v0)
-
-traverseE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Applicative t) => 
-	Sized b -> ([f k] -> a -> t (b)) -> Edge' f k a -> t (Edge' f k b)
-traverseE s f (Edge _ ks v ts) =
-	edge s ks <$> traverse (f ks) v <*> traverseWithKeyT edgeSize (\ l -> traverseE s (\ ls -> f (ks ++ l:ls))) ts
-
-foldE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => ([f k] -> a -> b -> b) -> Edge' f k a -> b -> b
-foldE f (Edge _ ks v ts) z = foldr (f ks) (foldWithKeyT (\ l -> foldE (\ ls -> f (ks ++ l:ls))) ts z) v
-
-foldlE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => ([f k] -> b -> a -> b) -> Edge' f k a -> b -> b
-foldlE f (Edge _ ks v ts) z = foldlWithKeyT (\ l z m -> foldlE (\ ls -> f (ks ++ l:ls)) m z) ts (foldl (f ks) z v)
-
-mapEitherE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized b -> Sized c -> 
-	EitherMap (EitherMap [f k] (a) (b) (c)) (Edge' f k a) (Edge' f k b) (Edge' f k c)
-mapEitherE s1 s2 f (Edge _ ks v ts) = case (maybe (Nothing, Nothing) (f ks) v, mapEitherT edgeSize edgeSize 
-					(\ l -> mapEitherE s1 s2 (\ ls -> f (ks ++ l:ls))) ts) of 
-	((vL, vR), (tsL, tsR)) -> (compact (edge s1 ks vL tsL), compact (edge s2 ks vR tsR))
-
-splitLookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> SplitMap (a) x -> [f k] -> SplitMap (Edge' f k a) x
-splitLookupE s f ks e@(Edge _ ls v ts) = match ks ls where
-	match (k:ks) (l:ls) = case compareT k l of
-		LT	-> (Nothing, Nothing, Just e)
-		EQ	-> match ks ls
-		GT	-> (Just e, Nothing, Nothing)
-	match [] [] = case v of
-		Nothing	-> (Nothing, Nothing, Just e)
-		Just v	-> compact `sides` case f v of
-			(vL, x, vR) -> (edge s ls vL emptyT, x, edge s ls vR ts)
-	match [] (l:ls) = (Just e, Nothing, Nothing)
-	match (k:ks) [] = compact `sides` case splitLookupT edgeSize g k ts of
-		(tsL, x, tsR)	-> (edge s ls v tsL, x, edge s ls Nothing tsR)
-		where	g = splitLookupE s f ks
-
-unionE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> UnionFunc (UnionFunc [f k] (a)) (Edge' f k a)
-unionE s f (Edge szK ks0 vK tsK) (Edge szL ls0 vL tsL) = match 0 ks0 ls0 where
-	match i _ _ | i `seq` False = undefined
-	match i (k:ks) (l:ls)
-		| k `eqT` l	= match (i+1) ks ls
-		| otherwise	= Just (Edge (szK + szL) (take i ks0) Nothing 
-					(fromListT edgeSize (const const) [(k, Edge szK ks vK tsK), (l, Edge szL ls vL tsL)]))
-	match _ (k:ks) [] = compact (edge s ls0 vL $ alterT edgeSize g k tsL) where
-		g Nothing = Just (Edge szK ks vK tsK)
-		g (Just e) = unionE s (\ ks' -> f (ls0 ++ k:ks')) (Edge szK ks vK tsK) e
-	match _ [] (l:ls) = compact (edge s ks0 vK $ alterT edgeSize g l tsK) where
-		g Nothing = Just (Edge szL ls vL tsL)
-		g (Just e) = unionE s (\ ls' -> f (ks0 ++ l:ls')) e (Edge szL ls vL tsL)
-	match _ [] [] = compact (edge s ks0 (unionMaybe (f ks0) vK vL) (unionT edgeSize g tsK tsL)) where
-		g x = unionE s (\ xs -> f (ks0 ++ x:xs))
-
-extractE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) => Sized a -> ([f k] -> a -> t (CPair x (Maybe a))) -> 
-	Edge' f k a -> t (CPair x (MEdge' f k a))
-extractE s f (Edge _ ks v ts) = (maybe empty (fmap (\ v' -> compact (edge s ks v' ts)) <.> f ks) v) <|>
-  		(fmap (compact . edge s ks Nothing) <$> extractT edgeSize g ts)
-	where	g l = extractE s (\ ls -> f (ks ++ l:ls))
-
-aboutE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) => ([f k] -> a -> t x) ->
-	Edge' f k a -> t x
-aboutE f = cpFst <.> extractE (const 0) (\ k a -> fmap (flip cP Nothing) (f k a))
-
--- extractMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> ([f k] -> a -> (x, Maybe a)) -> 
--- 	Edge' f k a -> Last (x, MEdge' f k a)
--- extractMaxE s f (Edge _ ks v ts) = (do
--- 		v <- Last v
--- 		let (x, v') = f ks v
--- 		return (x, compact (edge s ks v' ts))) <|> 
---  			(second (compact . edge s ks v) <.> extractMaxT edgeSize g ts)
--- 	where	g x = fromJust . getLast . extractMaxE s (\ xs -> f (ks ++ x:xs))
-
--- alterMinE, alterMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a ->
--- 	([f k] -> a -> Maybe (a)) -> Edge' f k a -> MEdge' f k a
--- alterMinE s f (Edge _ ks (Just v) ts) = compact (edge s ks (f ks v) ts)
--- alterMinE s f (Edge _ ks Nothing ts) = compact (edge s ks Nothing (alterMinT edgeSize (\ x -> alterMinE s (\ xs -> f (ks ++ x:xs))) ts))
--- 
--- alterMaxE s f (Edge _ ks v ts)
--- 	| nullT ts	= do	v' <- v >>= f ks
--- 				return (Edge (s v') ks (Just v') ts)
--- 	| otherwise	= compact (edge s ks v (alterMaxT edgeSize (\ x -> alterMaxE s (\ xs -> f (ks ++ x:xs))) ts))
-
-isectE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized c ->
-	IsectFunc (IsectFunc [f k] (a) (b) (c)) (Edge' f k a) (Edge' f k b) (Edge' f k c)
-isectE s f (Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where
-	match (k:ks) (l:ls)
-		| k `eqT` l	= match ks ls
-	match (k:ks) [] = do	e' <- lookupT k tsL
-				liftM (cat ls . cons k) (isectE s (\ ks' -> f (ls ++ k:ks')) (Edge szK ks vK tsK) e')
-	match [] (l:ls) = do	e' <- lookupT l tsK
-				liftM (cat ks . cons l) (isectE s (\ ls' -> f (ks ++ l:ls')) e' (Edge szL ls vL tsL))
-	match [] [] = compact (edge s ks (isectMaybe (f ks) vK vL) (isectT edgeSize g tsK tsL)) where
-		g x = isectE s (\ xs -> f (ks ++ x:xs))
-
-diffE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a ->
-	DiffFunc (DiffFunc [f k] (a) (b)) (Edge' f k a) (Edge' f k b)
-diffE s f e@(Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where
-	match (k:ks) (l:ls)
-		| k `eqT` l	= match ks ls
-	match (k:ks) []
-		| Just e' <- lookupT k tsL
-			= fmap (cat ls . cons k) (diffE s (\ ks' -> f (ls ++ k:ks')) (Edge szK ks vK tsK) e')
-	match [] (l:ls) = compact (edge s ks vK (alterT edgeSize (>>= g) l tsK)) where
-		g e' = diffE s (\ ls' -> f (ks ++ l:ls')) e' (Edge szL ls vL tsL)
-	match [] [] = compact (edge s ks (diffMaybe (f ks) vK vL) (diffT edgeSize g tsK tsL)) where
-		g x = diffE s (\ xs -> f (ks ++ x:xs))
-
-isSubEdge :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => LEq (a) (b) -> LEq (Edge' f k a) (Edge' f k b)
-isSubEdge (<=) (Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where
-	match (k:ks) (l:ls)
-		| k `eqT` l	= match ks ls
-	match (k:ks) []
-		| Just e' <- lookupT k tsL
-			= isSubEdge (<=) (Edge szK ks vK tsK) e'
-	match [] []
-		= subMaybe (<=) vK vL && isSubmapT (isSubEdge (<=)) tsK tsL
-	match _ _ = False
-
-filterer :: (k -> k -> Bool) -> (a -> a -> a) -> [([k], a)] -> (Maybe a, [(k, [([k], a)])])
-filterer (==) f = filterer' where
-	filterer' (([], a):xs) = first (Just . maybe a (flip f a)) (filterer' xs)
-	filterer' ((k:ks, a):xs) = second (cons k ks a) (filterer' xs)
-	filterer' [] = (Nothing, [])
-	cons k ks a [] = [(k, [(ks, a)])]
-	cons k ks a ys0@((k', xs):ys)
-		| k == k'	= (k', (ks,a):xs):ys
-		| otherwise	= (k, [(ks, a)]):ys0
-
-fromListE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> ([f k] -> a -> a -> a) -> [([f k], a)] -> MEdge' f k a
-fromListE _ _ [] = Nothing
-fromListE s f xs = case filterer eqT (f []) xs of
-	(Nothing, [(k, xs)]) -> cons k <$> fromListE s (f . (k:)) xs
-	(v, xss) -> Just (edge s [] v (mapWithKeyT edgeSize (\ k (K0 xs) -> fromJust (fromListE s (f . (k:)) xs))
-				(fromListT (const 1) (\ _ (K0 xs) (K0 ys) -> K0 (ys ++ xs)) [(k, K0 xs) | (k, xs) <- xss])))
-
-fromAscListE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 
-	Sized a -> ([f k] -> a -> a -> a) -> [([f k], a)] -> MEdge' f k a
-fromAscListE _ _ [] = Nothing
-fromAscListE s f xs = case filterer eqT (f []) xs of
-	(Nothing, [(k, xs)]) -> cons k <$> fromAscListE s (f . (k:)) xs
-	(v, xss) -> Just (edge s [] v (fromDistAscListT edgeSize [(k, fromJust (fromAscListE s (f . (k:)) xs)) | (k, xs) <- xss]))
-
-lookupIxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
-	Sized a -> Int -> [f k] -> Edge' f k a -> IndexPos [f k] a
-lookupIxE _ i _ _ | i `seq` False = undefined
-lookupIxE s i ks e@(Edge _ ls v ts) = match ks ls where
-	match (k:ks) (l:ls) = case compareT k l of
-		LT	-> (mzero, mzero, getMin (Asc i) e)
-		EQ	-> match ks ls
-		GT	-> (getMax (Asc i) e, mzero, mzero)
-	match (k:ks) [] = case lookupIxT edgeSize k ts of
-		(lb, x, ub) -> let lookupX = do	Asc iK k' e' <- x
-						let (lb', x', ub') = lookupIxE s (i + iK) ks e'
-						let f = onKeyA ((ls ++) . (k' :))
-						return (f <$> lb', f <$> x', f <$> ub')
-			in ((do	Asc iL kL eL <- lb
-				getMax (\ ksL -> Asc (i + iL) (ls ++ kL:ksL)) eL) <|>
-			    (do	(lb', _, _) <- Last lookupX
-			    	lb'),
-			    (do	(_, x', _) <- lookupX
-			    	x'),
-			    (do (_, _, ub') <- First lookupX
-			    	ub') <|>
-			    (do	Asc iR kR eR <- ub
-			    	getMin (\ ksR -> Asc (i + iR) (ls ++ kR:ksR)) eR))
-	match [] [] = (mzero, Asc i ls <$> v, aboutT
-				(\ x -> aboutE (\ xs v' -> return (Asc (i + maybe 0 s v) (ls ++ x:xs) v'))) ts)
-	match [] _ = (mzero, mzero, getMin (Asc i) e)
-	getMin f = aboutE (return .: f)
-	getMax f = aboutE (return .: f)
-
-assocAtE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
-	Sized a -> Int -> Int -> Edge' f k a -> IndexPos [f k] a
-assocAtE s i0 i (Edge _ ks Nothing ts) = case assocAtT edgeSize i ts of
-	(lb, x, ub) -> let lookupX = do	Asc i' l e' <- x
-					return (onKey ((ks ++) . (l:)) (assocAtE s (i0 + i') (i - i') e'))
-		in ((do	Asc iL lL eL <- lb
-			getMax (\ ls -> Asc (i0 + iL) (ks ++ lL:ls)) eL) <|>
-		    (do	(lb', _, _) <- Last lookupX
-		    	lb'),
-		    (do	(_, x', _) <- lookupX
-		    	x'),
-		    (do	(_, _, ub') <- First lookupX
-		    	ub') <|>
-		    (do	Asc iR lR eR <- ub
-		    	getMin (\ ls -> Asc (i0 + iR) (ks ++ lR:ls)) eR))
-	where 	getMin f e = aboutE (return .: f) e
-		getMax f e = aboutE (return .: f) e
-assocAtE s i0 i (Edge _ ks (Just v) ts)
-	| i < sv	= (mzero, return (Asc i ks v), aboutT (\ l -> aboutE (\ ls v' -> return (Asc (i0 + sv) (ks ++ l:ls) v'))) ts)
-	| (lb, x, ub) <- assocAtT edgeSize (i - sv) ts
-		= let lookupX = do	Asc i' l e' <- x
-					return (onKey ((ks ++) . (l:)) (assocAtE s (i0 + i' + sv) (i - sv - i') e'))
-		in ((do	Asc iL lL eL <- lb
-			getMax (\ ls -> Asc (i0 + iL + sv) (ks ++ lL:ls)) eL) <|>
-		    (do	(lb', _, _) <- Last lookupX
-		    	lb'),
-		    (do	(_, x', _) <- lookupX
-		    	x'),
-		    (do	(_, _, ub') <- First lookupX
-		    	ub') <|>
-		    (do	Asc iR lR eR <- ub
-		    	getMin (\ ls -> Asc (i0 + iR + sv) (ks ++ lR:ls)) eR))
-	where 	getMin f = aboutE (return .: f)
-		getMax f = aboutE (return .: f)
-		sv = s v
-
--- alterMinE, alterMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 
--- 	Sized a -> ([f k] -> a -> Maybe a) -> Edge' f k a -> MEdge' f k a
--- alterMinE s f e = maybe (Just e) snd $ getFirst (extractMinE s (\ k a -> ((), f k a)) e)
--- alterMaxE s f e = maybe (Just e) snd $ getLast (extractMaxE s (\ k a -> ((), f k a)) e)
-
--- updateAtE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
--- 	Sized a -> Round -> (Int -> [f k] -> a -> Maybe (a)) -> Int -> Edge' f k a -> MEdge' f k a
--- updateAtE s r f i (Edge sz ks Nothing ts) = compact (edge s ks Nothing (updateAtT edgeSize r g i ts)) where
--- 	g iT l e
--- 		| not r, i < iT
--- 			= alterMinE s (f iT . (ks++) . (l:)) e
--- 		| r, i >= iT + edgeSize e
--- 			= alterMaxE s (\ ls a -> f (edgeSize e + iT - s a) (ks ++ l:ls) a) e
--- 		| otherwise
--- 			= updateAtE s r (\ i' ls -> f (i' + iT) (ks ++ l:ls)) (i - iT) e
--- updateAtE s r f i (Edge sz ks (Just v) ts)
--- 	| i < sv	= compact (edge s ks (f 0 ks v) ts)
--- 	| otherwise	= compact (edge s ks (Just v) (updateAtT edgeSize r g i1 ts))
--- 	where	sv = s v
--- 		i1 = i - sv
--- 		g iT l e 
--- 			| not r, i1 < iT 
--- 				= alterMinE s (f (iT + sv) . (ks ++) . (l:)) e
--- 			| r, i1 >= iT + edgeSize e
--- 				= alterMaxE s (\ ls a -> f (iT + sv + edgeSize e + iT - s a) (ks ++ l:ls) a) e
--- 			| otherwise
--- 				= updateAtE s r (\ i' ls -> f (sv + iT + i') (ks ++ l:ls)) (i - sv - iT) e
diff --git a/Data/TrieMap/Regular/RegMap.hs b/Data/TrieMap/Regular/RegMap.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/RegMap.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}
-
-module Data.TrieMap.Regular.RegMap() where
-
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.TrieKey
-
-import Control.Applicative
-import Control.Arrow
-import Control.Monad
-
-newtype RegMap k m a = RegMap (m (Reg k) a)
-
-instance (Regular k, Functor (PF k), TrieKeyT (PF k) m, m ~ TrieMapT (PF k)) => TrieKey (Reg k) (RegMap k m) where
-	emptyM = RegMap emptyT	
-	nullM (RegMap m) = nullT m
-	sizeM s (RegMap m) = sizeT s m
-	lookupM k (RegMap m) = lookupT (from' k) m
-	lookupIxM s k (RegMap m) = onKey to' (lookupIxT s (from' k) m)
-	assocAtM s i (RegMap m) = onKey to' (assocAtT s i m)
--- 	updateAtM s r f i (RegMap m) = RegMap (updateAtT s r (\ i' -> f i' . to') i m)
-	alterM s f k (RegMap m) = RegMap (alterT s f (from' k) m)
-	alterLookupM s f k (RegMap m) = RegMap <$> alterLookupT s f (from' k) m
-	traverseWithKeyM s f (RegMap m) = RegMap <$> traverseWithKeyT s (f . to') m
-	foldWithKeyM f (RegMap m) = foldWithKeyT (f . to') m
-	foldlWithKeyM f (RegMap m) = foldlWithKeyT (f . to') m
-	mapEitherM s1 s2 f (RegMap m) = (RegMap *** RegMap) (mapEitherT s1 s2 (f . to') m)
-	splitLookupM s f k (RegMap m) = RegMap `sides` splitLookupT s f (from' k) m
-	unionM s f (RegMap m1) (RegMap m2) = RegMap (unionT s (f . to') m1 m2)
-	isectM s f (RegMap m1) (RegMap m2) = RegMap (isectT s (f . to') m1 m2)
-	diffM s f (RegMap m1) (RegMap m2) = RegMap (diffT s (f . to') m1 m2)
-	extractM s f (RegMap m) = fmap RegMap <$> extractT s (f . to') m
--- 	extractMinM s f (RegMap m) = second RegMap <$> extractMinT s (f . to') m
--- 	extractMaxM s f (RegMap m) = second RegMap <$> extractMaxT s (f . to') m
--- 	alterMinM s f (RegMap m) = RegMap (alterMinT s (f . to') m)
--- 	alterMaxM s f (RegMap m) = RegMap (alterMaxT s (f . to') m)
-	isSubmapM (<=) (RegMap m1) (RegMap m2) = isSubmapT (<=) m1 m2
-	fromListM s f xs = RegMap (fromListT s (f . to') [(from' k, a) | (k, a) <- xs])
-	fromAscListM s f xs = RegMap (fromAscListT s (f . to') [(from' k, a) | (k, a) <- xs])
-	fromDistAscListM s xs = RegMap (fromDistAscListT s [(from' k, a) | (k, a) <- xs])
diff --git a/Data/TrieMap/Regular/Rep.hs b/Data/TrieMap/Regular/Rep.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/Rep.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-{-# LANGUAGE UndecidableInstances, TypeOperators, TypeFamilies, TemplateHaskell #-}
-
-module Data.TrieMap.Regular.Rep where
-
-import Data.TrieMap.Rep
-import Data.TrieMap.Rep.TH
-import Data.TrieMap.Regular.Base
-
-type instance RepT (K0 a) = K0 (Rep a)
-type instance RepT I0 = I0
-type instance RepT U0 = U0
-type instance RepT (L f) = L (RepT f)
-type instance RepT (f :*: g) = RepT f :*: RepT g
-type instance RepT (f :+: g) = RepT f :+: RepT g
-type instance RepT (f `O` g) = RepT f `O` RepT g
-
-type instance Rep (K0 a b) = RepT (K0 a) b
-type instance Rep (I0 a) = I0 (Rep a)
-type instance Rep (U0 a) = U0 a
-type instance Rep (L f a) = L (RepT f) (Rep a)
-type instance Rep ((f :*: g) a) = RepT (f :*: g) (Rep a)
-type instance Rep ((f :+: g) a) = RepT (f :+: g) (Rep a)
-type instance Rep ((f `O` g) a) = RepT (f `O` g) (Rep a)
-type instance Rep (Fix f) = Fix (RepT f)
-
-instance Repr a => ReprT (K0 a) where
-	toRepTMap _ (K0 a) = K0 (toRep a)
-	fromRepTMap _ (K0 a) = K0 (fromRep a)
-
-instance Repr a => Repr (K0 a b) where
-	toRep = toRepT
-	fromRep = fromRepT
-
-$(genRepT [d|
-   instance ReprT I0 where
-	toRepTMap = fmap
-	fromRepTMap = fmap |])
-
-instance ReprT U0 where
-	toRepTMap _ _ = U0
-	fromRepTMap _ _ = U0
-
-instance Repr (U0 a) where
-	toRep _ = U0
-	fromRep _ = U0
-
-$(genRepT [d|
-   instance ReprT f => ReprT (L f) where
-	toRepTMap f (List xs) = List (map (toRepTMap f) xs)
-	fromRepTMap f (List xs) = List (map (fromRepTMap f) xs) |])
-
-$(genRepT [d|
-   instance (ReprT f, ReprT g) => ReprT (f :*: g) where
-	toRepTMap f (x :*: y) = toRepTMap f x :*: toRepTMap f y
-	fromRepTMap f (x :*: y) = fromRepTMap f x :*: fromRepTMap f y |])
-
-$(genRepT [d|
-   instance (ReprT f, ReprT g) => ReprT (f :+: g) where
-	toRepTMap f (L a) = L (toRepTMap f a)
-	toRepTMap f (R b) = R (toRepTMap f b)
-	fromRepTMap f (L a) = L (fromRepTMap f a)
-	fromRepTMap f (R b) = R (fromRepTMap f b) |])
-
-$(genRepT [d|
-   instance (ReprT f, ReprT g) => ReprT (f `O` g) where
-	toRepTMap f (O x) = O (toRepTMap (toRepTMap f) x)
-	fromRepTMap f (O x) = O (fromRepTMap (fromRepTMap f) x) |])
-
-instance ReprT f => Repr (Fix f) where
-	toRep (In x) = In (toRepTMap toRep x)
-	fromRep (In x) = In (fromRepTMap fromRep x)
diff --git a/Data/TrieMap/Regular/Sized.hs b/Data/TrieMap/Regular/Sized.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/Sized.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-{-# LANGUAGE Rank2Types #-}
-
-module Data.TrieMap.Regular.Sized where
-
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Sized
-
-sizeK0 :: Sized (K0 a b)
-sizeK0 _ = 1
diff --git a/Data/TrieMap/Regular/TH.hs b/Data/TrieMap/Regular/TH.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/TH.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, QuasiQuotes #-}
-
-module Data.TrieMap.Regular.TH where
-
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.TrieKey
-import Language.Haskell.TH
-
-deriveM :: Q [Dec] -> Q [Dec]
-deriveM decs = do
-	iT@(InstanceD cxt inst _:_) <- decs
-	let myDecs = zipWith (\ m t -> ValD (VarP m) (NormalB (VarE t)) [])
-		['emptyM, 'nullM, 'lookupM, 'lookupIxM, 'assocAtM, 'alterM, 'alterLookupM, 'traverseWithKeyM,
-			'foldWithKeyM, 'foldlWithKeyM, 'mapEitherM, 'splitLookupM, 'unionM, 'isectM, 'diffM, 'extractM,
-			'isSubmapM, 'fromListM, 'fromAscListM, 'fromDistAscListM]
-		['emptyT, 'nullT, 'lookupT, 'lookupIxT, 'assocAtT, 'alterT, 'alterLookupT, 'traverseWithKeyT,
-			'foldWithKeyT, 'foldlWithKeyT, 'mapEitherT, 'splitLookupT, 'unionT, 'isectT, 'diffT, 'extractT,
-			'isSubmapT, 'fromListT, 'fromAscListT, 'fromDistAscListT]
-	k <- mkVar "k"
-	let triekey = ConT ''TrieKey
-	let triemap = ConT ''TrieMap
-	let ordT = ConT ''Ord
-	return [InstanceD cxt inst myDecs]
-
-mkVar :: String -> TypeQ
-mkVar x = varT =<< newName x
diff --git a/Data/TrieMap/Regular/UnionMap.hs b/Data/TrieMap/Regular/UnionMap.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/UnionMap.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-{-# LANGUAGE PatternGuards, FlexibleInstances, TemplateHaskell, TypeOperators, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
-
-module Data.TrieMap.Regular.UnionMap() where
-
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Base
--- import Data.TrieMap.Regular.TH
-import Data.TrieMap.TrieKey
-import Data.TrieMap.Applicative
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.TH
-
-import Control.Applicative
--- import Control.Arrow
-import Control.Monad
-
--- import Data.Either
--- import Data.Monoid
-
--- import Generics.MultiRec.Base
-data UnionMap m1 m2 k a = m1 k a :&: m2 k a
-
-type instance TrieMapT (f :+: g) = UnionMap (TrieMapT f) (TrieMapT g)
-type instance TrieMap ((f :+: g) r) = TrieMapT (f :+: g) r
-
--- type instance RepT (UnionMap m1 m2 k) = RepT (m1 k) :*: RepT (m2 k)
--- type instance Rep (UnionMap f g k a) = RepT (UnionMap f g k) (Rep a)
--- 
--- -- $(genRepT [d|
---    instance (ReprT (m1 k), ReprT (m2 k)) => ReprT (UnionMap m1 m2 k) where
--- 	toRepT (m1 :&: m2) = toRepT m1 :*: toRepT m2
--- 	fromRepT (m1 :*: m2) = fromRepT m1 :&: fromRepT m2 |])
-
-instance (TrieKeyT f m1, TrieKeyT g m2, TrieKey k (TrieMap k)) => TrieKey ((f :+: g) k) (UnionMap m1 m2 k) where
-	emptyM = emptyT
-	nullM = nullT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
-
-
-instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :+: g) (UnionMap m1 m2) where
-	emptyT = emptyT :&: emptyT
-	nullT (m1 :&: m2) = nullT m1 && nullT m2
-	sizeT s (m1 :&: m2) = sizeT s m1 + sizeT s m2
-	lookupT k (m1 :&: m2) = case k of
-		L k -> lookupT k m1
-		R k -> lookupT k m2
-	lookupIxT s k (m1 :&: m2) = case k of
-		L k | (lb, x, ub) <- onKey L (lookupIxT s k m1)
-			-> (lb, x, ub <|> fmap (onKeyA R . onIndexA (sizeT s m1 +)) (getMin m2))
-		R k | (lb, x, ub) <- onIndex (sizeT s m1 +) (onKey R (lookupIxT s k m2))
-			-> (fmap (onKeyA L) (getMax m1) <|> lb, x, ub)
-		where	getMin = aboutT (return .: Asc 0)
-			getMax m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m
-	assocAtT s i (m1 :&: m2)
-		| i < s1	= onKey L (assocAtT s i m1)
-		| otherwise	= onKey R (onIndex (s1 +) (assocAtT s (i - s1) m2))
-		where s1 = sizeT s m1
-{-	updateAtT s r f i (m1 :&: m2)
-		| not r, i >= maxIx m1
-				= m1 :&: updateAtT s r (\ i' -> f (i' + s1) . R) (i - s1) m2
-		| i < s1	= updateAtT s r (\ i' -> f i' . L) i m1 :&: m2
-		| otherwise	= m1 :&: updateAtT s r (\ i' -> f (i' + s1) . R) (i - s1) m2
-		where 	s1 = sizeT s m1
-			maxIx m = maybe (sizeT s m) fst $ getLast (extractMaxT s (\ _ v -> (sizeT s m - s v, Just v)) m)-}
-	alterT s f k (m1 :&: m2) = case k of
-		L k -> alterT s f k m1 :&: m2
-		R k -> m1 :&: alterT s f k m2
-	alterLookupT s f k (m1 :&: m2) = case k of
-		L k -> fmap (:&: m2) (alterLookupT s f k m1)
-		R k -> fmap (m1 :&:) (alterLookupT s f k m2)
-	traverseWithKeyT s f (m1 :&: m2) = (:&:) <$> traverseWithKeyT s (f . L) m1 <*> traverseWithKeyT s (f . R) m2
-	foldWithKeyT f (m1 :&: m2) = foldWithKeyT (f . L) m1 . foldWithKeyT (f . R) m2
-	foldlWithKeyT f (m1 :&: m2) = foldlWithKeyT (f . R) m2 . foldlWithKeyT (f . L) m1
-	mapEitherT s1 s2 f (m1 :&: m2) = case (mapEitherT s1 s2 (f . L) m1, mapEitherT s1 s2 (f . R) m2) of
-		((m1L, m1R), (m2L, m2R)) -> (m1L :&: m2L, m1R :&: m2R)
-	splitLookupT s f k (m1 :&: m2) = case k of
-		L k -> case splitLookupT s f k m1 of
-			(m1L, ans, m1R) -> (m1L :&: emptyT, ans, m1R :&: m2)
-		R k -> case splitLookupT s f k m2 of
-			(m2L, ans, m2R) -> (m1 :&: m2L, ans, emptyT :&: m2R)
-	unionT s f (m11 :&: m12) (m21 :&: m22) = unionT s (f . L) m11 m21 :&: unionT s (f . R) m12 m22
-	isectT s f (m11 :&: m12) (m21 :&: m22) = isectT s (f . L) m11 m21 :&: isectT s (f . R) m12 m22
-	diffT s f (m11 :&: m12) (m21 :&: m22) = diffT s (f . L) m11 m21 :&: diffT s (f . R) m12 m22
-	extractT s f (m1 :&: m2) = fmap (:&: m2) <$> extractT s (f . L) m1 <|>
-		fmap (m1 :&:) <$> extractT s (f . R) m2
--- 	extractMinT s f (m1 :&: m2) = second (:&: m2) <$> extractMinT s (f . L) m1 <|>
--- 		second (m1 :&:) <$> extractMinT s (f . R) m2
--- 	extractMaxT s f (m1 :&: m2) = second (:&: m2) <$> extractMaxT s (f . L) m1 <|>
--- 		second (m1 :&:) <$> extractMaxT s (f . R) m2
--- 	alterMinT s f (m1 :&: m2)
--- 		| nullT m1	= m1 :&: alterMinT s (f . R) m2
--- 		| otherwise	= alterMinT s (f . L) m1 :&: m2
--- 	alterMaxT s f (m1 :&: m2)
--- 		| nullT m2	= alterMaxT s (f . L) m1 :&: m2
--- 		| otherwise	= m1 :&: alterMaxT s (f . R) m2
-	isSubmapT (<=) (m11 :&: m12) (m21 :&: m22) = isSubmapT (<=) m11 m21 && isSubmapT (<=) m12 m22
-	fromListT s f xs = case partEithers xs of
-		(ys, zs) -> fromListT s (f . L) ys :&: fromListT s (f . R) zs
-	fromAscListT s f xs = case partEithers xs of
-		(ys, zs) -> fromAscListT s (f . L) ys :&: fromAscListT s (f . R) zs
-	fromDistAscListT s xs = case partEithers xs of
-		(ys, zs) -> fromDistAscListT s ys :&: fromDistAscListT s zs
diff --git a/Data/TrieMap/Regular/UnitMap.hs b/Data/TrieMap/Regular/UnitMap.hs
deleted file mode 100644
--- a/Data/TrieMap/Regular/UnitMap.hs
+++ /dev/null
@@ -1,90 +0,0 @@
-{-# LANGUAGE UndecidableInstances, TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-}
-
-module Data.TrieMap.Regular.UnitMap() where
-
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.TrieKey
--- import Data.TrieMap.Rep
--- import Data.TrieMap.Rep.Instances
--- import Data.TrieMap.Rep.TH
-import Data.TrieMap.Applicative
-
-import Control.Applicative
-import Control.Arrow
-import Control.Monad
-
-import Data.Foldable
-import Data.Maybe
-import Data.Monoid
-import Data.Traversable
-
-import Prelude hiding (foldr, foldl)
-
-newtype M k a = M (Maybe a)
-type instance TrieMapT U0 = M
-type instance TrieMap (U0 r) = M r
-
-instance TrieKey (U0 r) (M r) where
-	emptyM = M Nothing
-	nullM (M a) = isNothing a
-	sizeM s (M a) = maybe 0 s a
-	lookupM _ (M a) = a
-	lookupIxM s _ (M a) = (mzero, Asc 0 U0 <$> a, mzero)
-	assocAtM s i (M a)
-		| i < 0	= (mzero, mzero, Asc 0 U0 <$> First a)
-		| i > maybe 0 s a
-			= (Asc 0 U0 <$> Last a, mzero, mzero)
-		| otherwise
-			= (mzero, Asc 0 U0 <$> a, mzero)
--- 	updateAtM s r f i (M v) = case v of
--- 		Just a	| not r && i <= 0	-> M (v >>= f 0 U0)
--- 			| r && i >= 0		-> M (v >>= f 0 U0)
--- 		_ -> M v
-	alterM _ f _ (M a) = M (f a)
-	alterLookupM _ f _ (M a) = M <$> f a
-	traverseWithKeyM _ f (M a) = M <$> traverse (f U0) a
-	foldWithKeyM f (M a) z = foldr (f U0) z a
-	foldlWithKeyM f (M a) z = foldl (f U0) z a
-	mapEitherM _ _ f (M Nothing) = (M Nothing, M Nothing)
-	mapEitherM _ _ f (M (Just a)) = (M *** M) (f U0 a)
-	splitLookupM _ f _ (M a) = M `sides` maybe (Nothing, Nothing, Nothing) f a
-	unionM _ f (M a) (M b) = M (unionMaybe (f U0) a b)
-	isectM _ f (M a) (M b) = M (isectMaybe (f U0) a b)
-	diffM _ f (M a) (M b) = M (diffMaybe (f U0) a b)
-	extractM _ f (M a) = maybe empty (fmap M <.> f U0) a
--- 	extractMinM _ f (M a) = fmap (second M . f U0) (First a)
--- 	extractMaxM _ f (M a) = fmap (second M . f U0) (Last a)
--- 	alterMinM _ f (M a) = M (a >>= f U0)
--- 	alterMaxM = alterMinM
-	isSubmapM (<=) (M a) (M b) = subMaybe (<=) a b
-	fromListM _ f = M . foldr (\ (_, a) -> Just . maybe a (f U0 a)) Nothing
-	fromDistAscListM _ = M . fmap snd . listToMaybe
-
-instance TrieKeyT U0 M where
-	emptyT = emptyM
-	nullT = nullM
-	sizeT = sizeM
-	lookupT = lookupM
-	lookupIxT = lookupIxM
-	assocAtT = assocAtM
--- 	updateAtT = updateAtM
-	alterT = alterM
-	alterLookupT = alterLookupM
-	traverseWithKeyT = traverseWithKeyM
-	foldWithKeyT = foldWithKeyM
-	foldlWithKeyT = foldlWithKeyM
-	mapEitherT = mapEitherM
-	splitLookupT = splitLookupM
-	unionT = unionM
-	isectT = isectM
-	diffT = diffM
-	extractT = extractM
--- 	extractMinT = extractMinM
--- 	extractMaxT = extractMaxM
--- 	alterMinT = alterMinM
--- 	alterMaxT = alterMaxM
-	isSubmapT = isSubmapM
-	fromListT = fromListM
-	fromAscListT = fromAscListM
-	fromDistAscListT = fromDistAscListM
diff --git a/Data/TrieMap/Rep.hs b/Data/TrieMap/Rep.hs
--- a/Data/TrieMap/Rep.hs
+++ b/Data/TrieMap/Rep.hs
@@ -2,14 +2,13 @@
 
 module Data.TrieMap.Rep where
 
-type family Rep a
-type family RepT (f :: * -> *) :: * -> *
-
 class Repr a where
+	type Rep a
 	toRep :: a -> Rep a
 	fromRep :: Rep a -> a
 
 class Functor (RepT f) => ReprT f where
+	type RepT f :: * -> *
 	toRepT :: f a -> RepT f a
 	fromRepT :: RepT f a -> f a
 	toRepTMap :: (a -> b) -> f a -> RepT f b
diff --git a/Data/TrieMap/Rep/Instances.hs b/Data/TrieMap/Rep/Instances.hs
--- a/Data/TrieMap/Rep/Instances.hs
+++ b/Data/TrieMap/Rep/Instances.hs
@@ -1,28 +1,23 @@
-{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies, TypeOperators, TemplateHaskell, NPlusKPatterns #-}
+{-# LANGUAGE RankNTypes, FlexibleContexts, UndecidableInstances, TypeFamilies, TypeOperators, TemplateHaskell, NPlusKPatterns #-}
+{-# OPTIONS -funbox-strict-fields #-}
 
 module Data.TrieMap.Rep.Instances()  where
 
 import Data.TrieMap.Rep
 import Data.TrieMap.Rep.TH
-import Data.TrieMap.Regular.Base
--- import Data.TrieMap.OrdMap
 import Data.TrieMap.Modifiers
--- import Language.Haskell.TH
 
-import Control.Arrow
-
 import Data.Char
 import Data.Int
 import Data.Word
 import Data.Foldable (toList)
 import Data.Bits
-import Data.Array.IArray
 import qualified Data.IntSet as ISet
 import qualified Data.IntMap as IMap
 import Data.ByteString hiding (map)
 import qualified Data.ByteString as BS
 
-import Data.Sequence (Seq, (|>))
+import Data.Sequence ((|>))
 import qualified Data.Sequence as Seq
 import qualified Data.Foldable as Fold
 
@@ -34,132 +29,87 @@
 type Pair a = (,) a
 type Sum a = Either a
 
-type instance RepT Rev = Rev
-type instance Rep (Rev a) = Rev (Rep a)
-
-$(genRepT [d|
-   instance ReprT Rev where
-	toRepTMap f (Rev a) = Rev (f a)
-	fromRepTMap f (Rev a) = Rev (f a) |])
-
-type instance RepT Maybe = Sum ()
-type instance Rep (Maybe a) = RepT Maybe (Rep a)
-
-$(genRepT [d|
-   instance ReprT Maybe where
-	toRepTMap f = maybe (Left ()) (Right . f)
-	fromRepTMap f = either (const Nothing) (Just . f) |])
+instance ReprT Rev where
+  type RepT Rev = Rev
+  toRepTMap = fmap
+  fromRepTMap = fmap
 
-type instance RepT [] = []
-type instance Rep [a] = [Rep a]
+genRepr [t| Rev |]
 
-$(genRepT [d| 
-   instance ReprT [] where
+instance ReprT [] where
+	type RepT [] = []
 	toRepTMap = map
-	fromRepTMap = map |])
-
-type instance RepT ((,) a) = Pair (Rep a)
-type instance Rep (a, b) = RepT ((,) a) (Rep b)
-
-$(genRepT [d|
-    instance Repr a => ReprT ((,) a) where
-	toRepTMap f = toRep *** f
-	fromRepTMap f = fromRep *** f |])
-
--- instance (ReprT ((,) a), Repr b) => Repr ((,) a b) where
-
--- instance (Repr a, Repr b) => Repr (a, b) where
--- 	toRep = fmap toRep . toRepT
--- 	fromRep = fromRepT . fmap fromRep
-
-type instance RepT ((,,) a b) = K0 (Rep a) :*: K0 (Rep b) :*: I0
-type instance Rep (a, b, c) = RepT ((,,) a b) (Rep c)
-
-$(genRepT [d|
-   instance (Repr a, Repr b) => ReprT ((,,) a b) where
-	toRepTMap f (a, b, c) = K0 (toRep a) :*: K0 (toRep b) :*: I0 (f c)
-	fromRepTMap f (K0 a :*: K0 b :*: I0 c) = (fromRep a, fromRep b, f c) |])
-
-type instance RepT ((,,,) a b c) = K0 (Rep a) :*: K0 (Rep b) :*: K0 (Rep c) :*: I0
-type instance Rep (a, b, c, d) = RepT ((,,,) a b c) (Rep d)
-
-$(genRepT [d|
-   instance (Repr a, Repr b, Repr c) => ReprT ((,,,) a b c) where
-	toRepTMap f (a, b, c, d) = K0 (toRep a) :*: K0 (toRep b) :*: K0 (toRep c) :*: I0 (f d)
-	fromRepTMap f (K0 a :*: K0 b :*: K0 c :*: I0 d) = (fromRep a, fromRep b, fromRep c, f d) |])
+	fromRepTMap = map
 
-type instance RepT (Either a) = Sum (Rep a)
-type instance Rep (Either a b) = RepT (Either a) (Rep b)
+genRepr [t| [] |]
 
-$(genRepT [d|
-  instance Repr a => ReprT (Either a) where
-	toRepTMap f = either (Left . toRep) (Right . f)
-	fromRepTMap f = either (Left . fromRep) (Right . f) |])
+genTupleRepr 2
+genTupleRepr 3
+genTupleRepr 4
+genTupleRepr 5
+genTupleRepr 6
+genTupleRepr 7
+genTupleRepr 8
 
-type instance Rep Bool = Sum () ()
-instance Repr Bool where
-	toRep False = Left ()
-	toRep True = Right ()
-	fromRep = either (const False) (const True)
+instance (Repr a, Repr b) => Repr (Either a b) where
+  type Rep (Either a b) = Either (Rep a) (Rep b)
+  toRep (Left a) = Left (toRep a)
+  toRep (Right b) = Right (toRep b)
+  fromRep (Left a) = Left (fromRep a)
+  fromRep (Right b) = Right (fromRep b)
 
-type instance Rep Char = Word32
 instance Repr Char where
+	type Rep Char = Word32
 	toRep = fromIntegral . ord
 	fromRep = chr . fromIntegral
 
-type instance Rep () = ()
 instance Repr () where
+	type Rep () = ()
 	toRep _ = ()
 	fromRep _ = ()
 
-type instance Rep Double = Ordered Double
-instance Repr Double where
-	toRep = Ord
-	fromRep = unOrd
-
-type instance Rep Int = Rep Int32
 instance Repr Int where
+	type Rep Int = Rep Int32
 	toRep = toSigned
 	fromRep = fromSigned
 
-type instance Rep Word8 = Word32
 instance Repr Word8 where
+	type Rep Word8 = Word32
 	toRep = fromIntegral
 	fromRep = fromIntegral
 
-type instance Rep Word16 = Word32
 instance Repr Word16 where
+	type Rep Word16 = Word32
 	toRep = fromIntegral
 	fromRep = fromIntegral
 
-type instance Rep Word = Word32
 instance Repr Word where
+	type Rep Word = Word32
 	toRep = fromIntegral
 	fromRep = fromIntegral
 
-type instance Rep Int8 = Rep Int32
-
 instance Repr Int8 where
+	type Rep Int8 = Rep Int32
 	toRep = toSigned
 	fromRep = fromSigned
 
-type instance Rep Int16 = Rep Int32
 instance Repr Int16 where
+	type Rep Int16 = Rep Int32
 	toRep = toSigned
 	fromRep = fromSigned
 
-type instance Rep Int32 = Sum (Rev Word32) Word32
 instance Repr Int32 where
+	type Rep Int32 = Sum (Rev Word32) Word32
 	toRep = toSigned
 	fromRep = fromSigned
 
-type instance Rep Word64 = Pair Word32 Word32
 instance Repr Word64 where
+	type Rep Word64 = Pair Word32 Word32
 	toRep x = (fromIntegral (x `shiftR` 32), fromIntegral x)
 	fromRep (x, y) = fromIntegral x `shiftL` 32 .|. fromIntegral y
 
-type instance Rep Int64 = Sum (Rev (Rep Word64)) (Rep Word64)
 instance Repr Int64 where
+	type Rep Int64 = Sum (Rev (Rep Word64)) (Rep Word64)
 	toRep x | x < 0	= Left (Rev (toRep' (fromIntegral (-x))))
 		| otherwise = Right (toRep' (fromIntegral x))
 		where toRep' = toRep :: Word64 -> Rep Word64
@@ -176,27 +126,25 @@
 fromSigned :: Integral a => Sum (Rev Word32) Word32 -> a
 fromSigned = either (\ (Rev x) -> - fromIntegral x) fromIntegral
 
-type instance Rep Word32 = Word32
 instance Repr Word32 where
+	type Rep Word32 = Word32
 	toRep = id
 	fromRep = id
 
-type instance Rep ByteString = ([] :*: I0) Word32
 instance Repr ByteString where
-	toRep xs = toList64 xs :*: I0 (fromIntegral (length xs))
-	fromRep (xs :*: I0 n) = case xs of
+	type Rep ByteString = ([Word32], Word32)
+	toRep xs = (toList64 xs, fromIntegral (length xs))
+	fromRep (xs, n) = case xs of
 		[]	-> BS.empty
 		(x:xs) -> fst (unfoldrN (fromIntegral n) toBlock (W (Words 3 x) xs))
 
-data Words = Words {ix :: {-# UNPACK #-} !Int, word32 :: {-# UNPACK #-} !Word32}
-data Words' = W {-# UNPACK #-} !Words [Word32]
+data Words = Words !Int !Word32
+data Words' = W !Words [Word32]
 
 toList64 :: ByteString -> [Word32]
-toList64 xs = case BS.foldl c (Words 4 0, Seq.empty) xs of
-	(Words i w32, ys) -> toList ys ++ [w32]
-	where	fS :: Word8 -> Int -> Word32
-		fS w x = fromIntegral w `shiftL` x
-		(Words 0 w, xs) `c` w8
+toList64 xs = case BS.foldl' c (Words 4 0, Seq.empty) xs of
+	(Words _ w32, ys) -> toList ys ++ [w32]
+	where	(Words 0 w, xs) `c` w8
 			= (Words 3 (w .|. sL w8 24), xs |> w)
 		(Words i' w, xs) `c` w8
 			= let !i = i' - 1 in (Words i (w .|. sL w8 (8 * i)), xs)
@@ -210,58 +158,31 @@
 toBlock (W (Words 0 w) (x:xs)) = Just (fromIntegral w, (W (Words 3 x) xs))
 toBlock _ = Nothing
 
-type instance RepT (Array i) = L (Pair (Rep i)) :*: K0 (Pair (Rep i) (Rep i))
-type instance Rep (Array i e) = RepT (Array i) (Rep e)
-
-$(genRepT [d| 
-   instance (Repr i, Ix i) => ReprT (Array i) where
-	toRepTMap f arr = List [(toRep i, f a) | (i, a) <- assocs arr] :*: K0 (toRep l, toRep u)
-		where (l, u) = bounds arr
-	fromRepTMap f (List xs :*: K0 (l, r))
-		= array (fromRep l, fromRep r) [(fromRep k, f a) | (k, a) <- xs] |])
-
-type instance RepT Set.Set = []
-type instance RepT (Map.Map k) = L (Pair (Rep k))
-type instance Rep (Set.Set a) = [Rep a]
-type instance Rep (Map.Map k a) = RepT (Map.Map k) (Rep a)
-
-$(genRepT [d|
-   instance ReprT Set.Set where
-	toRepTMap f s = Fold.foldr ((:) . f) [] s
-	fromRepTMap f xs = Set.fromDistinctAscList [f x | x <- xs] |])
-
-$(genRepT [d|
-   instance Repr k => ReprT (Map.Map k) where
-	toRepTMap f m = List (Map.foldWithKey (\ k a xs -> (toRep k, f a):xs) [] m)
-	fromRepTMap f (List xs) = Map.fromDistinctAscList [(fromRep k, f x) | (k, x) <- xs] |])
-
-type instance RepT Rev = Rev
-type instance Rep (Rev a) = Rev (Rep a)
+instance ReprT Set.Set where
+  type RepT Set.Set = []
+  toRepTMap f s = Fold.foldr ((:) . f) [] s
+  fromRepTMap f xs = Set.fromDistinctAscList [f x | x <- xs] 
 
--- -- $(genRepT [d|
---    instance ReprT Rev where
---    	toRepTMap f (Rev m) = Rev (f m)
--- 	fromRepTMap f (Rev m) = Rev (f m) |])
+genRepr [t| Set.Set |]
 
-type instance Rep ISet.IntSet = Rep [Int]
-type instance RepT IMap.IntMap = L (Pair (Rep Int))
-type instance Rep (IMap.IntMap a) = RepT IMap.IntMap (Rep a)
+instance (Repr k, Repr a) => Repr (Map.Map k a) where
+  type Rep (Map.Map k a) = [(Rep k, Rep a)]
+  toRep m = [(toRep k, toRep a) | (k, a) <- Map.assocs m]
+  fromRep xs = Map.fromDistinctAscList [(fromRep k, fromRep a) | (k, a) <- xs]
 
 instance Repr ISet.IntSet where
-	toRep = toRep . ISet.toList
-	fromRep = ISet.fromDistinctAscList . fromRep
-
-
-type instance RepT Seq.Seq = []
-type instance Rep (Seq.Seq a) = [Rep a]
-
--- type instance Rep (Rev a) = Rev (Rep a)
+  type Rep ISet.IntSet = Rep [Int]
+  toRep = toRep . ISet.toList
+  fromRep = ISet.fromDistinctAscList . fromRep
 
-$(genRepT [d|
-   instance ReprT Seq.Seq where
-	toRepTMap f = Fold.foldr (\ a xs -> f a:xs) []
-	fromRepTMap f = Fold.foldl (\ xs a -> xs |> f a) Seq.empty |])
+instance Repr a => Repr (IMap.IntMap a) where
+  type Rep (IMap.IntMap a) = [(Rep Int, Rep a)]
+  toRep m = [(toRep i, toRep a) | (i, a) <- IMap.assocs m]
+  fromRep xs = IMap.fromDistinctAscList [(fromRep i, fromRep a) | (i, a) <- xs]
 
+instance ReprT Seq.Seq where
+  type RepT Seq.Seq = []
+  toRepTMap f = Fold.foldr (\ a xs -> f a:xs) []
+  fromRepTMap f = Fold.foldl (\ xs a -> xs |> f a) Seq.empty
 
--- instance Functor Rev where
--- 	fmap f (Rev a) = Rev (f a)
+genRepr [t| Seq.Seq |]
diff --git a/Data/TrieMap/Rep/TH.hs b/Data/TrieMap/Rep/TH.hs
--- a/Data/TrieMap/Rep/TH.hs
+++ b/Data/TrieMap/Rep/TH.hs
@@ -1,50 +1,38 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, TemplateHaskell, QuasiQuotes #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, TemplateHaskell, QuasiQuotes, UndecidableInstances #-}
 
-module Data.TrieMap.Rep.TH (genRepT, mkCon, conT, mkVar, appT, Type(..)) where
+module Data.TrieMap.Rep.TH where
 
 import Language.Haskell.TH
 import Data.TrieMap.Rep
--- import Language.Haskell.TH.Ppr
--- import Debug.Trace
-{-
-genRepT ::  TypeQ -> Q [Dec]
-genRepT ff = do
-	f <- ff
-	a <- newName "a"
-	b <- newName "b"
-	g <- newName "g"
-	let reprt = ConT (mkName "ReprT")
-	let repr = ConT (mkName "Repr")
-	let rept = ConT (mkName "RepT")
-	let rep = ConT (mkName "Rep")
-	torep <- [| fmap toRep . toRepT |]
-	fromrep <- [| fromRepT . fmap fromRep |]
-	let toRepType = ForallT [g, b] [AppT reprt (VarT g), AppT repr (VarT b)]
-		(AppT (VarT g) (VarT b) ~> AppT (AppT rept (VarT g)) (AppT rep (VarT b)))
-	let fromRepType = ForallT [g, b] [AppT reprt (VarT g), AppT repr (VarT b)] 
-		(AppT (AppT rept (VarT g)) (AppT rep (VarT b)) ~> AppT (VarT g) (VarT b))
-	let ans = [InstanceD [AppT reprt f, AppT repr (VarT a)] (AppT repr (AppT f (VarT a)))
-		[FunD (mkName "toRep") [Clause [] (NormalB ( torep )) []],
-			FunD (mkName "fromRep") [Clause [] (NormalB ( fromrep )) []]]]
-	return ans-}
 
-genRepT :: Q [Dec] -> Q [Dec]
-genRepT decs = do
-	iT@(InstanceD cxt (reprt `AppT` f) _:_) <- decs
-	let myDecs = [ValD (VarP 'toRep) (NormalB (AppE (VarE 'toRepTMap) (VarE 'toRep))) [],
-		ValD (VarP 'fromRep) (NormalB (AppE (VarE 'fromRepTMap) (VarE 'fromRep))) []]
-	a <- mkVar "a"
-	return (InstanceD (ClassP ''Repr [a]:cxt) (ConT ''Repr `AppT` (f `AppT` a)) myDecs :iT)
-
-(~>) :: Type -> Type -> Type
-a ~> b = AppT (AppT ArrowT a) b
-
-mkCon :: String -> TypeQ
-mkCon = conT . mkName
-
-mkVar :: String -> TypeQ
-mkVar x = varT =<< newName x
+genRepr :: Q Type -> Q [Dec]
+genRepr typ = do
+  t <- typ
+  let a = VarT (mkName "a")
+  toRepImpl <- [| toRepTMap toRep |]
+  fromRepImpl <- [| fromRepTMap fromRep |]
+  return [InstanceD [ClassP ''Repr [a]]
+		(ConT ''Repr `AppT` (t `AppT` a))
+		[TySynInstD ''Rep [t `AppT` a] ((ConT ''RepT `AppT` t) `AppT` (ConT ''Rep `AppT` a)),
+			ValD (VarP 'toRep)
+				(NormalB toRepImpl) [],
+			ValD (VarP 'fromRep)
+				(NormalB fromRepImpl) []]]
 
--- f :: Q [Dec]
--- f = do	ans <- [d| instance (ReprT ((,) a), Repr b) => Repr (a, b) where |]
--- 	traceShow ans $ return ans
+genTupleRepr :: Int -> Q [Dec]
+genTupleRepr n = do
+  let ts = [mkName [a] | a <- take n ['a'..]]
+  xs <- sequence [newName [a] | a <- take n ['a'..]]
+  xReps <- sequence [newName (a:"Rep") | a <- take n ['a'..]]
+  let toR = 'toRep
+  let fromR = 'fromRep
+  let tupleT = foldl AppT (TupleT n) [VarT t | t <- ts]
+  return [InstanceD [ClassP ''Repr [VarT t] | t <- ts]
+    (ConT ''Repr `AppT` tupleT)
+    [TySynInstD ''Rep [tupleT] (foldl AppT (TupleT n) [ConT ''Rep `AppT` VarT t | t <- ts]),
+	FunD toR
+	  [Clause [TupP [VarP x | x <- xs]]
+	    (NormalB (TupE [VarE toR `AppE` VarE x |  x <- xs])) []],
+	FunD fromR
+	  [Clause [TupP [VarP xRep | xRep <- xReps]]
+	    (NormalB (TupE [VarE fromR `AppE` VarE xRep | xRep <- xReps])) []]]]
diff --git a/Data/TrieMap/Representation.hs b/Data/TrieMap/Representation.hs
--- a/Data/TrieMap/Representation.hs
+++ b/Data/TrieMap/Representation.hs
@@ -1,14 +1,42 @@
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-module Data.TrieMap.Representation (Repr(..), ReprT(..), Rep, RepT) where
+{-# LANGUAGE TypeFamilies, TemplateHaskell, UndecidableInstances #-}
+module Data.TrieMap.Representation (Repr(..)) where
 
+import Data.TrieMap.Sized
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Class
 import Data.TrieMap.Rep
-import Data.TrieMap.Rep.Instances
-import Data.TrieMap.Rep.TH
-import Data.TrieMap.Regular.Rep
-import Data.TrieMap.Regular.Base
-import qualified Data.IntMap as IMap
+import Data.TrieMap.Rep.Instances ()
+import Data.TrieMap.Representation.TH
 
-$(genRepT [d|
-   instance ReprT IMap.IntMap where
-   	toRepTMap f m = List [(toRep k, f a) | (k, a) <- IMap.assocs m]
-	fromRepTMap f (List xs) = IMap.fromDistinctAscList [(fromRep k, f a) | (k, a) <- xs] |])
+import Data.Complex
+import Data.Tree
+import Data.Ratio
+import Foreign.C.Types
+
+instance (TKey k, Repr a) => Repr (TMap k a) where
+	type Rep (TMap k a) = [(Rep k, Rep a)]
+	toRep (TMap m) = foldWithKeyM (\ k (Elem a) xs -> (k, toRep a):xs) m []
+	fromRep xs = TMap (fromDistAscListM (const 1) [(k, Elem (fromRep a)) | (k, a) <- xs])
+
+genOrdRepr ''Float
+genOrdRepr ''Double
+genRepr ''Bool
+genRepr ''Tree
+genRepr ''Ratio
+genRepr ''Maybe
+genRepr ''Complex
+genRepr ''CInt
+genRepr ''CChar
+genRepr ''CSChar
+genRepr ''CUChar
+genRepr ''CShort
+genRepr ''CUShort
+genRepr ''CUInt
+genRepr ''CLong
+genRepr ''CULong
+genRepr ''CLLong
+genRepr ''CULLong
+genRepr ''CClock
+genRepr ''CTime
+genRepr ''CFloat
+genRepr ''CDouble
diff --git a/Data/TrieMap/Representation/TH.hs b/Data/TrieMap/Representation/TH.hs
--- a/Data/TrieMap/Representation/TH.hs
+++ b/Data/TrieMap/Representation/TH.hs
@@ -1,16 +1,12 @@
 {-# LANGUAGE TemplateHaskell, QuasiQuotes, PatternGuards, DoAndIfThenElse #-}
 
-module Data.TrieMap.Representation.TH (genRepr) where
+module Data.TrieMap.Representation.TH (genRepr, genOrdRepr) where
 
-import Data.TrieMap.Rep.TH
+import Data.TrieMap.Modifiers
 import Data.TrieMap.Rep
-import Data.TrieMap.Regular.Base
-import Data.TrieMap.Key
-import Data.TrieMap.Rep.Instances
+import Data.TrieMap.Rep.Instances ()
 import Language.Haskell.TH
 import Language.Haskell.TH.ExpandSyns
-import Control.Arrow
-import Control.Monad
 
 data ToRepCase = ToRepCase [Pat] Exp
 data FromRepCase = FromRepCase Pat [Exp]
@@ -19,28 +15,56 @@
 
 type Representation = (Type, ToRep, FromRep)
 
--- | Given the name of a type constructor, automatically generates an efficient 'Repr' instance.  /Warning/: Generalized tries do not work for "infinitely complicated types," for example, a type-system construction of the natural numbers.
--- In these cases, a context reduction stack overflow will occur at compile time when you use the 'TKey' instance for that type.
+-- | Given a type with an associated 'Ord' instance, generates a representation that will cause its 'TMap'
+-- implementation to be essentially equivalent to "Data.Map".
+genOrdRepr :: Name -> Q [Dec]
+genOrdRepr tycon = do
+	TyConI dec <- reify tycon
+	let theTyp = foldl AppT (ConT tycon) . map tyVarBndrType
+	case dec of
+		DataD cxt _ tyvars _ _ -> do
+			repr <- ordRepr (theTyp tyvars)
+			return (decsForRepr cxt (theTyp tyvars) repr)
+		NewtypeD cxt _ tyvars _ _ -> do
+			repr <- ordRepr (theTyp tyvars)
+			return (decsForRepr cxt (theTyp tyvars) repr)
+		_	-> fail ("Cannot generate Repr instance for " ++ pprint dec)
+
+ordRepr :: Type -> Q Representation
+ordRepr t0 = do
+	x <- newName "x"
+	return (ConT ''Ordered `AppT` t0, 
+			[ToRepCase [VarP x] (ConE 'Ord `AppE` VarE x)],
+			[FromRepCase (ConP 'Ord [VarP x])
+				[VarE x]])
+	
+
+-- | Given the name of a type constructor, automatically generates an efficient 'Repr' instance.  
+-- /Warning/: Generalized tries do not work for "infinitely complicated types," for example, a
+-- type-system construction of the natural numbers.  In these cases, a context reduction stack
+-- overflow will occur at compile time when you use the 'TKey' instance for that type.
 genRepr :: Name -> Q [Dec]
 genRepr tycon = do
 	TyConI dec <- reify tycon
+	let theTyp = foldl AppT (ConT tycon) . map tyVarBndrType
 	case dec of
-		DataD _ _ tyvars cons _ -> do
+		DataD cxt _ tyvars cons _ -> do
 			conReprs <- mapM conRepr cons
-			return (decsForRepr (foldl AppT (ConT tycon) (map tyVarBndrType tyvars)) (foldr1 union conReprs))
-		NewtypeD _ _ tyvars con _ -> do
+			return (decsForRepr cxt (theTyp tyvars) (foldr1 union conReprs))
+		NewtypeD cxt _ tyvars con _ -> do
 			theConRepr <- conRepr con
-			return (decsForRepr (foldl AppT (ConT tycon) (map tyVarBndrType tyvars)) theConRepr)
+			return (decsForRepr cxt (theTyp tyvars) theConRepr)
+		_	-> fail ("Cannot generate Repr instance for " ++ pprint dec)
 
 tyVarBndrType :: TyVarBndr -> Type
 tyVarBndrType (PlainTV tyvar) = VarT tyvar
 tyVarBndrType (KindedTV tyvar _) = VarT tyvar
 
-decsForRepr :: Type -> Representation -> [Dec]
-decsForRepr t (tRep, toR, fromR) = [
-		TySynInstD ''Rep [t] tRep,
-		InstanceD [] (ConT ''Repr `AppT` t)
-			[FunD 'toRep
+decsForRepr :: Cxt -> Type -> Representation -> [Dec]
+decsForRepr cxt t (tRep, toR, fromR) = [
+		InstanceD cxt (ConT ''Repr `AppT` t)
+			[TySynInstD ''Rep [t] tRep,
+			 FunD 'toRep
 				[Clause pats (NormalB e) [] | ToRepCase pats e <- toR],
 			 FunD 'fromRep
 				[Clause [pat] (NormalB e) [] | FromRepCase pat [e] <- fromR]]]
@@ -59,6 +83,7 @@
 conRepr (NormalC con args) = do
 	argCons <- mapM (typeRepr . snd) args
 	return (conify con (foldr1 prod argCons))
+conRepr con = fail ("Cannot generate representation for existential constructor " ++ pprint con)
 
 typeRepr :: Type -> ReprM Representation
 typeRepr t00 = expandSyns t00 >>= \ t0 -> case decompose t0 of
@@ -76,7 +101,7 @@
 				[CompE [BindS (VarP xRep) (VarE xsRep),
 					NoBindS (CaseE (VarE xRep) [Match pat (NormalB e) [] | FromRepCase pat [e] <- fromR])]]])
 	(TupleT 0, _)	-> return unit
-	(TupleT n, ts)	-> do
+	(TupleT _, ts)	-> do
 		reps <- mapM typeRepr ts
 		let (tRep, toR, fromR) = foldr1 prod reps
 		return (tRep, [ToRepCase [TupP pats] e | ToRepCase pats e <- toR], [FromRepCase pat [TupE es] | FromRepCase pat es <- fromR])
@@ -90,16 +115,9 @@
 						[ToRepCase [ConP 'Right pats] (ConE 'Right `AppE` e) | ToRepCase pats e <- rToR],
 					[FromRepCase (ConP 'Left [pat]) [ConE 'Left `AppE` e] | FromRepCase pat [e] <- lFromR] ++
 						[FromRepCase (ConP 'Right [pat]) [ConE 'Right `AppE` e] | FromRepCase pat [e] <- rFromR])
-		| con == ''Maybe, [t] <- ts
-			-> do	(tRep, toR, fromR) <- typeRepr t
-				return (ConT ''Either `AppT` TupleT 0 `AppT` tRep,
-					[ToRepCase [ConP 'Nothing []] (ConE 'Left `AppE` TupE [])] ++
-						[ToRepCase [ConP 'Just pats] (ConE 'Right `AppE` e) | ToRepCase pats e <- toR],
-					[FromRepCase (RecP 'Left []) [ConE 'Nothing]] ++
-						[FromRepCase (ConP 'Right [pat]) [ConE 'Just `AppE` e] | FromRepCase pat [e] <- fromR])
-		| otherwise -> do
-					ClassI _ instances <- reify ''Repr
+		| otherwise -> do	ClassI _ instances <- reify ''Repr
 					let knowns = [tycon | ClassInstance{ci_tys = [ConT tycon]} <- instances]
+					-- TODO: recognize preexisting higher-arity instances
 					if con `elem` knowns && null ts then do
 						arg <- newName "arg"
 						argRep <- newName "argRep"
@@ -109,10 +127,6 @@
 					else recursiveRepr t0
 	_	-> recursiveRepr t0
 
-tyVarBndrName :: TyVarBndr -> Name
-tyVarBndrName (PlainTV n) = n
-tyVarBndrName (KindedTV n _) = n
-
 recursiveRepr :: Type -> ReprM Representation
 recursiveRepr t0 = do	-- TODO: handle type synonyms here
 		x <- newName "arg"
@@ -136,7 +150,8 @@
 
 conify :: Name -> Representation -> Representation
 conify conName (t, toR, fromR) =
-	(t, [ToRepCase [ConP conName args] e | ToRepCase args e <- toR], [FromRepCase p [foldl AppE (ConE conName) outs] | FromRepCase p outs <- fromR])
+	(t, [ToRepCase [ConP conName args] e | ToRepCase args e <- toR], 
+		[FromRepCase p [foldl AppE (ConE conName) outs] | FromRepCase p outs <- fromR])
 
 union :: Representation -> Representation -> Representation
 union (t1, toRep1, fromRep1)
@@ -146,6 +161,3 @@
 		[ToRepCase pats (ConE 'Right `AppE` e) | ToRepCase pats e <- toRep2],
 		[FromRepCase (ConP 'Left [pat]) es | FromRepCase pat es <- fromRep1] ++
 		[FromRepCase (ConP 'Right [pat]) es | FromRepCase pat es <- fromRep2])
-
--- genRepInstance :: Type -> Representationesentation -> Q Dec
--- genInstance
diff --git a/Data/TrieMap/ReverseMap.hs b/Data/TrieMap/ReverseMap.hs
--- a/Data/TrieMap/ReverseMap.hs
+++ b/Data/TrieMap/ReverseMap.hs
@@ -1,85 +1,41 @@
-{-# LANGUAGE TemplateHaskell, UndecidableInstances, TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}
+{-# LANGUAGE UnboxedTuples, TypeFamilies #-}
 
 module Data.TrieMap.ReverseMap (reverse, unreverse) where
 
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Modifiers
 import Data.TrieMap.Applicative
-import Data.TrieMap.Regular.Class
-import Data.TrieMap.Regular.TH
 
 import Control.Applicative
-import Control.Arrow
 
-import Data.Monoid hiding (Dual)
-
 import Prelude hiding (reverse)
 import qualified Data.List as L
 
-newtype ReverseMap k a = RMap (TrieMap k a)
-
-type instance TrieMapT Rev = ReverseMap
-type instance TrieMap (Rev k) = ReverseMap k
-
-instance TrieKey k (TrieMap k) => TrieKey (Rev k) (ReverseMap k) where
-	emptyM = emptyT
-	nullM = nullT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
-
-
-instance TrieKeyT Rev ReverseMap where
-	emptyT = RMap emptyM
-	nullT (RMap m) = nullM m
-	sizeT s (RMap m) = sizeM s m
-	lookupT (Rev k) (RMap m) = lookupM k m
-	lookupIxT s (Rev k) (RMap m) = case lookupIxM s k m of
-		(Last lb, x, First ub) -> onKey Rev (onIndex (sizeM s m - 1 -) (Last ub, x, First lb))
-	assocAtT s i (RMap m) = case assocAtM s (sz - 1 - i) m of
-		(Last lb, x, First ub) -> onKey Rev (onIndex (sz -) (Last ub, x, First lb))
-		where 	sz = sizeM s m
--- 	updateAtM s r f i (RMap m) = RMap (updateAtM s r' f' (sz - i) m) where
--- 		r' = not r
--- 		f' i = f (sz - 1 - i) . Rev
--- 		sz = sizeM s m
-	traverseWithKeyT s f (RMap m) = RMap <$> runDual (traverseWithKeyM s (\ k a -> Dual (f (Rev k) a)) m)
-	alterT s f (Rev k) (RMap m) = RMap (alterM s f k m)
-	alterLookupT s f (Rev k) (RMap m) = RMap <$> alterLookupM s f k m
-	splitLookupT s f (Rev k) (RMap m) = case splitLookupM s f' k m of
-		(mL, x, mR) -> (RMap mR, x, RMap mL)
+instance TrieKey k => TrieKey (Rev k) where
+	newtype TrieMap (Rev k) a = RMap (TrieMap k a)
+	emptyM = RMap emptyM
+	singletonM s (Rev k) a = RMap (singletonM s k a)
+	nullM (RMap m) = nullM m
+	sizeM s (RMap m) = sizeM s m
+	lookupM (Rev k) (RMap m) = lookupM k m
+	traverseWithKeyM s f (RMap m) = RMap <$> runDual (traverseWithKeyM s (\ k a -> Dual (f (Rev k) a)) m)
+	alterM s f (Rev k) (RMap m) = RMap (alterM s f k m)
+	alterLookupM s f (Rev k) (RMap m) = onUnboxed RMap (alterLookupM s f k) m
+	splitLookupM s f (Rev k) (RMap m) = sides RMap (splitLookupM s f' k) m
 		where f' x = case f x of
-			(xL, ans, xR) -> (xR, ans, xL)
-	mapEitherT s1 s2 f (RMap m) = (RMap *** RMap) (mapEitherM s1 s2 (f . Rev) m)
-	foldWithKeyT f (RMap m) = foldlWithKeyM (flip . f . Rev) m
-	foldlWithKeyT f (RMap m) = foldWithKeyM (flip . f . Rev) m
-	unionT s f (RMap m1) (RMap m2) = RMap (unionM s (f . Rev) m1 m2)
-	isectT s f (RMap m1) (RMap m2) = RMap (isectM s (f . Rev) m1 m2)
-	diffT s f (RMap m1) (RMap m2) = RMap (diffM s (f . Rev) m1 m2)
-	extractT s f (RMap m) = fmap RMap <$> runDual (extractM s (\ k a -> Dual (f (Rev k) a)) m)
--- 	extractMinM s f (RMap m) = second RMap <$> First (getLast (extractMaxM s (f . Rev) m))
--- 	extractMaxM s f (RMap m) = second RMap <$> Last (getFirst (extractMinM s (f . Rev) m))
--- 	alterMinM s f (RMap m) = RMap (alterMaxM s (f . Rev) m)
--- 	alterMaxM s f (RMap m) = RMap (alterMinM s (f . Rev) m)
-	isSubmapT (<=) (RMap m1) (RMap m2) = isSubmapM (<=) m1 m2
-	fromListT s f xs = RMap (fromListM s (f . Rev) [(k, a) | (Rev k, a) <- xs])
-	fromAscListT s f xs = RMap (fromAscListM s (\ k -> flip (f (Rev k))) [(k, a) | (Rev k, a) <- L.reverse xs])
-	fromDistAscListT s xs = RMap (fromDistAscListM s [(k, a) | (Rev k, a) <- L.reverse xs])
+			(# xL, ans, xR #) -> (# xR, ans, xL #)
+	mapMaybeM s f (RMap m) = RMap (mapMaybeM s (f . Rev) m)
+	mapEitherM s1 s2 f (RMap m) = both RMap RMap (mapEitherM s1 s2 (f . Rev)) m
+	foldWithKeyM f (RMap m) = foldlWithKeyM (flip . f . Rev) m
+	foldlWithKeyM f (RMap m) = foldWithKeyM (flip . f . Rev) m
+	unionM s f (RMap m1) (RMap m2) = RMap (unionM s (f . Rev) m1 m2)
+	isectM s f (RMap m1) (RMap m2) = RMap (isectM s (f . Rev) m1 m2)
+	diffM s f (RMap m1) (RMap m2) = RMap (diffM s (f . Rev) m1 m2)
+	extractM s f (RMap m) = fmap RMap <$> runDual (extractM s (\ k a -> Dual (f (Rev k) a)) m)
+	isSubmapM (<=) (RMap m1) (RMap m2) = isSubmapM (<=) m1 m2
+	fromListM s f xs = RMap (fromListM s (f . Rev) [(k, a) | (Rev k, a) <- xs])
+	fromAscListM s f xs = RMap (fromAscListM s (\ k -> flip (f (Rev k))) [(k, a) | (Rev k, a) <- L.reverse xs])
+	fromDistAscListM s xs = RMap (fromDistAscListM s [(k, a) | (Rev k, a) <- L.reverse xs])
 
 reverse :: TrieMap k a -> TrieMap (Rev k) a
 reverse = RMap
diff --git a/Data/TrieMap/TrieKey.hs b/Data/TrieMap/TrieKey.hs
--- a/Data/TrieMap/TrieKey.hs
+++ b/Data/TrieMap/TrieKey.hs
@@ -1,48 +1,29 @@
-{-# LANGUAGE PatternGuards, Rank2Types, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, KindSignatures #-}
+{-# LANGUAGE TupleSections, TypeFamilies, UnboxedTuples #-}
 
 module Data.TrieMap.TrieKey where
 
 import Data.TrieMap.Applicative
 import Data.TrieMap.Sized
-import Data.TrieMap.CPair
 
 import Control.Applicative
 import Control.Arrow
 
 import Data.Monoid
-import Data.List
 
-type family TrieMap k :: * -> *
-
--- type family MapPF (m :: (* -> *) -> * -> *) ix :: (* -> *) -> *
--- data Fixer f
-
-type EitherMap k a b c = k -> a -> (Maybe b, Maybe c)
-type SplitMap a x = a -> (Maybe a, Maybe x, Maybe a)
+type EitherMap k a b c = k -> a -> (# Maybe b, Maybe c #)
+type SplitMap a x = a -> (# Maybe a, Maybe x, Maybe a #)
 type UnionFunc k a = k -> a -> a -> Maybe a
 type IsectFunc k a b c = k -> a -> b -> Maybe c
 type DiffFunc k a b = k -> a -> b -> Maybe a
-type ExtractFunc f m k a x = (k -> a -> f (CPair x (Maybe a))) -> m -> f (CPair x m)
+type ExtractFunc f m k a x = (k -> a -> f (x, Maybe a)) -> m -> f (x, m)
 type LEq a b = a -> b -> Bool
 
 data Assoc k a = Asc {-# UNPACK #-} !Int k a
--- data IndexPos k a = Between {-# UNPACK #-} !(Assoc k a) {-# UNPACK #-} !(Assoc k a)
--- 			| Exact {-# UNPACK #-} !(Assoc k a) (Last (Assoc k a)) (First (Assoc k a))
--- 			| Above {-# UNPACK #-} !(Assoc k a) | Below {-# UNPACK #-} !(Assoc k a) | Nada
-type IndexPos k a = (Last (Assoc k a), Maybe (Assoc k a), First (Assoc k a))
+type IndexPos k a = (# Last (Assoc k a), Maybe (Assoc k a), First (Assoc k a) #)
 
 onIndexA :: (Int -> Int) -> Assoc k a -> Assoc k a
 onIndexA f (Asc i k a) = Asc (f i) k a
 
-onIndex :: (Int -> Int) -> IndexPos k a -> IndexPos k a
-onIndex f (l, x, r) = (onIndexA f <$> l, onIndexA f <$> x, onIndexA f <$> r)
-
-onKey :: (k -> k') -> IndexPos k a -> IndexPos k' a
-onKey = onValue . first
-
-onVal :: (a -> a') -> IndexPos k a -> IndexPos k a'
-onVal = onValue . second
-
 onKeyA :: (k -> k') -> Assoc k a -> Assoc k' a
 onKeyA = onValueA . first
 
@@ -53,84 +34,71 @@
 onValueA :: ((k, a) -> (k', a')) -> Assoc k a -> Assoc k' a'
 onValueA f (Asc i k a) = uncurry (Asc i) (f (k, a))
 
-{-# INLINE onValue #-}
-onValue :: ((k, a) -> (k', a')) -> IndexPos k a -> IndexPos k' a'
-onValue f (l, x, r) = (onValueA f <$> l, onValueA f <$> x, onValueA f <$> r)
-
-type Round = Bool
--- type Sized f = forall ix . f ix -> Int
-
--- toFixer :: a -> Fixer a
--- toFixer _ = undefined
+onUnboxed :: (c -> d) -> (a -> (# b, c #)) -> a -> (# b, d #)
+onUnboxed g f a = case f a of
+		       (# b, c #) -> (# b, g c #)
 
-class Ord k => TrieKey k m | m -> k where
-	emptyM :: TrieMap k ~ m => m a
-	nullM :: TrieMap k ~ m => m a -> Bool
-	sizeM :: (TrieMap k ~ m) => Sized a -> m a -> Int
-	lookupM :: TrieMap k ~ m => k -> m a -> Maybe (a)
-	lookupIxM :: TrieMap k ~ m => Sized a -> k -> m a -> IndexPos k a
-	assocAtM :: TrieMap k ~ m => Sized a -> Int -> m a -> IndexPos k a
--- 	updateAtM :: TrieMap k ~ m => Sized a -> Round -> (Int -> k -> a -> Maybe (a)) -> Int -> m a -> m a
-	alterM :: (TrieMap k ~ m) => Sized a -> (Maybe (a) -> Maybe (a)) -> k -> m a -> m a
-	alterLookupM :: TrieMap k ~ m => Sized a -> (Maybe a -> CPair x (Maybe a)) -> k -> m a -> CPair x (m a)
-	{-# SPECIALIZE traverseWithKeyM :: (k -> a -> Id (b)) -> m a -> Id (m b) #-}
+class Ord k => TrieKey k where
+	data TrieMap k :: * -> *
+	emptyM :: TrieMap k a
+	singletonM :: Sized a -> k -> a -> TrieMap k a
+	nullM :: TrieMap k a -> Bool
+	sizeM :: Sized a -> TrieMap k a -> Int
+	lookupM :: k -> TrieMap k a -> Maybe a
+	alterM :: Sized a -> (Maybe (a) -> Maybe (a)) -> k -> TrieMap k a -> TrieMap k a
+	alterLookupM :: Sized a -> (Maybe a -> (# x, Maybe a #)) -> k -> TrieMap k a -> (# x, TrieMap k a #)
+	{-# SPECIALIZE traverseWithKeyM :: (k -> a -> Id (b)) -> TrieMap k a -> Id (TrieMap k b) #-}
 	traverseWithKeyM :: (TrieMap k ~ m, Applicative f) => Sized b ->
-		(k -> a -> f (b)) -> m a -> f (m b)
-	foldWithKeyM :: TrieMap k ~ m => (k -> a -> b -> b) -> m a -> b -> b
-	foldlWithKeyM :: TrieMap k ~ m => (k -> b -> a -> b) -> m a -> b -> b
-	mapEitherM :: (TrieMap k ~ m) => Sized b -> Sized c -> EitherMap k (a) (b) (c) -> m a -> (m b, m c)
-	splitLookupM :: (TrieMap k ~ m) => Sized a -> SplitMap (a) x -> k -> m a -> (m a, Maybe x, m a)
-	unionM :: (TrieMap k ~ m) => Sized a -> UnionFunc k (a) -> m a -> m a -> m a
-	isectM :: (TrieMap k ~ m) => Sized c -> IsectFunc k (a) (b) (c) -> m a -> m b -> m c
-	diffM :: (TrieMap k ~ m) => Sized a -> DiffFunc k (a) (b) -> m a -> m b -> m a
-	extractM :: (TrieMap k ~ m, Alternative f) => Sized a -> ExtractFunc f (m a) k a x
--- 	extractMinM :: (TrieMap k ~ m) => Sized a -> ExtractFunc k First (a) (m a) x
--- 	extractMaxM :: (TrieMap k ~ m) => Sized a -> ExtractFunc k Last (a) (m a) x
--- 	alterMinM :: (TrieMap k ~ m) => Sized a -> (k -> a -> Maybe a) -> m a -> First (m a)
--- 	alterMaxM :: (TrieMap k ~ m) => Sized a -> (k -> a -> Maybe a) -> m a -> Last (m a)
-	isSubmapM :: TrieMap k ~ m => LEq (a) (b) -> LEq (m a) (m b)
-	fromListM, fromAscListM :: (TrieMap k ~ m) => Sized a -> (k -> a -> a -> a) -> [(k, a)] -> m a
-	fromDistAscListM :: (TrieMap k ~ m) => Sized a -> [(k, a)] -> m a
+		(k -> a -> f (b)) -> TrieMap k a -> f (TrieMap k b)
+	foldWithKeyM :: (k -> a -> b -> b) -> TrieMap k a -> b -> b
+	foldlWithKeyM :: (k -> b -> a -> b) -> TrieMap k a -> b -> b
+	mapMaybeM :: Sized b -> (k -> a -> Maybe b) -> TrieMap k a -> TrieMap k b
+	mapEitherM :: Sized b -> Sized c -> EitherMap k (a) (b) (c) -> TrieMap k a -> (# TrieMap k b, TrieMap k c #)
+	splitLookupM :: Sized a -> SplitMap a x -> k -> TrieMap k a -> (# TrieMap k a, Maybe x, TrieMap k a #)
+	unionM :: Sized a -> UnionFunc k (a) -> TrieMap k a -> TrieMap k a -> TrieMap k a
+	isectM :: Sized c -> IsectFunc k (a) (b) (c) -> TrieMap k a -> TrieMap k b -> TrieMap k c
+	diffM :: Sized a -> DiffFunc k (a) (b) -> TrieMap k a -> TrieMap k b -> TrieMap k a
+	extractM :: (Alternative f) => Sized a -> ExtractFunc f (TrieMap k a) k a x
+	isSubmapM :: LEq (a) (b) -> LEq (TrieMap k a) (TrieMap k b)
+	fromListM, fromAscListM :: Sized a -> (k -> a -> a -> a) -> [(k, a)] -> TrieMap k a
+	fromDistAscListM :: Sized a -> [(k, a)] -> TrieMap k a
 	
--- 	alterLookupM s f k m = fmap (\ v' -> alterM s (const v') k m) (f (lookupM k m))
-	alterM s f k m = cpSnd (alterLookupM s (cP () . f) k m)
 	sizeM s m = foldWithKeyM (\ _ a n -> s a + n) m 0
-	fromListM s f = foldl' (flip (uncurry (insertWithKeyM s f))) emptyM
+	fromListM s f = foldr (uncurry (insertWithKeyM s f)) emptyM
 	fromAscListM = fromListM
 	fromDistAscListM s = fromAscListM s (const const)
 
-guardNullM :: (TrieKey k m, m ~ TrieMap k) => m a -> Maybe (m a)
+guardNullM :: TrieKey k => TrieMap k a -> Maybe (TrieMap k a)
 guardNullM m
 	| nullM m	= Nothing
 	| otherwise	= Just m
 
-sides :: (a -> c) -> (a, b, a) -> (c, b, c)
-sides f (l, x, r) = (f l, x, f r)
+sides :: (b -> d) -> (a -> (# b, c, b #)) -> a -> (# d, c, d #)
+sides g f a = case f a of
+		   (# x, y, z #) -> (# g x, y, g z #)
 
-mapMaybeM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a -> Maybe (b)) -> m a -> m b
-mapMaybeM s f = snd . mapEitherM elemSize s (((,) (Nothing :: Maybe (Elem ix))) .: f)
+both :: (b -> b') -> (c -> c') -> (a -> (# b, c #)) -> a -> (# b', c' #)
+both g1 g2 f a = case f a of
+		  (# x, y #) -> (# g1 x, g2 y #)
 
 {-# INLINE [1] mapWithKeyM #-}
-mapWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a -> b) -> m a -> m b
+mapWithKeyM :: TrieKey k => Sized b -> (k -> a -> b) -> TrieMap k a -> TrieMap k b
 mapWithKeyM s f  = unId . traverseWithKeyM s (Id .: f)
 
-mapM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (a -> b) -> m a -> m b
+mapM :: TrieKey k => Sized b -> (a -> b) -> TrieMap k a -> TrieMap k b
 mapM s = mapWithKeyM s . const
 
-assocsM :: (TrieKey k m, m ~ TrieMap k) => m a -> [(k, a)]
+assocsM :: TrieKey k => TrieMap k a -> [(k, a)]
 assocsM m = foldWithKeyM (\ k a xs -> (k, a):xs) m []
 
-insertM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> k -> a -> m a -> m a
+insertM :: TrieKey k => Sized a -> k -> a -> TrieMap k a -> TrieMap k a
 insertM s = insertWithKeyM s (const const)
 
-insertWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> (k -> a -> a -> a) -> k -> a -> m a -> m a
+insertWithKeyM :: TrieKey k => Sized a -> (k -> a -> a -> a) -> k -> a -> TrieMap k a -> TrieMap k a
 insertWithKeyM s f k a = alterM s f' k where
 	f' = Just . maybe a (f k a)
 
-singletonM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> k -> a -> m a
-singletonM s k a = insertM s k a emptyM
-
-fromListM' :: (TrieKey k m, m ~ TrieMap k) => Sized a -> [(k, a)] -> m a
+fromListM' :: TrieKey k => Sized a -> [(k, a)] -> TrieMap k a
 fromListM' s = fromListM s (const const) --xs = foldr (uncurry insertM) emptyM xs
 
 unionMaybe :: (a -> a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a
@@ -143,16 +111,17 @@
 isectMaybe _ _ _ = Nothing
 
 diffMaybe :: (a -> b -> Maybe a) -> Maybe a -> Maybe b -> Maybe a
-diffMaybe f Nothing = const Nothing
-diffMaybe f (Just x) = maybe (Just x) (f x)
+diffMaybe _ Nothing _ = Nothing
+diffMaybe _ (Just x) Nothing = Just x
+diffMaybe f (Just x) (Just y) = f x y
 
 subMaybe :: (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
 subMaybe _ Nothing _ = True
 subMaybe (<=) (Just a) (Just b) = a <= b
 subMaybe _ _ _ = False
 
-aboutM :: (TrieKey k (TrieMap k), Alternative t) => (k -> a -> t z) -> TrieMap k a -> t z
-aboutM f = cpFst <.> extractM (const 0) (\ k a -> fmap (flip cP Nothing) (f k a))
+aboutM :: (TrieKey k, Alternative t) => (k -> a -> t z) -> TrieMap k a -> t z
+aboutM f = fst <.> extractM (const 0) (\ k a -> fmap (, Nothing) (f k a))
 
 {-# RULES
 -- 	"lookupM/emptyM" forall k . lookupM k emptyM = Nothing;
diff --git a/Data/TrieMap/UnionMap.hs b/Data/TrieMap/UnionMap.hs
--- a/Data/TrieMap/UnionMap.hs
+++ b/Data/TrieMap/UnionMap.hs
@@ -1,106 +1,108 @@
-{-# LANGUAGE FlexibleContexts, PatternGuards, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}
-
+{-# LANGUAGE PatternGuards, UnboxedTuples, TypeFamilies, PatternGuards, ViewPatterns #-}
+{-# OPTIONS -funbox-strict-fields #-}
 module Data.TrieMap.UnionMap () where
 
 import Data.TrieMap.TrieKey
-import Data.TrieMap.Regular.Class
--- import Data.TrieMap.Regular.TH
-import Data.TrieMap.Applicative
+import Data.TrieMap.Sized
 
 import Control.Applicative
--- import Control.Arrow
 
--- import Data.Monoid
+union :: (TrieKey k1, TrieKey k2) => Sized a -> TrieMap k1 a -> TrieMap k2 a -> TrieMap (Either k1 k2) a
+union _ (nullM -> True) (nullM -> True)	= Empty
+union s m1@(sizeM s -> s1) m2@(sizeM s -> s2) = Union (s1 + s2) m1 m2
 
-data UMap m1 k2 a = m1 a :&: TrieMap k2 a
+singletonMaybe :: (TrieKey k1, TrieKey k2) => Sized a -> Either k1 k2 -> Maybe a -> TrieMap (Either k1 k2) a
+singletonMaybe s k a = maybe Empty (singletonM s k) a
 
-type instance TrieMapT (Either a) = UMap (TrieMap a)
-type instance TrieMap (Either a b) = UMap (TrieMap a) b
+singletonL :: (TrieKey k1, TrieKey k2) => Sized a -> k1 -> a -> TrieMap (Either k1 k2) a
+singletonL s k a = Union (s a) (singletonM s k a) emptyM
 
-instance (TrieKey a m, TrieKey b (TrieMap b)) => TrieKey (Either a b) (UMap m b) where
-	emptyM = emptyT
-	nullM = nullT
-	lookupM = lookupT
-	lookupIxM = lookupIxT
-	assocAtM = assocAtT
-	alterM = alterT
-	alterLookupM = alterLookupT
-	traverseWithKeyM = traverseWithKeyT
-	foldWithKeyM = foldWithKeyT
-	foldlWithKeyM = foldlWithKeyT
-	mapEitherM = mapEitherT
-	splitLookupM = splitLookupT
-	unionM = unionT
-	isectM = isectT
-	diffM = diffT
-	extractM = extractT
-	isSubmapM = isSubmapT
-	fromListM = fromListT
-	fromAscListM = fromAscListT
-	fromDistAscListM = fromDistAscListT
+singletonR :: (TrieKey k1, TrieKey k2) => Sized a -> k2 -> a -> TrieMap (Either k1 k2) a
+singletonR s k a = Union (s a) emptyM (singletonM s k a)
 
-instance TrieKey k1 m1 => TrieKeyT (Either k1) (UMap m1) where
-	emptyT = emptyM :&: emptyM
-	nullT (m1 :&: m2) = nullM m1 && nullM m2
-	sizeT s (m1 :&: m2) = sizeM s m1 + sizeM s m2
-	lookupT k (m1 :&: m2) = either (`lookupM` m1) (`lookupM` m2) k
-	lookupIxT s k (m1 :&: m2) = case k of
-		Left k	| (lb, x, ub) <- onKey Left $ lookupIxM s k m1
-				-> (lb, x, ub <|> aboutM (\ k -> return . Asc (sizeM s m1) (Right k)) m2)
-		Right k | (lb, x, ub) <- onKey Right $ lookupIxM s k m2
-				-> (aboutM (\ k a -> return (Asc (sizeM s m1 - s a) (Left k) a)) m1 <|> lb, x, ub)
-	assocAtT s i (m1 :&: m2)
-		| i < s1, (lb, x, ub) <- onKey Left (assocAtM s i m1)
-			= (lb, x, ub <|> aboutM (\ k -> return . Asc s1 (Right k)) m2)
-		| (lb, x, ub) <- onKey Right (onIndex (s1 +) (assocAtM s (i - s1) m2))
-			= (aboutM (\ k a -> return (Asc (s1 - s a) (Left k) a)) m1 <|> lb, x, ub)
-		where s1 = sizeM s m1
--- 	updateAtM s r i (m1 :&: m2)
-	alterT s f k (m1 :&: m2) = case k of
-		Left k	-> alterM s f k m1 :&: m2
-		Right k	-> m1 :&: alterM s f k m2
-	alterLookupT s f k (m1 :&: m2) = case k of
-		Left k	-> fmap (:&: m2) (alterLookupM s f k m1)
-		Right k	-> fmap (m1 :&:) (alterLookupM s f k m2)
-	traverseWithKeyT s f (m1 :&: m2) = (:&:) <$> traverseWithKeyM s (f . Left) m1 <*> traverseWithKeyM s (f . Right) m2
-	foldWithKeyT f (m1 :&: m2) = foldWithKeyM (f . Left) m1 . foldWithKeyM (f . Right) m2
-	foldlWithKeyT f (m1 :&: m2) = foldlWithKeyM (f . Right) m2 . foldlWithKeyM (f . Left) m1
-	mapEitherT s1 s2 f (m1 :&: m2) = (m1L :&: m2L, m1R :&: m2R)
-		where	(m1L, m1R) = mapEitherM s1 s2 (f . Left) m1
-			(m2L, m2R) = mapEitherM s1 s2 (f . Right) m2
--- 	extractMinT s f (m1 :&: m2) = second (:&: m2) <$> extractMinM s (f . Left) m1 <|>
--- 		second (m1 :&:) <$> extractMinM s (f . Right) m2
--- 	extractMaxT s f (m1 :&: m2) = second (:&: m2) <$> extractMaxM s (f . Left) m1 <|>
--- 		second (m1 :&:) <$> extractMaxM s (f . Right) m2
-	extractT s f (m1 :&: m2) = fmap (:&: m2) <$> extractM s (f . Left) m1 <|>
-		fmap (m1 :&:) <$> extractM s (f . Right) m2
-	splitLookupT s f k (m1 :&: m2) = case k of
-		Left k | (m1L, x, m1R) <- splitLookupM s f k m1
-			-> (m1L :&: emptyM, x, m1R :&: m2)
-		Right k | (m2L, x, m2R) <- splitLookupM s f k m2
-			-> (m1 :&: m2L, x, emptyM :&: m2R)
-	unionT s f (m11 :&: m12) (m21 :&: m22)
-		= unionM s (f . Left) m11 m21 :&: unionM s (f . Right) m12 m22
-	isectT s f (m11 :&: m12) (m21 :&: m22)
-		= isectM s (f . Left) m11 m21 :&: isectM s (f . Right) m12 m22
-	diffT s f (m11 :&: m12) (m21 :&: m22)
-		= diffM s (f . Left) m11 m21 :&: diffM s (f . Right) m12 m22
-	isSubmapT (<=) (m11 :&: m12) (m21 :&: m22) = isSubmapM (<=) m11 m21 && isSubmapM (<=) m12 m22
-	fromListT s f xs = case partEithers xs of
-		(ys, zs) -> fromListM s (f . Left) ys :&: fromListM s (f . Right) zs
-	fromAscListT s f xs = case partEithers xs of
-		(ys, zs) -> fromAscListM s (f . Left) ys :&: fromAscListM s (f . Right) zs
-	fromDistAscListT s xs = case partEithers xs of
-		(ys, zs) -> fromDistAscListM s ys :&: fromDistAscListM s zs
+instance (TrieKey k1, TrieKey k2) => TrieKey (Either k1 k2) where
+	data TrieMap (Either k1 k2) a = Empty | Union !Int (TrieMap k1 a) (TrieMap k2 a)
+
+	emptyM = Empty
 	
+	singletonM s = either (singletonL s) (singletonR s)
+	
+	nullM Empty = True
+	nullM _ = False
+	
+	sizeM _ Empty = 0
+	sizeM _ (Union s _ _) = s
+	
+	lookupM k (Union _ m1 m2) = either (`lookupM` m1) (`lookupM` m2) k
+	lookupM _ _ = Nothing
+	
+	alterM s f k (Union _ m1 m2) = case k of
+		Left k	-> union s (alterM s f k m1) m2
+		Right k	-> union s m1 (alterM s f k m2)
+	alterM s f k _ = singletonMaybe s k (f Nothing)
+
+	alterLookupM s f k Empty = onUnboxed (singletonMaybe s k) f Nothing
+	alterLookupM s f (Left k) (Union _ m1 m2) = onUnboxed (flip (union s) m2) (alterLookupM s f k) m1
+	alterLookupM s f (Right k) (Union _ m1 m2) = onUnboxed (union s m1) (alterLookupM s f k) m2
+
+	traverseWithKeyM s f (Union _ m1 m2) = union s <$> traverseWithKeyM s (f . Left) m1 <*> traverseWithKeyM s (f . Right) m2
+	traverseWithKeyM _ _ _ = pure Empty
+
+	foldWithKeyM f (Union _ m1 m2) = foldWithKeyM (f . Left) m1 . foldWithKeyM (f . Right) m2
+	foldWithKeyM _ _ = id
+
+	foldlWithKeyM f (Union _ m1 m2) = foldlWithKeyM (f . Right) m2 . foldlWithKeyM (f . Left) m1
+	foldlWithKeyM _ _ = id
+
+	mapMaybeM s f (Union _ m1 m2) = union s (mapMaybeM s (f . Left) m1) (mapMaybeM s (f . Right) m2)
+	mapMaybeM _ _ _ = Empty
+
+	mapEitherM s1 s2 f (Union _ m1 m2)
+	  | (# m1L, m1R #) <- mapEitherM s1 s2 (f . Left) m1,
+	    (# m2L, m2R #) <- mapEitherM s1 s2 (f . Right) m2
+	    	= (# union s1 m1L m2L, union s2 m1R m2R #)
+	mapEitherM _ _ _ _ = (# Empty, Empty #)
+
+	extractM s f (Union _ m1 m2) = let (&) = union s in fmap (& m2) <$> extractM s (f . Left) m1 <|>
+		fmap (m1 &) <$> extractM s (f . Right) m2
+	extractM _ _ _ = empty
+
+	splitLookupM s f k (Union _ m1 m2) = let (&) = union s in case k of
+		Left k | (# m1L, x, m1R #) <- splitLookupM s f k m1
+			-> (# m1L & emptyM, x, m1R & m2 #)
+		Right k | (# m2L, x, m2R #) <- splitLookupM s f k m2
+			-> (# m1 & m2L, x, emptyM & m2R #)
+	splitLookupM _ _ _ _ = (# emptyM, Nothing, emptyM #)
+
+	unionM s f (Union _ m11 m12) (Union _ m21 m22)
+		= union s (unionM s (f . Left) m11 m21) (unionM s (f . Right) m12 m22)
+	unionM _ _ Empty m2 = m2
+	unionM _ _ m1 Empty = m1
+
+	isectM _ _ Empty _ = Empty
+	isectM _ _ _ Empty = Empty
+	isectM s f (Union _ m11 m12) (Union _ m21 m22)
+		= union s (isectM s (f . Left) m11 m21) (isectM s (f . Right) m12 m22)
+
+	diffM _ _ Empty _ = Empty
+	diffM _ _ m1 Empty = m1
+	diffM s f (Union _ m11 m12) (Union _ m21 m22)
+		= union s (diffM s (f . Left) m11 m21) (diffM s (f . Right) m12 m22)
+
+	isSubmapM _ Empty _ = True
+	isSubmapM (<=) (Union _ m11 m12) (Union _ m21 m22) = isSubmapM (<=) m11 m21 && isSubmapM (<=) m12 m22
+	isSubmapM _ Union{} Empty = False
+
+	fromListM s f = onPair (union s) (fromListM s (f . Left)) (fromListM s (f . Right)) . partEithers
+
+	fromAscListM s f = onPair (union s) (fromAscListM s (f . Left)) (fromAscListM s (f . Right)) . partEithers
+
+	fromDistAscListM s = onPair (union s) (fromDistAscListM s) (fromDistAscListM s) . partEithers
+
+onPair :: (c -> d -> e) -> (a -> c) -> (b -> d) -> (a, b) -> e
+onPair f g h (a, b) = f (g a) (h b)
+
 partEithers :: [(Either a b, x)] -> ([(a, x)], [(b, x)])
 partEithers = foldr part ([], []) where
 	  part (Left x, z) (xs, ys) = ((x,z):xs, ys)
 	  part (Right y, z) (xs, ys) = (xs, (y, z):ys)
-
---   aboutMinM :: TrieKey k (TrieMap k) => (k -> a -> x) -> TrieMap k a -> First x
---   aboutMinM f m = fst <$> extractMinM (const 0) (\ k a -> (f k a, Nothing)) m
--- 
---   aboutMaxM :: TrieKey k (TrieMap k) => (k -> a -> x) -> TrieMap k a -> Last x
---   aboutMaxM f m = fst <$> extractMaxM (const 0) (\ k a -> (f k a, Nothing)) m 
-	
diff --git a/Data/TrieMap/UnitMap.hs b/Data/TrieMap/UnitMap.hs
--- a/Data/TrieMap/UnitMap.hs
+++ b/Data/TrieMap/UnitMap.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies, UnboxedTuples #-}
 
 module Data.TrieMap.UnitMap where
 
@@ -12,32 +12,27 @@
 
 import Prelude hiding (foldr, foldl)
 
-type instance TrieMap () = Maybe
-
-instance TrieKey () Maybe where
-	emptyM = Nothing
-	nullM = isNothing
-	sizeM = maybe 0
-	lookupM = flip const
-	lookupIxM _ _ m = (empty, Asc 0 () <$> m, empty)
-	assocAtM s i m = case m of
-		Nothing	-> (empty, empty, empty)
-		Just m
-			| i < 0		-> (empty, empty, return (Asc 0 () m))
-			| i < s m	-> (empty, return (Asc 0 () m), empty)
-			| otherwise	-> (return (Asc 0 () m), empty, empty)
-	traverseWithKeyM _ f = traverse (f ())
-	foldWithKeyM f m z = foldr (f ()) z m
-	foldlWithKeyM f m z = foldl (f ()) z m
-	mapEitherM _ _ f = maybe (Nothing, Nothing) (f ())
-	splitLookupM _ f _ = maybe (Nothing, Nothing, Nothing) f
-	alterM _ f _ = f
-	alterLookupM _ f _ = f
-	unionM _ f = unionMaybe (f ())
-	isectM _ f = isectMaybe (f ())
-	diffM _ f = diffMaybe (f ())
-	extractM _ f = maybe empty (f ())
-	isSubmapM (<=) = subMaybe (<=)
-	fromListM _ f [] = Nothing
-	fromListM _ f ((_, v):xs) = Just (foldl (\ v' -> f () v' . snd) v xs)
-	fromAscListM = fromListM
+instance TrieKey () where
+	newtype TrieMap () a = Unit {getUnit :: Maybe a}
+	emptyM = Unit Nothing
+	singletonM _ _ = Unit . Just
+	nullM = isNothing . getUnit
+	sizeM s = maybe 0 s . getUnit
+	lookupM _ (Unit m) = m
+	traverseWithKeyM _ f (Unit m) = Unit <$> traverse (f ()) m
+	foldWithKeyM f (Unit m) z = foldr (f ()) z m
+	foldlWithKeyM f (Unit m) z = foldl (f ()) z m
+	mapMaybeM _ f (Unit m) = Unit (m >>= f ())
+	mapEitherM _ _ f (Unit (Just a)) = both Unit Unit (f ()) a
+	mapEitherM _ _ _ _ = (# emptyM, emptyM #)
+	splitLookupM _ f _ (Unit (Just a)) = sides Unit f a
+	splitLookupM _ _ _ _ = (# emptyM, Nothing, emptyM #)
+	alterM _ f _ (Unit m) = Unit (f m)
+	alterLookupM _ f _ (Unit m) = onUnboxed Unit f m
+	unionM _ f (Unit m1) (Unit m2) = Unit (unionMaybe (f ()) m1 m2)
+	isectM _ f (Unit m1) (Unit m2) = Unit (isectMaybe (f ()) m1 m2)
+	diffM _ f (Unit m1) (Unit m2) = Unit (diffMaybe (f ()) m1 m2)
+	extractM _ f (Unit m) = maybe empty (fmap (fmap Unit) . f ()) m
+	isSubmapM (<=) (Unit m1) (Unit m2) = subMaybe (<=) m1 m2
+	fromListM _ _ [] = Unit Nothing
+	fromListM _ f ((_, v):xs) = Unit $ Just (foldl (\ v' -> f () v' . snd) v xs)
diff --git a/Tests.hs b/Tests.hs
new file mode 100644
--- /dev/null
+++ b/Tests.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE TemplateHaskell, TypeFamilies, GADTs, ExistentialQuantification, CPP #-}
+-- module Tests where
+
+import Control.Monad
+import qualified Data.TrieMap as T
+import qualified Data.Map as M
+import Test.QuickCheck
+import Prelude hiding (null, lookup)
+
+type Key = [String]
+type Val = [String]
+
+main = quickCheck (verify M.empty T.empty)
+
+instance Arbitrary Op where
+	arbitrary = oneof [
+		liftM Op (liftM2 Insert arbitrary arbitrary),
+		return (Op Map),
+		return (Op ToList),
+		return (Op Size),
+		liftM (Op . Lookup) arbitrary,
+		liftM (Op . Delete) arbitrary,
+		return (Op MinView),
+		return (Op MaxView),
+		return (Op MapMaybe)]
+	shrink (Op (Insert k v)) = [Op (Insert k' v') | k' <- shrink k, v' <- shrink v]
+	shrink (Op (Lookup k)) = map (Op . Lookup) (shrink k)
+	shrink (Op (Delete k)) = map (Op . Delete) (shrink k)
+	shrink _ = []
+
+data Op = forall r . Op (Operation r)
+
+instance Show Op where
+	show (Op (Insert k v)) = "Insert " ++ show k ++ " " ++ show v
+	show (Op (Lookup k)) = "Lookup " ++ show k
+	show (Op (Delete k)) = "Delete " ++ show k
+	show (Op Map) = "Map"
+	show (Op Size) = "Size"
+	show (Op ToList) = "ToList"
+	show (Op MinView) = "MinView"
+	show (Op MaxView) = "MaxView"
+	show (Op MapMaybe) = "MapMaybe"
+
+data Operation r where
+	Insert :: Key -> Val -> Operation ()
+	Map :: Operation ()
+	ToList :: Operation [(Key, Val)]
+	Size :: Operation Int
+	Lookup :: Key -> Operation (Maybe Val)
+	Delete :: Key -> Operation ()
+	MinView :: Operation (Maybe (Key, Val))
+	MaxView :: Operation (Maybe (Key, Val))
+	MapMaybe :: Operation ()
+
+operateMap :: M.Map Key Val -> Operation r -> (r, M.Map Key Val)
+operateMap m (Insert k v) = ((), M.insert k v m)
+operateMap m (Lookup k) = (M.lookup k m, m)
+operateMap m Map = ((), M.mapWithKey (\ k a -> k ++ a) m)
+operateMap m ToList = (M.assocs m, m)
+operateMap m Size = (M.size m, m)
+operateMap m (Delete k) = ((), M.delete k m)
+operateMap m MinView = case M.minViewWithKey m of
+	Nothing	 -> (Nothing, m)
+	Just ((k, v), m')	-> (Just (k, v), m')
+operateMap m MaxView = case M.maxViewWithKey m of
+	Nothing	-> (Nothing, m)
+	Just (kv, m')	-> (Just kv, m')
+operateMap m MapMaybe = ((), M.mapMaybeWithKey f m)
+	where	f ("":xs) ("":ys) = Just (xs ++ ys)
+		f _ _ = Nothing
+
+operateTMap :: T.TMap Key Val -> Operation r -> (r, T.TMap Key Val)
+operateTMap m (Insert k v) = ((), T.insert k v m)
+operateTMap m (Lookup k) = (T.lookup k m, m)
+operateTMap m Map = ((), T.mapWithKey (\ k a -> k ++ a) m)
+operateTMap m ToList = (T.assocs m, m)
+operateTMap m Size = (T.size m, m)
+operateTMap m (Delete k) = ((), T.delete k m)
+operateTMap m MinView = case T.minViewWithKey m of
+	Nothing	 -> (Nothing, m)
+	Just ((k, v), m')	-> (Just (k, v), m')
+operateTMap m MaxView = case T.maxViewWithKey m of
+	Nothing	-> (Nothing, m)
+	Just (kv, m')	-> (Just kv, m')
+operateTMap m MapMaybe = ((), T.mapMaybeWithKey f m)
+	where	f ("":xs) ("":ys) = Just (xs ++ ys)
+		f _ _ = Nothing
+
+#define VERIFYOP(operation) verifyOp op@operation{} m tm = \
+	case (operateMap m op, operateTMap tm op) of \
+		{((r1, m'), (r2, tm'))	-> guard (r1 == r2 && M.assocs m' == T.assocs tm') >> return (m', tm');}
+
+verifyOp :: Operation r -> M.Map Key Val -> T.TMap Key Val -> Maybe (M.Map Key Val, T.TMap Key Val)
+VERIFYOP(Insert)
+VERIFYOP(Lookup)
+VERIFYOP(Map)
+VERIFYOP(Size)
+VERIFYOP(ToList)
+VERIFYOP(Delete)
+VERIFYOP(MinView)
+VERIFYOP(MaxView)
+VERIFYOP(MapMaybe)
+
+verify :: M.Map Key Val -> T.TMap Key Val -> [Op] -> Bool
+verify m tm (Op op:ops) = case verifyOp op m tm of
+	Nothing	-> False
+	Just (m', tm') -> verify m' tm' ops
+verify _ _ [] = True
diff --git a/TrieMap.cabal b/TrieMap.cabal
--- a/TrieMap.cabal
+++ b/TrieMap.cabal
@@ -1,32 +1,29 @@
 name:		     TrieMap
-version:             0.7.2
+version:             1.0.0
 tested-with:	     GHC
 category:            Algorithms
 synopsis:	     Automatic type inference of generalized tries.
-description:	     Builds on the multirec library to create a system capable of automatic or simple generalized trie type inference.  Uses Template Haskell to automatically derive a TKey instance for almost any datatype.  Just splice @'Data.TrieMap.Representation.TH.genRepr' \'\'Foo@
-			to derive a 'Data.TrieMap.Class.TKey' instance for @Foo@.  (It works if @Foo@ has type arguments, too!)
+description:	     Builds on the multirec library to create a system capable of automatic or simple generalized trie type inference.
 license:             BSD3
 license-file:	     LICENSE
 author:              Louis Wasserman
 maintainer:          wasserman.louis@gmail.com
-build-Depends:       base < 5.0.0.0, containers, multirec, template-haskell >= 2.5.0.0, bytestring, array, th-expand-syns >= 0.1.1.0
+build-Depends:       base < 5.0.0.0, containers, template-haskell, bytestring, array, th-expand-syns, ghc-prim
 build-type:	     Simple
+ghc-options:         -Wall -fno-warn-name-shadowing -fno-warn-orphans
+extra-source-files:  Tests.hs
 exposed-modules:  
 	Data.TrieMap,
 	Data.TrieSet,
 	Data.TrieMap.Class,
-	Data.TrieMap.Regular,
-	Data.TrieMap.MultiRec,
 	Data.TrieMap.Representation,
 	Data.TrieMap.Representation.TH,
 	Data.TrieMap.Modifiers
-	-- Data.TrieMap.TrieKey
 other-modules:
-	Data.TrieMap.Key,
 	Data.TrieMap.Class.Instances,
+	Data.TrieMap.Key,
 	Data.TrieMap.TrieKey,
 	Data.TrieMap.Applicative,
-	Data.TrieMap.CPair,
 	Data.TrieMap.ProdMap,
 	Data.TrieMap.RadixTrie,
 	Data.TrieMap.UnionMap,
@@ -34,39 +31,6 @@
 	Data.TrieMap.Rep,
 	Data.TrieMap.Rep.Instances,
 	Data.TrieMap.Rep.TH,
-	-- Data.TrieMap.MultiRec.TH,
-	Data.TrieMap.MultiRec.FamMap,
-	Data.TrieMap.MultiRec.Eq,
-	Data.TrieMap.MultiRec.Ord,
-	Data.TrieMap.MultiRec.Class,
-	Data.TrieMap.MultiRec.ConstMap,
-	Data.TrieMap.MultiRec.IMap,
-	Data.TrieMap.MultiRec.Base,
-	-- Data.TrieMap.MultiRec.XMap,
-	-- Data.TrieMap.MultiRec.FixMap,
-	-- Data.TrieMap.MultiRec.AppMap,
-	Data.TrieMap.MultiRec.Instances,
-	Data.TrieMap.MultiRec.ProdMap,
-	Data.TrieMap.MultiRec.TagMap,
-	Data.TrieMap.MultiRec.UnionMap,
-	Data.TrieMap.MultiRec.UnitMap,
-	Data.TrieMap.MultiRec.Sized,
-	Data.TrieMap.Regular.Base,
-	Data.TrieMap.Regular.Class,
-	Data.TrieMap.Regular.ConstMap,
-	Data.TrieMap.Regular.Eq,
-	Data.TrieMap.Regular.IdMap,
-	Data.TrieMap.Regular.Instances,
-	Data.TrieMap.Regular.Ord,
-	Data.TrieMap.Regular.ProdMap,
-	Data.TrieMap.Regular.RadixTrie,
-	Data.TrieMap.Regular.UnitMap,
-	Data.TrieMap.Regular.RegMap,
-	Data.TrieMap.Regular.CompMap,
-	Data.TrieMap.Regular.UnionMap,
-	Data.TrieMap.Regular.TH,
-	Data.TrieMap.Regular.Sized,
-	Data.TrieMap.Regular.Rep,
 	Data.TrieMap.IntMap,
 	Data.TrieMap.OrdMap,
 	Data.TrieMap.ReverseMap,