diff --git a/Data/TrieMap.hs b/Data/TrieMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap.hs
@@ -0,0 +1,355 @@
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
+
+module Data.TrieMap (
+	-- * Map type
+	TKey,
+	TMap,
+	-- * Operators
+	(!),
+	(\\),
+	-- * Query
+	null,
+	size,
+	member,
+	notMember,
+	lookup,
+	findWithDefault,
+	-- * Construction
+	empty,
+	singleton,
+	-- ** Insertion
+	insert,
+	insertWith,
+	insertWithKey,
+	-- ** Delete/Update
+	delete,
+	adjust,
+	adjustWithKey,
+	update,
+	updateWithKey,
+	alter,
+	-- * Combine
+	-- ** Union
+	union,
+	unionWith,
+	unionWithKey,
+	unionMaybeWith,
+	unionMaybeWithKey,
+	-- ** Difference
+	difference,
+	differenceWith,
+	differenceWithKey,
+	-- ** Intersection
+	intersection,
+	intersectionWith,
+	intersectionWithKey,
+	intersectionMaybeWith,
+	intersectionMaybeWithKey,
+	-- * Traversal
+	-- ** Map
+	map,
+	mapWithKey,
+	mapKeys,
+	mapKeysWith,
+	mapKeysMonotonic,
+	-- ** Traverse
+	traverseWithKey,
+	-- ** Fold
+	fold,
+	foldWithKey,
+	foldrWithKey,
+	foldlWithKey,
+	-- * Conversion
+	elems,
+	keys,
+	assocs,
+	-- ** Lists
+	fromList,
+	fromListWith,
+	fromListWithKey,
+	-- ** Ordered lists
+	fromAscList,
+	fromAscListWith,
+	fromAscListWithKey,
+	fromDistinctAscList,
+	-- * Filter
+	filter,
+	filterWithKey,
+	partition,
+	partitionWithKey,
+	mapMaybe,
+	mapMaybeWithKey,
+	mapEither,
+	mapEitherWithKey,
+	split,
+	splitLookup,
+	-- * Submap
+	isSubmapOf,
+	isSubmapOfBy,
+	-- * Min/Max
+	findMin,
+	findMax,
+	deleteMin,
+	deleteMax,
+	deleteFindMin,
+	deleteFindMax,
+	updateMin,
+	updateMax,
+	updateMinWithKey,
+	updateMaxWithKey,
+	minView,
+	maxView,
+	minViewWithKey,
+	maxViewWithKey
+	) where
+
+import Data.TrieMap.Class
+import Data.TrieMap.Class.Instances()
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Applicative
+
+import Control.Applicative hiding (empty)
+import Control.Arrow
+import Data.Maybe hiding (mapMaybe)
+import Data.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)
+
+-- newtype Elem a k = Elem {getElem :: a}
+empty :: TKey k => TMap k a
+empty = TMap emptyM
+
+singleton :: TKey k => k -> a -> TMap k a
+singleton k a = insert k a empty
+
+null :: TKey k => TMap k a -> Bool
+null (TMap m) = nullM m
+
+lookup :: TKey k => k -> TMap k a -> Maybe a
+lookup k (TMap m) = unK0 <$> lookupM (toRep k) m
+
+findWithDefault :: TKey k => a -> k -> TMap k a -> a
+findWithDefault a = fromMaybe a .: lookup
+
+(!) :: TKey k => TMap k a -> k -> a
+m ! k = fromMaybe (error "Element not found") (lookup k m)
+
+alter :: TKey k => (Maybe a -> Maybe a) -> k -> TMap k a -> TMap k a
+alter f k (TMap m) = TMap (alterM sizeK0 (fmap K0 . f . fmap unK0) (toRep k) m)
+
+insert :: TKey k => k -> a -> TMap k a -> TMap k a
+insert = insertWith const
+
+insertWith :: TKey k => (a -> a -> a) -> k -> a -> TMap k a -> TMap k a
+insertWith = insertWithKey . const
+
+insertWithKey :: TKey k => (k -> a -> a -> a) -> k -> a -> TMap k a -> TMap k a
+insertWithKey f k a = alter f' k where
+	f' = Just . maybe a (f k a)
+
+delete :: TKey k => k -> TMap k a -> TMap k a
+delete = alter (const Nothing)
+
+adjust :: TKey k => (a -> a) -> k -> TMap k a -> TMap k a
+adjust = adjustWithKey . const
+
+adjustWithKey :: TKey k => (k -> a -> a) -> k -> TMap k a -> TMap k a
+adjustWithKey f = updateWithKey (Just .: f)
+
+update :: TKey k => (a -> Maybe a) -> k -> TMap k a -> TMap k a
+update f = alter (>>= f)
+
+updateWithKey :: TKey k => (k -> a -> Maybe a) -> k -> TMap k a -> TMap k a
+updateWithKey f k = update (f k) k
+
+fold :: TKey k => (a -> b -> b) -> b -> TMap k a -> b
+fold = foldWithKey . const
+
+foldWithKey, foldrWithKey :: TKey k => (k -> a -> b -> b) -> b -> TMap k a -> b
+foldWithKey f z (TMap m) = foldWithKeyM (\ k (K0 a) -> f (fromRep k) a) m z
+foldrWithKey = foldWithKey
+
+foldlWithKey :: TKey k => (b -> k -> a -> b) -> b -> TMap k a -> b
+foldlWithKey f z (TMap m) = foldlWithKeyM (\ k z (K0 a) -> f z (fromRep k) a) m z
+
+traverseWithKey :: (TKey k, Applicative f) => (k -> a -> f b) -> TMap k a -> f (TMap k b)
+traverseWithKey f (TMap m) = TMap <$> traverseWithKeyM sizeK0 (\ k (K0 a) -> K0 <$> f (fromRep k) a) m
+
+map :: TKey k => (a -> b) -> TMap k a -> TMap k b
+map = fmap
+
+mapWithKey :: TKey k => (k -> a -> b) -> TMap k a -> TMap k b
+mapWithKey f (TMap m) = TMap (mapWithKeyM sizeK0 (\ k (K0 a) -> K0 (f (fromRep k) a)) m)
+
+mapKeys :: (TKey k, TKey k') => (k -> k') -> TMap k a -> TMap k' a
+mapKeys f m = fromList [(f k, a) | (k, a) <- assocs m]
+
+mapKeysWith :: (TKey k, TKey k') => (a -> a -> a) -> (k -> k') -> TMap k a -> TMap k' a
+mapKeysWith g f m = fromListWith g [(f k, a) | (k, a) <- assocs m]
+
+mapKeysMonotonic :: (TKey k, TKey k') => (k -> k') -> TMap k a -> TMap k' a
+mapKeysMonotonic f m = fromDistinctAscList [(f k, a) | (k, a) <- assocs m]
+
+union :: TKey k => TMap k a -> TMap k a -> TMap k a
+union = unionWith const
+
+unionWith :: TKey k => (a -> a -> a) -> TMap k a -> TMap k a -> TMap k a
+unionWith = unionWithKey . const
+
+unionWithKey :: TKey k => (k -> a -> a -> a) -> TMap k a -> TMap k a -> TMap k a
+unionWithKey f = unionMaybeWithKey (\ k a b -> Just (f k a b))
+
+unionMaybeWith :: TKey k => (a -> a -> Maybe a) -> TMap k a -> TMap k a -> TMap k a
+unionMaybeWith = unionMaybeWithKey . const
+
+unionMaybeWithKey :: TKey k => (k -> a -> a -> Maybe a) -> TMap k a -> TMap k a -> TMap k a
+unionMaybeWithKey f (TMap m1) (TMap m2) = TMap (unionM sizeK0 f' m1 m2) where
+	f' k (K0 a) (K0 b) = K0 <$> f (fromRep k) a b
+
+symmetricDifference :: TKey k => TMap k a -> TMap k a -> TMap k a
+symmetricDifference = unionMaybeWith (\ _ _ -> Nothing)
+
+intersection :: TKey k => TMap k a -> TMap k b -> TMap k a
+intersection = intersectionWith const
+
+intersectionWith :: TKey k => (a -> b -> c) -> TMap k a -> TMap k b -> TMap k c
+intersectionWith = intersectionWithKey . const
+
+intersectionWithKey :: TKey k => (k -> a -> b -> c) -> TMap k a -> TMap k b -> TMap k c
+intersectionWithKey f = intersectionMaybeWithKey (\ k a b -> Just (f k a b))
+
+intersectionMaybeWith :: TKey k => (a -> b -> Maybe c) -> TMap k a -> TMap k b -> TMap k c
+intersectionMaybeWith = intersectionMaybeWithKey . const
+
+intersectionMaybeWithKey :: TKey k => (k -> a -> b -> Maybe c) -> TMap k a -> TMap k b -> TMap k c
+intersectionMaybeWithKey f (TMap m1) (TMap m2) = TMap (isectM sizeK0 f' m1 m2) where
+	f' k (K0 a) (K0 b) = K0 <$> f (fromRep k) a b
+
+difference, (\\) :: TKey k => TMap k a -> TMap k b -> TMap k a
+difference = differenceWith (\ x _ -> Nothing)
+
+(\\) = difference
+
+differenceWith :: TKey k => (a -> b -> Maybe a) -> TMap k a -> TMap k b -> TMap k a
+differenceWith = differenceWithKey . const
+
+differenceWithKey :: TKey k => (k -> a -> b -> Maybe a) -> TMap k a -> TMap k b -> TMap k a
+differenceWithKey f (TMap m1) (TMap m2) = TMap (diffM sizeK0 f' m1 m2) where
+	f' k (K0 a) (K0 b) = K0 <$> f (fromRep k) a b
+
+minView, maxView :: TKey k => TMap k a -> Maybe (a, TMap k a)
+minView m = first snd <$> minViewWithKey m
+maxView m = first snd <$> maxViewWithKey m
+
+findMin, findMax :: TKey k => TMap k a -> (k, a)
+findMin = maybe (error "empty map has no minimal element") fst . minViewWithKey
+findMax = maybe (error "empty map has no maximal element") fst . maxViewWithKey
+
+deleteMin, deleteMax :: TKey k => TMap k a -> TMap k a
+deleteMin m = maybe m snd (minViewWithKey m)
+deleteMax m = maybe m snd (maxViewWithKey m)
+
+updateMin, updateMax :: TKey k => (a -> Maybe a) -> TMap k a -> TMap k a
+updateMin = updateMinWithKey . const
+updateMax = updateMaxWithKey . const
+
+updateMinWithKey, updateMaxWithKey :: TKey k => (k -> a -> Maybe a) -> TMap k a -> TMap k a
+updateMinWithKey f (TMap m) = TMap (alterMinM sizeK0 (\ k (K0 a) -> K0 <$> f (fromRep k) a) m)
+updateMaxWithKey f (TMap m) = TMap (alterMaxM sizeK0 (\ k (K0 a) -> K0 <$> f (fromRep k) a) m)
+
+deleteFindMin, deleteFindMax :: TKey k => TMap k a -> ((k, a), TMap k a)
+deleteFindMin m = fromMaybe (error "Cannot return the minimal element of an empty map") (minViewWithKey m)
+deleteFindMax m = fromMaybe (error "Cannot return the maximal element of an empty map") (maxViewWithKey m)
+
+minViewWithKey, maxViewWithKey :: TKey k => TMap k a -> Maybe ((k, a), TMap k a)
+minViewWithKey (TMap m) = do
+	((k, K0 a), m') <- getFirst (extractMinM sizeK0 m)
+	return ((fromRep k, a), TMap m')
+maxViewWithKey (TMap m) = do
+	((k, K0 a), m') <- getLast (extractMaxM sizeK0 m)
+	return ((fromRep k, a), TMap m')
+
+elems :: TKey k => TMap k a -> [a]
+elems = fmap snd . assocs
+
+keys :: TKey k => TMap k a -> [k]
+keys = fmap fst . assocs
+
+assocs :: TKey k => TMap k a -> [(k, a)]
+assocs m = build (\ c n -> foldWithKey (curry c) n m)
+
+mapEither :: TKey k => (a -> Either b c) -> TMap k a -> (TMap k b, TMap k c)
+mapEither = mapEitherWithKey . const
+
+mapEitherWithKey :: TKey k => (k -> a -> Either b c) -> TMap k a -> (TMap k b, TMap k c)
+mapEitherWithKey f (TMap m) = case mapEitherM sizeK0 sizeK0 f' m of
+	(mL, mR) -> (TMap mL, TMap mR) 
+	where	f' k (K0 a) = case f (fromRep k) a of
+			Left b	-> (Just (K0 b), Nothing)
+			Right c	-> (Nothing, Just (K0 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 sizeK0 sizeK0 f' m)) where
+	f' k (K0 a) = (Nothing, K0 <$> f (fromRep k) a)
+
+partition :: TKey k => (a -> Bool) -> TMap k a -> (TMap k a, TMap k a)
+partition = partitionWithKey . const
+
+partitionWithKey :: TKey k => (k -> a -> Bool) -> TMap k a -> (TMap k a, TMap k a)
+partitionWithKey p = mapEitherWithKey (\ k a -> (if p k a then Left else Right) a)
+
+filter :: TKey k => (a -> Bool) -> TMap k a -> TMap k a
+filter = filterWithKey . const
+
+filterWithKey :: TKey k => (k -> a -> Bool) -> TMap k a -> TMap k a
+filterWithKey p = mapMaybeWithKey (\ k a -> if p k a then Just a else Nothing)
+
+split :: TKey k => k -> TMap k a -> (TMap k a, TMap k a)
+split k m = case splitLookup k m of
+	(mL, _, mR) -> (mL, mR)
+
+splitLookup :: TKey k => k -> TMap k a -> (TMap k a, Maybe a, TMap k a)
+splitLookup k (TMap m) = case splitLookupM sizeK0 f (toRep k) m of
+	(mL, x, mR) -> (TMap mL, x, TMap mR) 
+	where	f (K0 x) = (Nothing, Just x, Nothing)
+
+isSubmapOf :: (TKey k, Eq a) => TMap k a -> TMap k a -> Bool
+isSubmapOf = isSubmapOfBy (==)
+
+isSubmapOfBy :: TKey k => (a -> b -> Bool) -> TMap k a -> TMap k b -> Bool
+isSubmapOfBy (<=) (TMap m1) (TMap m2) = isSubmapM (<<=) m1 m2 where
+	K0 a <<= K0 b = a <= b
+
+fromList, fromAscList :: TKey k => [(k, a)] -> TMap k a
+fromList = fromListWith const
+fromAscList = fromAscListWith const
+
+fromListWith, fromAscListWith :: TKey k => (a -> a -> a) -> [(k, a)] -> TMap k a
+fromListWith = fromListWithKey . const
+fromAscListWith = fromAscListWithKey . const
+
+fromListWithKey, fromAscListWithKey :: TKey k => (k -> a -> a -> a) -> [(k, a)] -> TMap k a
+fromListWithKey f xs = TMap (fromListM sizeK0 (\ k (K0 a) (K0 b) -> K0 (f (fromRep k) a b)) [(toRep k, K0 a) | (k, a) <- xs])
+fromAscListWithKey f xs = TMap (fromAscListM sizeK0 (\ k (K0 a) (K0 b) -> K0 (f (fromRep k) a b)) [(toRep k, K0 a) | (k, a) <- xs])
+
+fromDistinctAscList :: TKey k => [(k, a)] -> TMap k a
+fromDistinctAscList xs = TMap (fromDistAscListM sizeK0 [(toRep k, K0 a) | (k, a) <- xs])
+
+size :: TKey k => TMap k a -> Int
+size (TMap m) = sizeM sizeK0 m
+
+member :: TKey k => k -> TMap k a -> Bool
+member = isJust .: lookup
+
+notMember :: TKey k => k -> TMap k a -> Bool
+notMember = not .: member
diff --git a/Data/TrieMap/Applicative.hs b/Data/TrieMap/Applicative.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Applicative.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
+
+module Data.TrieMap.Applicative where
+
+import Control.Applicative
+import Control.Monad
+
+import Data.Monoid
+
+newtype Id a = Id {unId :: a}
+
+deriving instance Functor First
+deriving instance Functor Last
+deriving instance Monad First
+deriving instance Monad Last
+
+instance Applicative Id where
+	pure = Id
+	Id f <*> Id x = Id (f x)
+
+instance Functor Id where
+	fmap f (Id x) = Id (f x)
+
+instance MonadPlus First where
+	mzero = mempty
+	mplus = mappend
+
+instance MonadPlus Last where
+	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)
+
+(<.>) :: Functor f => (b -> c) -> (a -> f b) -> a -> f c
+f <.> g = fmap f . g
+
+(<.:>) :: Functor f => (c -> d) -> (a -> b -> f c) -> a -> b -> f d
+(f <.:> g) x y = f <$> g x y
diff --git a/Data/TrieMap/Class.hs b/Data/TrieMap/Class.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Class.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances #-}
+
+module Data.TrieMap.Class (TMap(..), TKey(..), Rep, Ordered (..), TrieMap, TrieKey) where
+
+import Data.TrieMap.TrieKey
+import Data.TrieMap.OrdMap
+
+import Control.Applicative
+import Data.Foldable
+import Data.Traversable
+
+-- import Generics.MultiRec.Base
+import Data.TrieMap.Regular.Base
+import Data.TrieMap.Regular.Sized
+
+import Prelude hiding (foldr)
+
+newtype TMap k a = TMap {getTMap :: TrieMap (Rep k) (K0 a) (Rep k)}
+
+type family Rep k
+
+class TrieKey (Rep k) (TrieMap (Rep k)) => TKey k where
+	toRep :: k -> Rep k
+	fromRep :: Rep k -> k
+
+instance TKey k => Functor (TMap k) where
+	fmap = fmapDefault
+
+instance TKey k => Foldable (TMap k) where
+	foldr f z (TMap m) = foldWithKeyM (\ _ (K0 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 sizeK0 (\ _ (K0 a) -> K0 <$> f a) m
diff --git a/Data/TrieMap/Class/Instances.hs b/Data/TrieMap/Class/Instances.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Class/Instances.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}
+
+module Data.TrieMap.Class.Instances where
+
+import Data.TrieMap.Class
+-- import Data.TrieMap.RadixTrie()
+import Data.TrieMap.MultiRec.Instances
+import Data.TrieMap.IntMap()
+import Data.TrieMap.OrdMap(Ordered(..))
+import Data.TrieMap.Class
+import Data.TrieMap.Regular.Base
+import Data.TrieMap.Regular.Class
+import Data.TrieMap.Regular.Instances
+-- import Data.TrieMap.UnionMap()
+-- import Data.TrieMap.UnitMap()
+
+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 Prelude hiding (foldr)
+{-
+instance TKey k => TKey [k] where
+	type Rep [k] = L I0 (Rep k)
+	toRep = map toRep
+	fromRep = map fromRep-}
+
+type instance Rep Int = Ordered Int
+instance TKey Int where
+	toRep = Ord
+	fromRep = unOrd
+
+type instance Rep Double = Ordered Double
+instance TKey Double where
+	toRep = Ord
+	fromRep = unOrd
+
+type instance Rep Char = Int
+instance TKey Char where
+	toRep = ord
+	fromRep = chr
+
+type instance Rep Word = Int
+instance TKey Word where
+	toRep = fromEnum
+	fromRep = toEnum
+
+type instance Rep Word8 = Int
+instance TKey Word8 where
+	toRep = fromEnum
+	fromRep = toEnum
+
+type instance Rep Word16 = Int
+instance TKey Word16 where
+	toRep = fromEnum
+	fromRep = toEnum
+
+type instance Rep Word32 = Int
+instance TKey Word32 where
+	toRep = fromEnum
+	fromRep = toEnum
+
+type instance Rep Int8 = Int
+instance TKey Int8 where
+	toRep = fromIntegral
+	fromRep = fromIntegral
+
+type instance Rep Int16 = Int
+instance TKey Int16 where
+	toRep = fromIntegral
+	fromRep = fromIntegral
+
+type instance Rep Int32 = Int
+instance TKey Int32 where
+	toRep = fromIntegral
+	fromRep = fromIntegral
+-- 
+-- type instance Rep (Complex a) = Rep (a, a)
+-- instance (RealFloat a, TKey a) => TKey (Complex a) where
+-- 	toRep (a :+ b) = toRep (a, b)
+-- 	fromRep = uncurry (:+) . fromRep
+
+type instance Rep Integer = Rep [Int32]
+instance TKey Integer where
+	toRep = toRep . unroll
+	fromRep = roll . fromRep
+
+unroll :: Integer -> [Int32]
+unroll = unfoldr step where
+	step 0 = Nothing
+	step i = Just (fromIntegral i,  i `shiftR` 32)
+
+roll :: [Int32] -> Integer
+roll = foldr unstep 0 where
+	unstep b a = a `shiftL` 32 .|. fromIntegral b
+
+type instance Rep () = U0 ()
+instance TKey () where
+	toRep _ = U0
+	fromRep _ = ()
+
+type instance Rep (Either a b) = (K0 (Rep a) :+: I0) (Rep b)
+instance (TKey a, TKey b) => TKey (Either a b) where
+	toRep = either (L . K0 . toRep) (R . I0 . toRep)
+	fromRep = either' (Left . unK0 . fromRep) (Right . unI0 . fromRep)
+
+either' :: (f r -> a) -> (g r -> a) -> (f :+: g) r -> a
+either' f g x = case x of
+	L x	-> f x
+	R x	-> g x
+
+type instance Rep (a, b) = (K0 (Rep a) :*: I0) (Rep b)
+instance (TKey a, TKey b) => TKey (a, b) where
+	toRep (a, b) = K0 (toRep a) :*: I0 (toRep b)
+	fromRep (K0 a :*: I0 b) = (fromRep a, fromRep b)
+
+type instance Rep (a, b, c) = (K0 (Rep a) :*: K0 (Rep b) :*: I0) (Rep c)
+instance (TKey a, TKey b, TKey c) => TKey (a, b, c) where
+	toRep (a, b, c) = K0 (toRep a) :*: K0 (toRep b) :*: I0 (toRep c)
+	fromRep (K0 a :*: K0 b :*: I0 c) = (fromRep a, fromRep b, fromRep c)
+
+type instance Rep (a, b, c, d) = (K0 (Rep a) :*: K0 (Rep b) :*: K0 (Rep c) :*: I0) (Rep d)
+instance (TKey a, TKey b, TKey c, TKey d) => TKey (a, b, c, d) where
+	toRep (a, b, c, d) = K0 (toRep a) :*: K0 (toRep b) :*: K0 (toRep c) :*: I0 (toRep d)
+	fromRep (K0 a :*: K0 b :*: K0 c :*: I0 d) = (fromRep a, fromRep b, fromRep c, fromRep d)
+
+type instance Rep (a, b, c, d, e) = (K0 (Rep a) :*: K0 (Rep b) :*: K0 (Rep c) :*: K0 (Rep d) :*: I0) (Rep e)
+instance (TKey a, TKey b, TKey c, TKey d, TKey e) => TKey (a, b, c, d, e) where
+	toRep (a, b, c, d, e) = K0 (toRep a) :*: K0 (toRep b) :*: K0 (toRep c) :*: K0 (toRep d) :*: I0 (toRep e)
+	fromRep (K0 a :*: K0 b :*: K0 c :*: K0 d :*: I0 e) = (fromRep a, fromRep b, fromRep c, fromRep d, fromRep e)
+
+type instance Rep (Maybe a) = (U0 :+: I0) (Rep a)
+instance TKey a => TKey (Maybe a) where
+	toRep = maybe (L U0) (R . I0 . toRep)
+	fromRep = either' (const Nothing) (Just . fromRep . unI0)
+
+type instance Rep [a] = L I0 (Rep a)
+instance TKey a => TKey [a] where
+	toRep xs = List [I0 (toRep x) | x <- xs]
+	fromRep (List xs) = [fromRep x | I0 x <- xs]
+
+type instance Rep ((f :*: g) r) = (f :*: g) (Rep r)
+instance (TKey a, TrieKeyT f (TrieMapT f), TrieKeyT g (TrieMapT g), Functor f, Functor g) => TKey ((f :*: g) a) where
+	toRep = fmap toRep
+	fromRep = fmap fromRep
+
+type instance Rep ((f :+: g) r) = (f :+: g) (Rep r)
+instance (TKey a, TrieKeyT f (TrieMapT f), TrieKeyT g (TrieMapT g), Functor f, Functor g) => TKey ((f :+: g) a) where
+	toRep = fmap toRep
+	fromRep = fmap fromRep
+{-
+type instance Rep [r] = L I0 (Rep r)
+instance TKey r => TKey [r] where
+	toRep = List . map (I0 . toRep)
+	fromRep (List xs) = [fromRep x | I0 x <- xs]-}
+
+type instance Rep (L f r) = L f (Rep r)
+instance (TKey a, TrieKeyT f (TrieMapT f), Functor f) => TKey (L f a) where
+	toRep = fmap toRep
+	fromRep = fmap fromRep
+
+type instance Rep (U0 r) = U0 r
+instance TKey (U0 r) where
+	toRep _ = U0
+	fromRep _ = U0
+
+type instance Rep (K0 k r) = K0 (Rep k) r
+instance TKey k => TKey (K0 k r) where
+	toRep (K0 a) = K0 (toRep a)
+	fromRep (K0 a) = K0 (fromRep a)
+
+type instance Rep (I0 r) = I0 (Rep r)
+instance TKey r => TKey (I0 r) where
+	toRep = fmap toRep
+	fromRep = fmap fromRep
diff --git a/Data/TrieMap/IntMap.hs b/Data/TrieMap/IntMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/IntMap.hs
@@ -0,0 +1,478 @@
+{-# LANGUAGE BangPatterns, Rank2Types, CPP, MagicHash, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}
+
+module Data.TrieMap.IntMap () where
+
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Applicative
+import Data.TrieMap.Sized
+
+import Control.Applicative (Applicative(..), (<$>))
+import Control.Arrow
+
+import Data.Bits
+import Data.Maybe
+import Data.Monoid
+import Data.Word
+
+#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 = Word
+
+data IntMap a ix = Nil
+              | Tip {-# UNPACK #-} !Size {-# UNPACK #-} !Key (a ix)
+              | Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(IntMap a ix) !(IntMap a ix) 
+type instance TrieMap Int = IntMap
+
+type Prefix = Int
+type Mask   = Int
+type Key    = Int
+type Size   = Int
+
+instance TrieKey Int IntMap where
+	emptyM = Nil
+	nullM = null
+	sizeM _ = size
+	lookupM = lookup . natFromInt
+	lookupIxM _ = lookupIx . natFromInt
+	assocAtM _ = fromJust .: assocAt
+	updateAtM = updateAt
+	alterM = alter
+	traverseWithKeyM = traverseWithKey
+	foldWithKeyM = foldr
+	foldlWithKeyM = foldl
+	mapEitherM = mapEither
+	splitLookupM = splitLookup
+	unionM = unionWithKey
+	isectM = intersectionWithKey
+	diffM = differenceWithKey
+	extractMinM _ = First . minViewWithKey
+	extractMaxM _ = Last . maxViewWithKey
+	alterMinM = updateMinWithKey
+	alterMaxM = updateMaxWithKey
+	isSubmapM = isSubmapOfBy
+
+natFromInt :: Int -> Nat
+natFromInt = fromIntegral
+
+intFromNat :: Nat -> Int
+intFromNat = fromIntegral
+
+shiftRL :: Nat -> Key -> Nat
+#if __GLASGOW_HASKELL__
+{--------------------------------------------------------------------
+  GHC: use unboxing to get @shiftRL@ inlined.
+--------------------------------------------------------------------}
+shiftRL (W# x) (I# i)
+  = W# (shiftRL# x i)
+#else
+shiftRL x i   = shiftR x i
+#endif
+
+
+size :: IntMap a ix -> Int
+size Nil = 0
+size (Tip s _ _) = s
+size (Bin s _ _ _ _) = s
+
+null :: IntMap a ix -> Bool
+null Nil = True
+null _ = False
+
+lookup :: Nat -> IntMap a ix -> Maybe (a ix)
+lookup k (Bin _ _ m l r) = lookup k (if zeroN k (natFromInt m) then l else r)
+lookup k (Tip _ kx x)
+	| k == natFromInt kx	= Just x
+lookup _ _ = Nothing
+
+lookupIx :: Nat -> IntMap a ix -> Maybe (Int, a ix)
+lookupIx k t = case t of
+	Bin _ 0 m l r | m < 0	-> if zeroN k (natFromInt m) then lookupIx' (size r) k l else lookupIx' 0 k r
+	Bin{}	-> lookupIx' 0 k t
+	Tip _ k x -> return (0, x)
+	Nil	-> Nothing
+
+assocAt :: Int -> IntMap a ix -> Maybe (Int, Key, a ix)
+assocAt !i t = case t of
+	Bin _ 0 m l r | m < 0	-> let sr = size r in
+		if i < sr then assocAt' 0 i r else assocAt' sr (i - sr) l
+	Bin{} -> assocAt' 0 i t
+	Tip _ k x -> return (0, k, x)
+	_	-> Nothing
+
+assocAt' :: Int -> Int -> IntMap a ix -> Maybe (Int, Key, a ix)
+assocAt' !i0 !i (Bin _ _ _ l r)
+	| i < sl	= assocAt' i0 i l
+	| otherwise	= assocAt' (i0 + sl) (i - sl) r
+	where	sl = size l
+assocAt' i0 _ (Tip _ k x) = return (i0, k, x)
+assocAt' _ _ _ = Nothing
+
+updateAt :: Sized a -> (Int -> Key -> a ix -> Maybe (a ix)) -> Int -> IntMap a ix -> IntMap a ix
+updateAt s f !i t = case t of
+	Bin _ 0 m l r | m < 0	-> let sr = size r in
+		if i < sr then updateAt' s 0 f i r else updateAt' s sr f (i - sr) l
+	Bin{}	-> updateAt' s 0 f i t
+	Tip _ kx x -> singletonMaybe s kx (f 0 kx x)
+	Nil	-> Nil
+
+updateAt' :: Sized a -> Int -> (Int -> Key -> a ix -> Maybe (a ix)) -> Int -> IntMap a ix -> IntMap a ix
+updateAt' s !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 i0 f i l) r 
+			else bin p m l (updateAt' s (i0 + sl) f (i - sl) r)
+
+lookupIx' :: Int -> Nat -> IntMap a ix -> Maybe (Int, a ix)
+lookupIx' !i k t = case t of
+	Bin _ _ m l r
+		| zeroN k (natFromInt m)	-> lookupIx' i k l
+		| otherwise			-> lookupIx' (i + size l) k r
+	Tip _ kx x
+		| k == natFromInt kx		-> Just (i, x)
+	_ -> Nothing
+
+singleton :: Sized a -> Key -> a ix -> IntMap a ix
+singleton s k a = Tip (s a) k a
+
+singletonMaybe :: Sized a -> Key -> Maybe (a ix) -> IntMap a ix
+singletonMaybe s k = maybe Nil (singleton s k)
+
+alter :: Sized a -> (Maybe (a ix) -> Maybe (a ix)) -> Int -> IntMap a ix -> IntMap a ix
+alter s f k t = case t of
+	Bin sz p m l r
+		| nomatch k p m	-> singletonMaybe s k (f Nothing)
+		| 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
+		| 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
+	Nil	-> singletonMaybe s k (f Nothing)
+
+traverseWithKey :: Applicative f => Sized b -> (Key -> a ix -> f (b ix)) -> IntMap a ix -> f (IntMap b ix)
+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 ix -> b -> b) -> IntMap a ix -> b -> b
+foldr f t
+  = case t of
+      Bin _ 0 m l r | m < 0 -> foldr' f r . foldr' f l  -- put negative numbers before.
+      Bin _ _ _ _ _ -> foldr' f t
+      Tip _ k x     -> f k x
+      Nil         -> id
+
+foldr' :: (Key -> a ix -> b -> b) -> IntMap a ix -> 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, foldl' :: (Key -> b -> a ix -> b) -> IntMap a ix -> b -> b
+foldl f t
+  = case t of
+      Bin _ 0 m l r | m < 0 -> foldl' f l . foldl' f r  -- put negative numbers before.
+      Bin _ _ _ _ _ -> foldl' f t
+      Tip _ k x     -> flip (f k) x
+      Nil           -> id
+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 ix) (b ix) (c ix) ->
+	IntMap a ix -> (IntMap b ix, IntMap c ix)
+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)
+
+splitLookup :: Sized a -> SplitMap (a ix) x -> Key -> IntMap a ix -> (IntMap a ix ,Maybe x,IntMap a ix)
+splitLookup s f k t
+  = case t of
+      Bin _ _ m l r
+          | m < 0 -> (if k >= 0 -- handle negative numbers.
+                      then let (lt,found,gt) = splitLookup' s f k l in (union r lt,found, gt)
+                      else let (lt,found,gt) = splitLookup' s f k r in (lt,found, union gt l))
+          | otherwise   -> splitLookup' s f k t
+      Tip _ ky y 
+        | k>ky      -> (t,Nothing,Nil)
+        | k<ky      -> (Nil,Nothing,t)
+        | otherwise -> singletonMaybe s k `sides` f y
+      Nil -> (Nil,Nothing,Nil)
+
+splitLookup' :: Sized a -> SplitMap (a ix) x -> Key -> IntMap a ix -> (IntMap a ix ,Maybe x,IntMap a ix)
+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 gt r)
+        | otherwise -> let (lt,found,gt) = splitLookup s f k r in (union 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)
+
+union :: IntMap a ix -> IntMap a ix -> IntMap a ix
+union t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
+  | shorter m1 m2  = union1
+  | shorter m2 m1  = union2
+  | p1 == p2       = bin p1 m1 (union l1 l2) (union r1 r2)
+  | otherwise      = join p1 t1 p2 t2
+  where
+    union1  | nomatch p2 p1 m1  = join p1 t1 p2 t2
+            | zero p2 m1        = bin p1 m1 (union l1 t2) r1
+            | otherwise         = bin p1 m1 l1 (union r1 t2)
+
+    union2  | nomatch p1 p2 m2  = join p1 t1 p2 t2
+            | zero p1 m2        = bin p2 m2 (union t1 l2) r2
+            | otherwise         = bin p2 m2 l2 (union t1 r2)
+
+unionWithKey :: Sized a -> UnionFunc Key (a ix) -> IntMap a ix -> IntMap a ix -> IntMap a ix
+unionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
+  | shorter m1 m2  = union1
+  | shorter m2 m1  = union2
+  | p1 == p2       = bin p1 m1 (unionWithKey s f l1 l2) (unionWithKey s f r1 r2)
+  | otherwise      = join p1 t1 p2 t2
+  where
+    union1  | nomatch p2 p1 m1  = join p1 t1 p2 t2
+            | zero p2 m1        = bin p1 m1 (unionWithKey s f l1 t2) r1
+            | otherwise         = bin p1 m1 l1 (unionWithKey s f r1 t2)
+
+    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 ix) (b ix) (c ix) -> IntMap a ix -> IntMap b ix -> IntMap c ix
+intersectionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
+  | shorter m1 m2  = intersection1
+  | shorter m2 m1  = intersection2
+  | p1 == p2       = bin p1 m1 (intersectionWithKey s f l1 l2) (intersectionWithKey s f r1 r2)
+  | otherwise      = Nil
+  where
+    intersection1 | nomatch p2 p1 m1  = Nil
+                  | zero p2 m1        = intersectionWithKey s f l1 t2
+                  | otherwise         = intersectionWithKey s f r1 t2
+
+    intersection2 | nomatch p1 p2 m2  = Nil
+                  | 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 ix -> b ix -> Maybe (a ix)) -> IntMap a ix -> IntMap b ix -> IntMap a ix
+differenceWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
+  | shorter m1 m2  = difference1
+  | shorter m2 m1  = difference2
+  | p1 == p2       = bin p1 m1 (differenceWithKey s f l1 l2) (differenceWithKey s f r1 r2)
+  | otherwise      = t1
+  where
+    difference1 | nomatch p2 p1 m1  = t1
+                | zero p2 m1        = bin p1 m1 (differenceWithKey s f l1 t2) r1
+                | otherwise         = bin p1 m1 l1 (differenceWithKey s f r1 t2)
+
+    difference2 | nomatch p1 p2 m2  = t1
+                | 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 ix) (b ix) -> LEq (IntMap a ix) (IntMap b ix)
+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
+
+
+maxViewWithKey, minViewWithKey :: IntMap a ix -> Maybe ((Key, a ix), IntMap a ix)
+maxViewWithKey t
+    = case t of
+        Bin _ p m l r | m < 0 -> let (result, t') = maxViewUnsigned l in Just (result, bin p m t' r)
+        Bin _ p m l r         -> let (result, t') = maxViewUnsigned r in Just (result, bin p m l t')
+        Tip _ k y -> Just ((k,y), Nil)
+        Nil -> Nothing
+
+maxViewUnsigned, minViewUnsigned :: IntMap a ix -> ((Key, a ix), IntMap a ix)
+maxViewUnsigned t 
+    = case t of
+        Bin _ p m l r -> let (result,t') = maxViewUnsigned r in (result,bin p m l t')
+        Tip _ k y -> ((k,y), Nil)
+        Nil -> error "maxViewUnsigned Nil"
+
+-- 
+-- minViewWithKey :: IntMap a ix -> Maybe ((Key, a ix), IntMap a ix)
+minViewWithKey t
+    = case t of
+        Bin _ p m l r | m < 0 -> let (result, t') = minViewUnsigned r in Just (result, bin p m l t')
+        Bin _ p m l r         -> let (result, t') = minViewUnsigned l in Just (result, bin p m t' r)
+        Tip _ k y -> Just ((k,y),Nil)
+        Nil -> Nothing
+
+-- minViewUnsigned :: IntMap a ix -> ((Key, a ix), IntMap a ix)
+minViewUnsigned t 
+    = case t of
+        Bin _ p m l r -> let (result,t') = minViewUnsigned l in (result,bin p m t' r)
+        Tip _ k y -> ((k,y),Nil)
+        Nil -> error "minViewUnsigned Nil"
+
+updateMinWithKey :: Sized a -> (Key -> a ix -> Maybe (a ix)) -> IntMap a ix -> IntMap a ix
+updateMinWithKey s f t
+    = case t of
+        Bin _ p m l r | m < 0 -> let t' = updateMinWithKeyUnsigned s f r in bin p m l t'
+        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 ix -> Maybe (a ix)) -> IntMap a ix -> IntMap a ix
+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 ix -> Maybe (a ix)) -> IntMap a ix -> IntMap a ix
+updateMaxWithKey s f t
+    = case t of
+        Bin _ p m l r | m < 0 -> let t' = updateMaxWithKeyUnsigned s f l in bin p m t' r
+        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
+
+updateMaxWithKeyUnsigned :: Sized a -> (Key -> a ix -> Maybe (a ix)) -> IntMap a ix -> IntMap a ix
+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
+
+mask :: Key -> Mask -> Prefix
+mask i m
+  = maskW (natFromInt i) (natFromInt m)
+
+zero :: Key -> Mask -> Bool
+zero i m
+  = (natFromInt i) .&. (natFromInt m) == 0
+
+nomatch,match :: Key -> Prefix -> Mask -> Bool
+nomatch i p m
+  = (mask i m) /= p
+
+match i p m
+  = (mask i m) == p
+
+zeroN :: Nat -> Nat -> Bool
+zeroN i m = (i .&. m) == 0
+
+maskW :: Nat -> Nat -> Prefix
+maskW i m
+  = intFromNat (i .&. (complement (m-1) `xor` m))
+
+shorter :: Mask -> Mask -> Bool
+shorter m1 m2
+  = (natFromInt m1) > (natFromInt m2)
+
+branchMask :: Prefix -> Prefix -> Mask
+branchMask p1 p2
+  = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
+
+highestBitMask :: Nat -> Nat
+highestBitMask x0
+  = case (x0 .|. shiftRL x0 1) of
+     x1 -> case (x1 .|. shiftRL x1 2) of
+      x2 -> case (x2 .|. shiftRL x2 4) of
+       x3 -> case (x3 .|. shiftRL x3 8) of
+        x4 -> case (x4 .|. shiftRL x4 16) of
+         x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms
+          x6 -> (x6 `xor` (shiftRL x6 1))
+
+join :: Prefix -> IntMap a ix -> Prefix -> IntMap a ix -> IntMap a ix
+join p1 t1 p2 t2
+  | zero p1 m = bin p m t1 t2
+  | otherwise = bin p m t2 t1
+  where
+    m = branchMask p1 p2
+    p = mask p1 m
+
+bin :: Prefix -> Mask -> IntMap a ix -> IntMap a ix -> IntMap a ix
+bin _ _ l Nil = l
+bin _ _ Nil r = r
+bin p m l r   = Bin (size l + size r) p m l r
+
+-- import Data.Monoid
+-- import Data.IntMap
+-- import qualified Data.IntMap as IMap
+-- import Data.Traversable
+-- 
+-- newtype IntTMap a ix = ITMap (IntMap (a ix))
+-- type instance TrieMap Int = IntTMap
+-- newtype MaybeF a ix = MF {unF :: Maybe (a ix)}
+-- 
+-- instance TrieKey Int IntTMap where
+-- 	emptyM = ITMap empty
+-- 	nullM (ITMap m) = IMap.null m
+-- 	alterM _ f k (ITMap m) = ITMap (IMap.alter f k m)
+-- 	lookupM k (ITMap m) = IMap.lookup k m
+-- 	traverseWithKeyM _ f (ITMap m) = (ITMap . IMap.fromDistinctAscList) <$>
+-- 		sequenceA (IMap.foldWithKey (\ k a xs -> (((,) k) <$> f k a):xs) [] m)
+-- 	foldWithKeyM f (ITMap m) z = IMap.foldWithKey f z m
+-- 	foldlWithKeyM f (ITMap m) z = foldl (\ z (k, a) -> f k z a) z (IMap.assocs m)
+-- 	mapEitherM _ _ f (ITMap m) = (ITMap (mapMaybe fst m'), ITMap (mapMaybe snd m')) where
+-- 		m' = mapWithKey f m
+-- 	splitLookupM _ f k (ITMap m) = ITMap `sides` case splitLookup k m of
+-- 		(mL, x, mR)
+-- 			| Nothing <- x	-> (mL, Nothing, mR)
+-- 			| Just x <- x, (xL, x, xR) <- f x
+-- 				-> (mIns k mL xL, x, mIns k mR xR)
+-- 		where	mIns k m = maybe m (\ x -> IMap.insert k x m)
+-- 	unionM _ f (ITMap m1) (ITMap m2) = ITMap (mapMaybe unF (unionWithKey f' m1' m2')) where
+-- 		f' k (MF a) (MF b) = MF (unionMaybe (f k) a b)
+-- 		m1' = fmap (MF . Just) m1
+-- 		m2' = fmap (MF . Just) m2
+-- 	isectM _ f (ITMap m1) (ITMap m2) = ITMap (mapMaybe unF (intersectionWithKey f' m1' m2')) where
+-- 		f' k (MF a) (MF b) = MF (isectMaybe (f k) a b)
+-- 		m1' = fmap (MF . Just) m1
+-- 		m2' = fmap (MF . Just) m2
+-- 	diffM _ f (ITMap m1) (ITMap m2) = ITMap (differenceWithKey f m1 m2)
+-- 	extractMinM _ (ITMap m) = fmap ITMap <$> First (minViewWithKey m)
+-- 	extractMaxM _ (ITMap m) = fmap ITMap <$> Last (maxViewWithKey m)
+-- 	alterMinM _ f (ITMap m) = ITMap $ case minViewWithKey m of
+-- 		Just ((k, v), m') 
+-- 				-> maybe m' (\ v' -> updateMin (const v') m) (f k v)
+-- 		Nothing		-> m
+-- 	alterMaxM _ f (ITMap m) = ITMap $ case maxViewWithKey m of
+-- 		Just ((k, v), m')
+-- 				-> maybe m' (\ v' -> updateMax (const v') m) (f k v)
+-- 		Nothing		-> m
+-- 	isSubmapM (<=) (ITMap m1) (ITMap m2) = isSubmapOfBy (<=) m1 m2
+-- 	fromListM _ = ITMap .: fromListWithKey
+-- 	fromAscListM _ = ITMap .: fromAscListWithKey
+-- 	fromDistAscListM _ = ITMap . fromDistinctAscList
diff --git a/Data/TrieMap/MultiRec.hs b/Data/TrieMap/MultiRec.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec.hs
@@ -0,0 +1,6 @@
+module Data.TrieMap.MultiRec (HTrieKey, HTrieKeyT, Family(..), HEq0(..), HOrd0(..), HOrd(..)) where
+
+import Data.TrieMap.MultiRec.Class
+import Data.TrieMap.MultiRec.FamMap (Family (..))
+import Data.TrieMap.MultiRec.Eq
+import Data.TrieMap.MultiRec.Ord
diff --git a/Data/TrieMap/MultiRec/Class.hs b/Data/TrieMap/MultiRec/Class.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/Class.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE Rank2Types, FunctionalDependencies, FlexibleContexts, KindSignatures, TypeFamilies, MultiParamTypeClasses #-}
+
+module Data.TrieMap.MultiRec.Class where
+
+import Data.TrieMap.MultiRec.Sized
+import Data.TrieMap.MultiRec.Eq
+import Data.TrieMap.MultiRec.Ord
+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 | phi f -> m, m -> phi f where
+	emptyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r a ix
+	nullT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r a ix -> Bool
+	sizeT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => HSized phi a -> m r a ix -> Int
+	lookupT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> f r ix -> m r a ix -> Maybe (a ix)
+	lookupIxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> f r ix -> m r a ix -> Maybe (Int, a ix)
+	assocAtT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> Int -> m r a ix -> (Int, f r ix, a ix)
+	updateAtT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> (Int -> f r ix -> a ix -> Maybe (a ix)) -> Int -> m r a ix -> m r a ix
+	alterT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> (Maybe (a ix) -> Maybe (a ix)) -> f r ix ->
+			m r a ix -> m r a ix
+	{-# SPECIALIZE traverseWithKeyT :: HTrieKey phi r =>
+		phi ix -> HSized phi b -> (f r ix -> a ix -> Id (b ix)) -> m r a ix -> Id (m r b ix) #-}
+	traverseWithKeyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r), Applicative t) =>
+		phi ix -> HSized phi b -> (f r ix -> a ix -> t (b ix)) -> m r a ix -> t (m r b ix)
+	foldWithKeyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> (f r ix -> a ix -> b -> b) -> m r a ix -> b -> b
+	foldlWithKeyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>
+		phi ix -> (f r ix -> b -> a ix -> b) -> m r a ix -> b -> b
+	mapEitherT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> 
+		HSized phi b -> HSized phi c -> EitherMap (f r ix) (a ix) (b ix) (c ix) -> m r a ix -> (m r b ix, m r c ix)
+	splitLookupT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> SplitMap (a ix) x -> f r ix ->
+			m r a ix -> (m r a ix, Maybe x, m r a ix)
+	unionT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> UnionFunc (f r ix) (a ix) ->
+			m r a ix -> m r a ix -> m r a ix
+	isectT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi c -> IsectFunc (f r ix) (a ix) (b ix) (c ix) -> m r a ix -> m r b ix -> m r c ix
+	diffT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) =>
+		phi ix -> HSized phi a -> DiffFunc (f r ix) (a ix) (b ix) -> m r a ix -> m r b ix -> m r a ix
+	extractMinT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> ExtractFunc (f r ix) First (a ix) (m r a ix)
+	extractMaxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> ExtractFunc (f r ix) Last (a ix) (m r a ix)
+	alterMinT, alterMaxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> (f r ix -> a ix -> Maybe (a ix)) -> m r a ix -> m r a ix
+	isSubmapT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> LEq (a ix) (b ix) -> LEq (m r a ix) (m r b ix)
+	fromListT, fromAscListT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> (f r ix -> a ix -> a ix -> a ix) -> [(f r ix, a ix)] -> m r a ix
+	fromDistAscListT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+		phi ix -> HSized phi a -> [(f r ix, a ix)] -> m r a ix
+-- 	sizeT pf s m = foldWithKeyT pf (\ _ x n -> s pf x + n) m 0
+	fromListT pf s f = foldr (\ (k, a) -> alterT pf s (Just . maybe a (f k a)) k) (emptyT pf)
+	fromAscListT = fromListT
+	fromDistAscListT pf s = fromAscListT pf s (const const)
+	updateAtT pf s f i m = case assocAtT pf s i m of
+		(i', k, a) -> alterT pf s (const (f i' k a)) k m
+
+class HOrd0 phi r => HTrieKey (phi :: * -> *) (r :: * -> *) m | phi r -> m, m -> phi r where
+	emptyH :: m ~ HTrieMap phi r => phi ix -> m a ix
+	nullH :: m ~ HTrieMap phi r => phi ix -> m a ix -> Bool
+	sizeH :: (m ~ HTrieMap phi r) => HSized phi a -> m a ix -> Int
+	lookupH :: m ~ HTrieMap phi r => phi ix -> r ix -> m a ix -> Maybe (a ix)
+	alterH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (Maybe (a ix) -> Maybe (a ix)) -> r ix -> m a ix -> m a ix
+	lookupIxH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> r ix -> m a ix -> Maybe (Int, a ix)
+	assocAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Int -> m a ix -> (Int, r ix, a ix)
+	updateAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> (Int -> r ix -> a ix -> Maybe (a ix)) -> Int -> m a ix -> m a ix
+	{-# SPECIALIZE traverseWithKeyH :: phi ix -> (r ix -> a ix -> Id (b ix)) ->
+		m a ix -> Id (m b ix) #-}
+	traverseWithKeyH :: (m ~ HTrieMap phi r, Applicative f) => 
+		phi ix -> HSized phi b -> (r ix -> a ix -> f (b ix)) -> m a ix -> f (m b ix)
+	foldWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> a ix -> b -> b) -> m a ix -> b -> b
+	foldlWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> b -> a ix -> b) -> m a ix -> b -> b
+	mapEitherH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi b -> HSized phi c ->
+		EitherMap (r ix) (a ix) (b ix) (c ix) -> m a ix -> (m b ix, m c ix)
+	splitLookupH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> SplitMap (a ix) x -> r ix -> m a ix ->
+				(m a ix, Maybe x, m a ix)
+	unionH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> UnionFunc (r ix) (a ix) -> m a ix -> m a ix
+			-> m a ix
+	isectH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi c -> IsectFunc (r ix) (a ix) (b ix) (c ix) ->
+			m a ix -> m b ix -> m c ix
+	diffH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> DiffFunc (r ix) (a ix) (b ix) ->
+			m a ix -> m b ix -> m a ix
+	extractMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) First (a ix) (m a ix)
+	extractMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) Last (a ix) (m a ix)
+	alterMinH, alterMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a ix -> Maybe (a ix)) ->
+		m a ix -> m a ix
+	isSubmapH :: m ~ HTrieMap phi r => 
+		phi ix -> LEq (a ix) (b ix) -> LEq (m a ix) (m b ix)
+	fromListH, fromAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a ix -> a ix -> a ix) ->
+		[(r ix, a ix)] -> m a ix
+	fromDistAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> [(r ix, a ix)] -> m a ix
+-- 	sizeH pf s m = foldWithKeyH pf (\ _ x n -> s pf 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)
+	updateAtH pf s f i m = case assocAtH pf s i m of
+		(i', k, a) -> alterH pf s (const (f i' k a)) k m
+
+mapWithKeyT :: (HTrieKeyT phi f (HTrieMapT phi f), HTrieKey phi r (HTrieMap phi r)) =>
+	phi ix -> HSized phi b -> (f r ix -> a ix -> b ix) -> HTrieMapT phi f r a ix -> HTrieMapT phi f r b ix
+mapWithKeyT pf s f m = unId (traverseWithKeyT pf s (Id .: f) m)
+
+mapWithKeyH :: (HTrieKey phi r (HTrieMap phi r)) =>
+	phi ix -> HSized phi b -> (r ix -> a ix -> b ix) -> HTrieMap phi r a ix -> HTrieMap phi r b ix
+mapWithKeyH pf s f m = unId (traverseWithKeyH pf s (Id .: f) m)
+
+guardNullT :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r)) => 
+	phi ix -> m r a ix -> Maybe (m r a ix)
+guardNullT pf m
+	| nullT pf m	= Nothing
+	| otherwise	= Just m
diff --git a/Data/TrieMap/MultiRec/ConstMap.hs b/Data/TrieMap/MultiRec/ConstMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/ConstMap.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE 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.Applicative
+import Data.TrieMap.TrieKey
+
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+
+import Data.Maybe
+import Data.Foldable
+import Generics.MultiRec
+
+newtype KMap (phi :: * -> *) m (r :: * -> *) (a :: * -> *) ix = KMap (m a ix)
+type instance HTrieMapT phi (K k) = KMap phi (TrieMap k)
+type instance HTrieMap phi (K k r) = HTrieMapT phi (K k) r
+
+instance TrieKey k m => HTrieKeyT phi (K k) (KMap phi m) where
+	emptyT = emptyH
+	nullT = nullH
+	sizeT = sizeH
+	lookupT = lookupH
+	lookupIxT = lookupIxH
+	assocAtT = assocAtH
+	updateAtT = updateAtH
+	alterT = alterH
+	traverseWithKeyT = traverseWithKeyH
+	foldWithKeyT = foldWithKeyH
+	foldlWithKeyT = foldlWithKeyH
+	mapEitherT = mapEitherH
+	splitLookupT = splitLookupH
+	unionT = unionH
+	isectT = isectH
+	diffT = diffH
+	extractMinT = extractMinH
+	extractMaxT = extractMaxH
+	alterMinT = alterMinH
+	alterMaxT = alterMaxH
+	isSubmapT = isSubmapH
+	fromListT = fromListH
+	fromAscListT = fromAscListH
+	fromDistAscListT = fromDistAscListH
+
+instance TrieKey k m => HTrieKey phi (K k r) (KMap phi m r) where
+	emptyH _ = KMap emptyM
+	nullH _ (KMap m) = nullM m
+	sizeH s (KMap m) = sizeM (s) m
+	lookupH _ (K k) (KMap m) = lookupM k m
+	lookupIxH _ s (K k) (KMap m) = lookupIxM s k m
+	assocAtH _ s i (KMap m) = case assocAtM s i m of
+		(i, k, a) -> (i, K k, a)
+	updateAtH _ s f i (KMap m) = KMap (updateAtM s (\ i -> f i . K) i m)
+	alterH pf s f (K k) (KMap m) = KMap (alterM (s) f k m)
+	traverseWithKeyH pf 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 pf s1 s2 f (KMap m) = (KMap *** KMap) (mapEitherM (s1) (s2) (f . K) m)
+	splitLookupH pf s f (K k) (KMap m) = KMap `sides` splitLookupM (s) f k m
+	unionH pf s f (KMap m1) (KMap m2) = KMap (unionM (s) (f . K) m1 m2)
+	isectH pf s f (KMap m1) (KMap m2) = KMap (isectM (s) (f . K) m1 m2)
+	diffH pf s f (KMap m1) (KMap m2) = KMap (diffM (s) (f . K) m1 m2)
+	extractMinH pf s (KMap m) = do
+		((k, a), m') <- extractMinM (s) m
+		return ((K k, a), KMap m')
+	extractMaxH pf s (KMap m) = do
+		((k, a), m') <- extractMaxM (s) m
+		return ((K k, a), KMap m')
+	alterMinH pf s f (KMap m) = KMap (alterMinM (s) (f . K) m)
+	alterMaxH pf s f (KMap m) = KMap (alterMaxM (s) (f . K) m)
+	isSubmapH _ (<=) (KMap m1) (KMap m2) = isSubmapM (<=) m1 m2
+	fromListH pf s f xs = KMap (fromListM (s) (f . K) [(k, a) | (K k, a) <- xs])
+	fromAscListH pf s f xs = KMap (fromAscListM (s) (f . K) [(k, a) | (K k, a) <- xs])
+	fromDistAscListH pf s xs = KMap (fromDistAscListM (s) [(k, a) | (K k, a) <- xs])
diff --git a/Data/TrieMap/MultiRec/Eq.hs b/Data/TrieMap/MultiRec/Eq.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/Eq.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances #-}
+
+module Data.TrieMap.MultiRec.Eq where
+
+import Generics.MultiRec
+import Generics.MultiRec.Eq
+
+class HEq0 phi r where
+	heqH :: 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 heqH
+
+instance Eq k => HEq0 phi (K k r) where
+	heqH _ (K x) (K y) = 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
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/FamMap.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE 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.Sized
+import Data.TrieMap.Applicative
+import Data.TrieMap.TrieKey
+
+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 Family phi ix = F ix
+newtype FamMap (phi :: * -> *) m (a :: * -> *) ix = FamMap (m (Family phi) a ix)
+type instance HTrieMap phi (Family phi) = FamMap phi (HTrieMapT phi (PF phi))
+
+instance (Fam phi, HEq phi (PF phi), HFunctor phi (PF phi)) => HEq0 phi (Family phi) where
+	heqH pf (F x) (F y) = heqT pf (from' pf x) (from' pf y)
+
+instance (Fam phi, HOrd phi (PF phi), HFunctor phi (PF phi)) => HOrd0 phi (Family phi) where
+	compareH0 pf (F x) (F y) = hcompare pf (from' pf x) (from' pf y)
+
+instance (El phi ix, Fam phi, HEq phi (PF phi), HFunctor phi (PF phi)) => Eq (Family phi ix) where
+	x == y = heqH (prove x) x y
+
+instance (El phi ix, Fam phi, HOrd phi (PF phi), HFunctor phi (PF phi)) => Ord (Family phi ix) where
+	x `compare` y = compareH0 (prove x) x y
+
+prove :: El phi ix => Family phi ix -> phi ix
+prove _ = proof
+
+from' :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> ix -> PF phi (Family phi) ix
+from' pf = hmap (const (F . unI0)) pf . from pf
+
+to' :: (Fam phi, HFunctor phi (PF phi)) => phi ix -> PF phi (Family phi) ix -> ix
+to' pf = 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 . F . to' pf
+
+instance (Fam phi, HFunctor phi (PF phi), HTrieKeyT phi (PF phi) m) => HTrieKey phi (Family phi) (FamMap phi m) where
+	emptyH pf = FamMap (emptyT pf)
+	nullH pf (FamMap m) = nullT pf m
+	sizeH s (FamMap m) = sizeT s m
+	lookupH pf (F k) (FamMap m) = lookupT pf (from' pf k) m
+	lookupIxH pf s (F k) (FamMap m) = lookupIxT pf s (from' pf k) m
+	assocAtH pf s i (FamMap m) = case assocAtT pf s i m of
+		(i, k, a) -> (i, F (to' pf k), a)
+	updateAtH pf s f i (FamMap m) = FamMap (updateAtT pf s (\ i -> f i . F . to' pf) i m)
+	alterH pf s f (F k) (FamMap m) = FamMap (alterT pf s f (from' pf k) m)
+	traverseWithKeyH pf s f (FamMap m) =
+		FamMap <$> traverseWithKeyT pf s (push pf f) m
+	foldWithKeyH pf f (FamMap m) = foldWithKeyT pf (push pf f) m
+	foldlWithKeyH pf f (FamMap m) = foldlWithKeyT pf (push pf f) m
+	mapEitherH pf s1 s2 f (FamMap m) = (FamMap *** FamMap) (mapEitherT pf s1 s2 (push pf f) m)
+	splitLookupH pf s f (F k) (FamMap m) = FamMap `sides` splitLookupT pf s f (from' pf k) m
+	unionH pf s f (FamMap m1) (FamMap m2) = FamMap (unionT pf s (push pf f) m1 m2)
+	isectH pf s f (FamMap m1) (FamMap m2) = FamMap (isectT pf s (push pf f) m1 m2)
+	diffH pf s f (FamMap m1) (FamMap m2) = FamMap (diffT pf s (push pf f) m1 m2)
+	extractMinH pf s (FamMap m) = do
+		((k, a), m') <- extractMinT pf s m
+		return ((F (to' pf k), a), FamMap m')
+	extractMaxH pf s (FamMap m) = do
+		((k, a), m') <- extractMaxT pf s m
+		return ((F (to' pf k), a), FamMap m')
+	alterMinH pf s f (FamMap m) = FamMap (alterMinT pf s (push pf f) m)
+	alterMaxH pf s f (FamMap m) = FamMap (alterMaxT pf s (push pf f) m)
+	isSubmapH pf (<=) (FamMap m1) (FamMap m2) = isSubmapT pf (<=) m1 m2
+	fromListH pf s f xs = FamMap (fromListT pf s (push pf f) [(from' pf k, a) | (F k, a) <- xs])
+	fromAscListH pf s f xs = FamMap (fromAscListT pf s (push pf f) [(from' pf k, a) | (F k, a) <- xs])
+	fromDistAscListH pf s xs = FamMap (fromDistAscListT pf s [(from' pf k, a) | (F k, a) <- xs])
+
+-- type family UniqueFam ix :: * -> *
+newtype FMap (phi :: * -> *) m xi a ix = FMap (m (I ix a) xi)
+type instance TrieMap (Family phi ix) = FMap phi (HTrieMap phi (Family phi)) ix
+
+sizeI :: Sized a -> HSized phi (I ix a)
+sizeI s (I a) = s a
+
+instance (El phi ix, Fam phi, HFunctor phi (PF phi), HTrieKey phi (Family phi) m, m ~ HTrieMap phi (Family phi),
+		HOrd phi (PF phi)) => TrieKey (Family phi ix) (FMap phi m ix) where
+	emptyM = FMap (emptyH proof)
+	nullM (FMap m) = nullH proof m
+	sizeM s (FMap m) = sizeH (sizeI s) m
+	lookupM k (FMap m) = unI <$> lookupH proof k m
+	lookupIxM s k (FMap m) = fmap unI <$> lookupIxH proof (sizeI s) k m
+	assocAtM s i (FMap m) = case assocAtH proof (sizeI s) i m of
+		(i, k, I a) -> (i, k, a)
+	updateAtM s f i (FMap m) = FMap (updateAtH proof (sizeI s) (\ i' k (I a) -> I <$> f i' k a) i m)
+	alterM s f k (FMap m) = FMap (alterH proof (sizeI s) (fmap I . f . fmap unI) k m)
+	traverseWithKeyM s f (FMap m) = FMap <$> traverseWithKeyH proof (sizeI s) (\ k (I a) -> I <$> f k a) m
+	foldWithKeyM f (FMap m) = foldWithKeyH proof (\ k (I a) -> f k a) m
+	foldlWithKeyM f (FMap m) = foldlWithKeyH proof (\ k z (I a) -> f k z a) m
+	mapEitherM s1 s2 f (FMap m) = 
+		(FMap *** FMap) (mapEitherH proof (sizeI s1) (sizeI s2) (\ k (I a) -> (fmap I *** fmap I) (f k a)) m)
+	splitLookupM s f k (FMap m) = FMap `sides` splitLookupH proof (sizeI s) (sides (I <$>) . f . unI) k m
+	unionM s f (FMap m1) (FMap m2) = FMap (unionH proof (sizeI s) f' m1 m2) where
+		f' k (I x) (I y) = I <$> f k x y
+	isectM s f (FMap m1) (FMap m2) = FMap (isectH proof (sizeI s) f' m1 m2) where
+		f' k (I x) (I y) = I <$> f k x y
+	diffM s f (FMap m1) (FMap m2) = FMap (diffH proof (sizeI s) f' m1 m2) where
+		f' k (I x) (I y) = I <$> f k x y
+	extractMinM s (FMap m) = do
+		((k, I a), m') <- extractMinH proof (sizeI s) m
+		return ((k, a), FMap m')
+	extractMaxM s (FMap m) = do
+		((k, I a), m') <- extractMaxH proof (sizeI s) m
+		return ((k, a), FMap m')
+	alterMinM s f (FMap m) = FMap (alterMinH proof (sizeI s) (\ k (I a) -> I <$> f k a) m)
+	alterMaxM s f (FMap m) = FMap (alterMaxH proof (sizeI s) (\ k (I a) -> I <$> f k a) m)
+	isSubmapM (<=) (FMap m1) (FMap m2) = isSubmapH proof (<<=) m1 m2 where
+		I a <<= I b = a <= b
+	fromListM s f xs = FMap (fromListH proof (sizeI s) (\ k (I a) (I b) -> I (f k a b)) [(k, I a) | (k, a) <- xs])
+	fromAscListM s f xs = FMap (fromAscListH proof (sizeI s) (\ k (I a) (I b) -> I (f k a b)) [(k, I a) | (k, a) <- xs])
+	fromDistAscListM s xs = FMap (fromDistAscListH proof (sizeI s) [(k, I a) | (k, a) <- xs])
diff --git a/Data/TrieMap/MultiRec/IMap.hs b/Data/TrieMap/MultiRec/IMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/IMap.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE 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.TrieKey
+
+import Control.Applicative
+import Control.Arrow
+
+import Generics.MultiRec
+
+newtype IMap phi xi r a ix = IMap (HTrieMap phi r (I ix a) xi)
+type instance HTrieMapT phi (I xi) = IMap phi xi
+type instance HTrieMap phi (I xi r) = HTrieMapT phi (I xi) r
+
+combineI :: (I xi r ix -> a ix -> b ix -> Maybe (c ix)) -> r xi -> I ix a xi -> I ix b xi -> Maybe (I ix c xi)
+combineI f k (I a) (I b) = I <$> f (I k) a b
+
+mapI :: Functor f => (I xi r ix -> a ix -> f (b ix)) -> r xi -> I ix a xi -> f (I ix b xi)
+mapI f k (I a) = I <$> f (I k) a
+
+sizeI :: HSized phi r -> HSized phi (I xi r)
+sizeI s (I x) = s x
+
+instance El phi xi => HTrieKeyT phi (I xi) (IMap phi xi) where
+	emptyT _ = IMap (emptyH proof)
+	nullT _ (IMap m) = nullH proof m
+	sizeT s (IMap m) = sizeH (sizeI s) m
+	lookupT _ (I k) (IMap m) = unI <$> lookupH proof k m
+	lookupIxT _ s (I k) (IMap m) = fmap unI <$> lookupIxH proof (sizeI s) k m
+	assocAtT _ s i (IMap m) = case assocAtH proof (sizeI s) i m of
+		(i, k, I a) -> (i, I k, a)
+	updateAtT _ s f i (IMap m) = IMap (updateAtH proof (sizeI s) (\ i' k (I a) -> I <$> f i' (I k) a) i m)
+	alterT _ s f (I k) (IMap m) = IMap (alterH proof (sizeI s) f' k m) where
+		f' = fmap I . f . fmap unI
+	traverseWithKeyT _ s f (IMap m) = IMap <$> traverseWithKeyH proof (sizeI s) (mapI f) m
+	foldWithKeyT _ f (IMap m) = foldWithKeyH proof (\ k (I a) -> f (I k) a) m
+	foldlWithKeyT _ f (IMap m) = foldlWithKeyH proof (\ k z (I a) -> f (I k) z a) m
+	mapEitherT _ s1 s2 f (IMap m) = (IMap *** IMap) (mapEitherH proof (sizeI s1) (sizeI s2) f' m) where
+		f' k (I a) = (fmap I *** fmap I) (f (I k) a)
+	splitLookupT pf s f (I k) (IMap m) = IMap `sides` splitLookupH proof (sizeI s) f' k m
+		where	f' = sides (I <$>) . f . unI
+	unionT pf s f (IMap m1) (IMap m2) = IMap (unionH proof (sizeI s) (combineI f) m1 m2)
+	isectT pf s f (IMap m1) (IMap m2) = IMap (isectH proof (sizeI s) (combineI f) m1 m2)
+	diffT pf s f (IMap m1) (IMap m2) = IMap (diffH proof (sizeI s) (combineI f) m1 m2)
+	extractMinT pf s (IMap m) = do
+		((k, I a), m') <- extractMinH proof (sizeI s) m
+		return ((I k, a), IMap m')
+	extractMaxT pf s (IMap m) = do
+		((k, I a), m') <- extractMaxH proof (sizeI s) m
+		return ((I k, a), IMap m')
+	alterMinT pf s f (IMap m) = IMap (alterMinH proof (sizeI s) (mapI f) m)
+	alterMaxT pf s f (IMap m) = IMap (alterMaxH proof (sizeI s) (mapI f) m)
+	isSubmapT pf (<=) (IMap m1) (IMap m2) = isSubmapH proof (<<=) m1 m2 where
+		I a <<= I b = a <= b
+	fromListT _ s f xs = IMap (fromListH proof (sizeI s) (\ k (I a) (I b) -> I (f (I k) a b)) [(k, I a) | (I k, a) <- xs])
+	fromAscListT _ s f xs = IMap (fromAscListH proof (sizeI s) (\ k (I a) (I b) -> I (f (I k) a b)) [(k, I a) | (I k, a) <- xs])
+	fromDistAscListT _ s xs = IMap (fromDistAscListH proof (sizeI s) [(k, I a) | (I k, a) <- xs])
+
+instance (El phi xi, HTrieKey phi r (HTrieMap phi r)) => HTrieKey phi (I xi r) (IMap phi xi 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/Instances.hs b/Data/TrieMap/MultiRec/Instances.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/Instances.hs
@@ -0,0 +1,9 @@
+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
diff --git a/Data/TrieMap/MultiRec/Ord.hs b/Data/TrieMap/MultiRec/Ord.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/Ord.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE FlexibleInstances, TypeOperators, MultiParamTypeClasses, Rank2Types #-}
+
+module Data.TrieMap.MultiRec.Ord where
+
+import Data.TrieMap.MultiRec.Eq
+
+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)
+
+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 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
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/ProdMap.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE 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.Sized
+import Data.TrieMap.Applicative
+import Data.TrieMap.TrieKey
+
+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 ProdMap (phi :: * -> *) m1 (m2 :: (* -> *) -> (* -> *) -> * -> *) (r :: * -> *) (a :: * -> *) ix = PMap (m1 r (m2 r a) ix)
+type instance HTrieMapT phi (f :*: g) = ProdMap phi (HTrieMapT phi f) (HTrieMapT phi g)
+type instance HTrieMap phi ((f :*: g) r) = HTrieMapT phi (f :*: g) r
+
+-- instance (HTrieKey phi (f r), HTrieKey phi (g r)) => HTrieKey phi ((f :*: g) r) where
+-- 	emptyH pf ~(a :*: b) = PMap (emptyH pf a)
+-- 	nullH pf ~(a :*: b) (PMap m) = nullH pf a m
+-- 	lookupH pf (a :*: b) (PMap m) = lookupH pf a m >>= lookupH pf b
+-- 	alterH pf f (a :*: b) (PMap m) = PMap (alterH pf (guardNull . g) a m) where
+-- 		g = alterH pf f b . fromMaybe (emptyH pf b)
+-- 		guardNull m
+-- 			| nullH pf b m	= Nothing
+-- 			| otherwise	= Just m
+-- 	traverseWithKeyH pf f (PMap m) = 
+-- 		PMap <$> traverseWithKeyH pf (\ a -> traverseWithKeyH pf (\ b -> f (a :*: b))) m
+-- 	foldWithKeyH pf f (PMap m) = 
+-- 		foldWithKeyH pf (\ a -> foldWithKeyH pf (\ b -> f (a :*: b))) m
+
+instance (HTrieKeyT phi f m1, m1 ~ HTrieMapT phi f, HTrieKeyT phi g m2, m2 ~ HTrieMapT phi g) => 
+		HTrieKeyT phi (f :*: g) (ProdMap phi m1 m2) where
+	emptyT = PMap . emptyT
+	nullT pf (PMap m) = nullT pf m
+	sizeT s (PMap m) = sizeT (sizeT s) m
+	lookupT pf (a :*: b) (PMap m) = lookupT pf a m >>= lookupT pf b
+	lookupIxT pf s (a :*: b) (PMap m) = do
+		(iA, m') <- lookupIxT pf (sizeT s) a m
+		(iB, v) <- lookupIxT pf s b m'
+		return (iA + iB, v)
+	assocAtT pf s i (PMap m) = case assocAtT pf (sizeT s) i m of
+		(iA, a, m') -> case assocAtT pf s (i - iA) m' of
+			(iB, b, v) -> (iA + iB, a :*: b, v)
+	updateAtT pf s f i (PMap m) = PMap (updateAtT pf (sizeT s) g i m) where
+		g iA a = guardNullT pf . updateAtT pf s (\ iB b -> f (iA + iB) (a :*: b)) (i - iA)
+	alterT pf s f (a :*: b) (PMap m) = PMap (alterT pf (sizeT s) (guardNullT pf . g) a m) where
+		g = alterT pf s f b . fromMaybe (emptyT pf)
+	traverseWithKeyT pf s f (PMap m) = 
+		PMap <$> traverseWithKeyT pf (sizeT s) (\ a -> traverseWithKeyT pf s (\ b -> f (a :*: b))) m
+	foldWithKeyT pf f (PMap m) =
+		foldWithKeyT pf (\ a -> foldWithKeyT pf (\ b -> f (a :*: b))) m
+	foldlWithKeyT pf f (PMap m) =
+		foldlWithKeyT pf (\ a -> flip (foldlWithKeyT pf (\ b -> f (a :*: b)))) m
+	mapEitherT pf s1 s2 f (PMap m) = (PMap *** PMap) (mapEitherT pf (sizeT s1) (sizeT s2) g m) where
+		g a = (guardNullT pf *** guardNullT pf) . mapEitherT pf s1 s2 (\ b -> f (a :*: b))
+	splitLookupT pf s f (a :*: b) (PMap m) = PMap `sides` splitLookupT pf (sizeT s) g a m where
+		g = sides (guardNullT pf) . splitLookupT pf s f b
+	unionT pf s f (PMap m1) (PMap m2) = PMap (unionT pf (sizeT s) g m1 m2) where
+		g a = guardNullT pf .: unionT pf s (\ b -> f (a :*: b))
+	isectT pf s f (PMap m1) (PMap m2) = PMap (isectT pf (sizeT s) g m1 m2) where
+		g a = guardNullT pf .: isectT pf s (\ b -> f (a :*: b))
+	diffT pf s f (PMap m1) (PMap m2) = PMap (diffT pf (sizeT s) g m1 m2) where
+		g a = guardNullT pf .: diffT pf s (\ b -> f (a :*: b))
+	extractMinT pf s (PMap m) = do
+		((a, m1), m') <- extractMinT pf (sizeT s) m
+		((b, v), m1') <- extractMinT pf s m1
+		return ((a :*: b, v), PMap (maybe m' (\ m1' -> alterMinT pf (sizeT s) (\ _ _ -> Just m1') m) (guardNullT pf m1')))
+	extractMaxT pf s (PMap m) = do
+		((a, m1), m') <- extractMaxT pf (sizeT s) m
+		((b, v), m1') <- extractMaxT pf s m1
+		return ((a :*: b, v), PMap (maybe m' (\ m1' -> alterMaxT pf (sizeT s) (\ _ _ -> Just m1') m) (guardNullT pf m1')))
+	alterMinT pf s f (PMap m) = PMap (alterMinT pf (sizeT s) g m) where
+		g a = guardNullT pf . alterMinT pf s (\ b -> f (a :*: b))
+	alterMaxT pf s f (PMap m) = PMap (alterMaxT pf (sizeT s) g m) where
+		g a = guardNullT pf . alterMaxT pf s (\ b -> f (a :*: b))
+	isSubmapT pf (<=) (PMap m1) (PMap m2) = isSubmapT pf (isSubmapT pf (<=)) m1 m2
+	fromListT pf s f xs = PMap (mapWithKeyT pf (sizeT s) (\ a -> fromListT pf s (\ b -> f (a :*: b)) . unK0)
+				(fromListT pf (const 1) (\ _ (K0 xs) (K0 ys) -> K0 (xs ++ ys))
+					[(a, K0 ts) | (a, ts) <- breakFst pf xs]))
+	fromAscListT pf s f xs = PMap (fromDistAscListT pf (sizeT s)
+		[(a, fromAscListT pf s (\ b -> f (a :*: b)) ts) | (a, ts) <- breakFst pf xs])
+	fromDistAscListT pf s xs = PMap (fromDistAscListT pf (sizeT s)
+		[(a, fromDistAscListT pf s ts) | (a, ts) <- breakFst pf xs])
+
+breakFst :: (HEq phi f, HEq0 phi r) => phi ix -> [((f :*: g) r ix, a ix)] -> [(f r ix, [(g r ix, a ix)])]
+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)]
+
+instance (HTrieKeyT phi f m1, m1 ~ HTrieMapT phi f, HTrieKeyT phi g m2, m2 ~ HTrieMapT phi g,
+		HTrieKey phi r (HTrieMap phi r)) => HTrieKey phi ((f :*: g) r) (ProdMap phi m1 m2 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/Sized.hs b/Data/TrieMap/MultiRec/Sized.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/Sized.hs
@@ -0,0 +1,20 @@
+{-# 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 :: * -> *) r = forall ix . r ix -> Int
+
+newtype Elem a = Elem {getElem :: a}
+
+sizeElem :: HSized phi Elem
+sizeElem _ = 1
diff --git a/Data/TrieMap/MultiRec/TagMap.hs b/Data/TrieMap/MultiRec/TagMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/TagMap.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE 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.Applicative
+import Data.TrieMap.TrieKey
+
+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 :: * -> * where
+	TagF :: a ix -> TagF a ix ix
+
+unTagF :: TagF a ix xi -> a xi
+unTagF (TagF x) = x
+
+newtype TagMap (phi :: * -> *) m ix (r :: * -> *) a xi = TagMap (m r (TagF a ix) xi)
+type instance HTrieMapT phi (f :>: ix) = TagMap phi (HTrieMapT phi f) ix
+type instance HTrieMap phi ((f :>: ix) r) = HTrieMapT phi (f :>: ix) r
+
+combineTag :: IsectFunc ((f :>: ix) r xi) (a xi) (b xi) (c xi) ->
+	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 xi -> t (b xi)) -> 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)
+sizeTag s (TagF x) = s x
+
+instance (HTrieKeyT phi f m, m ~ HTrieMapT phi f) => HTrieKeyT phi (f :>: ix) (TagMap phi m ix) where
+	emptyT = TagMap . emptyT
+	nullT pf (TagMap m) = nullT pf m
+	sizeT s (TagMap m) = sizeT (sizeTag s) m
+	lookupT pf (Tag k) (TagMap m) = unTagF <$> lookupT pf k m
+	lookupIxT pf s (Tag k) (TagMap m) = fmap unTagF <$> lookupIxT pf (sizeTag s) k m
+	assocAtT pf s i (TagMap m) = unTagger (assocAtT pf (sizeTag s) i m)
+		where	unTagger :: (Int, f r ix, TagF a xi ix) -> (Int, (f :>: xi) r ix, a ix)
+			unTagger (i', k, TagF a) = (i', Tag k, a)
+	updateAtT pf s f i (TagMap m) = TagMap (updateAtT pf (sizeTag s) (f' f) i m) where
+		f' :: (Int -> (f :>: xi) r ix -> a ix -> Maybe (a ix)) -> 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
+	alterT pf s f (Tag k) (TagMap m) = TagMap (alterT pf (sizeTag s) (fmap TagF . f . fmap unTagF) k m)
+	traverseWithKeyT pf s f (TagMap m) = TagMap <$> traverseWithKeyT pf (sizeTag s) (mapTag f) m where
+		f' :: Applicative t => ((f :>: ix) r xi -> a xi -> t (b xi)) -> f r xi -> TagF a ix xi -> t (TagF b ix xi)
+		f' f k (TagF a) = TagF <$> f (Tag k) a
+	foldWithKeyT pf f (TagMap m) = foldWithKeyT pf (f' f) m where
+		f' :: ((f :>: ix) r xi -> a xi -> b -> b) -> f r xi -> TagF a ix xi -> b -> b
+		f' f k (TagF a) = f (Tag k) a
+	foldlWithKeyT pf f (TagMap m) = foldlWithKeyT pf (f' f) m where
+		f' :: ((f :>: ix) r xi -> b -> a xi  -> b) -> f r xi -> b -> TagF a ix xi -> b
+		f' f k z (TagF a) = f (Tag k) z a
+	mapEitherT pf s1 s2 f (TagMap m) = (TagMap *** TagMap) (mapEitherT pf (sizeTag s1) (sizeTag s2) (f' f) m) where
+		f' :: EitherMap ((f :>: ix) r xi) (a xi) (b xi) (c xi) -> 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)
+	splitLookupT pf s f (Tag k) (TagMap m) = TagMap `sides` splitLookupT pf (sizeTag s) (f' f) k m where
+		f' :: SplitMap (a ix) x -> SplitMap (TagF a xi ix) x
+		f' f (TagF a) = fmap TagF `sides` f a
+	unionT pf s f (TagMap m1) (TagMap m2) = TagMap (unionT pf (sizeTag s) (combineTag f) m1 m2) 
+	isectT pf s f (TagMap m1) (TagMap m2) = TagMap (isectT pf (sizeTag s) (combineTag f) m1 m2)
+	diffT pf s f (TagMap m1) (TagMap m2) = TagMap (diffT pf (sizeTag s) (combineTag f) m1 m2)
+	extractMinT pf s (TagMap m) = do
+		((k, TagF a), m') <- extractMin' pf ((sizeTag :: HSized phi a -> HSized phi (TagF a ix)) s) m
+		return ((Tag k, a), TagMap m')
+	 where	extractMin' :: (HTrieKeyT phi f m, m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+	 		phi ix -> HSized phi (TagF a xi) -> m r (TagF a xi) ix ->
+	 			First ((f r ix, TagF a xi ix), m r (TagF a xi) ix)
+	 	extractMin' = extractMinT
+	extractMaxT pf s (TagMap m) = do
+		((k, TagF a), m') <- extractMax' pf ((sizeTag :: HSized phi a -> HSized phi (TagF a ix)) s) m
+		return ((Tag k, a), TagMap m')
+	 where	extractMax' :: (HTrieKeyT phi f m, m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+	 		phi ix -> HSized phi (TagF a xi) -> m r (TagF a xi) ix ->
+	 			Last ((f r ix, TagF a xi ix), m r (TagF a xi) ix)
+	 	extractMax' = extractMaxT
+	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) 
+	isSubmapT pf (<=) (TagMap m1) (TagMap m2) = isSubmapT pf (le (<=)) m1 m2 where
+		le :: LEq (a ix) (b ix) -> LEq (TagF a xi ix) (TagF b xi ix)
+		le (<=) (TagF a) (TagF b) = a <= b
+	fromListT pf s f xs = TagMap (fromListT pf (sizeTag s) (f' f) [(k, TagF a) | (Tag k, a) <- xs]) where
+		f' :: ((f :>: ix) r xi -> a xi -> a xi -> a xi) -> 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)
+	fromAscListT pf s f xs = TagMap (fromAscListT pf (sizeTag s) (f' f) [(k, TagF a) | (Tag k, a) <- xs]) where
+		f' :: ((f :>: ix) r xi -> a xi -> a xi -> a xi) -> 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)
+	fromDistAscListT pf s xs = TagMap (fromDistAscListT pf (sizeTag s) (map f xs)) where
+		f :: ((f :>: ix) r xi, a xi) -> (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 m 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
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/UnionMap.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE 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.Applicative
+import Data.TrieMap.TrieKey
+
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+
+import Data.Maybe
+import Data.Foldable
+import Generics.MultiRec
+
+import Prelude hiding (foldr)
+
+data UnionMap (phi :: * -> *) m1 m2 (r :: * -> *) (a :: * -> *) ix = m1 r a ix :&: m2 r a ix
+type instance HTrieMapT phi (f :+: g) = UnionMap phi (HTrieMapT phi f) (HTrieMapT phi g)--HTrieMap phi (f r) :*: HTrieMap phi (g r)
+type instance HTrieMap phi ((f :+: g) r) = HTrieMapT phi (f :+: g) r
+
+instance (HTrieKeyT phi f m1, HTrieKeyT phi g m2) => HTrieKeyT phi (f :+: g) (UnionMap phi m1 m2) where
+	emptyT = liftM2 (:&:) emptyT emptyT
+	nullT pf (m1 :&: m2) = nullT pf m1 && nullT pf m2
+	sizeT s (m1 :&: m2) = sizeT s m1 + sizeT s m2
+	lookupT pf k (m1 :&: m2)
+		| L k <- k	= lookupT pf k m1
+		| R k <- k	= lookupT pf k m2
+	lookupIxT pf s k (m1 :&: m2)
+		| L k <- k	= lookupIxT pf s k m1
+		| R k <- k	= first (sizeT s m1 +) <$> lookupIxT pf s k m2
+	assocAtT pf s i (m1 :&: m2)
+		| i < s1, (i', k, a) <- assocAtT pf s i m1
+				= (i', L k, a)
+		| (i', k, a) <- assocAtT pf s (i - s1) m2
+				= (i' + s1, R k, a)
+		where	s1 = sizeT s m1
+	updateAtT pf s f i (m1 :&: m2)
+		| i < s1	= updateAtT pf s (\ i' -> f i' . L) i m1 :&: m2
+		| otherwise	= m1 :&: updateAtT pf s (\ i' -> f (s1 + i') . R) (i - s1) m2
+		where	s1 = sizeT s m1
+	alterT pf s f k (m1 :&: m2)
+		| L k <- k	= alterT pf s f k m1 :&: m2
+		| R k <- k	= m1 :&: alterT pf s f k m2
+	traverseWithKeyT pf s f (m1 :&: m2)
+		= (:&:) <$> traverseWithKeyT pf s (f . L) m1 <*> traverseWithKeyT pf s (f . R) m2
+	foldWithKeyT pf f (m1 :&: m2) 
+		= foldWithKeyT pf (f . L) m1 . foldWithKeyT pf (f . R) m2
+	foldlWithKeyT pf f (m1 :&: m2)
+		= foldlWithKeyT pf (f . R) m2 . foldlWithKeyT pf (f . L) m1
+	mapEitherT pf s1 s2 f (m1 :&: m2) = case (mapEitherT pf s1 s2 (f . L) m1, mapEitherT pf s1 s2 (f . R) m2) of
+		((m1L, m1R), (m2L, m2R)) -> (m1L :&: m2L, m1R :&: m2R)
+	splitLookupT pf s f k0 (m1 :&: m2)
+		| L k <- k0, (m1L, x, m1R) <- splitLookupT pf s f k m1
+			= (m1L :&: emptyT pf, x, m1R :&: m2)
+		| R k <- k0, (m2L, x, m2R) <- splitLookupT pf s f k m2
+			= (m1 :&: m2L, x, emptyT pf :&: m2R)
+	unionT pf s f (m11 :&: m12) (m21 :&: m22)
+		= unionT pf s (f . L) m11 m21 :&: unionT pf s (f . R) m12 m22
+	isectT pf s f (m11 :&: m12) (m21 :&: m22)
+		= isectT pf s (f . L) m11 m21 :&: isectT pf s (f . R) m12 m22
+	diffT pf s f (m11 :&: m12) (m21 :&: m22)
+		= diffT pf s (f . L) m11 m21 :&: diffT pf s (f . R) m12 m22
+	extractMinT pf s (m1 :&: m2) = (do
+		((k, v), m1') <- extractMinT pf s m1
+		return ((L k, v), m1' :&: m2)) `mplus`
+	  (do	((k, v), m2') <- extractMinT pf s m2
+		return ((R k, v), m1 :&: m2'))
+	extractMaxT pf s (m1 :&: m2) = (do
+		((k, v), m1') <- extractMaxT pf s m1
+		return ((L k, v), m1' :&: m2)) `mplus`
+	  (do	((k, v), m2') <- extractMaxT pf s m2
+		return ((R k, v), m1 :&: m2'))
+	alterMinT pf s f (m1 :&: m2)
+		| nullT pf m1	= m1 :&: alterMinT pf s (f . R) m2
+		| otherwise	= alterMinT pf s (f . L) m1 :&: m2
+	alterMaxT pf s f (m1 :&: m2)
+		| nullT pf m2	= alterMaxT pf s (f . L) m1 :&: m2
+		| otherwise	= m1 :&: alterMaxT pf s (f . R) m2
+	isSubmapT pf (<=) (m11 :&: m12) (m21 :&: m22)
+		= isSubmapT pf (<=) m11 m21 && isSubmapT pf (<=) m12 m22
+	fromListT pf s f xs = case breakEither xs of
+		(ys, zs) -> fromListT pf s (f . L) ys :&: fromListT pf s (f . R) zs
+	fromAscListT pf s f xs = case breakEither xs of
+		(ys, zs) -> fromAscListT pf s (f . L) ys :&: fromAscListT pf s (f . R) zs
+	fromDistAscListT pf s xs = case breakEither xs of
+		(ys, zs) -> fromDistAscListT pf s ys :&: fromDistAscListT pf s zs
+
+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)
+
+instance (HTrieKeyT phi f m1, m1 ~ HTrieMapT phi f, HTrieKeyT phi g m2, m2 ~ HTrieMapT phi g, 
+		HTrieKey phi r (HTrieMap phi r)) => HTrieKey phi ((f :+: g) r) (UnionMap phi m1 m2 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/UnitMap.hs b/Data/TrieMap/MultiRec/UnitMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/UnitMap.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE 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 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 :: * -> *) a ix = UMap (Maybe (a ix))
+type instance HTrieMapT phi U = UMap phi
+type instance HTrieMap phi (U r) = UMap phi r
+
+instance HTrieKeyT phi U (UMap phi) where
+	emptyT = emptyH
+	nullT = nullH
+	sizeT = sizeH
+	lookupT = lookupH
+	lookupIxT = lookupIxH
+	assocAtT = assocAtH
+	updateAtT = updateAtH
+	alterT = alterH
+	traverseWithKeyT = traverseWithKeyH
+	foldWithKeyT = foldWithKeyH
+	foldlWithKeyT = foldlWithKeyH
+	mapEitherT = mapEitherH
+	splitLookupT = splitLookupH
+	unionT = unionH
+	isectT = isectH
+	diffT = diffH
+	extractMinT = extractMinH
+	extractMaxT = extractMaxH
+	alterMinT = alterMinH
+	alterMaxT = alterMaxH
+	isSubmapT = isSubmapH
+	fromListT = fromListH
+	fromAscListT = fromAscListH
+	fromDistAscListT = fromDistAscListH
+
+instance HTrieKey phi (U r) (UMap phi r) where
+	emptyH _ = UMap Nothing
+	nullH _ (UMap m) = isNothing m
+	sizeH s (UMap m) = maybe 0 s m
+	lookupH _ _ (UMap m) = m
+	lookupIxH _ _ _ (UMap m) = fmap ((,) 0) m
+	assocAtH _ _ _ (UMap (Just a)) = (0, U, a)
+	updateAtH _ _ f _ (UMap m) = UMap (m >>= f 0 U)
+	alterH _ _ 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)
+	extractMinH _ _ (UMap m) = do	v <- First m
+					return ((U, v), UMap Nothing)
+	extractMaxH _ _ (UMap m) = do	v <- Last m
+					return ((U, v), UMap Nothing)
+	alterMinH _ _ f (UMap m) = UMap (m >>= f U)
+	alterMaxH = alterMinH
+	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
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/OrdMap.hs
@@ -0,0 +1,393 @@
+{-# LANGUAGE Rank2Types, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}
+
+module Data.TrieMap.OrdMap (Ordered (..)) where
+
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Sized
+import Data.TrieMap.Applicative
+
+import Control.Applicative (Applicative(..), (<$>))
+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)
+
+newtype Ordered a = Ord {unOrd :: a} deriving (Eq, Ord)
+data OrdMap k a ix = Tip 
+              | Bin {-# UNPACK #-} !Int k (a ix) !(OrdMap k a ix) !(OrdMap k a ix) 
+
+type instance TrieMap (Ordered k) = OrdMap k
+
+instance Ord k => TrieKey (Ordered k) (OrdMap k) where
+	emptyM = Tip
+	nullM Tip = True
+	nullM _ = False
+	sizeM _ = size
+	lookupM (Ord k) = lookup k
+	lookupIxM _ (Ord k) = lookupIx 0 k
+	assocAtM _ i m = fromJust (do	(i', k, a) <- assocAt 0 i m
+					return (i', Ord k, a))
+	updateAtM s f = updateAt s (\ i -> f i . Ord)
+	alterM s f (Ord k) = alter s f k
+	traverseWithKeyM s f = traverseWithKey s (f . Ord)
+	foldWithKeyM f = foldrWithKey (f . Ord)
+	foldlWithKeyM f = foldlWithKey (f . Ord)
+	mapEitherM s1 s2 f = mapEither s1 s2 (f . Ord)
+	extractMinM s Tip = mzero
+	extractMinM s m = return (first (first Ord) $ deleteFindMin s m)
+	extractMaxM s Tip = mzero
+	extractMaxM s m = return (first (first Ord) $ deleteFindMax s m)
+	alterMinM s f = updateMin s (f . Ord)
+	alterMaxM s f = updateMax 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
+	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
+
+lookup :: Ord k => k -> OrdMap k a ix -> Maybe (a ix)
+lookup k Tip = Nothing
+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 => Int -> k -> OrdMap k a ix -> Maybe (Int, a ix)
+lookupIx i _ _ | i `seq` False = undefined
+lookupIx _ _ Tip = Nothing
+lookupIx i k (Bin sz k' v l r) = case compare k k' of
+	LT	-> lookupIx i k l
+	EQ	-> Just (size l, v)
+	GT	-> lookupIx (i + sz - size r) k r
+
+assocAt :: Int -> Int -> OrdMap k a ix -> Maybe (Int, k, a ix)
+assocAt i0 i _ | i0 `seq` i `seq` False = Nothing
+assocAt _ _ Tip = Nothing
+assocAt i0 i (Bin sz k a l r)
+	| i < sL	= assocAt i0 i l
+	| i < sK	= Just (i0 + sL, k, a)
+	| otherwise	= assocAt (i0 + sK) (i - sK) r
+	where	sL = size l
+		sK = sz - size r
+
+updateAt :: Sized a -> (Int -> k -> a ix -> Maybe (a ix)) -> Int -> OrdMap k a ix -> OrdMap k a ix
+updateAt _ _ i _ | i `seq` False = undefined
+updateAt _ _ _ Tip = Tip
+updateAt s f i (Bin sz k a l r)
+	| i < sL	= balance s k a (updateAt s f i l) r
+	| i < sK	= case f sK k a of
+		Nothing	-> glue s l r
+		Just a'	-> bin s k a' l r
+	| otherwise	= balance s k a l (updateAt s (f . (+ sK)) (i - sK) r)
+	where	sL = size l
+		sK = sz - size r 
+
+alter :: Ord k => Sized a -> (Maybe (a ix) -> Maybe (a ix)) -> k -> OrdMap k a ix -> OrdMap k a ix
+alter s f k Tip = case f Nothing of
+	Nothing	-> Tip
+	Just x	-> singleton s k x
+alter s f k (Bin _ kx x l r) = case compare k kx of
+	LT	-> balance s kx x (alter s f k l) r
+	EQ	-> case f (Just x) of
+		Nothing	-> glue s l r
+		Just x'	-> balance s k x' l r
+	GT	-> balance s kx x l (alter s f k r)
+
+singleton :: Sized a -> k -> a ix -> OrdMap k a ix
+singleton s k a = Bin (s a) k a Tip Tip
+
+traverseWithKey :: Applicative f => Sized b -> (k -> a ix -> f (b ix)) -> OrdMap k a ix -> f (OrdMap k b ix)
+traverseWithKey s f 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 ix -> b -> b) -> OrdMap k a ix -> b -> b
+foldrWithKey f Tip = id
+foldrWithKey f (Bin _ k a l r) = foldrWithKey f l . f k a . foldrWithKey f r
+
+foldlWithKey :: (k -> b -> a ix -> b) -> OrdMap k a ix -> b -> b
+foldlWithKey f 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 ix) (b ix) (c ix) ->
+	OrdMap k a ix -> (OrdMap k b ix, OrdMap k c ix)
+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 ix -> Maybe (a ix)) -> OrdMap k a ix -> OrdMap k a ix
+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
+
+updateMax :: Ord k => Sized a -> (k -> a ix -> Maybe (a ix)) -> OrdMap k a ix -> OrdMap k a ix
+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)
+
+splitLookup :: Ord k => Sized a -> SplitMap (a ix) x -> k -> OrdMap k a ix -> (OrdMap k a ix, Maybe x, OrdMap k a ix)
+splitLookup s f k m = case m of
+	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)
+		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)
+		GT	-> case splitLookup s f k r of
+			(rL, ans, rR) -> (join s kx x l rL, ans, rR)
+
+isSubmap :: Ord k => LEq (a ix) (b ix) -> LEq (OrdMap k a ix) (OrdMap k b ix)
+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
+
+fromAscList :: Eq k => Sized a -> (k -> a ix -> a ix -> a ix) -> [(k, a ix)] -> OrdMap k a ix
+fromAscList s f xs = fromDistinctAscList s (combineEq xs) where
+	combineEq (x:xs) = combineEq' x xs
+	combineEq [] = []
+	
+	combineEq' z [] = [z]
+	combineEq' z@(kz, zz) (x@(kx, xx):xs)
+		| kz == kx	= combineEq' (kx, f kx xx zz) xs
+		| otherwise	= (kz,zz):combineEq' x xs
+
+fromDistinctAscList :: Sized a -> [(k, a ix)] -> OrdMap k a ix
+fromDistinctAscList s xs = build const (length xs) xs
+  where
+    -- 1) use continutations so that we use heap space instead of stack space.
+    -- 2) special case for n==5 to build bushier trees. 
+    build c 0 xs'  = c Tip xs'
+    build c 5 xs'  = case xs' of
+                       ((k1,x1):(k2,x2):(k3,x3):(k4,x4):(k5,x5):xx) 
+                            -> c (bin s k4 x4 (bin s k2 x2 (singleton s k1 x1) (singleton s k3 x3)) (singleton s k5 x5)) xx
+                       _ -> error "fromDistinctAscList build"
+    build c n xs'  = seq nr $ build (buildR nr c) nl xs'
+                   where
+                     nl = n `div` 2
+                     nr = n - nl - 1
+
+    buildR n c l ((k,x):ys) = build (buildB l k x c) n ys
+    buildR _ _ _ []         = error "fromDistinctAscList buildR []"
+    buildB l k x c r zs     = c (bin s k x l r) zs
+
+hedgeUnionWithKey :: Ord k
+                  => Sized a -> (k -> a ix -> a ix -> Maybe (a ix))
+                  -> (k -> Ordering) -> (k -> Ordering)
+                  -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+hedgeUnionWithKey _ _ _     _     t1 Tip
+  = t1
+hedgeUnionWithKey s _ cmplo cmphi Tip (Bin _ kx x l r)
+  = join s kx x (filterGt s cmplo l) (filterLt s cmphi r)
+hedgeUnionWithKey s f cmplo cmphi (Bin _ kx x l r) t2
+  = joinMaybe s kx newx (hedgeUnionWithKey s f cmplo cmpkx l lt) 
+                 (hedgeUnionWithKey s f cmpkx cmphi r gt)
+  where
+    cmpkx k     = compare kx k
+    lt          = trim cmplo cmpkx t2
+    (found,gt)  = trimLookupLo kx cmphi t2
+    newx        = case found of
+                    Nothing -> Just x
+                    Just (_,y) -> f kx x y
+
+filterGt :: Ord k => Sized a -> (k -> Ordering) -> OrdMap k a ix -> OrdMap k a ix
+filterGt _ _   Tip = Tip
+filterGt s cmp (Bin _ kx x l r)
+  = case cmp kx of
+      LT -> join s kx x (filterGt s cmp l) r
+      GT -> filterGt s cmp r
+      EQ -> r
+      
+filterLt :: Ord k => Sized a -> (k -> Ordering) -> OrdMap k a ix -> OrdMap k a ix
+filterLt _ _   Tip = Tip
+filterLt s cmp (Bin _ kx x l r)
+  = case cmp kx of
+      LT -> filterLt s cmp l
+      GT -> join s kx x l (filterLt s cmp r)
+      EQ -> l
+
+trim :: (k -> Ordering) -> (k -> Ordering) -> OrdMap k a ix -> OrdMap k a ix
+trim _     _     Tip = Tip
+trim cmplo cmphi t@(Bin _ kx _ l r)
+  = case cmplo kx of
+      LT -> case cmphi kx of
+              GT -> t
+              _  -> trim cmplo cmphi l
+      _  -> trim cmplo cmphi r
+              
+trimLookupLo :: Ord k => k -> (k -> Ordering) -> OrdMap k a ix -> (Maybe (k,a ix), OrdMap k a ix)
+trimLookupLo _  _     Tip = (Nothing,Tip)
+trimLookupLo lo cmphi t@(Bin _ kx x l r)
+  = case compare lo kx of
+      LT -> case cmphi kx of
+              GT -> (((,) lo) <$> lookup lo t, t)
+              _  -> trimLookupLo lo cmphi l
+      GT -> trimLookupLo lo cmphi r
+      EQ -> (Just (kx,x),trim (compare lo) cmphi r)
+
+isect :: Ord k => Sized c -> IsectFunc k (a ix) (b ix) (c ix) -> OrdMap k a ix -> OrdMap k b ix -> OrdMap k c ix
+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
+	 in joinMaybe s k2 (found >>= \ x1' -> f k2 x1' x2) tl tr
+
+
+hedgeDiffWithKey :: Ord k
+                 => Sized a -> (k -> a ix -> b ix -> Maybe (a ix))
+                 -> (k -> Ordering) -> (k -> Ordering)
+                 -> OrdMap k a ix -> OrdMap k b ix -> OrdMap k a ix
+hedgeDiffWithKey _ _ _     _     Tip _
+  = Tip
+hedgeDiffWithKey s _ cmplo cmphi (Bin _ kx x l r) Tip
+  = join s kx x (filterGt s cmplo l) (filterLt s cmphi r)
+hedgeDiffWithKey s f cmplo cmphi t (Bin _ kx x l r) 
+  = case found of
+      Nothing -> merge s tl tr
+      Just (ky,y) -> 
+          case f ky y x of
+            Nothing -> merge s tl tr
+            Just z  -> join s ky z tl tr
+  where
+    cmpkx k     = compare kx k   
+    lt          = trim cmplo cmpkx t
+    (found,gt)  = trimLookupLo kx cmphi t
+    tl          = hedgeDiffWithKey s f cmplo cmpkx lt l
+    tr          = hedgeDiffWithKey s f cmpkx cmphi gt r
+
+joinMaybe :: Ord k => Sized a -> k -> Maybe (a ix) -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+joinMaybe s kx = maybe (merge s) (join s kx)
+
+join :: Ord k => Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+join s kx x Tip r  = insertMin s kx x r
+join s kx x l Tip  = insertMax s kx x l
+join s kx x l@(Bin sizeL ky y ly ry) r@(Bin sizeR kz z lz rz)
+  | delta*sizeL <= sizeR  = balance s kz z (join s kx x l lz) rz
+  | delta*sizeR <= sizeL  = balance s ky y ly (join s kx x ry r)
+  | otherwise             = bin s kx x l r
+
+
+-- insertMin and insertMax don't perform potentially expensive comparisons.
+insertMax,insertMin :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix
+insertMax s kx x t
+  = case t of
+      Tip -> singleton s kx x
+      Bin _ ky y l r
+          -> balance s ky y l (insertMax s kx x r)
+             
+insertMin s kx x t
+  = case t of
+      Tip -> singleton s kx x
+      Bin _ ky y l r
+          -> balance s ky y (insertMin s kx x l) r
+             
+{--------------------------------------------------------------------
+  [merge l r]: merges two trees.
+--------------------------------------------------------------------}
+merge :: Sized a -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+merge _ Tip r   = r
+merge _ l Tip   = l
+merge s l@(Bin sizeL kx x lx rx) r@(Bin sizeR ky y ly ry)
+  | delta*sizeL <= sizeR = balance s ky y (merge s l ly) ry
+  | delta*sizeR <= sizeL = balance s kx x lx (merge s rx r)
+  | otherwise            = glue s l r
+
+{--------------------------------------------------------------------
+  [glue l r]: glues two trees together.
+  Assumes that [l] and [r] are already balanced with respect to each other.
+--------------------------------------------------------------------}
+glue :: Sized a -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+glue _ Tip r = r
+glue _ l Tip = l
+glue s l r   
+  | size l > size r = let ((km,m),l') = deleteFindMax s l in balance s km m l' r
+  | otherwise       = let ((km,m),r') = deleteFindMin s r in balance s km m l r'
+
+deleteFindMin :: Sized a -> OrdMap k a ix -> ((k, a ix), OrdMap k a ix)
+deleteFindMin s t 
+  = case t of
+      Bin _ k x Tip r -> ((k,x),r)
+      Bin _ k x l r   -> let (km,l') = deleteFindMin s l in (km,balance s k x l' r)
+      Tip             -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
+
+deleteFindMax :: Sized a -> OrdMap k a ix -> ((k, a ix), OrdMap k a ix)
+deleteFindMax s t
+  = case t of
+      Bin _ k x l Tip -> ((k,x),l)
+      Bin _ k x l r   -> let (km,r') = deleteFindMax s r in (km,balance s k x l r')
+      Tip             -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
+
+delta,ratio :: Int
+delta = 5
+ratio = 2
+
+size :: OrdMap k a ix -> Int
+size Tip = 0
+size (Bin s _ _ _ _) = s
+
+balance :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+balance s k x l r
+  | sizeL + sizeR <= 1    = Bin sizeX k x l r
+  | sizeR >= delta*sizeL  = rotateL s k x l r
+  | sizeL >= delta*sizeR  = rotateR s k x l r
+  | otherwise             = Bin sizeX k x l r
+  where
+    sizeL = size l
+    sizeR = size r
+    sizeX = sizeL + sizeR + s x
+
+-- rotate
+rotateL :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+rotateL s k x l r@(Bin _ _ _ ly ry)
+  | size ly < ratio*size ry = singleL s k x l r
+  | otherwise               = doubleL s k x l r
+rotateL _ _ _ _ Tip = error "rotateL Tip"
+
+rotateR :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+rotateR s k x l@(Bin _ _ _ ly ry) r
+  | size ry < ratio*size ly = singleR s k x l r
+  | otherwise               = doubleR s k x l r
+rotateR _ _ _ Tip _ = error "rotateR Tip"
+
+-- basic rotations
+singleL, singleR :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+singleL s k1 x1 t1 (Bin _ k2 x2 t2 t3)  = bin s k2 x2 (bin s k1 x1 t1 t2) t3
+singleL _ _ _ _ Tip = error "singleL Tip"
+singleR s k1 x1 (Bin _ k2 x2 t1 t2) t3  = bin s k2 x2 t1 (bin s k1 x1 t2 t3)
+singleR _ _ _ Tip _ = error "singleR Tip"
+
+doubleL, doubleR :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+doubleL s k1 x1 t1 (Bin _ k2 x2 (Bin _ k3 x3 t2 t3) t4) = bin s k3 x3 (bin s k1 x1 t1 t2) (bin s k2 x2 t3 t4)
+doubleL _ _ _ _ _ = error "doubleL"
+doubleR s k1 x1 (Bin _ k2 x2 t1 (Bin _ k3 x3 t2 t3)) t4 = bin s k3 x3 (bin s k2 x2 t1 t2) (bin s k1 x1 t3 t4)
+doubleR _ _ _ _ _ = error "doubleR"
+
+bin :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+bin s k x l r
+  = Bin (size l + size r + s x) k x l r
diff --git a/Data/TrieMap/Regular.hs b/Data/TrieMap/Regular.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular.hs
@@ -0,0 +1,6 @@
+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
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/Base.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE FlexibleContexts, TypeFamilies, TypeOperators #-}
+
+module Data.TrieMap.Regular.Base where
+
+newtype K0 a r = K0 {unK0 :: a}
+newtype I0 r = I0 {unI0 :: r}
+data U0 r = U0
+data (f :*: g) r = f r :*: g r
+data (f :+: g) r = L (f r) | R (g r)
+newtype L f r = List [f r]
+newtype Reg r = Reg {unReg :: r}
+
+newtype Fix f = In {out :: f (Fix f)}
+
+type family PF a :: * -> *
+
+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 :+:
diff --git a/Data/TrieMap/Regular/Class.hs b/Data/TrieMap/Regular/Class.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/Class.hs
@@ -0,0 +1,69 @@
+{-# 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.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 ix
+	nullT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => m k a ix -> Bool
+	sizeT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> m k a ix -> Int
+	lookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => f k -> m k a ix -> Maybe (a ix)
+	lookupIxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> f k -> m k a ix -> Maybe (Int, a ix)
+	assocAtT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> Int -> m k a ix -> (Int, f k, a ix)
+	updateAtT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (Int -> f k -> a ix -> Maybe (a ix)) -> Int -> m k a ix -> m k a ix
+	alterT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (Maybe (a ix) -> Maybe (a ix)) -> f k -> m k a ix -> m k a ix
+	traverseWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k), Applicative t) => 
+		Sized b -> (f k -> a ix -> t (b ix)) -> m k a ix -> t (m k b ix)
+	foldWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => 
+		(f k -> a ix -> b -> b) -> m k a ix -> b -> b
+	foldlWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) =>
+		(f k -> b -> a ix -> b) -> m k a ix -> b -> b
+	mapEitherT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => 
+		Sized b -> Sized c -> EitherMap (f k) (a ix) (b ix) (c ix) -> m k a ix -> (m k b ix, m k c ix)
+	splitLookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> SplitMap (a ix) x -> f k ->
+		m k a ix -> (m k a ix, Maybe x, m k a ix)
+	unionT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> UnionFunc (f k) (a ix) ->
+		m k a ix -> m k a ix -> m k a ix
+	isectT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized c -> IsectFunc (f k) (a ix) (b ix) (c ix) ->
+		m k a ix -> m k b ix -> m k c ix
+	diffT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> DiffFunc (f k) (a ix) (b ix) ->
+		m k a ix -> m k b ix -> m k a ix
+	extractMinT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> m k a ix -> First ((f k, a ix), m k a ix)
+	extractMaxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> m k a ix -> Last ((f k, a ix), m k a ix)
+	alterMinT, alterMaxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (f k -> a ix -> Maybe (a ix)) ->
+		m k a ix -> m k a ix
+	isSubmapT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => LEq (a ix) (b ix) -> LEq (m k a ix) (m k b ix)
+	fromListT, fromAscListT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (f k -> a ix -> a ix -> a ix) ->
+		[(f k, a ix)] -> m k a ix
+	fromDistAscListT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> [(f k, a ix)] -> m k a ix
+	fromListT s f = foldr (\ (k, a) -> alterT s (Just . maybe a (f k a)) k) emptyT
+	fromAscListT = fromListT
+	fromDistAscListT s = fromAscListT s (const const)
+	updateAtT s f i m = case assocAtT s i m of
+		(i, k, a) -> alterT s (const (f i k a)) k m
+
+guardNullT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a ix -> Maybe (TrieMapT f k a ix)
+guardNullT m
+	| nullT m	= Nothing
+	| otherwise	= Just m
+
+assocsT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a ix -> [(f k, a ix)]
+assocsT m = foldWithKeyT (\ k a -> ((k, a):)) m []
+
+singletonT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> f k -> a ix -> TrieMapT f k a ix
+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 ix -> b ix) -> TrieMapT f k a ix -> TrieMapT f k b ix
+mapWithKeyT s f m = unId (traverseWithKeyT s (Id .: f) m)
diff --git a/Data/TrieMap/Regular/ConstMap.hs b/Data/TrieMap/Regular/ConstMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/ConstMap.hs
@@ -0,0 +1,70 @@
+{-# 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 :: * -> *) ix = KMap (m a ix)
+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) = lookupIxM s k m
+	assocAtM s i (KMap m) = case assocAtM s i m of
+		(i', k, a) -> (i', K0 k, a)
+	updateAtM s f i (KMap m) = KMap (updateAtM s (\ i -> f i . K0) i m)
+	alterM s f (K0 k) (KMap m) = KMap (alterM 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)
+	extractMinM s (KMap m) = (first K0 *** KMap) `liftM` extractMinM s m
+	extractMaxM s (KMap m) = (first K0 *** KMap) `liftM` extractMaxM s 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
+	traverseWithKeyT = traverseWithKeyM
+	foldWithKeyT = foldWithKeyM
+	foldlWithKeyT = foldlWithKeyM
+	mapEitherT = mapEitherM
+	splitLookupT = splitLookupM
+	unionT = unionM
+	isectT = isectM
+	diffT = diffM
+	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
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/Eq.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeOperators #-}
+
+module Data.TrieMap.Regular.Eq where
+
+import Data.TrieMap.Regular.Base
+
+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 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 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
diff --git a/Data/TrieMap/Regular/IdMap.hs b/Data/TrieMap/Regular/IdMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/IdMap.hs
@@ -0,0 +1,68 @@
+{-# 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 ix = IMap (TrieMap k a ix)
+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) = lookupIxM s k m
+	assocAtT s i (IMap m) = case assocAtM s i m of
+		(i', k, a) -> (i', I0 k, a)
+	updateAtT s f i (IMap m) = IMap (updateAtM s (\ i -> f i . I0) i m)
+	alterT s f (I0 k) (IMap m) = IMap (alterM 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)
+	extractMinT s (IMap m) = (first I0 *** IMap) `liftM` extractMinM s m
+	extractMaxT s (IMap m) = (first I0 *** IMap) `liftM` extractMaxM s 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
+	traverseWithKeyM = traverseWithKeyT
+	foldWithKeyM = foldWithKeyT
+	foldlWithKeyM = foldlWithKeyT
+	mapEitherM = mapEitherT
+	splitLookupM = splitLookupT
+	unionM = unionT
+	isectM = isectT
+	diffM = diffT
+	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
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/Instances.hs
@@ -0,0 +1,9 @@
+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
diff --git a/Data/TrieMap/Regular/Ord.hs b/Data/TrieMap/Regular/Ord.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/Ord.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE UndecidableInstances, FlexibleContexts, TypeOperators #-}
+
+module Data.TrieMap.Regular.Ord where
+
+import Data.TrieMap.Regular.Base
+import Data.TrieMap.Regular.Eq
+
+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 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 :+: 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)
diff --git a/Data/TrieMap/Regular/ProdMap.hs b/Data/TrieMap/Regular/ProdMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/ProdMap.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts,  TypeOperators, UndecidableInstances #-}
+
+module Data.TrieMap.Regular.ProdMap() where
+
+import Data.TrieMap.Regular.Class
+import Data.TrieMap.Regular.Base
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Applicative
+
+import Control.Applicative
+import Control.Arrow
+
+import Data.Maybe
+
+newtype PMap m1 (m2 :: * -> (* -> *) -> * -> *) k (a :: * -> *) ix = PMap (m1 k (m2 k a) ix)
+type instance TrieMapT (f :*: g) = PMap (TrieMapT f) (TrieMapT g)
+type instance TrieMap ((f :*: g) r) = TrieMapT (f :*: g) r
+
+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) = do
+		(iA, m') <- lookupIxT (sizeT s) a m
+		(iB, v) <- lookupIxT s b m'
+		return (iA + iB, v)
+	assocAtT s i (PMap m) = case assocAtT (sizeT s) i m of
+		(iA, a, m') -> case assocAtT s (i - iA) m' of
+			(iB, b, v) -> (iA + iB, a :*: b, v)
+	updateAtT s f i (PMap m) = PMap (updateAtT (sizeT s) g i m) where
+		g iA a = guardNullT . updateAtT s (\ iB b -> f (iA + iB) (a :*: b)) (i - iA)
+	alterT s f (a :*: b) (PMap m) = PMap (alterT (sizeT s) g a m) where
+		g = guardNullT . alterT 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)
+	extractMinT s (PMap m) = do
+		((a, m1), m') <- extractMinT (sizeT s) m
+		((b, v), m1') <- extractMinT s m1
+		return ((a :*: b, v), PMap (maybe m' (\ _ -> alterMinT (sizeT s) (\ _ _ -> Just m1') m) (guardNullT m1')))
+	extractMaxT s (PMap m) = do
+		((a, m1), m') <- extractMaxT (sizeT s) m
+		((b, v), m1') <- extractMaxT s m1
+		return ((a :*: b, v), PMap (maybe m' (\ _ -> alterMaxT (sizeT s) (\ _ _ -> Just m1') m) (guardNullT m1')))
+	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
+
+instance (TrieKeyT f m1, TrieKeyT g m2, TrieKey k (TrieMap k)) => TrieKey ((f :*: g) k) (PMap m1 m2 k) where
+	emptyM = emptyT
+	nullM = nullT
+	sizeM = sizeT
+	lookupM = lookupT
+	lookupIxM = lookupIxT
+	assocAtM = assocAtT
+	updateAtM = updateAtT
+	alterM = alterT
+	traverseWithKeyM = traverseWithKeyT
+	foldWithKeyM = foldWithKeyT
+	foldlWithKeyM = foldlWithKeyT
+	mapEitherM = mapEitherT
+	splitLookupM = splitLookupT
+	unionM = unionT
+	isectM = isectT
+	diffM = diffT
+	extractMinM = extractMinT
+	extractMaxM = extractMaxT
+	alterMinM = alterMinT
+	alterMaxM = alterMaxT
+	isSubmapM = isSubmapT
+	fromListM = fromListT
+	fromAscListM = fromAscListT
+	fromDistAscListM = fromDistAscListT
diff --git a/Data/TrieMap/Regular/RadixTrie.hs b/Data/TrieMap/Regular/RadixTrie.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/RadixTrie.hs
@@ -0,0 +1,322 @@
+{-# LANGUAGE 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.Sized
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Applicative
+
+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 :: * -> *) ix = Edge {-# UNPACK #-} !Int [f k] (Maybe (a ix)) (m k (Edge f m k a) ix)
+type Edge' f k a ix = Edge f (TrieMapT f) k a ix
+type MEdge f k m a ix = Maybe (Edge f m k a ix)
+type MEdge' f k a ix = Maybe (Edge' f k a ix)
+newtype RadixTrie f k a ix = Radix (MEdge' f k a ix)
+-- newtype K0 a b = K0 a
+
+type instance TrieMapT (L f) = RadixTrie f
+type instance TrieMap (L f r) = RadixTrie f r
+-- type instance TrieMap [k] = RadixTrie k (TrieMap k)
+
+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 ix) -> m k (Edge f m k a) ix -> Edge f m k a ix
+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) = m >>= lookupIxE s 0 ks
+	assocAtT s i (Radix m) = fromJust (do	(i', ks, v) <- m >>= assocAtE s i
+						return (i', List ks, v))
+	updateAtT s f i (Radix m) = Radix (m >>= updateAtE s (\ i' -> f i' . List) i)
+	alterT s f (List ks) (Radix m) = Radix (maybe (singletonME s ks (f Nothing)) (alterE 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)
+	extractMinT s (Radix m) = First m >>= liftM (first List *** Radix) . extractMinE s
+	extractMaxT s (Radix m) = Last m >>= liftM (first List *** Radix) . extractMaxE s
+	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
+	traverseWithKeyM = traverseWithKeyT
+	foldWithKeyM = foldWithKeyT
+	foldlWithKeyM = foldlWithKeyT
+	mapEitherM = mapEitherT
+	splitLookupM = splitLookupT
+	unionM = unionT
+	isectM = isectT
+	diffM = diffT
+	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 ix -> MEdge' f k a ix
+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 ix -> Edge' f k a ix
+l `cons` Edge s ls v ts = Edge s (l:ls) v ts
+
+cat :: [f k] -> Edge' f k a ix -> Edge' f k a ix
+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 ix) -> MEdge' f k a ix
+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 ix -> Maybe (a ix)
+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 ix) -> Maybe (a ix)) -> [f k] -> Edge' f k a ix -> MEdge' f k a ix
+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
+
+traverseE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Applicative t) => 
+	Sized b -> ([f k] -> a ix -> t (b ix)) -> Edge' f k a ix -> t (Edge' f k b ix)
+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 ix -> b -> b) -> Edge' f k a ix -> 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 ix -> b) -> Edge' f k a ix -> 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 ix) (b ix) (c ix)) (Edge' f k a ix) (Edge' f k b ix) (Edge' f k c ix)
+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 ix) x -> [f k] -> SplitMap (Edge' f k a ix) 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 ix)) (Edge' f k a ix)
+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))
+
+extractMinE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> Edge' f k a ix -> First (([f k], a ix), MEdge' f k a ix)
+extractMinE s (Edge _ ks v ts) = (do
+	v <- First v
+	return ((ks, v), compact (edge s ks Nothing ts))) `mplus` 
+  (do	((x, e'), ts') <- extractMinT edgeSize ts
+	((xs, v), e'') <- extractMinE s e'
+	return ((ks ++ x:xs, v), compact (edge s ks Nothing (maybe ts' (\ e'' -> alterMinT edgeSize (\ _ _ -> Just e'') ts) e''))))
+
+extractMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> Edge' f k a ix -> Last (([f k], a ix), MEdge' f k a ix)
+extractMaxE s (Edge _ ks v ts) = (do
+	v <- Last v
+	return ((ks, v), Nothing)) `mplus`
+  (do	((x, e'), ts') <- extractMaxT edgeSize ts
+	((xs, v), e'') <- extractMaxE s e'
+	return ((ks ++ x:xs, v), compact (edge s ks Nothing (maybe ts' (\ e'' -> alterMaxT edgeSize (\ _ _ -> Just e'') ts) e''))))
+
+alterMinE, alterMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a ->
+	([f k] -> a ix -> Maybe (a ix)) -> Edge' f k a ix -> MEdge' f k a ix
+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 ix) (b ix) (c ix)) (Edge' f k a ix) (Edge' f k b ix) (Edge' f k c ix)
+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 ix) (b ix)) (Edge' f k a ix) (Edge' f k b ix)
+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 ix) (b ix) -> LEq (Edge' f k a ix) (Edge' f k b ix)
+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 (f a)) (filterer' xs)
+	filterer' ((k:ks, a):xs) = second (cons k ks a) (filterer' xs)
+	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 ix -> a ix -> a ix) -> [([f k], a ix)] -> MEdge' f k a ix
+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 (xs ++ ys)) [(k, K0 xs) | (k, xs) <- xss])))
+
+fromAscListE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 
+	Sized a -> ([f k] -> a ix -> a ix -> a ix) -> [([f k], a ix)] -> MEdge' f k a ix
+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 ix -> Maybe (Int, a ix)
+lookupIxE _ i _ _ | i `seq` False = undefined
+lookupIxE s i ks (Edge _ ls v ts) = match ks ls where
+	match (k:ks) (l:ls)
+		| k `eqT` l	= match ks ls
+	match (k:ks) [] = do
+		(iT, e') <- lookupIxT edgeSize k ts
+		lookupIxE s (i + maybe 0 s v + iT) ks e'
+	match [] [] = (,) i <$> v
+	match _ _ = Nothing
+
+assocAtE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
+	Sized a -> Int -> Edge' f k a ix -> Maybe (Int, [f k], a ix)
+assocAtE s i (Edge _ ks Nothing ts) = case assocAtT edgeSize i ts of
+	(iT, l, e') -> do	(i', ls, v) <- assocAtE s (i - iT) e'
+				return (iT + i', ks ++ l:ls, v)
+assocAtE s i (Edge _ ks (Just v) ts)
+	| i < sv	= return (0, ks, v)
+	| (iT, l, e') <- assocAtT edgeSize (i - sv) ts
+		= do	(i', ls, v') <- assocAtE s ((i - sv) - iT) e'
+			return (i' + iT + sv, ks ++ l:ls, v')
+	where sv = s v
+
+updateAtE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
+	Sized a -> (Int -> [f k] -> a ix -> Maybe (a ix)) -> Int -> Edge' f k a ix -> MEdge' f k a ix
+updateAtE s f i (Edge sz ks Nothing ts) = compact (edge s ks Nothing (updateAtT edgeSize g i ts)) where
+	g iT l = updateAtE s (\ i' ls -> f (iT + i') (ks ++ l:ls)) (i - iT)
+updateAtE s 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 g (i - sv) ts))
+	where	sv = s v
+		g iT l = updateAtE s (\ i' ls -> f (sv + iT + i') (ks ++ l:ls)) (i - sv - iT)
diff --git a/Data/TrieMap/Regular/RegMap.hs b/Data/TrieMap/Regular/RegMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/RegMap.hs
@@ -0,0 +1,40 @@
+{-# 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 :: * -> *) ix = RegMap (m (Reg k) a ix)
+
+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) = lookupIxT s (from' k) m
+	assocAtM s i (RegMap m) = case assocAtT s i m of
+		(i', k, a) -> (i', to' k, a)
+	updateAtM s f i (RegMap m) = RegMap (updateAtT s (\ i' -> f i' . to') i m)
+	alterM s f k (RegMap m) = RegMap (alterT 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)
+	extractMinM s (RegMap m) = (first to' *** RegMap) `liftM` extractMinT s m
+	extractMaxM s (RegMap m) = (first to' *** RegMap) `liftM` extractMaxT s 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/Sized.hs b/Data/TrieMap/Regular/Sized.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/Sized.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE Rank2Types #-}
+
+module Data.TrieMap.Regular.Sized where
+
+import Data.TrieMap.Regular.Base
+import Data.TrieMap.Sized
+
+sizeK0 :: Sized (K0 a)
+sizeK0 _ = 1
diff --git a/Data/TrieMap/Regular/UnionMap.hs b/Data/TrieMap/Regular/UnionMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/UnionMap.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE TypeOperators, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
+
+module Data.TrieMap.Regular.UnionMap() 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.Either
+
+-- import Generics.MultiRec.Base
+data UnionMap m1 m2 k (a :: * -> *) ix = m1 k a ix :&: m2 k a ix
+
+type instance TrieMapT (f :+: g) = UnionMap (TrieMapT f) (TrieMapT g)
+type instance TrieMap ((f :+: g) r) = TrieMapT (f :+: g) r
+
+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 -> lookupIxT s k m1
+		R k -> first (+ sizeT s m1) <$> lookupIxT s k m2
+	assocAtT s i (m1 :&: m2)
+		| i < s1	= case assocAtT s i m1 of
+			(i', k, a) -> (i', L k, a)
+		| otherwise	= case assocAtT s (i - s1) m2 of
+			(i', k, a) -> (i' + s1, R k, a)
+		where s1 = sizeT s m1
+	updateAtT s f i (m1 :&: m2)
+		| i < s1	= updateAtT s (\ i' -> f i' . L) i m1 :&: m2
+		| otherwise	= m1 :&: updateAtT s (\ i' -> f (i' + s1) . R) (i - s1) m2
+		where s1 = sizeT s m1
+	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
+	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
+	extractMinT s (m1 :&: m2) = (do
+		((k, a), m1') <- extractMinT s m1
+		return ((L k, a), m1' :&: m2)) `mplus`
+	  (do	((k, a), m2') <- extractMinT s m2
+	  	return ((R k, a), m1 :&: m2'))
+	extractMaxT s (m1 :&: m2) = (do
+		((k, a), m1') <- extractMaxT s m1
+		return ((L k, a), m1' :&: m2)) `mplus`
+	  (do	((k, a), m2') <- extractMaxT s m2
+	  	return ((R k, a), m1 :&: 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
+
+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)
+
+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
+	updateAtM = updateAtT
+	alterM = alterT
+	traverseWithKeyM = traverseWithKeyT
+	foldWithKeyM = foldWithKeyT
+	foldlWithKeyM = foldlWithKeyT
+	mapEitherM = mapEitherT
+	splitLookupM = splitLookupT
+	unionM = unionT
+	isectM = isectT
+	diffM = diffT
+	extractMinM = extractMinT
+	extractMaxM = extractMaxT
+	alterMinM = alterMinT
+	alterMaxM = alterMaxT
+	isSubmapM = isSubmapT
+	fromListM = fromListT
+	fromAscListM = fromAscListT
+	fromDistAscListM = fromDistAscListT
diff --git a/Data/TrieMap/Regular/UnitMap.hs b/Data/TrieMap/Regular/UnitMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/UnitMap.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
+
+module Data.TrieMap.Regular.UnitMap() where
+
+import Data.TrieMap.Regular.Class
+import Data.TrieMap.Regular.Base
+import Data.TrieMap.TrieKey
+
+import Control.Applicative
+import Control.Arrow
+
+import Data.Foldable
+import Data.Maybe
+import Data.Monoid
+import Data.Traversable
+
+import Prelude hiding (foldr, foldl)
+
+newtype M k a ix = M (Maybe (a ix))
+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) = fmap ((,) 0) a
+	assocAtM s i (M (Just v)) = (0, U0, v)
+	updateAtM s f i (M v) = M (v >>= f 0 U0)
+	alterM _ 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)
+	extractMinM _ (M a) = do	a <- First a
+					return ((U0, a), M Nothing)
+	extractMaxM _ (M a) = do	a <- Last a
+					return ((U0, a), M Nothing)
+	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
+	traverseWithKeyT = traverseWithKeyM
+	foldWithKeyT = foldWithKeyM
+	foldlWithKeyT = foldlWithKeyM
+	mapEitherT = mapEitherM
+	splitLookupT = splitLookupM
+	unionT = unionM
+	isectT = isectM
+	diffT = diffM
+	extractMinT = extractMinM
+	extractMaxT = extractMaxM
+	alterMinT = alterMinM
+	alterMaxT = alterMaxM
+	isSubmapT = isSubmapM
+	fromListT = fromListM
+	fromAscListT = fromAscListM
+	fromDistAscListT = fromDistAscListM
diff --git a/Data/TrieMap/Sized.hs b/Data/TrieMap/Sized.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Sized.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE Rank2Types #-}
+
+module Data.TrieMap.Sized where
+
+-- class Sized f where
+-- 	getSize :: f a -> Int
+-- 
+-- newtype Elem a = Elem {getElem :: a}
+-- 
+-- instance Sized Elem where
+-- 	getSize _ = 1
+
+type Sized f = forall ix . f ix -> Int
+
+newtype Elem a = Elem {getElem :: a}
+
+elemSize :: Sized Elem
+elemSize _ = 1
diff --git a/Data/TrieMap/TrieKey.hs b/Data/TrieMap/TrieKey.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/TrieKey.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE Rank2Types, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, KindSignatures #-}
+
+module Data.TrieMap.TrieKey where
+
+import Data.TrieMap.Applicative
+import Data.TrieMap.Sized
+
+import Control.Applicative
+
+import Data.Monoid
+
+type family TrieMap k :: (* -> *) -> * -> *
+-- 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 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 k f a m = m -> f ((k, a), m)
+type LEq a b = a -> b -> Bool
+-- type Sized f = forall ix . f ix -> Int
+
+-- toFixer :: a -> Fixer a
+-- toFixer _ = undefined
+
+class Ord k => TrieKey k m | k -> m, m -> k where
+	emptyM :: TrieMap k ~ m => m a ix
+	nullM :: TrieMap k ~ m => m a ix -> Bool
+	sizeM :: (TrieMap k ~ m) => Sized a -> m a ix -> Int
+	lookupM :: TrieMap k ~ m => k -> m a ix -> Maybe (a ix)
+	lookupIxM :: TrieMap k ~ m => Sized a -> k -> m a ix -> Maybe (Int, a ix)
+	assocAtM :: TrieMap k ~ m => Sized a -> Int -> m a ix -> (Int, k, a ix)
+	updateAtM :: TrieMap k ~ m => Sized a -> (Int -> k -> a ix -> Maybe (a ix)) -> Int -> m a ix -> m a ix
+	alterM :: (TrieMap k ~ m) => Sized a -> (Maybe (a ix) -> Maybe (a ix)) -> k -> m a ix -> m a ix
+	{-# SPECIALIZE traverseWithKeyM :: (k -> a ix -> Id (b ix)) -> m a ix -> Id (m b ix) #-}
+	traverseWithKeyM :: (TrieMap k ~ m, Applicative f) => (forall ix . b ix -> Int) -> 
+		(k -> a ix -> f (b ix)) -> m a ix -> f (m b ix)
+	foldWithKeyM :: TrieMap k ~ m => (k -> a ix -> b -> b) -> m a ix -> b -> b
+	foldlWithKeyM :: TrieMap k ~ m => (k -> b -> a ix -> b) -> m a ix -> b -> b
+	mapEitherM :: (TrieMap k ~ m) => Sized b -> Sized c -> EitherMap k (a ix) (b ix) (c ix) -> m a ix -> (m b ix, m c ix)
+	splitLookupM :: (TrieMap k ~ m) => Sized a -> SplitMap (a ix) x -> k -> m a ix -> (m a ix, Maybe x, m a ix)
+	unionM :: (TrieMap k ~ m) => Sized a -> UnionFunc k (a ix) -> m a ix -> m a ix -> m a ix
+	isectM :: (TrieMap k ~ m) => Sized c -> IsectFunc k (a ix) (b ix) (c ix) -> m a ix -> m b ix -> m c ix
+	diffM :: (TrieMap k ~ m) => Sized a -> DiffFunc k (a ix) (b ix) -> m a ix -> m b ix -> m a ix
+	extractMinM :: (TrieMap k ~ m) => Sized a -> ExtractFunc k First (a ix) (m a ix)
+	extractMaxM :: (TrieMap k ~ m) => Sized a -> ExtractFunc k Last (a ix) (m a ix)
+	alterMinM, alterMaxM :: (TrieMap k ~ m) => Sized a -> (k -> a ix -> Maybe (a ix)) -> m a ix -> m a ix
+	isSubmapM :: TrieMap k ~ m => LEq (a ix) (b ix) -> LEq (m a ix) (m b ix)
+	fromListM, fromAscListM :: (TrieMap k ~ m) => Sized a -> (k -> a ix -> a ix -> a ix) -> [(k, a ix)] -> m a ix
+	fromDistAscListM :: (TrieMap k ~ m) => Sized a -> [(k, a ix)] -> m a ix
+	
+	sizeM s m = foldWithKeyM (\ _ a n -> s a + n) m 0
+	fromListM s f = foldr (uncurry (insertWithKeyM s f)) emptyM
+	fromAscListM = fromListM
+	fromDistAscListM s = fromAscListM s (const const)
+	updateAtM s f i m = case assocAtM s i m of
+		(i', k, a)	-> alterM s (const (f i' k a)) k m
+
+guardNullM :: (TrieKey k m, m ~ TrieMap k) => m a ix -> Maybe (m a ix)
+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)
+
+mapMaybeM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a ix -> Maybe (b ix)) -> m a ix -> m b ix
+mapMaybeM s f = snd . mapEitherM elemSize s (((,) (Nothing :: Maybe (Elem ix))) .: f)
+
+mapWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a ix -> b ix) -> m a ix -> m b ix
+mapWithKeyM s f  = unId . traverseWithKeyM s (Id .: f)
+
+mapM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (a ix -> b ix) -> m a ix -> m b ix
+mapM s = mapWithKeyM s . const
+
+assocsM :: (TrieKey k m, m ~ TrieMap k) => m a ix -> [(k, a ix)]
+assocsM m = foldWithKeyM (\ k a xs -> (k, a):xs) m []
+
+insertM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> k -> a ix -> m a ix -> m a ix
+insertM s = insertWithKeyM s (const const)
+
+insertWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> (k -> a ix -> a ix -> a ix) -> k -> a ix -> m a ix -> m a ix
+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 ix -> m a ix
+singletonM s k a = insertM s k a emptyM
+
+fromListM' :: (TrieKey k m, m ~ TrieMap k) => Sized a -> [(k, a ix)] -> m a ix
+fromListM' s = fromListM s (const const) --xs = foldr (uncurry insertM) emptyM xs
+
+unionMaybe :: (a -> a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a
+unionMaybe _ Nothing y = y
+unionMaybe _ x Nothing = x
+unionMaybe f (Just x) (Just y) = f x y
+
+isectMaybe :: (a -> b -> Maybe c) -> Maybe a -> Maybe b -> Maybe c
+isectMaybe f (Just x) (Just y) = f x y
+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)
+
+subMaybe :: (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
+subMaybe _ Nothing _ = True
+subMaybe (<=) (Just a) (Just b) = a <= b
+subMaybe _ _ _ = False
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2009, Louis Wasserman
+Copyright (c) 2008, Louis Wasserman
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
diff --git a/TrieMap.cabal b/TrieMap.cabal
--- a/TrieMap.cabal
+++ b/TrieMap.cabal
@@ -1,33 +1,51 @@
-name:		TrieMap
-version:	0.0.1.2
-license:	BSD3
-license-file:	LICENSE
-maintainer:	wasserman.louis@gmail.com
-category:	Data Structures
-synopsis:	An implementation of generalized tries with sophisticated map type inference.
-description:	Generalized trie implementation that automatically infers map types.  Keys must implement the class 'TrieMap.Algebraic.Algebraic', which 
-			declares that they are isomorphic to an /algebraic type/,
-			defined recursively as follows:
- .
- * () and 'Int' are algebraic types.
- .
- * If @'Ord' a@, then @'Ordered' a@ is an algebraic type.
- .
- * If @a,b@ are algebraic types, then so are @(a, b)@ and @Either a b@.
- .
- * If @a@ is algebraic, so is @[a]@.
- .
- This package exports almost the entire collection of methods available in Data.Map, and several new methods as well.  In addition, each method will automatically infer the correct map type.
- 
-build-type:	Simple
-build-depends:
-	base >= 4 && <= 5, containers == 0.2.0.1, bytestring
-exposed-modules:
-	TrieMap
-	TrieMap.Algebraic
+name:		     TrieMap
+version:             0.5.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.
+license:             BSD3
+license-file:	     LICENSE
+author:              Louis Wasserman
+maintainer:          wasserman.louis@gmail.com
+build-Depends:       base < 5.0.0.0, containers, multirec
+build-type:	     Simple
+exposed-modules:  
+	Data.TrieMap,
+	Data.TrieMap.Class,
+	Data.TrieMap.Regular,
+	Data.TrieMap.MultiRec
+	-- Data.TrieMap.TrieKey
 other-modules:
-	TrieMap.TrieAlgebraic
-	TrieMap.Applicative
-	TrieMap.Reflection
-	TrieMap.RadixTrie
-	TrieMap.MapTypes
+	Data.TrieMap.Class.Instances,
+	Data.TrieMap.TrieKey,
+	Data.TrieMap.Applicative,
+	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.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.UnionMap,
+	Data.TrieMap.Regular.Sized,
+	Data.TrieMap.IntMap,
+	Data.TrieMap.OrdMap,
+	Data.TrieMap.Sized,
+	Data.TrieMap.Applicative
diff --git a/TrieMap.hs b/TrieMap.hs
deleted file mode 100644
--- a/TrieMap.hs
+++ /dev/null
@@ -1,954 +0,0 @@
-{-# LANGUAGE TypeOperators, UndecidableInstances, FlexibleContexts, TypeFamilies #-}
-
--- | We will use the following terminology:
--- 
--- An /algebraic/ type is a type isomorphic to an algebraic type, as defined in the package description.  This isomorphism is
--- declared via the type class 'Algebraic', where @'AlgRep' k@ is algebraic.  It is assumed for purposes of ordering that
--- this isomorphism is order- and equality-preserving.  We also require that if @k@ is algebraic, @'AlgRep' k ~ k@.
---
--- These methods will automatically infer the correct type of a 'TrieMap' on any given argument.  For example,
--- 
--- @'fromList' [((\"alphabet\", 'Just' (0.2 :: 'Double'), 'True'), \"wxyz\")]@
--- 
---  returns a variable of type
--- 
--- @'TrieMap' ('String', 'Double', 'Bool') ('ProdMap' ('ConstMap' ('RadixTrie' 'Int' 'IntMap')) ('ProdMap' ('ConstMap' ('UnionMap' ('ConstMap' 'Maybe') 'IdMap' ('Ordered' 'Double') ('Map' 'Double'))) 'IdMap') (('Const' () :+: 'Id') '()') ('UnionMap' ('ConstMap' 'Maybe') 'IdMap' () 'Maybe')) 'String'@
--- 
--- The inference was done entirely automatically.  Note also:
--- 
--- 	* @'AlgRep' 'Char' ~ 'Int'@: the 'Algebraic' instance for 'Char' maps characters to their ASCII representations, so an 'IntMap' can be used.
--- 
--- 	* @'AlgRep' ('Maybe' a) ~ 'Either' () ('AlgRep' a)@; a 'TrieMap' on a 'Maybe' key type simply gets a space for one extra (possible) value.
--- 
--- 	* @'AlgRep' 'Double' ~ 'Ordered' 'Double'@; the 'Algebraic' instance for 'Double' tells "TrieMap" to just use a regular 'Data.Map.Map'
--- 		and the default ordering for 'Double's.
--- 
--- 	* @'AlgRep' 'Bool' ~ 'Either' () ()@, so a 'TrieMap' on a 'Bool' takes the form of -- essentially -- a pair of 'Maybe's.
--- 	
--- 	* @'AlgRep' (a, b, c) ~ ('AlgRep' a, ('AlgRep' b, 'AlgRep' c))@, so tuple types get handled by a sequence of map products.
--- 
--- (If you plan to use these maps in type arguments, it is strongly suggested that you either reproduce the context 
--- @('Algebraic' k, 'TrieKey' ('AlgRep' k) m) => TrieMap k m a@, or you create a type alias!)
---
-
--- The following is a general attempt to describe the runtime of operations supported by 'TrieMap's.
--- 
--- 	* Lookup operations take /O(log n)/ for 'Ordered' keys, /O(max(log n, W))/ for 'Int' keys, /O(l)/ times lookup cost for @k@ 
--- 		for keys of type @[k]@, and otherwise will take @O(1)@ over the total cost of their components.
--- 
--- 	* Insertion operations take roughly the same asymptotic time as lookup operations.
--- 	
--- 	* Traversal operations take /O(n)/ for all map types, with obviously greater overhead for use of specialized 
--- 		'Applicative' functors.
--- 	
--- 	* Set operations (union, intersection, difference) take /O(m + n)/ in all cases.
-
-module TrieMap (
-	-- * Map type
-	TrieMap,
-	Algebraic (..), 
-	AlgebraicT (..),
-	TrieKey,
-	TrieKeyT,
-	EqT,
-	-- * Map instances
-	ProdMap,  (:*:)(..), CProdMap, UnionMap, (:+:)(..), CUnionMap, RadixTrie, ConstMap, Const(..), IdMap, Id(..), CompMap, O, o, unO, FixMap, Fix(..), 
-	-- * Operators
-	(!), 
-	(\\),
-	-- * Query
-	null,
-	size,
-	member,
-	notMember,
-	lookup, 
-	find,
-	findWithDefault,
-	-- * Construction
-	empty,
-	singleton,
-	-- * Insertion
-	insert,
-	insertWith,
-	insertWithKey,
-	insertLookupWithKey,
-	-- * Delete/Update
-	delete,
-	update,
-	updateWithKey,
-	updateLookupWithKey,
-	alter,
-	alterLookup,
-	-- * Combine
-	-- ** Union/Symmetric Difference
-	union, 
-	unionWith,
-	unionWithKey,
-	unions,
-	unionsWith,
-	unionsWithKey,
-	unionMaybeWith,
-	unionMaybeWithKey,
-	symDifference,
-	-- ** Intersection
-	intersection,
-	intersectionWith,
-	intersectionWithKey,
-	intersectionMaybeWith,
-	intersectionMaybeWithKey,
-	-- ** Difference
-	difference, 
-	differenceWith,
-	differenceWithKey, 
-	-- * Traversal
-	-- ** Map
-	map,
-	mapWithKey,
-	traverseWithKey,
-	mapMaybe,
-	mapMaybeWithKey,
-	mapEither,
-	mapEitherWithKey,
-	mapKeys,
-	mapKeysWith,
-	mapKeysMonotonic,
-	-- ** Fold
-	fold,
-	foldWithKey,
-	-- * Conversion
-	elems,
-	keys,
-	assocs,
-	-- ** Lists
-	fromList,
-	fromListWith,
-	fromListWithKey,
-	-- ** Ordered lists
-	fromAscList,
-	fromAscListWith,
-	fromAscListWithKey,
-	fromDistinctAscList,
-	-- * Filter
-	filter,
-	filterWithKey,
-	partition,
-	partitionWithKey,
-	split,
-	splitLookup,
-	-- * Submap
-	isSubmapOf,
-	isSubmapOfBy,
-	-- * Min/Max
-	findMin,
-	getMin,
-	findMax,
-	getMax,
-	deleteMin,
-	deleteMax,
-	deleteFindMin,
-	deleteFindMax,
-	updateMin,
-	updateMax,
-	updateMinWithKey,
-	updateMaxWithKey,
-	minView,
-	maxView,
-	minViewWithKey,
-	maxViewWithKey) where
--- module TrieMap where
-
-import Control.Monad
-import Data.Monoid
-import Data.Traversable
-import TrieMap.MapTypes
-import TrieMap.Applicative
-import TrieMap.Algebraic
-import TrieMap.TrieAlgebraic
-import TrieMap.RadixTrie
-import TrieMap.Reflection
-import Control.Applicative hiding (Alternative(..), Const)
-import Data.Maybe hiding (mapMaybe)
-import Data.Map (Map)
-import Data.IntMap (IntMap)
-import Data.Foldable hiding (fold, find)
-import GHC.Exts
--- import TrieMap.FixPoint
--- import TrieMap.FixPoint.Algebraic
--- import TrieMap.Reflection
-import Prelude hiding (lookup, foldr, null, filter, foldl, map)
-import qualified Prelude as Prelude
-
--- | A 'TrieMap' is a size-tracking wrapper around a generalized trie map.
-data TrieMap k m a = TrieMap {sizeMap :: Int, trieMap :: m (Elem a)}
-
-instance (Eq k, Eq a, Algebraic k, TrieKey (AlgRep k) m) => Eq (TrieMap k m a) where
-	(==) = (==) `on` assocs
-
-instance (Ord k, Ord a, Algebraic k, TrieKey (AlgRep k) m) => Ord (TrieMap k m a) where
-	compare = compare `on` assocs
-
-instance (Show k, Show a, Algebraic k, TrieKey (AlgRep k) m) => Show (TrieMap k m a) where
-	show m = "fromList " ++ show (assocs m)
-
--- instance (Algebraic k, Algebraic a, TrieKey (AlgRep k) m) => Algebraic (TrieMap k m a) where
--- 	type AlgRep (TrieMap k m a) =  ([(AlgRep k, AlgRep a)], Int)
--- 	toAlg (TrieMap n m) = (build (\ c n -> foldWithKeyAlg (\ k a -> c (k, toAlg a)) n m), n)
--- 	fromAlg (xs, n) = TrieMap n $ fromDistAscListAlg [(k, fromAlg a) | (k, a) <- xs]
-
-instance SAlgebraicT m => AlgebraicT (TrieMap k m) where
-	type AlgRepT (TrieMap k m) = SAlgRepT m :*: Const Int
-	toAlgT (TrieMap n m) = fmap getElem (toSAlgT m) :*: Const n
-	fromAlgT (m :*: Const n) = TrieMap n (fromSAlgT (fmap Elem m))
-
-instance Algebraic (m (Elem a)) => Algebraic (TrieMap k m a) where
-	type AlgRep (TrieMap k m a) = AlgRep (m (Elem a), Int)
-	toAlg (TrieMap n m) = toAlg (m, n)
-	fromAlg = uncurry (flip TrieMap) . fromAlg
-{-
-instance (Algebraic (AlgRep k), Algebraic k, TrieKey (AlgRep k) m) => AlgebraicT (TrieMap k m) where
-	type AlgRepT (TrieMap k m) = AlgRepT ([] `O` ((,) (AlgRep k)))
-	toAlgT (TrieMap _ m) = toAlgT (o (fmap (fmap getElem) (assocsAlg m)))
-	fromAlgT = mkTrieMap . fromDistAscListAlg . fmap (fmap Elem) . unO . fromAlgT
-
-instance (Algebraic (AlgRep k), Algebraic k, TrieKey (AlgRep k) m, Algebraic a) => Algebraic (TrieMap k m a) where
-	type AlgRep (TrieMap k m a) = AlgRep (AlgWrap (TrieMap k m) a)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg-}
-
-
-instance TrieKey k' m => Functor (TrieMap k m) where
-	fmap = fmapDefault
-
-instance TrieKey k' m => Foldable (TrieMap k m) where
-	foldr f z = foldWithKeyAlg (\ _ (Elem x) z -> f x z) z . trieMap
-
-instance TrieKey k' m => Traversable (TrieMap k m) where
-	traverse f (TrieMap n m) = TrieMap n <$> mapAppAlg (\ _ (Elem v) -> Elem <$> f v) m
-
-instance (Algebraic k, TrieKey (AlgRep k) m) => Monoid (TrieMap k m a) where
-	mempty = empty
-	mappend = union
-	mconcat = unions
-
-mkTrieMap :: (Algebraic k, TrieKey (AlgRep k) m) => m (Elem a) -> TrieMap k m a
-mkTrieMap m = TrieMap (sizeAlg m) m
-
--- | Lookup the value of 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 :: (Algebraic k, TrieKey (AlgRep k) m) => k -> TrieMap k m a -> Maybe a
-lookup k = fmap getElem . lookupAlg (toAlg k) . trieMap
-
--- | Is the key a member of the map? See also 'notMember'.
---
--- > member 5 (fromList [(5,'a'), (3,'b')]) == True
--- > member 1 (fromList [(5,'a'), (3,'b')]) == False
-member :: (Algebraic k, TrieKey (AlgRep k) m) => k -> TrieMap k m a -> Bool
-member = isJust .: lookup
-
--- | Is the key not a member of the map? See also 'member'.
---
--- > notMember 5 (fromList [(5,'a'), (3,'b')]) == False
--- > notMember 1 (fromList [(5,'a'), (3,'b')]) == True
-notMember :: (Algebraic k, TrieKey (AlgRep k) m) => k -> TrieMap k m a -> Bool
-notMember = not .: member
-
--- | Find the value at a key.
--- Calls 'error' when the element can not be found.
-
-find :: (Algebraic k, TrieKey (AlgRep k) m) => k -> TrieMap k m a -> a
-find = findWithDefault $ error "TrieMap.find: element not in the map"
-
--- | 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 'x' 1 (fromList [(5,'a'), (3,'b')]) == 'x'
--- > findWithDefault 'x' 5 (fromList [(5,'a'), (3,'b')]) == 'a'
-findWithDefault :: (Algebraic k, TrieKey (AlgRep k) m) => a -> k -> TrieMap k m a -> a
-findWithDefault v = fromMaybe v .: lookup
-
--- | /O(1)/. A map with a single element.
---
--- > singleton 1 'a'        == fromList [(1, 'a')]
-singleton :: (Algebraic k, TrieKey (AlgRep k) m) => k -> a -> TrieMap k m a
-singleton k v = TrieMap 1 (insertAlg (toAlg k) (Elem v) emptyAlg)
-
--- | Find the value at a key.
--- Calls 'error' when the element can not be found.
---
--- > fromList [(5,'a'), (3,'b')] ! 1    Error: element not in the map
--- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
-(!) :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> k -> a
-m ! k = fromMaybe (error "element not in the map") (lookup k m)
-
-empty :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a
-empty = TrieMap 0 emptyAlg
-
--- | Check if the specified map is empty.
-null :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> Bool
-null = nullAlg . trieMap
-
--- | Returns the size of the specified map.
-size :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> Int
-size = sizeMap
-
--- | Build a map from a list of key\/value pairs. See also 'fromAscList'.
--- If the list contains more than one value for the same key, the last value
--- for the key is retained.
---
--- > fromList [] == empty
--- > fromList [(5,"a"), (3,"b"), (5, "c")] == fromList [(5,"c"), (3,"b")]
--- > fromList [(5,"c"), (3,"b"), (5, "a")] == fromList [(5,"a"), (3,"b")]
-fromList :: (Algebraic k, TrieKey (AlgRep k) m) => [(k, a)] -> TrieMap k m a
-fromList = fromListWith const
-
--- | Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWith'.
---
--- > fromListWith (++) [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "ab"), (5, "aba")]
--- > fromListWith (++) [] == empty
-fromListWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> a -> a) -> [(k, a)] -> TrieMap k m a
-fromListWith = fromListWithKey . const
-
--- | Build a map from a list of key\/value pairs with a combining function. See also 'fromAscListWithKey'.
---
--- > let f k a1 a2 = (show k) ++ a1 ++ a2
--- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]
--- > fromListWithKey f [] == empty
-fromListWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> a -> a) -> [(k, a)] -> TrieMap k m a
-fromListWithKey f xs = mkTrieMap $ fromListAlg (\ k (Elem v1) (Elem v2) -> Elem (f (fromAlg k) v1 v2)) [(toAlg k, Elem v) | (k, v) <- xs]
-
--- | /O(n)/. Build a map from an ascending list in linear time.
--- /The precondition (input list is ascending) is not checked./
---
--- > fromAscList [(3,"b"), (5,"a")]          == fromList [(3, "b"), (5, "a")]
--- > fromAscList [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "b")]
-fromAscList :: (Algebraic k, TrieKey (AlgRep k) m) => [(k, a)] -> TrieMap k m a
-fromAscList = fromAscListWith const
-
--- | /O(n)/. Build a map from an ascending list in linear time with a combining function for equal keys.
--- /The precondition (input list is ascending) is not checked./
---
--- > fromAscListWith (++) [(3,"b"), (5,"a"), (5,"b")] == fromList [(3, "b"), (5, "ba")]
-fromAscListWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> a -> a) -> [(k, a)] -> TrieMap k m a
-fromAscListWith = fromAscListWithKey . const
-
--- | /O(n)/. Build a map from an ascending list in linear time with a
--- combining function for equal keys.
--- /The precondition (input list is ascending) is not checked./
---
--- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
--- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] == fromList [(3, "b"), (5, "5:b5:ba")]
-fromAscListWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> a -> a) -> [(k, a)] -> TrieMap k m a
-fromAscListWithKey f xs = mkTrieMap $ fromAscListAlg g [(toAlg k, Elem v) | (k, v) <- xs] where
-	g k (Elem v1) (Elem v2) = Elem (f (fromAlg k) v1 v2)
-
--- | /O(n)/. Build a map from an ascending list of distinct elements in linear time.
--- /The precondition is not checked./
---
--- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
-fromDistinctAscList :: (Algebraic k, TrieKey (AlgRep k) m) => [(k, a)] -> TrieMap k m a
-fromDistinctAscList xs = TrieMap (length xs) $ fromDistAscListAlg [(toAlg k, Elem v) | (k, v) <- xs]
-
--- | Insert a new key and value in the map.
--- If the key is already present in the map, the associated value is
--- replaced with the supplied value. 'insert' is equivalent to
--- @'insertWith' 'const'@.
---
--- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
--- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
--- > insert 5 'x' empty                         == singleton 5 'x'
-insert :: (Algebraic k, TrieKey (AlgRep k) m) => k -> a -> TrieMap k m a -> TrieMap k m a
-insert = insertWith const
-
--- | Insert with a function, combining new value and old value.
--- @'insertWith' f key value mp@ 
--- will insert the pair (key, value) into @mp@ if key does
--- not exist in the map. If the key does exist, the function will
--- insert the pair @(key, f new_value old_value)@.
---
--- > insertWith (++) 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "xxxa")]
--- > insertWith (++) 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
--- > insertWith (++) 5 "xxx" empty                         == singleton 5 "xxx"
-insertWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> a -> a) -> k -> a -> TrieMap k m a -> TrieMap k m a
-insertWith = insertWithKey . const
-
--- | Insert with a function, combining key, new value and old value.
--- @'insertWithKey' f key value mp@ 
--- will insert the pair (key, value) into @mp@ if key does
--- not exist in the map. If the key does exist, the function will
--- insert the pair @(key,f key new_value old_value)@.
--- Note that the key passed to f is the same key passed to 'insertWithKey'.
---
--- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value
--- > insertWithKey f 5 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:xxx|a")]
--- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")]
--- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx"
-insertWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> a -> a) -> k -> a -> TrieMap k m a -> TrieMap k m a
-insertWithKey f k = snd .: insertLookupWithKey f k
-
--- | Combines insert operation with old value retrieval.
--- The expression (@'insertLookupWithKey' f k x map@)
--- is a pair where the first element is equal to (@'lookup' k map@)
--- and the second element equal to (@'insertWithKey' f k x map@).
-insertLookupWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> a -> a) -> k -> a -> TrieMap k m a -> (Maybe a, TrieMap k m a)
-insertLookupWithKey f k v (TrieMap n m) = case alterLookupAlg g (toAlg k) m of
-	(old, m')	-> (old, TrieMap (if isJust old then n else n + 1) m')
-	where	g v' = (fmap getElem v', Just $ Elem $ maybe v (f k v . getElem) v')
-
--- | The expression (@'update' f k map@) updates the value @x@
--- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
--- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
---
--- > let f x = if x == "a" then Just "new a" else Nothing
--- > update f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "new a")]
--- > update f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > update f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-update :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> Maybe a) -> k -> TrieMap k m a -> TrieMap k m a
-update = updateWithKey . const
-
--- | The expression (@'updateWithKey' f k map@) updates the
--- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing',
--- the element is deleted. If it is (@'Just' y@), the key @k@ is bound
--- to the new value @y@.
---
--- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
--- > updateWithKey f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "5:new a")]
--- > updateWithKey f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > updateWithKey f 3 (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-updateWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> Maybe a) -> k -> TrieMap k m a -> TrieMap k m a
-updateWithKey f = snd .: updateLookupWithKey f
-
--- | Lookup and update. See also 'updateWithKey'.
--- The function returns changed value, if it is updated.
--- Returns the original key value if the map entry is deleted. 
---
--- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing
--- > updateLookupWithKey f 5 (fromList [(5,"a"), (3,"b")]) == (Just "5:new a", fromList [(3, "b"), (5, "5:new a")])
--- > updateLookupWithKey f 7 (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a")])
--- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
-updateLookupWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> Maybe a) -> k -> TrieMap k m a -> (Maybe a, TrieMap k m a)
-updateLookupWithKey f k (TrieMap n m) = 
-	case alterLookupAlg g (toAlg k) m of
-		((del, res), m')	-> (res, TrieMap (if del then n - 1 else n) m')
-	where	g v = let v' = v >>= f k . getElem in ((isNothing v' && isJust v, maybe (fmap getElem v) Just v'), fmap Elem v')
-
--- | Delete a key and its value from the map. When the key is not
--- a member of the map, the original map is returned.
---
--- > delete 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
--- > delete 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > delete 5 empty                         == empty
--- 
--- 'delete' is equivalent to @'alter' ('const' 'Nothing')@.
-delete :: (Algebraic k, TrieKey (AlgRep k) m) => k -> TrieMap k m a -> TrieMap k m a
-delete = alter (const Nothing)
-
--- | 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 'Map'.
--- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@.
---
--- > let f _ = Nothing
--- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a")]
--- > alter f 5 (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
--- >
--- > let f _ = Just "c"
--- > alter f 7 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "c")]
--- > alter f 5 (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "c")]
-alter :: (Algebraic k, TrieKey (AlgRep k) m) => (Maybe a -> Maybe a) -> k -> TrieMap k m a -> TrieMap k m a
-alter f k = snd . alterLookup f k
-
--- | The expression (@'alterLookup' f k map@) alters the value @x@ at @k@, or absence thereof, and returns the old value.
--- 'alterLookup' can be used to insert, delete, or update a value in a 'Map'.
--- 
--- In short : @alterLookup f k m = (lookup k m, alter f k m)@.
-alterLookup :: (Algebraic k, TrieKey (AlgRep k) m) => (Maybe a -> Maybe a) -> k -> TrieMap k m a -> (Maybe a, TrieMap k m a)
-alterLookup f k (TrieMap n m) = case alterLookupAlg g (toAlg k) m of
-	((old, delta), m')	-> (old, TrieMap (n + delta) m')
-	where	g Nothing = let fv = f Nothing in ((Nothing, just1 fv), fmap Elem fv)
-		g (Just (Elem v)) = let fv = f (Just v) in ((Just v, just1 fv - 1), fmap Elem fv)
-		just1 = maybe 0 (const 1)
-
--- | /O(n)/. Map a function over all values in the map.
---
--- > let f key x = (show key) ++ ":" ++ x
--- > mapWithKey f (fromList [(5,"a"), (3,"b")]) == fromList [(3, "3:b"), (5, "5:a")]
-mapWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> b) -> TrieMap k m a -> TrieMap k m b
-mapWithKey f = unId . traverseWithKey (Id .: f)
-
--- | /O(n)/. Map a function over all values in the map.
---
--- > map (++ "x") (fromList [(5,"a"), (3,"b")]) == fromList [(3, "bx"), (5, "ax")]
-map :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> b) -> TrieMap k m a -> TrieMap k m b
-map = mapWithKey . const
-
--- | Essentially equivalent to 'traverse' with a function that takes both the key and the value as arguments.
-traverseWithKey :: (Algebraic k, TrieKey (AlgRep k) m, Applicative f) =>
-	(k -> a -> f b) -> TrieMap k m a -> f (TrieMap k m b)
-traverseWithKey f (TrieMap n m) = TrieMap n <$> mapAppAlg (\ k (Elem v) -> Elem <$> f (fromAlg k) v) m
-
--- | /O(n)/. Map keys\/values and collect the 'Just' results.
---
--- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
--- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
-mapMaybeWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> Maybe b) -> TrieMap k m a -> TrieMap k m b
-mapMaybeWithKey f = mkTrieMap . mapMaybeAlg (\ k (Elem v) -> Elem <$> f (fromAlg k) v) . trieMap
-
--- | /O(n)/. Map values and collect the 'Just' results.
---
--- > let f x = if x == "a" then Just "new a" else Nothing
--- > mapMaybe f (fromList [(5,"a"), (3,"b")]) == singleton 5 "new a"
-mapMaybe :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> Maybe b) -> TrieMap k m a -> TrieMap k m b
-mapMaybe = mapMaybeWithKey . const
-
--- | /O(n)/. Map values and separate the 'Left' and 'Right' results.
---
--- > let f a = if a < "c" then Left a else Right a
--- > mapEither f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
--- >     == (fromList [(3,"b"), (5,"a")], fromList [(1,"x"), (7,"z")])
--- >
--- > mapEither (\ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
--- >     == (empty, fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
-mapEither :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> Either b c) -> TrieMap k m a -> (TrieMap k m b, TrieMap k m c)
-mapEither = mapEitherWithKey . const
-
--- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results.
---
--- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a)
--- > mapEitherWithKey f (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
--- >     == (fromList [(1,2), (3,6)], fromList [(5,"aa"), (7,"zz")])
--- >
--- > mapEitherWithKey (\_ a -> Right a) (fromList [(5,"a"), (3,"b"), (1,"x"), (7,"z")])
--- >     == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
-mapEitherWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> Either b c) -> TrieMap k m a -> (TrieMap k m b, TrieMap k m c)
-mapEitherWithKey f (TrieMap _ m) = (mkTrieMap mL, mkTrieMap mR)
-	where	(mL, mR) = mapEitherAlg (\ k (Elem v) -> 
-				either (\ k -> (Just (Elem k), Nothing)) (\ k -> (Nothing, Just (Elem k))) (f (fromAlg k) v))
-				m
-
--- |
--- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
--- 
--- The size of the result may be smaller if @f@ maps two or more distinct
--- keys to the same new key.  In this case the value at the smallest of
--- these keys is retained.
---
--- > mapKeys (+ 1) (fromList [(5,"a"), (3,"b")])                        == fromList [(4, "b"), (6, "a")]
--- > mapKeys (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "c"
--- > mapKeys (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "c"
-mapKeys :: (Algebraic k1, Algebraic k2, TrieKey (AlgRep k1) m1, TrieKey (AlgRep k2) m2) =>
-	(k1 -> k2) -> TrieMap k1 m1 a -> TrieMap k2 m2 a
-mapKeys = mapKeysWith const
-
--- |
--- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
--- 
--- The size of the result may be smaller if @f@ maps two or more distinct
--- keys to the same new key.  In this case the associated values will be
--- combined using @c@.
---
--- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"
--- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
-mapKeysWith :: (Algebraic k1, Algebraic k2, TrieKey (AlgRep k1) m1, TrieKey (AlgRep k2) m2) =>
-	(a -> a -> a) -> (k1 -> k2) -> TrieMap k1 m1 a -> TrieMap k2 m2 a
-mapKeysWith f g m = fromListWith f [(g k, v) | (k, v) <- assocs m]
-
--- | /O(n)/.
--- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
--- is strictly monotonic.
--- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
--- /The precondition is not checked./
--- Semi-formally, we have:
--- 
--- > and [x < y ==> f x < f y | x <- ls, y <- ls] 
--- >                     ==> mapKeysMonotonic f s == mapKeys f s
--- >     where ls = keys s
---
--- This means that @f@ maps distinct original keys to distinct resulting keys.
--- This function has better performance than 'mapKeys'.
---
--- > mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")]) == fromList [(6, "b"), (10, "a")]
--- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList [(5,"a"), (3,"b")])) == True
--- > valid (mapKeysMonotonic (\ _ -> 1)     (fromList [(5,"a"), (3,"b")])) == False
-mapKeysMonotonic :: (Algebraic k1, Algebraic k2, TrieKey (AlgRep k1) m1, TrieKey (AlgRep k2) m2) =>
-	(k1 -> k2) -> TrieMap k1 m1 a -> TrieMap k2 m2 a
-mapKeysMonotonic f (TrieMap n m) = TrieMap n $ fromDistAscListAlg [(toAlg (f (fromAlg k)), v) | (k, v) <- assocsAlg m]
-
--- | /O(n)/. Filter all keys\/values that satisfy the predicate.
---
--- > filterWithKey (\k _ -> k > 4) (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-filterWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> Bool) -> TrieMap k m a -> TrieMap k m a
-filterWithKey p = mapMaybeWithKey (\ k v -> if p k v then Just v else Nothing)
-
--- | /O(n)/. Filter all values that satisfy the predicate.
---
--- > filter (> "a") (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
--- > filter (> "x") (fromList [(5,"a"), (3,"b")]) == empty
--- > filter (< "a") (fromList [(5,"a"), (3,"b")]) == empty
-filter :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> Bool) -> TrieMap k m a -> TrieMap k m a
-filter = filterWithKey . const
-
--- | /O(n)/. Partition the map according to a predicate. The first
--- map contains all elements that satisfy the predicate, the second all
--- elements that fail the predicate.
---
--- > partition (> "a") (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
--- > partition (< "x") (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
--- > partition (> "x") (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
-partition :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> Bool) -> TrieMap k m a -> (TrieMap k m a, TrieMap k m a)
-partition = partitionWithKey . const
-
--- | /O(n)/. Partition the map according to a predicate. The first
--- map contains all elements that satisfy the predicate, the second all
--- elements that fail the predicate.
---
--- > partitionWithKey (\ k _ -> k > 3) (fromList [(5,"a"), (3,"b")]) == (singleton 5 "a", singleton 3 "b")
--- > partitionWithKey (\ k _ -> k < 7) (fromList [(5,"a"), (3,"b")]) == (fromList [(3, "b"), (5, "a")], empty)
--- > partitionWithKey (\ k _ -> k > 7) (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3, "b"), (5, "a")])
-partitionWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> Bool) -> TrieMap k m a -> (TrieMap k m a, TrieMap k m a)
-partitionWithKey p = mapEitherWithKey (\ k v -> (if p k v then Left else Right) v)
-
-{-# INLINE assocs #-}
--- | /O(n)/. Return all key\/value pairs in the map in ascending key order.
---
--- > assocs (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]
--- > assocs empty == []
-assocs :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> [(k, a)]
-assocs m = build (\ c n -> foldWithKey (curry c) n m)
-
--- | /O(n)/. Return all keys of the map in ascending order.
---
--- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]
--- > keys empty == []
-keys :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> [k]
-keys m = Prelude.map fst (assocs m)
-
--- | /O(n)/.
--- Return all elements of the map in the ascending order of their keys.
---
--- > elems (fromList [(5,"a"), (3,"b")]) == ["b","a"]
--- > elems empty == []
-elems :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> [a]
-elems = toList
-
--- | /O(n)/. Fold the values in the map, such that
--- @'fold' f z == 'Prelude.foldr' f z . 'elems'@.
--- For example,
---
--- > elems map = fold (:) [] map
---
--- > let f a len = len + (length a)
--- > fold f 0 (fromList [(5,"a"), (3,"bbb")]) == 4
-fold :: TrieKey k m => (a -> b -> b) -> b -> TrieMap k m a -> b
-fold = foldr
-
--- | /O(n)/. Fold the keys and values in the map, such that
--- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'assocs'@.
--- For example,
---
--- > keys map = foldWithKey (\k x ks -> k:ks) [] map
---
--- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
--- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
-foldWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> b -> b) -> b -> TrieMap k m a -> b
-foldWithKey f z = foldWithKeyAlg (\ k (Elem v) -> f (fromAlg k) v) z . trieMap
-
--- | /O(n+m)/.  Union with a combining function that may discard some elements.
-unionMaybeWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> a -> Maybe a) -> TrieMap k m a -> TrieMap k m a -> TrieMap k m a
-unionMaybeWithKey f = mkTrieMap .: unionMaybeAlg (\ k (Elem v1) (Elem v2) -> Elem <$> f (fromAlg k) v1 v2) `on` trieMap
-
--- | /O(n+m)/.
--- Union with a combining function. 
---
--- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value
--- > unionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "5:a|A"), (7, "C")]
-unionWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> a -> a) -> TrieMap k m a -> TrieMap k m a -> TrieMap k m a
-unionWithKey f = unionMaybeWithKey (\ k x y -> Just (f k x y))
-
--- | /O(n+m)/. Union with a combining function.
---
--- > unionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "aA"), (7, "C")]
-unionWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> a -> a) -> TrieMap k m a -> TrieMap k m a -> TrieMap k m a
-unionWith = unionWithKey . const
-
--- | /O(n+m)/.  Union with a combining function that may discard some elements.
-unionMaybeWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> a -> Maybe a) -> TrieMap k m a -> TrieMap k m a -> TrieMap k m a
-unionMaybeWith = unionMaybeWithKey . const
-
--- | /O(n+m)/.
--- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@. 
--- It prefers @t1@ when duplicate keys are encountered,
--- i.e. (@'union' == 'unionWith' 'const'@).
---
--- > union (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == fromList [(3, "b"), (5, "a"), (7, "C")]
-union :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> TrieMap k m a -> TrieMap k m a
-union = unionWith const
-
-unions :: (Algebraic k, TrieKey (AlgRep k) m) => [TrieMap k m a] -> TrieMap k m a
-unions = unionsWith const
-
-unionsWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> a -> a) -> [TrieMap k m a] -> TrieMap k m a
-unionsWith = unionsWithKey . const
-
-unionsWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> a -> a) -> [TrieMap k m a] -> TrieMap k m a
-unionsWithKey f = mkTrieMap . foldl' (unionMaybeAlg (\ k (Elem x) (Elem y) -> Just $ Elem $ f (fromAlg k) x y)) emptyAlg 
-			. Prelude.map trieMap
-
--- | O(n+m).  Symmetric difference.  Equivalent to @'unionMaybeWith' (\ _ _ -> Nothing)@.
-symDifference :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> TrieMap k m a -> TrieMap k m a
-symDifference = unionMaybeWith (\ _ _ -> Nothing)
-
--- | /O(n+m)/.  Intersection of two maps with a combining function that may discard some elements.
-intersectionMaybeWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => 
-	(k -> a -> b -> Maybe c) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m c
-intersectionMaybeWithKey f (TrieMap _ m1) (TrieMap _ m2) = mkTrieMap $ 
-	intersectAlg (\ k (Elem a) (Elem b) -> Elem <$> f (fromAlg k) a b) m1 m2
-
--- | /O(n+m)/. Intersection with a combining function.
---
--- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar
--- > intersectionWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "5:a|A"
-intersectionWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> b -> c) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m c
-intersectionWithKey f = intersectionMaybeWithKey (\ k x y -> Just (f k x y))
-
--- | /O(n+m)/. Intersection with a combining function.
---
--- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
-intersectionWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> b -> c) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m c
-intersectionWith f = intersectionMaybeWith (Just .: f)
-
--- | /O(n+m)/.  Intersection of two maps with a combining function that may discard some elements.
-intersectionMaybeWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> b -> Maybe c) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m c
-intersectionMaybeWith = intersectionMaybeWithKey . const
-
--- | /O(n+m)/. Intersection of two maps.
--- Return data in the first map for the keys existing in both maps.
--- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@).
---
--- > intersection (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "a"
-intersection :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> TrieMap k m b -> TrieMap k m a
-intersection = intersectionWith const
-
--- | /O(n+m)/. Difference with a combining function. When two equal keys are
--- encountered, the combining function is applied to the key and both values.
--- If it returns 'Nothing', the element is discarded (proper set difference). If
--- it returns (@'Just' y@), the element is updated with a new value @y@. 
---
--- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing
--- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
--- >     == singleton 3 "3:b|B"
-differenceWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> b -> Maybe a) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m a
-differenceWithKey f (TrieMap _ m1) (TrieMap _ m2) = mkTrieMap $ 
-	differenceAlg (\ k (Elem x) (Elem y) -> Elem <$> f (fromAlg k) x y) m1 m2
-
--- | /O(n+m)/. Difference with a combining function. 
--- When two equal keys are
--- encountered, the combining function is applied to the values of these keys.
--- If it returns 'Nothing', the element is discarded (proper set difference). If
--- it returns (@'Just' y@), the element is updated with a new value @y@. 
---
--- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing
--- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
--- >     == singleton 3 "b:B"
-differenceWith :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> b -> Maybe a) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m a
-differenceWith = differenceWithKey . const
-
--- | /O(n+m)/. Difference of two maps. 
--- Return elements of the first map not existing in the second map.
---
--- > difference (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 3 "b"
-difference :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> TrieMap k m b -> TrieMap k m a
-difference = differenceWith (\ _ _ -> Nothing)
-
--- | Same as 'difference'.
-(\\) :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> TrieMap k m b -> TrieMap k m a
-(\\) = difference
-
--- | The minimal key of the map. Calls 'error' if the map is empty.
---
--- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b")
--- > findMin empty                            Error: empty map has no minimal element
-findMin :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> (k, a)
-findMin = fromMaybe (error "empty map has no minimal element") . getMin
-
--- | The minimal key of the map, if any. Returns 'Nothing' if the map is empty.
---
--- > getMin (fromList [(5,"a"), (3,"b")]) == Just (3,"b")
--- > getMin empty                         == Nothing
-getMin :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> Maybe (k, a)
-getMin = fst <.> minViewWithKey
-
--- | The maximal key of the map. Calls 'error' is the map is empty.
---
--- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")
--- > findMax empty                            Error: empty map has no maximal element
-findMax :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> (k, a)
-findMax = fromMaybe (error "empty map has no maximal element") . getMax
-
--- | The maximal key of the map, if any. Returns 'Nothing' if the map is empty.
---
--- > getMax (fromList [(5,"a"), (3,"b")]) == Just (5,"a")
--- > getMax empty                         == Nothing
-getMax :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> Maybe (k, a)
-getMax = fst <.> maxViewWithKey
-
--- | Delete the minimal key. Returns an empty map if the map is empty.
---
--- > deleteMin (fromList [(5,"a"), (3,"b"), (7,"c")]) == fromList [(5,"a"), (7,"c")]
--- > deleteMin empty == empty
-deleteMin :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> TrieMap k m a
-deleteMin m0@(TrieMap n m) = maybe m0 (TrieMap (n-1) . snd) $ getMinAlg m
-
--- | Delete the maximal key. Returns an empty map if the map is empty.
---
--- > deleteMax (fromList [(5,"a"), (3,"b"), (7,"c")]) == fromList [(3,"b"), (5,"a")]
--- > deleteMax empty == empty
-deleteMax :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> TrieMap k m a
-deleteMax m0@(TrieMap n m) = maybe m0 (TrieMap (n-1) . snd) $ getMaxAlg m
-
--- | Delete and find the minimal element.
---
--- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")]) 
--- > deleteFindMin                                            Error: can not return the minimal element of an empty map
-deleteFindMin :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> ((k, a), TrieMap k m a)
-deleteFindMin = fromMaybe (error "cannot return the minimal element of an empty map") . minViewWithKey
-
-checkNothing :: Maybe a -> (Bool, Maybe a)
-checkNothing x = (isNothing x, x)
-
--- | Delete and find the maximal element.
---
--- > deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((10,"c"), fromList [(3,"b"), (5,"a")])
--- > deleteFindMax empty                                      Error: can not return the maximal element of an empty map
-deleteFindMax :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> ((k, a), TrieMap k m a)
-deleteFindMax = fromMaybe (error "cannot return the maximal element of an empty map") . maxViewWithKey
-
--- | Update the value at the minimal key.
---
--- > updateMin (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "Xb"), (5, "a")]
--- > updateMin (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-updateMin :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> Maybe a) -> TrieMap k m a -> TrieMap k m a
-updateMin f (TrieMap n m) = TrieMap (if del then n-1 else n) m'
-	where	(del, m') = updateMinAlg (const (checkNothing . g)) m
-		g (Elem x) = Elem <$> f x
-
--- | Update the value at the maximal key.
---
--- > updateMax (\ a -> Just ("X" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "Xa")]
--- > updateMax (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-updateMax :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> Maybe a) -> TrieMap k m a -> TrieMap k m a
-updateMax f (TrieMap n m) = TrieMap (if del then n-1 else n) m'
-	where	(del, m') = updateMaxAlg (const (checkNothing . g)) m
-		g (Elem x) = Elem <$> f x
-
--- | Update the value at the minimal key.
---
--- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"3:b"), (5,"a")]
--- > updateMinWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
-updateMinWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> Maybe a) -> TrieMap k m a -> TrieMap k m a
-updateMinWithKey f (TrieMap n m) = TrieMap (if del then n-1 else n) m'
-	where	(del, m') = updateMinAlg (checkNothing .: g) m
-		g k (Elem v) = Elem <$> f (fromAlg k) v
-
--- | Update the value at the maximal key.
---
--- > updateMaxWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList [(5,"a"), (3,"b")]) == fromList [(3,"b"), (5,"5:a")]
--- > updateMaxWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
-updateMaxWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => (k -> a -> Maybe a) -> TrieMap k m a -> TrieMap k m a
-updateMaxWithKey f (TrieMap n m) = TrieMap (if del then n-1 else n) m'
-	where	(del, m') = updateMaxAlg (checkNothing .: g) m
-		g k (Elem v) = Elem <$>  f (fromAlg k) v
-
--- | Retrieves the value associated with the minimal key of the
--- map, and the map stripped of that element, or 'Nothing' if passed an
--- empty map.
---
--- > minView (fromList [(5,"a"), (3,"b")]) == Just ("b", singleton 5 "a")
--- > minView empty == Nothing
-minView :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> Maybe (a, TrieMap k m a)
-minView (TrieMap n m) = do
-	(~(_, Elem v), m') <- getMinAlg m
-	return (v, TrieMap (n-1) m')
-
--- | Retrieves the value associated with the maximal key of the
--- map, and the map stripped of that element, or 'Nothing' if passed an
---
--- > maxView (fromList [(5,"a"), (3,"b")]) == Just ("a", singleton 3 "b")
--- > maxView empty == Nothing
-maxView :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> Maybe (a, TrieMap k m a)
-maxView (TrieMap n m) = do
-	(~(_, Elem v), m') <- getMaxAlg m
-	return (v, TrieMap (n-1) m')
-
--- | Retrieves the minimal (key,value) pair of the map, and
--- the map stripped of that element, or 'Nothing' if passed an empty map.
---
--- > minViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((3,"b"), singleton 5 "a")
--- > minViewWithKey empty == Nothing
-minViewWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> Maybe ((k, a), TrieMap k m a)
-minViewWithKey (TrieMap n m) = do
-	(~(k, Elem v), m') <- getMinAlg m
-	return ((fromAlg k, v), TrieMap (n-1) m')
-
--- | Retrieves the maximal (key,value) pair of the map, and
--- the map stripped of that element, or 'Nothing' if passed an empty map.
---
--- > maxViewWithKey (fromList [(5,"a"), (3,"b")]) == Just ((5,"a"), singleton 3 "b")
--- > maxViewWithKey empty == Nothing
-maxViewWithKey :: (Algebraic k, TrieKey (AlgRep k) m) => TrieMap k m a -> Maybe ((k, a), TrieMap k m a)
-maxViewWithKey (TrieMap n m) = do
-	~(~(k, Elem v), m') <- getMaxAlg m
-	return ((fromAlg k, v), TrieMap (n-1) m')
-
--- | /O(n+m)/.
--- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
---
-isSubmapOf :: (Algebraic k, TrieKey (AlgRep k) m, Eq a) => TrieMap k m a -> TrieMap k m a -> Bool
-isSubmapOf = isSubmapOfBy (==)
-
-{- | /O(n+m)/.
- The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when
- applied to their respective values. For example, the following 
- expressions are all 'True':
- 
- > isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
- > isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
- > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)])
-
- But the following are all 'False':
- 
- > isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)])
- > isSubmapOfBy (<)  (fromList [('a',1)]) (fromList [('a',1),('b',2)])
- > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)])
- 
--}
-isSubmapOfBy :: (Algebraic k, TrieKey (AlgRep k) m) => (a -> b -> Bool) -> TrieMap k m a -> TrieMap k m b -> Bool
-isSubmapOfBy (<=) (TrieMap n1 m1) (TrieMap n2 m2) = (Prelude.<=) n1 n2 && isSubmapAlg (<<=) m1 m2
-	where	Elem x <<= Elem y = x <= y
-
--- | The expression (@'split' k map@) is a pair @(map1,map2)@ where
--- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@.
--- Any key equal to @k@ is found in neither @map1@ nor @map2@.
---
--- > split 2 (fromList [(5,"a"), (3,"b")]) == (empty, fromList [(3,"b"), (5,"a")])
--- > split 3 (fromList [(5,"a"), (3,"b")]) == (empty, singleton 5 "a")
--- > split 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", singleton 5 "a")
--- > split 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", empty)
--- > split 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], empty)
-split :: (Algebraic k, TrieKey (AlgRep k) m) => k -> TrieMap k m a -> (TrieMap k m a, TrieMap k m a)
-split k m = case splitLookup k m of
-	(mL, _, mR)	-> (mL, mR)
-
--- | The expression (@'splitLookup' k map@) splits a map just
--- like 'split' but also returns @'lookup' k map@.
---
--- > splitLookup 2 (fromList [(5,"a"), (3,"b")]) == (empty, Nothing, fromList [(3,"b"), (5,"a")])
--- > splitLookup 3 (fromList [(5,"a"), (3,"b")]) == (empty, Just "b", singleton 5 "a")
--- > splitLookup 4 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Nothing, singleton 5 "a")
--- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)
--- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
-splitLookup :: (Algebraic k, TrieKey (AlgRep k) m) => k -> TrieMap k m a -> (TrieMap k m a, Maybe a, TrieMap k m a)
-splitLookup k (TrieMap n m) = case splitLookupAlg (\ (Elem v) -> (Nothing, Just v, Nothing)) (toAlg k) m of
-	(mL, v, mR) -> (mkTrieMap mL, v, mkTrieMap mR)
diff --git a/TrieMap/Algebraic.hs b/TrieMap/Algebraic.hs
deleted file mode 100644
--- a/TrieMap/Algebraic.hs
+++ /dev/null
@@ -1,417 +0,0 @@
-{-# LANGUAGE TypeOperators, FlexibleContexts, UndecidableInstances, TypeFamilies, TypeSynonymInstances  #-}
-
-module TrieMap.Algebraic (Algebraic(..), AlgebraicT(..), SAlgebraicT(..), Ordered(..), AlgWrap (..)) where
-
-import Control.Arrow
-import Data.Bits
-import Data.ByteString (ByteString, pack, unpack)
-import Data.Char
-import Data.Maybe
-import Data.List (unfoldr)
-import Data.Word
-import Data.IntSet (IntSet)
-import Data.Set(Set)
-import qualified Data.IntSet as ISet
-import qualified Data.Set as Set
-import Data.IntMap (IntMap)
-import Data.Map (Map)
-import qualified Data.IntMap as IMap
-import qualified Data.Map as Map
-import qualified Data.Foldable as Fold
-import GHC.Exts (build)
-
-import TrieMap.TrieAlgebraic
-import TrieMap.MapTypes
-
-newtype AlgWrap t a = AlgWrap {unAlgWrap :: t a}
-
--- | 'Algebraic' refers to a type with an algebraic representation, armed with methods to convert in each direction.
--- 'toAlg' and 'fromAlg' should preserve equality and ordering.
-class Algebraic k where
-	-- | @'AlgRep' k@ is a fully decomposed representation of k into algebraic pieces.
-	type AlgRep k
-	toAlg :: k -> AlgRep k
-	fromAlg :: AlgRep k -> k
-
-class Functor (AlgRepT t) => AlgebraicT t where
-	type AlgRepT t :: * -> *
-	toAlgT :: t a -> AlgRepT t a
-	fromAlgT :: AlgRepT t a -> t a
-
-class Functor (SAlgRepT t) => SAlgebraicT t where
-	type SAlgRepT t :: * -> *
-	toSAlgT :: Sized a => t a -> SAlgRepT t a
-	fromSAlgT :: Sized a => SAlgRepT t a -> t a
-
-instance AlgebraicT Id where
-	type AlgRepT Id = Id
-	toAlgT = id
-	fromAlgT = id
-
-instance (AlgebraicT t, Algebraic a) => Algebraic (AlgWrap t a) where
-	type AlgRep (AlgWrap t a) = AlgRepT t (AlgRep a)
-	toAlg = fmap toAlg . toAlgT . unAlgWrap
-	fromAlg = AlgWrap . fromAlgT . fmap fromAlg
-
-instance (AlgebraicT f, AlgebraicT g) => AlgebraicT (f `O` g) where
-	type AlgRepT (f `O` g) = AlgRepT f `O` AlgRepT g
-	toAlgT (O x) = O (fmap (\ (App y) -> App (toAlgT y)) (toAlgT x))
-	fromAlgT (O x) = O (fromAlgT (fmap (\ (App y) -> App (fromAlgT y)) x))
-
-instance (Algebraic (f (g a)), Functor f) => Algebraic ((f `O` g) a) where
-	type AlgRep ((f `O` g) a) = AlgRep (f (g a))
-	toAlg = toAlg . unO
-	fromAlg = o . fromAlg
-
-instance (AlgebraicT f, AlgebraicT g) => AlgebraicT (f :*: g) where
-	type AlgRepT (f :*: g) = AlgRepT f :*: AlgRepT g
-	toAlgT (a :*: b) = toAlgT a :*: toAlgT b
-	fromAlgT (a :*: b) = fromAlgT a :*: fromAlgT b
-
-instance (AlgebraicT f, AlgebraicT g, Algebraic a) => Algebraic ((f :*: g) a) where
-	type AlgRep ((f :*: g) a) = (AlgRepT f :*: AlgRepT g) (AlgRep a)
-	toAlg (a :*: b) = fmap toAlg (toAlgT a :*: toAlgT b)
-	fromAlg (a :*: b) = fromAlgT (fmap fromAlg a) :*: fromAlgT (fmap fromAlg b)
-
-instance (AlgebraicT f, AlgebraicT g) => AlgebraicT (f :+: g) where
-	type AlgRepT (f :+: g) = AlgRepT f :+: AlgRepT g
-	toAlgT (A a) = A (toAlgT a)
-	toAlgT (B b) = B (toAlgT b)
-	fromAlgT (A a) = A (fromAlgT a)
-	fromAlgT (B b) = B (fromAlgT b)
-
-instance (AlgebraicT f, AlgebraicT g, Algebraic a) => Algebraic ((f :+: g) a) where
-	type AlgRep ((f :+: g) a) = AlgRep (AlgWrap (f :+: g) a)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg
-
-instance AlgebraicT f => Algebraic (Fix f) where
-	type AlgRep (Fix f) = Fix (AlgRepT f)
-	toAlg (Fix x) = Fix (fmap toAlg (toAlgT x))
-	fromAlg (Fix x) = Fix (fromAlgT (fmap fromAlg x))
-
-instance Algebraic a => AlgebraicT (Const a) where
-	type AlgRepT (Const a) = Const (AlgRep a)
-	toAlgT (Const a) = Const (toAlg a)
-	fromAlgT (Const a) = Const (fromAlg a)
-
-instance Algebraic a => Algebraic (Const a b) where
-	type AlgRep (Const a b) = Const (AlgRep a) b
-	toAlg (Const a) = Const (toAlg a)
-	fromAlg (Const a) = fromAlg (Const a)
-
-instance Algebraic a => AlgebraicT ((,) a) where
-	type AlgRepT ((,) a) = (,) (AlgRep a)
-	toAlgT = first toAlg
-	fromAlgT = first fromAlg
-
-instance (Algebraic a, Algebraic b) => Algebraic (a, b) where
-	type AlgRep (a, b) = AlgRep (AlgWrap ((,) a) b)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg
-
-instance (Algebraic a, Algebraic b) => AlgebraicT ((,,) a b) where
-	type AlgRepT ((,,) a b) = (,) (AlgRep (a, b))
-	toAlgT (a, b, c) = (toAlg (a, b), c)
-	fromAlgT (ab, c) = case fromAlg ab of
-		(a, b)	-> (a, b, c)
-
-instance (Algebraic a, Algebraic b, Algebraic c) => Algebraic (a, b, c) where
-	type AlgRep (a, b, c) = AlgRep (AlgWrap ((,,) a b) c)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg
-
-instance (Algebraic a, Algebraic b, Algebraic c) => AlgebraicT ((,,,) a b c) where
-	type AlgRepT ((,,,) a b c) = (,) (AlgRep (a, b, c))
-	toAlgT (a, b, c, d) = (toAlg (a, b, c), d)
-	fromAlgT (abc, d) = case fromAlg abc of
-		(a, b, c) -> (a, b, c, d)
-
-instance (Algebraic a, Algebraic b, Algebraic c, Algebraic d) => Algebraic (a, b, c, d) where
-	type AlgRep (a, b, c, d) = AlgRep (AlgWrap ((,,,) a b c) d)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg
-
-instance Algebraic a => AlgebraicT (Either a) where
-	type AlgRepT (Either a) = Either (AlgRep a)
-	toAlgT = either (Left . toAlg) Right
-	fromAlgT = either (Left . fromAlg) Right
-
-instance (Algebraic a, Algebraic b) => Algebraic (Either a b) where
-	type AlgRep (Either a b) = AlgRep (AlgWrap (Either a) b)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg
-
-instance AlgebraicT [] where
-	type AlgRepT [] = []
-	toAlgT = id
-	fromAlgT = id
-
-instance Algebraic k => Algebraic [k] where
-	type AlgRep [k] = [AlgRep k]
-	toAlg = map toAlg
-	fromAlg = map fromAlg
-
-instance Algebraic () where
-	type AlgRep () = ()
-	toAlg = id
-	fromAlg = id
-
-instance AlgebraicT Maybe where
-	type AlgRepT Maybe = Either ()
-	toAlgT = maybe (Left ()) Right
-	fromAlgT = either (const Nothing) Just
-
-instance SAlgebraicT Maybe where
-	type SAlgRepT Maybe = AlgRepT Maybe
-	toSAlgT = toAlgT 
-	fromSAlgT = fromAlgT
-
-instance Algebraic a => Algebraic (Maybe a) where
-	type AlgRep (Maybe a) = AlgRep (AlgWrap Maybe a)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg
-
-instance Algebraic Bool where
-	type AlgRep Bool = AlgRep (Maybe ())
-	toAlg b = toAlg $ if b then Just () else Nothing
-	fromAlg = maybe False (const True) . fromAlg'
-		where	fromAlg' = fromAlg :: AlgRep (Maybe ()) -> Maybe ()
-
-instance Algebraic Int where
-	type AlgRep Int = Int
-	toAlg = id
-	fromAlg = id
-
-instance Algebraic Char where
-	type AlgRep Char = Int
-	toAlg = ord
-	fromAlg = chr
-
-instance Algebraic Float where
-	type AlgRep Float = Ordered Float
-	toAlg = Ord
-	fromAlg = unOrd
-
-instance Algebraic Double where
-	type AlgRep Double = Ordered Double
-	toAlg = Ord
-	fromAlg = unOrd
-
-instance Algebraic Rational where
-	type AlgRep Rational = Ordered Rational
-	toAlg = Ord
-	fromAlg = unOrd
-
-instance Algebraic a => Algebraic (Ordered a) where
-	type AlgRep (Ordered a) = AlgRep a
-	toAlg = toAlg . unOrd
-	fromAlg = Ord . fromAlg
-
-instance (Algebraic k, Algebraic v) => Algebraic (Map k v) where
-	type AlgRep (Map k v) = AlgRep (AlgWrap (Map k) v) 
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg
-
-instance Algebraic k => AlgebraicT (Map k) where
-	type AlgRepT (Map k) = [] `O` ((,) k)
-	toAlgT = o . Map.assocs
-	fromAlgT = Map.fromDistinctAscList . unO
-
-instance Algebraic k => SAlgebraicT (Map k) where
-	type SAlgRepT (Map k) = [] `O` ((,) k)
-	toSAlgT = o . Map.assocs
-	fromSAlgT = Map.fromDistinctAscList . unO
-
-instance Algebraic v => Algebraic (IntMap v) where
-	type AlgRep (IntMap v) = AlgRep (AlgWrap IntMap v)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg
-
-instance AlgebraicT IntMap where
-	type AlgRepT IntMap = AlgRepT ([] `O` ((,) Int))
-	toAlgT = toAlgT . o . IMap.assocs
-	fromAlgT = IMap.fromDistinctAscList . unO . fromAlgT
-
-instance SAlgebraicT IntMap where
-	type SAlgRepT IntMap = AlgRepT ([] `O` ((,) Int))
-	toSAlgT = toAlgT . o . IMap.assocs
-	fromSAlgT = IMap.fromDistinctAscList . unO . fromAlgT
-
-instance Algebraic a => Algebraic (Set a) where
-	type AlgRep (Set a) = AlgRep (AlgWrap Set a)
-	toAlg = toAlg . AlgWrap
-	fromAlg = unAlgWrap . fromAlg 
-
-instance AlgebraicT Set where
-	type AlgRepT Set = AlgRepT []
-	toAlgT = toAlgT . Fold.toList
-	fromAlgT = Set.fromDistinctAscList . fromAlgT
-
-instance Algebraic IntSet where
-	type AlgRep IntSet = AlgRep [Int]
-	toAlg = toAlg . ISet.toList
-	fromAlg = ISet.fromDistinctAscList . fromAlg
-
-{-# RULES
-	"map/id" forall xs . map id xs = xs;
-	#-}
-
-instance SAlgebraicT m => SAlgebraicT (ConstMap m k m') where
-	type SAlgRepT (ConstMap m k m') = SAlgRepT m
-	toSAlgT (ConstMap m) = toSAlgT m
-	fromSAlgT = ConstMap . fromSAlgT
-
-instance Algebraic (m a) => Algebraic (ConstMap m k m' a) where
-	type AlgRep (ConstMap m k m' a) = AlgRep (m a)
-	toAlg (ConstMap m) = toAlg m
-	fromAlg = ConstMap . fromAlg
-
-instance SAlgebraicT m => SAlgebraicT (IdMap k m) where
-	type SAlgRepT (IdMap k m) = SAlgRepT m
-	toSAlgT (IdMap m) = toSAlgT m
-	fromSAlgT = IdMap . fromSAlgT
-
-instance Algebraic (m a) => Algebraic (IdMap k m a) where
-	type AlgRep (IdMap k m a) = AlgRep (m a)
-	toAlg (IdMap m) = toAlg m
-	fromAlg = IdMap . fromAlg
-
-instance (SAlgebraicT (t1 k m), SAlgebraicT (t2 k m), TrieKey k m, TrieKeyT f2 t2) => SAlgebraicT (ProdMap t1 t2 k m) where
-	type SAlgRepT (ProdMap t1 t2 k m) = (SAlgRepT (t1 k m) `O` SAlgRepT (t2 k m))
-	toSAlgT (PMap m) = O (fmap (App . toSAlgT) (toSAlgT m))
-	fromSAlgT (O m) = PMap (fromSAlgT (fmap (\ (App x) -> fromSAlgT x) m))
-
-instance Algebraic (t1 k m (t2 k m a)) => Algebraic (ProdMap t1 t2 k m a) where
-	type AlgRep (ProdMap t1 t2 k m a) = AlgRep (t1 k m (t2 k m a))
-	toAlg (PMap m) = toAlg m
-	fromAlg = PMap . fromAlg
-
-instance (SAlgebraicT m1, SAlgebraicT m2, TrieKey k2 m2) => SAlgebraicT (CProdMap m1 k2 m2) where
-	type SAlgRepT (CProdMap m1 k2 m2) = SAlgRepT m1 `O` SAlgRepT m2
-	toSAlgT (CPMap m) = O (fmap (App . toSAlgT) (toSAlgT m))
-	fromSAlgT (O m) = CPMap (fromSAlgT (fmap (fromSAlgT . unApp) m))
-
-instance (Algebraic (m1 (m2 a))) => Algebraic (CProdMap m1 k2 m2 a) where
-	type AlgRep (CProdMap m1 k2 m2 a) = AlgRep (m1 (m2 a))
-	toAlg (CPMap m) = toAlg m
-	fromAlg = CPMap . fromAlg
-
-{-
-instance Algebraic (t1 k m (t2 k m a)) => Algebraic (ProdMap t1 t2 k m a) where
-	type AlgRep (ProdMap t1 t2 k m a) = AlgRep (t1 k m (t2 k m a))
-	toAlg = toAlg . unPMap
-	fromAlg = PMap . fromAlg-}
-
-instance (SAlgebraicT (t1 k m), SAlgebraicT (t2 k m)) => SAlgebraicT (UnionMap t1 t2 k m) where
-	type SAlgRepT (UnionMap t1 t2 k m) = SAlgRepT (t1 k m) :*: SAlgRepT (t2 k m)
-	toSAlgT (UMap m1 m2) = toSAlgT m1 :*: toSAlgT m2
-	fromSAlgT (m1 :*: m2) = UMap (fromSAlgT m1) (fromSAlgT m2)
-
-instance (Algebraic (t1 k m a), Algebraic (t2 k m a)) => Algebraic (UnionMap t1 t2 k m a) where	
-	type AlgRep (UnionMap t1 t2 k m a) = AlgRep (t1 k m a, t2 k m a)
-	toAlg (UMap m1 m2) = toAlg (m1, m2)
-	fromAlg = uncurry UMap . fromAlg
-
-instance (SAlgebraicT m1, SAlgebraicT m2) => SAlgebraicT (CUnionMap m1 k2 m2) where
-	type SAlgRepT (CUnionMap m1 k2 m2) = SAlgRepT m1 :*: SAlgRepT m2
-	toSAlgT (CUMap m1 m2) = toSAlgT m1 :*: toSAlgT m2
-	fromSAlgT (m1 :*: m2) = CUMap (fromSAlgT m1) (fromSAlgT m2)
-
-instance (Algebraic (m1 a), Algebraic (m2 a)) => Algebraic (CUnionMap m1 k2 m2 a) where
-	type AlgRep (CUnionMap m1 k2 m2 a) = AlgRep (m1 a, m2 a)
-	toAlg (CUMap m1 m2) = toAlg (m1, m2)
-	fromAlg = uncurry CUMap . fromAlg
-
--- instance (Algebraic (t1 k m a), Algebraic (t2 k m a)) => Algebraic (UnionMap t1 t2 k m a) where
--- 	type AlgRep (UnionMap t1 t2 k m a) = AlgRep (t1 k m a, t2 k m a)
--- 	toAlg (UMap m1 m2) = toAlg (m1, m2)
--- 	fromAlg = uncurry UMap . fromAlg
-
-instance SAlgebraicT f => SAlgebraicT (App f) where
-	type SAlgRepT (App f) = SAlgRepT f
-	toSAlgT = toSAlgT . unApp
-	fromSAlgT = App . fromSAlgT
-
-instance AlgebraicT f => AlgebraicT (App f) where
-	type AlgRepT (App f) = AlgRepT f
-	toAlgT = toAlgT . unApp
-	fromAlgT = App . fromAlgT
-
-instance Algebraic (f a) => Algebraic (App f a) where
-	type AlgRep (App f a) = AlgRep (f a)
-	toAlg = toAlg . unApp
-	fromAlg = App . fromAlg
-
-instance SAlgebraicT (t1 (App f2 k) (App (t2 k m))) => SAlgebraicT (CompMap t1 f2 t2 k m) where
-	type SAlgRepT (CompMap t1 f2 t2 k m) = SAlgRepT (t1 (App f2 k) (App (t2 k m)))
-	toSAlgT (CompMap m) = toSAlgT m
-	fromSAlgT = CompMap . fromSAlgT
-
-instance Algebraic (t1 (App f2 k) (App (t2 k m)) a) => Algebraic (CompMap t1 f2 t2 k m a) where
-	type AlgRep (CompMap t1 f2 t2 k m a) = AlgRep (t1 (App f2 k) (App (t2 k m)) a)
-	toAlg (CompMap m) = toAlg m
-	fromAlg = CompMap . fromAlg
-
--- instance (AlgebraicT (t1 (App f2 k) (App (t2 k m))), Algebraic a) => Algebraic (CompMap t1 f2 t2 k m a) where
--- 	type AlgRep (CompMap t1 f2 t2 k m a) = AlgRep (AlgWrap (CompMap t1 f2 t2 k m) a) 
--- 	toAlg = toAlg . AlgWrap
--- 	fromAlg = unAlgWrap . fromAlg
-
--- newtype   f t a = FixMap (t (Fix f) (FixMap f t) a)
-
-instance (TrieKeyT f t) => SAlgebraicT (FixMap f t) where
-	type SAlgRepT (FixMap f t) = [] `O` ((,) (Fix f))
-	toSAlgT m = o (assocsAlg m)
-	fromSAlgT = fromDistAscListAlg . unO
-
-instance (TrieKeyT f t, AlgebraicT f, Sized a, Algebraic a) => Algebraic (FixMap f t a) where
-	type AlgRep (FixMap f t a) = AlgRep [(Fix f, a)]
-	toAlg = toAlg . assocsAlg
-	fromAlg = fromDistAscListAlg . fromAlg
-
--- instance (AlgebraicT f, TrieKeyT f t, Sized a, Algebraic a) => Algebraic (FixMap f t a) where
--- 	type AlgRep (FixMap f t a) = AlgRep [(Fix f, a)]
--- 	toAlg = toAlg . assocsAlg
--- 	fromAlg = fromDistAscListAlg . fromAlg
-
-instance Algebraic Word8 where
-	type AlgRep Word8 = Int
-	toAlg = fromIntegral
-	fromAlg = fromIntegral
-
-instance Algebraic Word16 where
-	type AlgRep Word16 = Int
-	toAlg = fromIntegral
-	fromAlg = fromIntegral
-
-instance Algebraic Word32 where
-	type AlgRep Word32 = Int
-	toAlg = fromIntegral
-	fromAlg = fromIntegral
-
-instance Algebraic Integer where
-	type AlgRep Integer = AlgRep [Word8]
-	toAlg = toAlg . unroll
-	fromAlg = roll . fromAlg
-
-instance Algebraic ByteString where
-	type AlgRep ByteString = AlgRep [Word8]
-	toAlg = toAlg . unpack
-	fromAlg = pack . fromAlg
-
-unroll :: Integer -> [Word8]
-unroll = unfoldr step
-  where
-    step 0 = Nothing
-    step i = Just (fromIntegral i, i `shiftR` 8)
-
-roll :: [Word8] -> Integer
-roll   = foldr unstep 0
-  where
-    unstep b a = a `shiftL` 8 .|. fromIntegral b
-
-
-{-# RULES
-	"toAlg/fromAlg" forall x . toAlg (fromAlg x) = x;
- #-}
diff --git a/TrieMap/Applicative.hs b/TrieMap/Applicative.hs
deleted file mode 100644
--- a/TrieMap/Applicative.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module TrieMap.Applicative(Id(..), (.:), (<.>), on, build) where
-
-import Control.Monad
-import Control.Applicative
-import Data.Traversable (sequenceA)
-import GHC.Exts (build)
-import TrieMap.MapTypes
-
-instance Applicative Id where
-	pure = return
-	(<*>) = ap
-
-instance Monad Id where
-	return = Id
-	m >>= k = k (unId m)
-
-(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
-(.:) = (.) . (.)
-
-(<.>) :: Functor f => (b -> c) -> (a -> f b) -> (a -> f c)
-(<.>) = (.) . (<$>)
-
-on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
-(f `on` g) x y = f (g x) (g y)
-
-infixr 9 <.>
-infixr 9 .:
-infixr 8 `on`
diff --git a/TrieMap/MapTypes.hs b/TrieMap/MapTypes.hs
deleted file mode 100644
--- a/TrieMap/MapTypes.hs
+++ /dev/null
@@ -1,166 +0,0 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, KindSignatures, StandaloneDeriving, GeneralizedNewtypeDeriving, IncoherentInstances, TypeOperators, FlexibleContexts, StandaloneDeriving, ExistentialQuantification #-}
-
-module TrieMap.MapTypes where
-
-import Data.Foldable
-import Data.Traversable
-import Control.Applicative hiding (Const)
-import Prelude hiding (foldl, foldr)
-import qualified Data.IntMap as IMap
-
-data (f :*: g) a = f a :*: g a deriving (Eq, Ord, Show)
-data (f :+: g) a = A (f a) | B (g a) deriving (Eq, Ord, Show)
-newtype Const a b = Const {unConst :: a} deriving (Eq, Ord, Show)
-newtype Id a = Id {unId :: a} deriving (Eq, Ord, Show)
-newtype Fix f = Fix (f (Fix f))
-newtype FixMap f t a = FixMap (t (Fix f) (FixMap f t) a)
-
-newtype O f g a = O (f (App g a))
-newtype App f a = App {unApp :: f a}
-
-o :: Functor f => f (g a) -> (f `O` g) a
-o = O . fmap App
-
-unO :: Functor f => (f `O` g) a -> f (g a)
-unO (O x) = fmap unApp x
-
--- | 'ProdMap' is used to hold a map on the product of two key types.
-newtype ProdMap t1 t2 k (m :: * -> *) a = PMap {unPMap :: t1 k m (t2 k m a)}
-data UnionMap t1 t2 k (m :: * -> *) a = UMap (t1 k m a) (t2 k m a)
-newtype CProdMap m1 k2 m2 a = CPMap {unCPMap :: m1 (m2 a)}
-data CUnionMap m1 k2 m2 a = CUMap (m1 a) (m2 a)
-
-data Edge k m v = Edge {-# UNPACK #-} !Int [k] (Maybe v) (m (Edge k m v))
-type MEdge k m v = Maybe (Edge k m v)
-
--- | 'RadixTrie' is used to hold a map on a list of keys.
-newtype RadixTrie k m v = Radix {unRad :: MEdge k m v} 
-
-newtype IdMap k m a = IdMap {unIdMap :: m a} 
-
-newtype ConstMap (m :: * -> *) k (x :: * -> *) a = ConstMap {unConstMap :: m a}
-
-newtype CompMap t1 f2 (t2 :: * -> (* -> *) -> * -> *) k (m :: * -> *) a = CompMap (t1 (App f2 k) (App (t2 k m)) a)
-
--- newtype FixMap (m :: (* -> *) -> * -> *) a = FixMap (m (FixMap m) a)
-
-newtype Elem a = Elem {getElem :: a} deriving (Eq, Ord)
-
-instance Functor Elem where
-	fmap f (Elem x) = Elem (f x)
-
-instance Foldable Elem where
-	foldr f z (Elem a) = a `f` z
-	foldl f z (Elem a) = z `f` a
-
-instance Traversable Elem where
-	traverse f (Elem x) = Elem <$> f x
-
-infixr 5 `ProdMap`
-infixr 5 :+:
-infixr 8 :*:
-infixr 9 `O`
-
-class Sized a where
-	getSize :: a -> Int
-
-instance Sized (Elem a) where
-	getSize _ = 1
-
-instance Functor m => Functor (Edge k m) where
-	fmap f (Edge n ks v ts) = Edge n ks (fmap f v) (fmap (fmap f) ts)
-raverse f (Radix e) = Radix <$> traverse (traverse f) e
-
-instance (Functor f, Functor g) => Functor (f :*: g) where
-	fmap f (a :*: b) = fmap f a :*: fmap f b
-
-instance (Foldable f, Foldable g) => Foldable (f :*: g) where
-	foldr f z (a :*: b) = foldr f (foldr f z b) a
-	foldl f z (a :*: b) = foldl f (foldl f z a) b
-
-instance (Traversable f, Traversable g) => Traversable (f :*: g) where
-	traverse f (a :*: b) = liftA2 (:*:) (traverse f a) (traverse f b)
-
-instance (Functor f, Functor g) => Functor (f :+: g) where
-	fmap f (A a) = A (fmap f a)
-	fmap f (B b) = B (fmap f b)
-
-instance (Foldable f, Foldable g) => Foldable (f :+: g) where
-	foldr f z (A a) = foldr f z a
-	foldr f z (B b) = foldr f z b
-	foldl f z (A a) = foldl f z a
-	foldl f z (B b) = foldl f z b
-
-instance (Traversable f, Traversable g) => Traversable (f :+: g) where
-	traverse f (A a) = A <$> traverse f a
-	traverse f (B b) = B <$> traverse f b
-
-instance Functor (Const a) where
-	fmap f (Const x) = Const x
-
-instance Foldable (Const a) where
-	foldr f z _ = z
-	foldl f z _ = z
-
-instance Traversable (Const a) where
-	traverse f (Const x) = pure (Const x)
-
-instance Functor Id where
-	fmap f (Id a) = Id (f a)
-
-instance Foldable Id where
-	foldr f z (Id a) = a `f` z
-	foldl f z (Id a) = z `f` a
-
-instance Traversable Id where
-	traverse f (Id a) = Id <$> f a
-
-class EqT f where
-	eq :: Eq a => f a -> f a -> Bool
-
-instance EqT f => Eq (Fix f) where
-	Fix x == Fix y = x `eq` y
-
-instance (EqT f, EqT g) => EqT (f :*: g) where
-	(a :*: x) `eq` (b :*: y) = a `eq` b && x `eq` y
-
-instance (EqT f, EqT g) => EqT (f :+: g) where
-	A a `eq` A b = a `eq` b
-	B x `eq` B y = x `eq` y
-	_ `eq` _ = False
-
-instance Eq a => EqT (Const a) where
-	Const a `eq` Const b = a == b
-
-instance EqT Id where
-	Id a `eq` Id b = a == b
-
-instance EqT [] where
-	eq = (==)
-
-instance EqT Maybe where
-	eq = (==)
-
-instance Eq a => EqT ((,) a) where
-	eq = (==)
-
-instance Eq a => EqT (Either a) where
-	eq = (==)
-
-instance EqT f => EqT (App f) where
-	App a `eq` App b = a `eq` b
-
-instance (EqT f, Eq a) => Eq (App f a) where
-	(==) = eq
-
-instance (EqT f, EqT g) => EqT (f `O` g) where
-	O a `eq` O b = a `eq` b
-
-instance (EqT f, EqT g, Eq a) => Eq ((f `O` g) a) where
-	(==) = eq
-
-instance (Functor f, Functor g) => Functor (f `O` g) where
-	fmap f (O x) = O (fmap (\ (App x) -> App (fmap f x)) x)
-
-instance Traversable IMap.IntMap where
-	traverse f m = IMap.fromDistinctAscList <$> traverse (\ (k, v) -> ((,) k) <$> f v) (IMap.assocs m)
diff --git a/TrieMap/RadixTrie.hs b/TrieMap/RadixTrie.hs
deleted file mode 100644
--- a/TrieMap/RadixTrie.hs
+++ /dev/null
@@ -1,274 +0,0 @@
-{-# LANGUAGE IncoherentInstances, PatternGuards, MultiParamTypeClasses, UndecidableInstances #-}
-
-module TrieMap.RadixTrie where
-
-import Control.Applicative
-
-import Data.Maybe
-import Data.Monoid
-import Data.Foldable
-import Data.Sequence (Seq, (|>))
-import qualified Data.Sequence as Seq
-import Data.Traversable
-
-import TrieMap.Algebraic
-import TrieMap.Applicative
-import TrieMap.MapTypes
-import TrieMap.TrieAlgebraic
-
-import Prelude hiding (foldr)
-
-instance Sized (Edge k m a) where
-	getSize (Edge s _ _ _) = s
-
-instance TrieKeyT [] RadixTrie where
-	compareKeyT (a:as) (b:bs) = compareKey a b `mappend` compareKeyT as bs
-	compareKeyT [] (_:_) = LT
-	compareKeyT (_:_) [] = GT
-	compareKeyT [] [] = EQ
-	emptyT = Radix Nothing
-	nullT (Radix m) = isNothing m
-	sizeT (Radix m) = getSize m
-	getSingleT (Radix m) = m >>= getSingleEdge
-	guardNullT (Radix m) = m >>= guardNullEdge >>= return . Radix . Just
-	alterLookupT f ks (Radix Nothing) = (Radix . single ks) <$> f Nothing
-	alterLookupT f ks (Radix (Just e)) = Radix <$> alterLookupEdge f ks e
-	lookupT ks (Radix m) = m >>= lookupEdge ks
-	foldWithKeyT f z (Radix m) = foldr (foldEdge f) z m
-	mapAppT f (Radix m) = Radix <$> traverse (mapAppEdge f) m
-	mapMaybeT f (Radix m) = Radix (m >>= mapMaybeEdge f)
-	mapEitherT f (Radix m) = radBoth (maybe (Nothing, Nothing) (mapEitherEdge f) m)
-		where	 radBoth (e1, e2) = (Radix e1, Radix e2)
-	fromDistAscListT = fromAscListT (\ _ x _ -> x)
-	fromAscListT _ [] = Radix Nothing
-	fromAscListT f (x:xs) = Radix (Just (groupAscHeads' f x xs))
-	fromListT f xs = Radix (groupHeads f xs)
-	splitLookupT _ _ (Radix Nothing) = (emptyT, Nothing, emptyT)
-	splitLookupT f k (Radix (Just e)) = case splitLookupEdge f k e of
-		(eL, ans, eR)	-> (Radix eL, ans, Radix eR)
-	isSubmapT (<=) (Radix m1) (Radix m2) = isSubmapAlg (isSubEdge (<=)) m1 m2
-	getMinT (Radix m) = fmap (Radix <$>) (m >>= getMinEdge)
-	getMaxT (Radix m) = fmap (Radix <$>) (m >>= getMaxEdge)
-	updateMinT _ (Radix Nothing) = (False, Radix Nothing)
-	updateMinT f (Radix (Just e)) = Radix <$> updateMinEdge f e
-	updateMaxT _ (Radix Nothing) = (False, Radix Nothing)
-	updateMaxT f (Radix (Just e)) = Radix <$> updateMaxEdge f e
-	unionT f (Radix m1) (Radix m2) = Radix (unionMaybe (unionEdge f) m1 m2)
-	intersectT f (Radix m1) (Radix m2) = Radix (intersectMaybe (intersectEdge f) m1 m2)
-	differenceT f (Radix m1) (Radix m2) = Radix (differenceMaybe (differenceEdge f) m1 m2)
-
-instance TrieKey k m => TrieKey [k] (RadixTrie k m) where
-	compareKey = compareKeyT
-	emptyAlg = emptyT
-	nullAlg = nullT
-	getSingleAlg = getSingleT
-	guardNullAlg = guardNullT
-	sizeAlg = sizeT
-	lookupAlg = lookupT
-	alterLookupAlg = alterLookupT
-	mapAppAlg = mapAppT
-	mapMaybeAlg = mapMaybeT
-	mapEitherAlg = mapEitherT
-	foldWithKeyAlg = foldWithKeyT
-	unionMaybeAlg = unionT
-	intersectAlg = intersectT
-	differenceAlg = differenceT
-	getMinAlg = getMinT
-	getMaxAlg = getMaxT
-	updateMinAlg = updateMinT
-	updateMaxAlg = updateMaxT
-	isSubmapAlg = isSubmapT
-	splitLookupAlg = splitLookupT
-
-single :: (Sized a, TrieKey k m) => [k] -> Maybe a -> MEdge k m a
-single ks = fmap (\ v -> Edge (getSize v) ks (Just v) emptyAlg)
-
-edge :: (Sized a, TrieKey k m) => [k] -> Maybe a -> m (Edge k m a) -> Edge k m a
-edge ks v ts = Edge (getSize v + getSize ts) ks v ts
-
-getSingleEdge :: TrieKey k m => Edge k m a -> Maybe ([k], a)
-getSingleEdge (Edge _ ks (Just v) ts)
-	| nullAlg ts	= Just (ks, v)
-getSingleEdge (Edge _ ks Nothing ts) = do
-	(l, e') <- getSingleAlg ts
-	(ls, v) <- getSingleEdge e'
-	return (ks ++ l:ls, v)
-getSingleEdge _ = Nothing
-
-guardNullEdge :: TrieKey k m => Edge k m a -> MEdge k m a
-guardNullEdge (Edge s ks Nothing ts)
-	| nullAlg ts	= Nothing
-	| Just (l, Edge _ ls v ts') <- getSingleAlg ts
-			= Just (Edge s (ks ++ l:ls) v ts')
-guardNullEdge e = Just e
-
-alterLookupEdge :: (Eq k, TrieKey k m, Sized a) => (Maybe a -> (b, Maybe a)) -> [k] -> Edge k m a -> (b, MEdge k m a)
-alterLookupEdge f ks0 e@(Edge s ls0 v0 ts) = procEdge 0 ks0 ls0 where
-	procEdge i _ _ | i `seq` False = undefined
-	procEdge i (k:ks) (l:ls)
-		| k == l	= procEdge (i+1) ks ls
-		| otherwise	= breakEdge <$> f Nothing where
-			breakEdge Nothing	= Just e
-			breakEdge (Just v)	= let sV = getSize v in
-				Just (Edge (sV + s) (take i ls0) Nothing 
-					(fromListAlg (\ _ v _ -> v) [(k, Edge sV ks (Just v) emptyAlg), (l, Edge s ls v0 ts)]))
-	procEdge _ [] (l:ls) = splitEdge <$> f Nothing where
-		splitEdge Nothing = Just e
-		splitEdge (Just v) = let sV = getSize v in
-			Just (Edge (sV + s) ks0 (Just v) (singletonAlg l (Edge s ls v0 ts)))
-	procEdge _(k:ks) [] = (guardNullEdge . edge ls0 v0) <$> alterLookupAlg g k ts where
-		g Nothing = fmap (\ v -> Edge (getSize v) ks (Just v) emptyAlg) <$> f Nothing 
-		g (Just e) = alterLookupEdge f ks e
-	procEdge _ [] [] = fmap (\ v -> guardNullEdge $ edge ls0 v ts) (f v0)
-
-lookupEdge :: (Eq k, TrieKey k m) => [k] -> Edge k m a -> Maybe a
-lookupEdge ks (Edge _ ls v ts) = procEdge ks ls where
-	procEdge (k:ks) (l:ls)
-		| k == l	= procEdge ks ls
-	procEdge (k:ks) [] = lookupAlg k ts >>= lookupEdge ks
-	procEdge [] [] = v
-	procEdge _ _ = Nothing
-
-foldEdge :: TrieKey k m => ([k] -> a -> b -> b) -> Edge k m a -> b -> b
-foldEdge f (Edge _ ks v ts) z = foldr (f ks) (foldWithKeyAlg (\ l -> foldEdge (\ ls -> f (ks ++ l:ls))) z ts) v
-
-mapAppEdge :: (TrieKey k m, Applicative f, Sized b) => ([k] -> a -> f b) -> Edge k m a -> f (Edge k m b)
-mapAppEdge f (Edge _ ks v ts) = edge ks <$> traverse (f ks) v <*> mapAppAlg (\ l -> mapAppEdge (\ ls -> f (ks ++ l:ls))) ts
-
-mapMaybeEdge :: (TrieKey k m, Sized b) => ([k] -> a -> Maybe b) -> Edge k m a -> MEdge k m b
-mapMaybeEdge f (Edge _ ks v ts) = 
-	guardNullEdge (edge ks (v >>= f ks) (mapMaybeAlg (\ l -> mapMaybeEdge (\ ls -> f (ks ++ l:ls))) ts))
-
-mapEitherEdge :: (TrieKey k m, Sized b, Sized c) => ([k] -> a -> (Maybe b, Maybe c)) -> Edge k m a -> 
-	(MEdge k m b, MEdge k m c)
-mapEitherEdge f (Edge _ ks v ts) = guardBoth (edge ks vL tsL, edge ks vR tsR)
-	where	(vL, vR) = maybe (Nothing, Nothing) (f ks) v
-		ts' = mapEitherAlg (\ l -> mapEitherEdge (\ ls -> f (ks ++ l:ls))) ts
-		(tsL, tsR) = mapEitherAlg (\ l -> mapEitherEdge (\ ls -> f (ks ++ l:ls))) ts
-		guardBoth (e1, e2) = (guardNullEdge e1, guardNullEdge e2)
-
-groupAscHeads' :: (Eq k, TrieKey k m, Sized a) => ([k] -> a -> a -> a) -> ([k], a) -> [([k], a)] -> Edge k m a
-groupAscHeads' f (ks, v) [] = Edge (getSize v) ks (Just v) emptyAlg
-groupAscHeads' f x xs = group0 Nothing (x:xs) where
-	group0 v0 (([], v):xs) = group0 (Just (maybe v (f [] v) v0)) xs
-	group0 (Just v0) [] = Edge (getSize v0) [] (Just v0) emptyAlg
-	group0 v0 ((k:ks, v):xs) = group1 Seq.empty k (ks, v) Seq.empty xs where
-		group1 ts k vk vs ((l:ls, v):xs)
-			| k == l	= group1 ts k vk (vs |> (ls, v)) xs
-			| otherwise	= group1 (ts |> (k, groupAscHeads' (f . (k:)) vk (toList vs))) l (ls, v) Seq.empty xs
-		group1 ts k v vs []
-			| Nothing <- v0, Seq.null ts, Edge s xs vX tsX <- groupAscHeads' (f . (k:)) v (toList vs)
-				= Edge s (k:xs) vX tsX
-			| otherwise
-				= edge [] v0 (fromDistAscListAlg (toList ts ++ [(k, groupAscHeads' (f . (k:)) v (toList vs))]))
-
-groupHeads :: (Eq k, TrieKey k m, Sized a) => ([k] -> a -> a -> a) -> [([k], a)] -> MEdge k m a
-groupHeads _ [] = Nothing
-groupHeads f xs = guardNullEdge $ edge [] v0 (mapMaybeAlg (\ k (Elem xs) -> groupHeads (f . (k:)) xs) $
-		fromListAlg (\ _ (Elem x) (Elem y) -> Elem (x ++ y)) [(k, Elem [(ks, v)]) | (k, ks, v) <- ts])
-	where	(v0, ts) = let	proc ([], v) (v0, ts) = (Just (maybe v (f [] v) v0), ts)
-				proc (k:ks, v) (v0, ts) = (v0, (k, ks, v):ts)
-				in foldr proc (Nothing, []) xs
-
-mapEdge :: (Sized b, TrieKey k m) => ([k] -> a -> b) -> Edge k m a -> Edge k m b
-mapEdge f (Edge _ ks v ts) = edge ks (fmap (f ks) v) (mapWithKeyAlg (\ l -> mapEdge (\ ls -> f (ks ++ l:ls))) ts)
-
-splitLookupEdge :: (Sized a, TrieKey k m) => (a -> (Maybe a, Maybe b, Maybe a)) -> [k] -> Edge k m a -> 
-	(MEdge k m a, Maybe b, MEdge k m a)
-splitLookupEdge f ks e@(Edge s ls v ts) = procEdge ks ls where
-	procEdge (k:ks) (l:ls) = case compareKey k l of
-		LT	-> (Nothing, Nothing, Just e)
-		GT	-> (Just e, Nothing, Nothing)
-		EQ	-> procEdge ks ls
-	procEdge (k:ks) [] = case splitLookupAlg g k ts of
-		(tsL, ans, tsR)	-> (guardNullEdge (edge ls v tsL), ans, guardNullEdge (edge ls Nothing tsR))
-		where	g = splitLookupEdge f ks 
-	procEdge [] (l:ls) = (Nothing, Nothing, Just e)
-	procEdge [] [] = case v of
-		Nothing	-> (Nothing, Nothing, Just e)
-		Just v	-> case f v of
-			(vL, ans, vR)	-> (single ls vL, ans, guardNullEdge (edge ls vR ts))
-
-isSubEdge :: (TrieKey k m, Sized a, Sized b) => (a -> b -> Bool) -> Edge k m a -> Edge k m b -> Bool
-isSubEdge (<=) (Edge sK ks vK tsK) (Edge _ ls vL tsL) = procEdge ks ls where
-	procEdge (k:ks) (l:ls)
-		| k == l	= procEdge ks ls
-	procEdge (k:ks) []
-		| Just e' <- lookupAlg k tsL
-			= isSubEdge (<=) (Edge sK ks vK tsK) e'
-	procEdge [] [] = isSubmapAlg (<=) vK vL && isSubmapAlg (isSubEdge (<=)) tsK tsL
-
-getMinEdge :: (TrieKey k m, Sized a) => Edge k m a -> Maybe (([k], a), MEdge k m a)
-getMinEdge (Edge s ks (Just v) ts) = Just ((ks, v), guardNullEdge (Edge (s - getSize v) ks Nothing ts))
-getMinEdge (Edge _ ks Nothing ts) = do
-	((l, e'), ts') <- getMinAlg ts
-	((ls, v), e'') <- getMinEdge e'
-	return ((ks ++ l:ls, v), fmap (edge ks Nothing) (maybe (guardNullAlg ts') 
-		(\ e'' -> Just $ snd $ updateMinAlg (\ _ _ -> (False, Just e'')) ts) e''))
-
-getMaxEdge :: (TrieKey k m, Sized a) => Edge k m a -> Maybe (([k], a), MEdge k m a)
-getMaxEdge (Edge _ ks v0 ts)
-	| nullAlg ts = maybe Nothing (\ v -> Just ((ks, v), Nothing)) v0
-	| otherwise	= do
-		((l, e'), ts') <- getMaxAlg ts
-		((ls, v), e'') <- getMaxEdge e'
-		return ((ks ++ l:ls, v), fmap (edge ks Nothing) (maybe (guardNullAlg ts') 
-			(\ e'' -> Just $ snd $ updateMaxAlg (\ _ _ -> (False, Just e'')) ts) e''))
-
-updateMinEdge :: (TrieKey k m, Sized a) => ([k] -> a -> (Bool, Maybe a)) -> Edge k m a -> (Bool, MEdge k m a)
-updateMinEdge f (Edge _ ks (Just v) ts)
-	= fmap (\ v -> guardNullEdge (edge ks v ts)) (f ks v)
-updateMinEdge f (Edge _ ks Nothing ts) = fmap (guardNullEdge . edge ks Nothing) (updateMinAlg g ts) where
-	g l = updateMinEdge (\ ls -> f (ks ++ l:ls))
-
-updateMaxEdge :: (TrieKey k m, Sized a) => ([k] -> a -> (Bool, Maybe a)) -> Edge k m a -> (Bool, MEdge k m a)
-updateMaxEdge f (Edge _ ks (Just v) ts)
-	| nullAlg ts = fmap (\ v -> guardNullEdge (edge ks v ts)) (f ks v)
-updateMaxEdge f (Edge _ ks v ts) = fmap (guardNullEdge . edge ks v) (updateMinAlg g ts) where
-	g l = updateMinEdge (\ ls -> f (ks ++ l:ls))
-
-unionEdge :: (TrieKey k m, Sized a) => ([k] -> a -> a -> Maybe a) -> Edge k m a -> Edge k m a -> MEdge k m a
-unionEdge f (Edge sK ks0 vK tsK) (Edge sL ls0 vL tsL) = procEdge 0 ks0 ls0 where
-	procEdge i _ _ | i `seq` False = undefined
-	procEdge i (k:ks) (l:ls)
-		| k == l	= procEdge (i+1) ks ls
-		| otherwise	= Just (Edge (sK + sL) (take i ks0) Nothing 
-					(insertAlg k (Edge sK ks vK tsK) $ singletonAlg l (Edge sL ls vL tsL)))
-	procEdge _ (k:ks) [] = guardNullEdge $ edge ls0 vL $ alterAlg g k tsL where
-		g Nothing = Just (Edge sK ks vK tsK)
-		g (Just e) = unionEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge sK ks vK tsK) e
-	procEdge _ [] (l:ls) = guardNullEdge $ edge ks0 vK $ alterAlg g l tsK where
-		g Nothing = Just (Edge sL ls vL tsL)
-		g (Just e) = unionEdge (\ ls' -> f (ks0 ++ l:ls')) e (Edge sL ls vL tsL)
-	procEdge _ [] [] = guardNullEdge $ edge ks0 (unionMaybe	(f ks0) vK vL) $
-		unionMaybeAlg (\ x -> unionEdge (\ xs -> f (ks0 ++ x:xs))) tsK tsL
-
-intersectEdge :: (TrieKey k m, Sized c) => ([k] -> a -> b -> Maybe c) -> Edge k m a -> Edge k m b -> MEdge k m c
-intersectEdge f (Edge sK ks0 vK tsK) (Edge sL ls0 vL tsL) = procEdge ks0 ls0 where
-	procEdge (k:ks) (l:ls)
-		| k == l	= procEdge ks ls
-		| otherwise	= Nothing
-	procEdge (k:ks) [] = do
-		e' <- lookupAlg k tsL
-		Edge sX xs vX tsX <- intersectEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge sK ks vK tsK) e'
-		return (Edge sX (ls0 ++ k:xs) vX tsX)
-	procEdge [] (l:ls) = do
-		e' <- lookupAlg l tsK
-		Edge sX xs vX tsX <- intersectEdge (\ ls' -> f (ks0 ++ l:ls')) e' (Edge sL ls vL tsL)
-		return (Edge sX (ks0 ++ l:xs) vX tsX)
-	procEdge [] [] = guardNullEdge $ edge ks0 (intersectMaybe (f ks0) vK vL) 
-		(intersectAlg (\ x -> intersectEdge (\ xs -> f (ks0 ++ x:xs))) tsK tsL)
-
-differenceEdge :: (TrieKey k m, Sized a) => ([k] -> a -> b -> Maybe a) -> Edge k m a -> Edge k m b -> MEdge k m a
-differenceEdge f e@(Edge sK ks0 vK tsK) (Edge sL ls0 vL tsL) = procEdge ks0 ls0 where
-	procEdge (k:ks) (l:ls)
-		| k == l	= procEdge ks ls
-	procEdge (k:ks) []
-		| Just e' <- lookupAlg k tsL
-			= do	Edge sX xs vX tsX <- differenceEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge sK ks vK tsK) e'
-				return (Edge sX (ls0 ++ k:xs) vX tsX)
-	procEdge [] (l:ls) = guardNullEdge $ edge ks0 vK (alterAlg (>>= g) l tsK) where
-		g e = differenceEdge (\ ls' -> f (ks0 ++ l:ls')) e (Edge sL ls vL tsL)
-	procEdge [] [] = guardNullEdge $ edge ks0 (intersectMaybe (f ks0) vK vL) $ 
-		intersectAlg (\ x -> intersectEdge (\ xs -> f (ks0 ++ x:xs))) tsK tsL
-	procEdge _ _ = Just e
diff --git a/TrieMap/Reflection.hs b/TrieMap/Reflection.hs
deleted file mode 100644
--- a/TrieMap/Reflection.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}
-
-module TrieMap.Reflection where
-
--- import TrieMap.Fixpoint
-import TrieMap.MapTypes
-import TrieMap.TrieAlgebraic
-import TrieMap.Algebraic
-import TrieMap.Applicative
-import TrieMap.RadixTrie()
-import qualified TrieMap.TrieAlgebraic as TA
-
-instance Algebraic v => Algebraic (Elem v) where
-	type AlgRep (Elem v) = AlgRep v
-	toAlg (Elem v) = toAlg v
-	fromAlg v = Elem (fromAlg v)
-
--- instance Algebraic (t1 k (m2 v)) => Algebraic (ProdMap m1 m2 v) where
--- 	type AlgRep (ProdMap m1 m2 v) = AlgRep (m1 (m2 v))
--- 	toAlg (PMap m) = toAlg m
--- 	fromAlg = PMap . fromAlg
--- 
--- instance (Ord k, Algebraic k, Sized v, Algebraic v, TrieKey k m) => Algebraic (RadixTrie k m v) where
--- 	type AlgRep (RadixTrie k m v) = AlgRep [([k], v)]
--- 	toAlg m = toAlg (build (\ c n -> foldWithKeyAlg (curry c) n m))
--- 	fromAlg = fromDistAscListAlg . fromAlg
-
-instance (Algebraic k, TrieKey k m) => SAlgebraicT (RadixTrie k m) where
-	type SAlgRepT (RadixTrie k m) = AlgRepT ([] `O` ((,) [k]))
-	toSAlgT = toAlgT . o . assocsAlg
-	fromSAlgT = fromDistAscListAlg . unO . fromAlgT
-
--- instance (AlgebraicT m, Algebraic k) => SAlgebraicT (Edge k m) where
--- 	type SAlgRepT (Edge k m) = AlgRepT (O Fix (O ((:*:) (Const Int :*: Co{--}nst [k] :*: AlgRepT m)) (O Const Maybe)))
-
-
-instance (AlgebraicT m, Algebraic k,  Algebraic a) => Algebraic (Edge k m a) where
-	type AlgRep (Edge k m a) = Fix (AlgRepT (Const (Int, [k], Maybe a)) :*: AlgRepT m)
-	toAlg (Edge s ks v ts) = Fix (toAlgT (Const (s, ks, v)) :*: fmap toAlg (toAlgT ts))
-	fromAlg (Fix (a :*: b)) = case (fromAlgT a, fmap fromAlg b) of
-		(Const (s, ks, v), ts) ->
-			Edge s ks v (fromAlgT ts)
-
-instance (AlgebraicT m, Algebraic k, Algebraic a) => Algebraic (RadixTrie k m a) where
-	type AlgRep (RadixTrie k m a) = AlgRep (Maybe (Edge k m a))
-	toAlg (Radix e) = toAlg e
-	fromAlg = Radix . fromAlg
diff --git a/TrieMap/TrieAlgebraic.hs b/TrieMap/TrieAlgebraic.hs
deleted file mode 100644
--- a/TrieMap/TrieAlgebraic.hs
+++ /dev/null
@@ -1,898 +0,0 @@
-{-# LANGUAGE TypeFamilies, FlexibleInstances, TypeOperators, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, PatternGuards, IncoherentInstances, TypeOperators #-}
-module TrieMap.TrieAlgebraic where
-
-import Control.Arrow ((***))
-import Data.Traversable
-import Data.Foldable
-import Data.Either
-import Data.Sequence (Seq)
-import Data.Maybe
-import Data.Monoid
-import Data.IntMap (IntMap)
-import Data.Map (Map)
-import qualified Data.Sequence as Seq
-import qualified Data.IntMap as IMap
-import qualified Data.Map as Map
-
-import Control.Monad
-import Control.Applicative hiding (Alternative(..), Const(..))
-import GHC.Exts (build)
-
-import TrieMap.Applicative
--- import TrieMap.Algebraic (Ordered (..))
-import TrieMap.MapTypes
-import Prelude hiding (foldr, foldl, all, any)
-
-newtype Ordered k = Ord {unOrd :: k} deriving (Eq, Ord)
-
-instance Show k => Show (Ordered k) where
-	show = show . unOrd
-	showsPrec x = showsPrec x . unOrd
-
-instance Functor Ordered where
-	fmap f (Ord x) = Ord (f x)
-
-type L a = Fix (Const () :+: (Const a :*: Id))
-
-class EqT f => TrieKeyT f t | f -> t, t -> f where
-	compareKeyT :: TrieKey k m => f k -> f k -> Ordering
-	emptyT :: (Sized a, TrieKey k m) => t k m a
-	nullT :: (Sized a, TrieKey k m) => t k m a -> Bool
-	guardNullT :: (Sized a, TrieKey k m) => t k m a -> Maybe (t k m a)
-	sizeT :: (Sized a, TrieKey k m) => t k m a -> Int
-	getSingleT :: (Sized a, TrieKey k m) => t k m a -> Maybe (f k, a)
-	alterLookupT :: (Sized a, TrieKey k m) =>
-		(Maybe a -> (b, Maybe a)) -> f k -> t k m a -> (b, t k m a)
-	lookupT :: (Sized a, TrieKey k m) => f k -> t k m a -> Maybe a
-	foldWithKeyT :: (TrieKey k m) => (f k -> a -> b -> b) -> b -> t k m a -> b
-	mapAppT :: (Applicative g, Sized a, Sized b, TrieKey k m) =>
-		(f k -> a -> g b) -> t k m a -> g (t k m b)
-	mapMaybeT :: (Sized a, Sized b, TrieKey k m) =>
-		(f k -> a -> Maybe b) -> t k m a -> t k m b
-	mapEitherT :: (Sized a, Sized b, Sized c, TrieKey k m) => 
-		(f k -> a -> (Maybe b, Maybe c)) -> t k m a -> (t k m b, t k m c)
-	unionT :: (Sized a, TrieKey k m) => (f k -> a -> a -> Maybe a) -> t k m a -> t k m a -> t k m a
-	intersectT :: (Sized a, Sized b, Sized c, TrieKey k m) =>
-		(f k -> a -> b -> Maybe c) -> t k m a -> t k m b -> t k m c
-	differenceT :: (Sized a, Sized b, TrieKey k m) => (f k -> a -> b -> Maybe a) -> t k m a -> t k m b -> t k m a
-	fromDistAscListT :: (Sized a, TrieKey k m) => [(f k, a)] -> t k m a
-	fromAscListT :: (Sized a, TrieKey k m) => (f k -> a -> a -> a) -> [(f k, a)] -> t k m a
-	fromListT :: (Sized a, TrieKey k m) => (f k -> a -> a -> a) -> [(f k, a)] -> t k m a
-	getMinT :: (Sized a, TrieKey k m) => t k m a -> Maybe ((f k, a), t k m a)
-	getMaxT :: (Sized a, TrieKey k m) => t k m a -> Maybe ((f k, a), t k m a)
-	updateMinT :: (Sized a, TrieKey k m) => (f k -> a -> (Bool, Maybe a)) -> t k m a -> (Bool, t k m a)
-	updateMaxT :: (Sized a, TrieKey k m) => (f k -> a -> (Bool, Maybe a)) -> t k m a -> (Bool, t k m a)
-	isSubmapT :: (Sized a, Sized b, TrieKey k m) => (a -> b -> Bool) -> t k m a -> t k m b -> Bool
-	splitLookupT :: (Sized a, TrieKey k m) => (a -> (Maybe a, Maybe b, Maybe a)) -> f k -> t k m a -> (t k m a, Maybe b, t k m a)
-
-	guardNullT m
-		| nullT m	= Nothing
-		| otherwise	= Just m
-
-eqKey :: TrieKey k m => k -> k -> Bool
-eqKey a b = compareKey a b == EQ
-
-eqKeyT :: (TrieKey k m, TrieKeyT f t) => f k -> f k -> Bool
-eqKeyT a b = compareKeyT a b == EQ
-
--- | TrieKey defines a bijection between map types and algebraic key types.
-class Eq k => TrieKey k m | k -> m, m -> k where
-	compareKey :: k -> k -> Ordering
-	emptyAlg :: Sized a => m a
-	nullAlg :: Sized a => m a -> Bool
-	sizeAlg :: Sized a => m a -> Int
-	getSingleAlg :: Sized a => m a -> Maybe (k, a)
-	guardNullAlg :: Sized a => m a -> Maybe (m a)
--- 	{-# SPECIALIZE alterAlg :: Sized v => (Maybe v -> Id (b, Maybe v)) -> a -> m v -> Id (b, m v) #-}
-	alterLookupAlg :: Sized a => (Maybe a -> (b, Maybe a)) -> k -> m a -> (b, m a)
-	lookupAlg :: Sized a => k -> m a -> Maybe a
-	foldWithKeyAlg :: (k -> a -> b -> b) -> b -> m a -> b
-	mapAppAlg :: (Applicative f, Sized a, Sized b) => (k -> a -> f b) -> m a -> f (m b)
-	mapMaybeAlg :: (Sized a, Sized b) => (k -> a -> Maybe b) -> m a -> m b
-	mapEitherAlg :: (Sized a, Sized b, Sized c) => (k -> a -> (Maybe b, Maybe c)) -> m a -> (m b, m c)
-	unionMaybeAlg :: Sized a => (k -> a -> a -> Maybe a) -> m a -> m a -> m a
-	intersectAlg :: (Sized a, Sized b, Sized c) => (k -> a -> b -> Maybe c) -> m a -> m b -> m c
-	differenceAlg :: (Sized a, Sized b) => (k -> a -> b -> Maybe a) -> m a -> m b -> m a
-	fromDistAscListAlg :: Sized a => [(k, a)] -> m a
-	fromAscListAlg :: Sized a => (k -> a -> a -> a) -> [(k, a)] -> m a
-	fromListAlg :: Sized a => (k -> a -> a -> a) -> [(k, a)] -> m a
-	getMinAlg :: Sized a => m a -> Maybe ((k, a), m a)
-	getMaxAlg :: Sized a => m a -> Maybe ((k, a), m a)
-	updateMinAlg :: Sized a => (k -> a -> (Bool, Maybe a)) -> m a -> (Bool, m a)
-	updateMaxAlg :: Sized a => (k -> a -> (Bool, Maybe a)) -> m a -> (Bool, m a)
-	valid :: Sized a =>  m a -> Bool
-	isSubmapAlg :: (Sized a, Sized b) => (a -> b -> Bool) -> m a -> m b -> Bool
-	splitLookupAlg :: (Sized a) => (a -> (Maybe a, Maybe b, Maybe a)) -> k -> m a -> (m a, Maybe b, m a)
-
-	lookupAlg k = fst . alterLookupAlg (\ v -> (v, v)) k
-	guardNullAlg m
-		| nullAlg m	= Nothing
-		| otherwise	= Just m
-	getSingleAlg m = do
-		((k, v), m') <- getMinAlg m
-		guard (nullAlg m')
-		return (k, v)
-	fromListAlg f = foldr (\ (k, v) -> alterAlg (Just . maybe v (f k v)) k) emptyAlg
-	fromAscListAlg _ [] = emptyAlg
-	fromAscListAlg f ((k, v):xs) = fromDistAscListAlg (distinct k v xs) where
-		distinct k v ((k', v'):xs)
-			| k `eqKey` k'	= distinct k (f k v v') xs
-			| otherwise	= (k, v):distinct k' v' xs
-		distinct k v [] = [(k, v)]
-	fromDistAscListAlg = fromListAlg'
-	sizeAlg = foldWithKeyAlg (\ _ x n -> n + getSize x) 0
-
-	updateMinAlg f m = maybe (False, m) (\ ((k, v), m') -> maybe m' (\ v' -> insertAlg k v' m) <$> f k v) (getMinAlg m)
-	updateMaxAlg f m = maybe (False, m) (\ ((k, v), m') -> maybe m' (\ v' -> insertAlg k v' m) <$> f k v) (getMaxAlg m)
-	valid = (`seq` True)
-
-instance TrieKeyT f t => TrieKey (Fix f) (FixMap f t) where
-	compareKey (Fix a) (Fix b) = compareKeyT a b
-	emptyAlg = FixMap emptyT
-	nullAlg (FixMap m) = nullT m
-	sizeAlg (FixMap m) = sizeT m
-	getSingleAlg (FixMap m) = do
-		(k, v) <- getSingleT m
-		return (Fix k, v)
-	lookupAlg (Fix k) (FixMap m) = lookupT k m
-	alterLookupAlg f (Fix k) (FixMap m) = FixMap <$> alterLookupT f k m
-	foldWithKeyAlg f z (FixMap m) = foldWithKeyT (f . Fix) z m
-	mapAppAlg f (FixMap m) = FixMap <$> mapAppT (f . Fix) m
-	mapMaybeAlg f (FixMap m) = FixMap (mapMaybeT (f . Fix) m)
-	mapEitherAlg f (FixMap m) = case mapEitherT (f . Fix) m of
-		(mL, mR) -> (FixMap mL, FixMap mR)
-	unionMaybeAlg f (FixMap m1) (FixMap m2) = FixMap (unionT (f . Fix) m1 m2)
-	intersectAlg f (FixMap m1) (FixMap m2) = FixMap (intersectT (f . Fix) m1 m2)
-	differenceAlg f (FixMap m1) (FixMap m2) = FixMap (differenceT (f . Fix) m1 m2)
-	getMinAlg (FixMap m) = do
-		(~(k, v), m') <- getMinT m
-		return ((Fix k, v), FixMap m')
-	getMaxAlg (FixMap m) = do
-		(~(k, v), m') <- getMaxT m
-		return ((Fix k, v), FixMap m')
-	updateMinAlg f (FixMap m) = FixMap <$> updateMinT (f . Fix) m
-	updateMaxAlg f (FixMap m) = FixMap <$> updateMaxT (f . Fix) m
-	isSubmapAlg (<=) (FixMap m1) (FixMap m2) = isSubmapT (<=) m1 m2
-	splitLookupAlg f (Fix k) (FixMap m) = case splitLookupT f k m of
-		(mL, ans, mR) -> (FixMap mL, ans, FixMap mR)
-
-instance (Sized a, TrieKey k m) => Sized (m a) where
-	getSize = sizeAlg
-
-instance (Sized a, TrieKey k m, TrieKeyT f t) => Sized (t k m a) where
-	getSize = sizeT
-
-fromListAlg' :: (Sized v, TrieKey k m) => [(k, v)] -> m v
-fromListAlg' = fromListAlg (const const)
-
-singletonAlg :: (Sized v, TrieKey k m) => k -> v -> m v
-singletonAlg k v = insertAlg k v emptyAlg
-
-mapWithKeyAlg :: (Sized v, Sized w, TrieKey k m) => (k -> v -> w) -> m v -> m w
-mapWithKeyAlg f m = unId (mapAppAlg (\ k v -> Id (f k v)) m)
-
-mapWithKeyT :: (Sized v, Sized w, TrieKeyT f t, TrieKey k m) => (f k -> v -> w) -> t k m v -> t k m w
-mapWithKeyT f m = unId (mapAppT (\ k v -> Id (f k v)) m)
-
-mapAlg :: (Sized v, Sized w, TrieKey k m) => (v -> w) -> m v -> m w
-mapAlg = mapWithKeyAlg . const
-
-mapT :: (Sized v, Sized w, TrieKeyT f t, TrieKey k m) => (v -> w) -> t k m v -> t k m w
-mapT = mapWithKeyT . const
-
--- mapMaybeWithKeyAlg :: TrieKey k m => (k -> v -> Maybe w) -> m v -> m w
--- mapMaybeWithKeyAlg f m = unId (mapAppMaybeAlg (\ k v -> Id (f k v)) m)
-
-insertAlg :: (Sized v, TrieKey k m) => k -> v -> m v -> m v
-insertAlg k v = alterAlg (const (Just v)) k
-
-insertT :: (Sized v, TrieKey k m, TrieKeyT f t) => f k -> v -> t k m v -> t k m v
-insertT k v = alterT (const (Just v)) k
-
-alterAlg :: (Sized v, TrieKey k m) => (Maybe v -> Maybe v) -> k -> m v -> m v
-alterAlg f k = snd . alterLookupAlg (\ x -> ((), f x)) k
-
-alterT :: (Sized v, TrieKey k m, TrieKeyT f t) => (Maybe v -> Maybe v) -> f k -> t k m v -> t k m v
-alterT f k = snd . alterLookupT (\ x -> ((), f x)) k
-
--- alterLookupAlg :: TrieKey k m => (Maybe a -> (b, Maybe a)) -> k -> m a -> (b, m a)
--- alterLookupAlg f = unId .: alterAppAlg (Id . f)
-
-foldrAlg :: (Sized a, TrieKey k m) => (a -> b -> b) -> b -> m a -> b
-foldrAlg = foldWithKeyAlg . const
-
-unionMaybe :: (a -> a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a
-unionMaybe f (Just x) (Just y) = f x y
-unionMaybe _ Nothing y = y
-unionMaybe _ x Nothing = x
-
-intersectMaybe :: (a -> b -> Maybe c) -> Maybe a -> Maybe b -> Maybe c
-intersectMaybe f (Just x) (Just y) = f x y
-intersectMaybe _ _ _ = Nothing
-
-differenceMaybe :: (a -> b -> Maybe a) -> Maybe a -> Maybe b -> Maybe a
-differenceMaybe _ Nothing _ = Nothing
-differenceMaybe _ x Nothing = x
-differenceMaybe f (Just x) (Just y) = f x y
-
-filterLeft :: a -> Either b c -> Maybe b
-filterLeft _ (Left x) = Just x
-filterLeft _ _ = Nothing
-
-filterRight :: a -> Either b c -> Maybe c
-filterRight _ (Right x) = Just x
-filterRight _ _ = Nothing
-
-{-# INLINE assocsAlg #-}
-assocsAlg :: (TrieKey k m) => m a -> [(k, a)]
-assocsAlg m = build (\ c n -> foldWithKeyAlg (\ k v xs -> (k,v) `c` xs) n m)
-
-instance (TrieKeyT f1 t1, TrieKeyT f2 t2) => TrieKeyT (f1 :*: f2) (t1 `ProdMap` t2) where
-	compareKeyT (a :*: x) (b :*: y) = compareKeyT a b `mappend` compareKeyT x y
-	emptyT = PMap emptyT
-	nullT (PMap m) = nullT m
-	sizeT (PMap m) = sizeT m
-	getSingleT (PMap m) = do
-		(k1, m') <- getSingleT m
-		(k2, v) <- getSingleT m'
-		return (k1 :*: k2, v)
-	lookupT (k1 :*: k2) (PMap m) = lookupT k1 m >>= lookupT k2
-	alterLookupT f (k1 :*: k2) (PMap m) = PMap <$> alterLookupT g k1 m where
-		g = fmap guardNullT . alterLookupT f k2 . fromMaybe emptyT
-	foldWithKeyT f z (PMap m) = foldWithKeyT (\ k1 -> flip (foldWithKeyT (\ k2 -> f (k1 :*: k2)))) z m
-	mapAppT f (PMap m) = PMap <$> mapAppT (\ k1 -> mapAppT (\ k2 -> f (k1 :*: k2))) m
-	mapMaybeT f (PMap m) = PMap (mapMaybeT (\ k1 -> guardNullT . mapMaybeT (\ k2 -> f (k1 :*: k2))) m)
-	mapEitherT f (PMap m) = (PMap *** PMap) (mapEitherT (\ k1 -> (guardNullT *** guardNullT) . mapEitherT (\ k2 -> f (k1 :*: k2))) m)
-	unionT f (PMap m1) (PMap m2) = PMap (unionT (\ k1 -> guardNullT .: unionT (\ k2 -> f (k1 :*: k2))) m1 m2)
-	intersectT f (PMap m1) (PMap m2) = PMap (intersectT (\ k1 -> guardNullT .: intersectT (\ k2 -> f (k1 :*: k2))) m1 m2)
-	differenceT f (PMap m1) (PMap m2) = PMap (differenceT (\ k1 -> guardNullT .: differenceT (\ k2 -> f (k1 :*: k2))) m1 m2)
-	fromListT f xs = PMap $ mapWithKeyT (\ k1 (Elem xs) -> fromListT (\ k2 -> f (k1 :*:  k2)) xs) $
-		fromListT (\ _ (Elem x) (Elem y) -> Elem (x ++ y)) [(k1, Elem [(k2, v)]) | ((k1 :*: k2), v) <- xs]
-	fromDistAscListT xs = PMap $ fromDistAscListT [(k1, fromDistAscListT ys) | (k1, ys) <- breakFst eqKeyT xs]	
-	fromAscListT f xs = PMap $ fromDistAscListT [(k1, fromAscListT (\ k2 -> f (k1 :*: k2)) ys) | (k1, ys) <- breakFst eqKeyT xs]
-	getMinT (PMap m) = do
-		((k1, m'), m1') <- getMinT m
-		((k2, v), m2') <- getMinT m'
-		return ((k1 :*: k2, v), PMap (maybe m1' (\ m2' -> insertT k1 m2' m) (guardNullT m2')))
-	getMaxT (PMap m) = do
-		((k1, m'), m1') <- getMaxT m
-		((k2, v), m2') <- getMaxT m'
-		return ((k1 :*: k2, v), PMap (maybe m1' (\ m2' -> insertT k1 m2' m) (guardNullT m2')))
-	updateMinT f (PMap m) = 
-		PMap <$> updateMinT (\ k1 -> guardNullT <.> updateMinT (\ k2 -> f (k1 :*: k2))) m
-	updateMaxT f (PMap m) =
-		PMap <$> updateMaxT (\ k1 -> guardNullT <.> updateMaxT (\ k2 -> f (k1 :*: k2))) m
-	isSubmapT (<=) (PMap m1) (PMap m2) =
-		isSubmapT (isSubmapT (<=)) m1 m2
-	splitLookupT f (k1 :*: k2) (PMap m) = case splitLookupT g k1 m of
-			(mL, ans, mR)	-> (PMap mL, ans, PMap mR)
-		where g m' = case splitLookupT f k2 m' of
-			(mL, ans, mR)	-> (guardNullT mL, ans, guardNullT mR)
-
-instance (Eq (f1 k), Eq (f2 k), TrieKey k m, TrieKeyT f1 t1, TrieKeyT f2 t2) => TrieKey ((f1 :*: f2) k) (ProdMap t1 t2 k m) where
-	compareKey = compareKeyT
-	emptyAlg = emptyT
-	nullAlg = nullT
-	getSingleAlg = getSingleT
-	guardNullAlg = guardNullT
-	sizeAlg = sizeT
-	lookupAlg = lookupT
-	alterLookupAlg = alterLookupT
-	mapAppAlg = mapAppT
-	mapMaybeAlg = mapMaybeT
-	mapEitherAlg = mapEitherT
-	foldWithKeyAlg = foldWithKeyT
-	unionMaybeAlg = unionT
-	intersectAlg = intersectT
-	differenceAlg = differenceT
-	getMinAlg = getMinT
-	getMaxAlg = getMaxT
-	updateMinAlg = updateMinT
-	updateMaxAlg = updateMaxT
-	isSubmapAlg = isSubmapT
-	splitLookupAlg = splitLookupT
-
-breakFst :: (f1 k -> f1 k -> Bool) -> [((f1 :*: f2) k, v)] -> [(f1 k, [(f2 k, v)])]
-breakFst _ [] = []
-breakFst eq (((k1 :*: k2), x):xs) = breakFst' k1 (Seq.singleton (k2, x)) xs where
-	breakFst' k xs (((k' :*: k2), x):xss)
-		| k `eq` k'	= breakFst' k ((Seq.|>) xs (k2, x)) xss
-		| otherwise	= (k, toList xs):breakFst' k' (Seq.singleton (k2, x)) xss
-	breakFst' k xs [] = [(k, toList xs)]
-
-instance (TrieKeyT f1 t1, TrieKeyT f2 t2) => TrieKeyT (f1 :+: f2) (UnionMap t1 t2) where
-	compareKeyT (A a) (A b) = compareKeyT a b
-	compareKeyT (B x) (B y) = compareKeyT x y
-	compareKeyT A{} B{} = LT
-	compareKeyT B{} A{} = GT
-	emptyT = UMap emptyT emptyT
-	nullT (UMap m1 m2) = nullT m1 && nullT m2
-	getSingleT (UMap m1 m2) = case (getSingleT m1, getSingleT m2) of
-		(Just (k, v), Nothing)	-> Just (A k, v)
-		(Nothing, Just (k, v))	-> Just (B k, v)
-		_			-> Nothing
-	sizeT (UMap m1 m2) = sizeT m1 + sizeT m2
-	lookupT (A k) (UMap m1 _) = lookupT k m1
-	lookupT (B k) (UMap _ m2) = lookupT k m2
-	alterLookupT f (A k) (UMap m1 m2) = (`UMap` m2) <$> alterLookupT f k m1
-	alterLookupT f (B k) (UMap m1 m2) = UMap m1 <$> alterLookupT f k m2
-	foldWithKeyT f z (UMap m1 m2) = foldWithKeyT (f . A) (foldWithKeyT (f . B) z m2) m1
-	mapAppT f (UMap m1 m2) = UMap <$> mapAppT (f . A) m1 <*> mapAppT (f . B) m2
-	mapMaybeT f (UMap m1 m2) = UMap (mapMaybeT (f . A) m1) (mapMaybeT (f . B) m2)
-	mapEitherT f (UMap m1 m2) = (UMap m1L m2L, UMap m1R m2R)
-		where	(m1L, m1R) = mapEitherT (f . A) m1
-			(m2L, m2R) = mapEitherT (f . B) m2
-	unionT f (UMap m11 m12) (UMap m21 m22) = 
-		UMap (unionT (f . A) m11 m21) (unionT (f . B) m12 m22)
-	intersectT f (UMap m11 m12) (UMap m21 m22) =
-		UMap (intersectT (f . A) m11 m21) (intersectT (f . B) m12 m22)
-	differenceT f (UMap m11 m12) (UMap m21 m22) =
-		UMap (differenceT (f . A) m11 m21) (differenceT (f . B) m12 m22)
-	getMinT (UMap m1 m2) 
-		| Just ~(~(k, v), m1') <- getMinT m1
-			= Just ((A k, v), UMap m1' m2)
-		| Just ~(~(k, v), m2') <- getMinT m2
-			 = Just ((B k, v), UMap m1 m2')
-		| otherwise = Nothing
-	getMaxT (UMap m1 m2)
-		| Just ~(~(k, v), m2') <- getMaxT m2
-			= Just ((B k, v), UMap m1 m2')
-		| Just ~(~(k, v), m1') <- getMaxT m1
-			= Just ((A k, v), UMap m1' m2)
-		| otherwise = Nothing
-	updateMinT f (UMap m1 m2)
-		| nullT m1	= UMap m1 <$> updateMinT (f . B) m2
-		| otherwise	= (`UMap` m2) <$> updateMinT (f . A) m1
-	updateMaxT f (UMap m1 m2)
-		| nullT m2	= (`UMap` m2) <$> updateMaxT (f . A) m1
-		| otherwise	= UMap m1 <$> updateMaxT (f . B) m2
-	fromDistAscListT xs = UMap (fromDistAscListT ys) (fromDistAscListT zs)
-		where	(ys, zs) = partitionEithers' (map pullEither xs)
-	fromAscListT f xs = UMap (fromAscListT (f . A) ys) (fromAscListT (f . B) zs) 
-		where	(ys, zs) = partitionEithers' (map pullEither xs)
-	fromListT f xs = UMap (fromListT (f . A) ys) (fromListT (f . B) zs)
-		where	(ys, zs) = partitionEithers' (map pullEither xs)
-	isSubmapT (<=) (UMap m11 m12) (UMap m21 m22) = isSubmapT (<=) m11 m21 && isSubmapT (<=) m12 m22
-	splitLookupT f (A k) (UMap m1 m2) = case splitLookupT f k m1 of
-		(m1L, ans, m1R)	-> (UMap m1L emptyT, ans, UMap m1R m2)
-	splitLookupT f (B k) (UMap m1 m2) = case splitLookupT f k m2 of
-		(m2L, ans, m2R)	-> (UMap m1 m2L, ans, UMap emptyT m2R)
-
-instance (Eq (f1 k), Eq (f2 k), TrieKey k m, TrieKeyT f1 t1, TrieKeyT f2 t2) => TrieKey ((f1 :+: f2) k) (UnionMap t1 t2 k m) where
-	compareKey = compareKeyT
-	emptyAlg = emptyT
-	nullAlg = nullT
-	getSingleAlg = getSingleT
-	guardNullAlg = guardNullT
-	sizeAlg = sizeT
-	lookupAlg = lookupT
-	alterLookupAlg = alterLookupT
-	mapAppAlg = mapAppT
-	mapMaybeAlg = mapMaybeT
-	mapEitherAlg = mapEitherT
-	foldWithKeyAlg = foldWithKeyT
-	unionMaybeAlg = unionT
-	intersectAlg = intersectT
-	differenceAlg = differenceT
-	getMinAlg = getMinT
-	getMaxAlg = getMaxT
-	updateMinAlg = updateMinT
-	updateMaxAlg = updateMaxT
-	isSubmapAlg = isSubmapT
-	splitLookupAlg = splitLookupT
-
-instance TrieKey k m => TrieKeyT ((,) k) (CProdMap m) where
-	compareKeyT (a, x) (b, y) = compareKey a b `mappend` compareKey x y
-	emptyT = CPMap emptyAlg
-	nullT (CPMap m) = nullAlg m
-	getSingleT (CPMap m) = do
-		(k1, m') <- getSingleAlg m
-		(k2, v) <- getSingleAlg m'
-		return ((k1, k2), v)
-	guardNullT (CPMap m) = CPMap <$> guardNullAlg m
-	sizeT (CPMap m) = sizeAlg m
-	lookupT (k1, k2) (CPMap m) = lookupAlg k1 m >>= lookupAlg k2
-	alterLookupT f (k1, k2) (CPMap m) = CPMap <$> alterLookupAlg g k1 m where
-		g = guardNullAlg <.> alterLookupAlg f k2 . fromMaybe emptyAlg
-	foldWithKeyT f z (CPMap m) = foldWithKeyAlg (\ k1 -> flip $ foldWithKeyAlg (\ k2 -> f (k1, k2))) z m
-	mapAppT f (CPMap m) = CPMap <$> mapAppAlg (\ k1 -> mapAppAlg (\ k2 -> f (k1, k2))) m
-	mapMaybeT f (CPMap m) = CPMap (mapMaybeAlg (\ k1 -> guardNullAlg . mapMaybeAlg (\ k2 -> f (k1, k2))) m)
-	mapEitherT f (CPMap m) = (CPMap *** CPMap) (mapEitherAlg (\ k1 -> (guardNullAlg *** guardNullAlg) . mapEitherAlg (\ k2 -> f (k1, k2))) m)
-	unionT f (CPMap m1) (CPMap m2) =
-		CPMap (unionMaybeAlg (\ k1 -> guardNullAlg .: unionMaybeAlg (\ k2 -> f (k1, k2))) m1 m2)
-	intersectT f (CPMap m1) (CPMap m2) =
-		CPMap (intersectAlg (\ k1 -> guardNullAlg .: intersectAlg (\ k2 -> f (k1, k2))) m1 m2)
-	differenceT f (CPMap m1) (CPMap m2) = 
-		CPMap (differenceAlg (\ k1 -> guardNullAlg .: differenceAlg (\ k2 -> f (k1, k2))) m1 m2)
-	getMinT (CPMap m) = do
-		((k1, m1), m') <- getMinAlg m
-		((k2, v), m1') <- getMinAlg m1
-		return (((k1, k2), v), CPMap $ maybe m' (\ m1' -> snd $ updateMinAlg (\ _ _ -> (False, Just m1')) m) (guardNullAlg m1'))
-	getMaxT (CPMap m) = do
-		((k1, m1), m') <- getMaxAlg m
-		((k2, v), m1') <- getMaxAlg m1
-		return (((k1, k2), v), CPMap $ maybe m' (\ m1' -> snd $ updateMaxAlg (\ _ _ -> (False, Just m1')) m) (guardNullAlg m1'))	
-	updateMinT f (CPMap m) = 
-		CPMap <$> updateMinAlg (\ k1 -> guardNullAlg <.> updateMinAlg (\ k2 -> f (k1, k2))) m
-	updateMaxT f (CPMap m) =
-		CPMap <$> updateMaxAlg (\ k1 -> guardNullAlg <.> updateMaxAlg (\ k2 -> f (k1, k2))) m
-	isSubmapT (<=) (CPMap m1) (CPMap m2) = isSubmapAlg (isSubmapAlg (<=)) m1 m2
-	splitLookupT f (k1, k2) (CPMap m) = case splitLookupAlg g k1 m of
-		(mL, ans, mR)	-> (CPMap mL, ans, CPMap mR)
-		where g m = case splitLookupAlg f k2 m of
-			(mL, ans, mR)	-> (guardNullAlg mL, ans, guardNullAlg mR)
-	fromDistAscListT xs = CPMap (fromDistAscListAlg [(k1, fromDistAscListAlg ys) | (k1, ys) <- breakFst' (==) xs])
-	fromAscListT f xs = CPMap (fromDistAscListAlg [(k1, fromAscListAlg (\ k2 -> f (k1, k2)) ys) | (k1, ys) <- breakFst' (==) xs])
-	fromListT f xs = CPMap (mapWithKeyAlg (\ k1 (Elem ys) -> fromListAlg (\ k2 -> f (k1, k2)) ys) $
-		fromListAlg (\ _ (Elem ys) (Elem zs) -> Elem (ys ++ zs)) [(k1, Elem [(k2, v)]) | ((k1, k2), v) <- xs])
-
-breakFst' :: (k1 -> k1 -> Bool) -> [((k1, k2), v)] -> [(k1, [(k2, v)])]
-breakFst' _ [] = []
-breakFst' eq (((k1, k2), x):xs) = breakFst'' k1 (Seq.singleton (k2, x)) xs where
-	breakFst'' k xs (((k', k2), x):xss)
-		| k `eq` k'	= breakFst'' k ((Seq.|>) xs (k2, x)) xss
-		| otherwise	= (k, toList xs):breakFst'' k' (Seq.singleton (k2, x)) xss
-	breakFst'' k xs [] = [(k, toList xs)]
-
-instance (TrieKey k1 m1, TrieKey k2 m2) => TrieKey (k1, k2) (CProdMap m1 k2 m2) where
-	compareKey = compareKeyT
-	emptyAlg = emptyT
-	nullAlg = nullT
-	getSingleAlg = getSingleT
-	guardNullAlg = guardNullT
-	sizeAlg = sizeT
-	lookupAlg = lookupT
-	alterLookupAlg = alterLookupT
-	mapAppAlg = mapAppT
-	mapMaybeAlg = mapMaybeT
-	mapEitherAlg = mapEitherT
-	foldWithKeyAlg = foldWithKeyT
-	unionMaybeAlg = unionT
-	intersectAlg = intersectT
-	differenceAlg = differenceT
-	getMinAlg = getMinT
-	getMaxAlg = getMaxT
-	updateMinAlg = updateMinT
-	updateMaxAlg = updateMaxT
-	isSubmapAlg = isSubmapT
-	splitLookupAlg = splitLookupT
-
-instance TrieKey k m => TrieKeyT (Either k) (CUnionMap m) where
-	{-# SPECIALIZE instance TrieKeyT (Either ()) (CUnionMap Maybe) #-}
-	compareKeyT (Left a) (Left b) = compareKey a b
-	compareKeyT (Right a) (Right b) = compareKey a b
-	compareKeyT Left{} Right{} = LT
-	compareKeyT Right{} Left{} = GT
-	emptyT = CUMap emptyAlg emptyAlg
-	nullT (CUMap m1 m2) = nullAlg m1 && nullAlg m2
-	sizeT (CUMap m1 m2) = sizeAlg m1 + sizeAlg m2
-	getSingleT (CUMap m1 m2) = case (getSingleAlg m1, getSingleAlg m2) of
-		(Just (k, v), Nothing)	-> Just (Left k, v)
-		(Nothing, Just (k, v))	-> Just (Right k, v)
-		_			-> Nothing
-	lookupT k (CUMap m1 m2) = either (`lookupAlg` m1) (`lookupAlg` m2) k
-	alterLookupT f (Left k) (CUMap m1 m2) = (`CUMap` m2) <$> alterLookupAlg f k m1
-	alterLookupT f (Right k) (CUMap m1 m2) = CUMap m1 <$> alterLookupAlg f k m2
-	foldWithKeyT f z (CUMap m1 m2) = foldWithKeyAlg (f . Left) (foldWithKeyAlg (f . Right) z m2) m1
-	mapAppT f (CUMap m1 m2) = CUMap <$> mapAppAlg (f . Left) m1 <*> mapAppAlg (f . Right) m2
-	mapMaybeT f (CUMap m1 m2) = CUMap (mapMaybeAlg (f . Left) m1) (mapMaybeAlg (f . Right) m2)
-	mapEitherT f (CUMap m1 m2) = (CUMap m1L m2L, CUMap m1R m2R)
-		where	(m1L, m1R) = mapEitherAlg (f . Left) m1
-			(m2L, m2R) = mapEitherAlg (f . Right) m2
-	unionT f (CUMap m11 m12) (CUMap m21 m22) = 
-		CUMap (unionMaybeAlg (f . Left) m11 m21) (unionMaybeAlg (f . Right) m12 m22)
-	intersectT f (CUMap m11 m12) (CUMap m21 m22) =
-		CUMap (intersectAlg (f . Left) m11 m21) (intersectAlg (f . Right) m12 m22)
-	differenceT f (CUMap m11 m12) (CUMap m21 m22) = 
-		CUMap (differenceAlg (f . Left) m11 m21) (differenceAlg (f . Right) m12 m22)
-	isSubmapT (<=) (CUMap m11 m12) (CUMap m21 m22) = 
-		isSubmapAlg (<=) m11 m21 && isSubmapAlg (<=) m12 m22
-	splitLookupT f (Left k) (CUMap m1 m2) = case splitLookupAlg f k m1 of
-		(m1L, ans, m1R)	-> (CUMap m1L emptyAlg, ans, CUMap m1R m2)
-	splitLookupT f (Right k) (CUMap m1 m2) = case splitLookupAlg f k m2 of
-		(m2L, ans, m2R)	-> (CUMap m1 m2L, ans, CUMap emptyAlg m2R)
-	getMinT (CUMap m1 m2) = case (getMinAlg m1, getMinAlg m2) of
-		(Just ((k, v), m1'), _)	-> Just ((Left k, v), CUMap m1' m2)
-		(_, Just ((k, v), m2'))	-> Just ((Right k, v), CUMap m1 m2')
-		_			-> Nothing
-	getMaxT (CUMap m1 m2) = case (getMaxAlg m1, getMaxAlg m2) of
-		(_, Just ((k, v), m2'))	-> Just ((Right k, v), CUMap m1 m2')
-		(Just ((k, v), m1'), _)	-> Just ((Left k, v), CUMap m1' m2)
-		_			-> Nothing
-	updateMinT f (CUMap m1 m2)
-		| nullAlg m1	= CUMap m1 <$> updateMinAlg (f . Right) m2
-		| otherwise	= (`CUMap` m2) <$> updateMinAlg (f . Left) m1
-	updateMaxT f (CUMap m1 m2)
-		| nullAlg m2	= (`CUMap` m2) <$> updateMaxAlg (f . Left) m1
-		| otherwise	= CUMap m1 <$> updateMaxAlg (f . Right) m2
-	fromListT f xs = CUMap (fromListAlg (f . Left) ys) (fromListAlg (f . Right) zs)
-		where	(ys, zs) = partitionEithers (map pullEither' xs)
-	fromAscListT f xs = CUMap (fromAscListAlg (f . Left) ys) (fromAscListAlg (f . Right) zs)
-		where	(ys, zs) = partitionEithers (map pullEither' xs)
-	fromDistAscListT xs = CUMap (fromDistAscListAlg ys) (fromDistAscListAlg zs) 
-		where	(ys, zs) = partitionEithers (map pullEither' xs)
-
-instance (TrieKey k1 m1, TrieKey k2 m2) => TrieKey (Either k1 k2) (CUnionMap m1 k2 m2) where
-	{-# SPECIALIZE instance TrieKey k m => TrieKey (Either () k) (CUnionMap Maybe k m) #-}
-	compareKey = compareKeyT
-	emptyAlg = emptyT
-	nullAlg = nullT
-	getSingleAlg = getSingleT
-	guardNullAlg = guardNullT
-	sizeAlg = sizeT
-	lookupAlg = lookupT
-	alterLookupAlg = alterLookupT
-	mapAppAlg = mapAppT
-	mapMaybeAlg = mapMaybeT
-	mapEitherAlg = mapEitherT
-	foldWithKeyAlg = foldWithKeyT
-	unionMaybeAlg = unionT
-	intersectAlg = intersectT
-	differenceAlg = differenceT
-	getMinAlg = getMinT
-	getMaxAlg = getMaxT
-	updateMinAlg = updateMinT
-	updateMaxAlg = updateMaxT
-	isSubmapAlg = isSubmapT
-	splitLookupAlg = splitLookupT
-
-partitionEithers' :: [Either a b] -> ([a], [b])
-partitionEithers' = foldr part ([], []) where
-	part (Left x) (xs, ys) = (x:xs, ys)
-	part (Right y) (xs, ys) = (xs, y:ys)
-
-pullEither :: ((f1 :+: f2) k, v) -> Either (f1 k, v) (f2 k, v)
-pullEither (A k, v) = Left (k, v)
-pullEither (B k, v) = Right (k, v)
-
-pullEither' :: (Either k1 k2, v) -> Either (k1, v) (k2, v)
-pullEither' (Left k, v) = Left (k, v)
-pullEither' (Right k, v) = Right (k, v)
-
-instance TrieKey k m => TrieKeyT (Const k) (ConstMap m) where
-	compareKeyT (Const a) (Const b) = compareKey a b
-	emptyT = ConstMap emptyAlg
-	nullT (ConstMap m) = nullAlg m
-	sizeT (ConstMap m) = sizeAlg m
-	getSingleT (ConstMap m) = do
-		(k, v) <- getSingleAlg m
-		return (Const k, v)
-	lookupT (Const k) (ConstMap m) = lookupAlg k m
-	alterLookupT f (Const k) (ConstMap m) = ConstMap <$> alterLookupAlg f k m
-	foldWithKeyT f z (ConstMap m) = foldWithKeyAlg (f . Const) z m
-	mapAppT f (ConstMap m) = ConstMap <$> mapAppAlg (f . Const) m
-	mapMaybeT f (ConstMap m) = ConstMap (mapMaybeAlg (f . Const) m)
-	mapEitherT f (ConstMap m) = case mapEitherAlg (f . Const) m of
-		(mL, mR) -> (ConstMap mL, ConstMap mR)
-	unionT f (ConstMap m1) (ConstMap m2) = ConstMap (unionMaybeAlg (f . Const) m1 m2)
-	intersectT f (ConstMap m1) (ConstMap m2) = ConstMap (intersectAlg (f . Const) m1 m2)
-	differenceT f (ConstMap m1) (ConstMap m2) = ConstMap (differenceAlg (f . Const) m1 m2)
-	fromDistAscListT xs = ConstMap (fromDistAscListAlg [(k, v) | (Const k, v) <- xs])
-	fromAscListT f xs = ConstMap (fromAscListAlg (f . Const) [(k, v) | (Const k, v) <- xs])
-	fromListT f xs = ConstMap (fromListAlg (f . Const) [(k, v) | (Const k, v) <- xs])
-	getMinT (ConstMap m) = do
-		(~(k, v), m') <- getMinAlg m
-		return ((Const k, v), ConstMap m')
-	getMaxT (ConstMap m) = do
-		(~(k, v), m') <- getMaxAlg m
-		return ((Const k, v), ConstMap m')
-	updateMinT f (ConstMap m) = ConstMap <$> updateMinAlg (f . Const) m
-	updateMaxT f (ConstMap m) = ConstMap <$> updateMaxAlg (f . Const) m
-	isSubmapT (<=) (ConstMap m1) (ConstMap m2) = isSubmapAlg (<=) m1 m2
-	splitLookupT f (Const k) (ConstMap m) = case splitLookupAlg f k m of
-		(mL, ans, mR) -> (ConstMap mL, ans, ConstMap mR)
-
-instance (TrieKey k m, TrieKey k' m') => TrieKey (Const k k') (ConstMap m k' m') where
-	compareKey = compareKeyT
-	emptyAlg = emptyT
-	nullAlg = nullT
-	getSingleAlg = getSingleT
-	guardNullAlg = guardNullT
-	sizeAlg = sizeT
-	lookupAlg = lookupT
-	alterLookupAlg = alterLookupT
-	mapAppAlg = mapAppT
-	mapMaybeAlg = mapMaybeT
-	mapEitherAlg = mapEitherT
-	foldWithKeyAlg = foldWithKeyT
-	unionMaybeAlg = unionT
-	intersectAlg = intersectT
-	differenceAlg = differenceT
-	getMinAlg = getMinT
-	getMaxAlg = getMaxT
-	updateMinAlg = updateMinT
-	updateMaxAlg = updateMaxT
-	isSubmapAlg = isSubmapT
-	splitLookupAlg = splitLookupT
-
-instance TrieKeyT Id IdMap where
-	compareKeyT (Id a) (Id b) = compareKey a b
-	emptyT = IdMap emptyAlg
-	nullT (IdMap m) = nullAlg m
-	sizeT (IdMap m) = sizeAlg m
-	getSingleT (IdMap m) = do
-		(k, v) <- getSingleAlg m
-		return (Id k, v)
-	lookupT (Id k) (IdMap m) = lookupAlg k m
-	alterLookupT f (Id k) (IdMap m) = IdMap <$> alterLookupAlg f k m
-	foldWithKeyT f z (IdMap m) = foldWithKeyAlg (f . Id) z m
-	mapAppT f (IdMap m) = IdMap <$> mapAppAlg (f . Id) m
-	mapMaybeT f (IdMap m) = IdMap (mapMaybeAlg (f . Id) m)
-	mapEitherT f (IdMap m) = case mapEitherAlg (f . Id) m of
-		(mL, mR) -> (IdMap mL, IdMap mR)
-	unionT f (IdMap m1) (IdMap m2) = IdMap (unionMaybeAlg (f . Id) m1 m2)
-	intersectT f (IdMap m1) (IdMap m2) = IdMap (intersectAlg (f . Id) m1 m2)
-	differenceT f (IdMap m1) (IdMap m2) = IdMap (differenceAlg (f . Id) m1 m2)
-	fromDistAscListT xs = IdMap (fromDistAscListAlg [(k, v) | (Id k, v) <- xs])
-	fromAscListT f xs = IdMap (fromAscListAlg (f . Id) [(k, v) | (Id k, v) <- xs])
-	fromListT f xs = IdMap (fromListAlg (f . Id) [(k, v) | (Id k, v) <- xs])
-	getMinT (IdMap m) = do
-		(~(k, v), m') <- getMinAlg m
-		return ((Id k, v), IdMap m')
-	getMaxT (IdMap m) = do
-		(~(k, v), m') <- getMaxAlg m
-		return ((Id k, v), IdMap m')
-	updateMinT f (IdMap m) = IdMap <$> updateMinAlg (f . Id) m
-	updateMaxT f (IdMap m) = IdMap <$> updateMaxAlg (f . Id) m
-	isSubmapT (<=) (IdMap m1) (IdMap m2) = isSubmapAlg (<=) m1 m2
-	splitLookupT f (Id k) (IdMap m) = case splitLookupAlg f k m of
-		(mL, ans, mR) -> (IdMap mL, ans, IdMap mR)
-
-instance TrieKey k m => TrieKey (Id k) (IdMap k m) where
-	compareKey = compareKeyT
-	emptyAlg = emptyT
-	nullAlg = nullT
-	getSingleAlg = getSingleT
-	guardNullAlg = guardNullT
-	sizeAlg = sizeT
-	lookupAlg = lookupT
-	alterLookupAlg = alterLookupT
-	mapAppAlg = mapAppT
-	mapMaybeAlg = mapMaybeT
-	mapEitherAlg = mapEitherT
-	foldWithKeyAlg = foldWithKeyT
-	unionMaybeAlg = unionT
-	intersectAlg = intersectT
-	differenceAlg = differenceT
-	getMinAlg = getMinT
-	getMaxAlg = getMaxT
-	updateMinAlg = updateMinT
-	updateMaxAlg = updateMaxT
-	isSubmapAlg = isSubmapT
-	splitLookupAlg = splitLookupT
-
--- instance (Sized k, TrieKey k m) => TrieKey (SizeElem k) (SizedMap k m) where
--- 	compareKey (SElem a) (SElem b) = compareKey a b
--- 	emptyAlg = SizedMap emptyAlg
--- 	nullAlg (SizedMap m) = nullAlg m
--- 	sizeAlg (SizedMap m) = sizeAlg m
--- 	getSingleAlg (SizedMap m) = do
--- 		(k, v) <- getSingleAlg m
--- 		return (SElem k, v)
--- 	lookupAlg (SElem k) (SizedMap m) = lookupAlg k m
--- 	alterLookupAlg f (SElem k) (SizedMap m) = SizedMap <$> alterLookupAlg f k m
--- 	foldWithKeyAlg f z (SizedMap m) = foldWithKeyAlg (f . SElem) z m
--- 	mapAppAlg f (SizedMap m) = SizedMap <$> mapAppAlg (f . SElem) m
--- 	mapMaybeAlg f (SizedMap m) = SizedMap (mapMaybeAlg (f . SElem) m)
--- 	mapEitherAlg f (SizedMap m) = case mapEitherAlg (f . SElem) m of
--- 		(mL, mR) -> (SizedMap mL, SizedMap mR)
--- 	unionMaybeAlg f (SizedMap m1) (SizedMap m2) = SizedMap (unionMaybeAlg (f . SElem) m1 m2)
--- 	intersectAlg f (SizedMap m1) (SizedMap m2) = SizedMap (intersectAlg (f . SElem) m1 m2)
--- 	differenceAlg f (SizedMap m1) (SizedMap m2) = SizedMap (differenceAlg (f . SElem) m1 m2)
--- 	fromDistAscListAlg xs = SizedMap (fromDistAscListAlg [(k, v) | (SElem k, v) <- xs])
--- 	fromAscListAlg f xs = SizedMap (fromAscListAlg (f . SElem) [(k, v) | (SElem k, v) <- xs])
--- 	fromListAlg f xs = SizedMap (fromListAlg (f . SElem) [(k, v) | (SElem k, v) <- xs])
--- 	getMinAlg (SizedMap m) = do
--- 		(~(k, v), m') <- getMinAlg m
--- 		return ((SElem k, v), SizedMap m')
--- 	getMaxAlg (SizedMap m) = do
--- 		(~(k, v), m') <- getMaxAlg m
--- 		return ((SElem k, v), SizedMap m')
--- 	updateMinAlg f (SizedMap m) = SizedMap <$> updateMinAlg (f . SElem) m
--- 	updateMaxAlg f (SizedMap m) = SizedMap <$> updateMaxAlg (f . SElem) m
--- 	isSubmapAlg (<=) (SizedMap m1) (SizedMap m2) = isSubmapAlg (<=) m1 m2
--- 	splitLookupAlg f (SElem k) (SizedMap m) = case splitLookupAlg f k m of
--- 		(mL, ans, mR) -> (SizedMap mL, ans, SizedMap mR)
-
-instance TrieKey Int IntMap where
-	compareKey = compare
-	emptyAlg = IMap.empty
-	nullAlg = IMap.null
-	getSingleAlg m
-		| IMap.size m == 1, [(k, v)] <- IMap.toList m
-			= Just (k, v)
-	getSingleAlg _ = Nothing
-	lookupAlg = IMap.lookup
-	alterLookupAlg f k m = fmap (\ v' -> IMap.alter (const v') k m) (f x)
-		where x = IMap.lookup k m
-	foldWithKeyAlg = IMap.foldWithKey
-	mapAppAlg = sequenceA .: IMap.mapWithKey
-	mapMaybeAlg = IMap.mapMaybeWithKey
-	mapEitherAlg f m = (IMap.mapMaybeWithKey (fst .: f) m, IMap.mapMaybeWithKey (snd .: f) m)
-	unionMaybeAlg f m1 m2 = IMap.mapMaybe (either Just id) (IMap.unionWithKey g (fmap Left m1) (fmap Left m2)) where
-		g k (Left v1) (Left v2) = Right (f k v1 v2)
-		g k (Right v) _ = Right v
-		g k _ (Right v) = Right v
-	intersectAlg f m1 m2 = IMap.mapMaybe (either (const Nothing) Just) $ IMap.intersectionWithKey g (fmap Left m1) m2 where
-		g k (Left x) = maybe (Left x) Right . f k x
-		g _ (Right x) = const (Right x)
-	differenceAlg = IMap.differenceWithKey
-	fromListAlg = IMap.fromListWithKey
-	fromAscListAlg = IMap.fromAscListWithKey
-	fromDistAscListAlg = IMap.fromDistinctAscList
-	getMinAlg = IMap.minViewWithKey
-	getMaxAlg = IMap.maxViewWithKey
-	updateMinAlg f m = case IMap.minViewWithKey m of
-		Just ((k, v), m')	-> let (ans, v') = f k v in (ans, maybe m' (\ v' -> IMap.updateMin (const v') m) v')
-		_			-> (False, m)
-	updateMaxAlg f m = case IMap.maxViewWithKey m of
-		Just ((k, v), m')	-> let (ans, v') = f k v in (ans, maybe m' (\ v' -> IMap.updateMax (const v') m) v')
-		_			-> (False, m)
-	isSubmapAlg = IMap.isSubmapOfBy
-	splitLookupAlg f k m = case IMap.splitLookup k m of
-		(mL, Nothing, mR)	-> (mL, Nothing, mR)
-		(mL, Just v, mR) -> case f v of
-			(vL, ans, vR)	-> (maybe mL (flip (IMap.insert k) mL) vL, ans, maybe mR (flip (IMap.insert k) mR) vR)
-
-instance Ord k => TrieKey (Ordered k) (Map k) where
-	compareKey = compare
-	emptyAlg = Map.empty
-	nullAlg = Map.null
--- 	sizeAlg = foldl' (\ n x -> n + getSize x) 0
-	getSingleAlg m
-		| Map.size m == 1, (k, v) <- Map.findMin m
-			= Just (Ord k, v)
-	lookupAlg = Map.lookup . unOrd
-	alterLookupAlg f (Ord k) m = fmap (\ v -> Map.alter (const v) k m) (f x)
-		where x = Map.lookup k m
-	foldWithKeyAlg f = Map.foldWithKey (f . Ord)
-	mapAppAlg f = sequenceA . Map.mapWithKey (f . Ord)
- 	mapMaybeAlg f = Map.mapMaybeWithKey (f . Ord)
-	mapEitherAlg f m = (Map.mapMaybeWithKey (fst .: f . Ord) m, Map.mapMaybeWithKey (snd .: f . Ord) m)
-	unionMaybeAlg f m1 m2 = Map.mapMaybe (either Just id) (Map.unionWithKey g (fmap Left m1) (fmap Left m2)) where
-		g k (Left v1) (Left v2) = Right (f (Ord k) v1 v2)
-		g k (Right v) _ = Right v
-		g k _ (Right v) = Right v
-	intersectAlg f = Map.mapMaybe id .: Map.intersectionWithKey (f . Ord)
-	differenceAlg f = Map.differenceWithKey (f . Ord)
-	fromListAlg f xs = Map.fromListWithKey (f . Ord) [(k, v) | (Ord k, v) <- xs]
-	fromAscListAlg f xs = Map.fromAscListWithKey (f . Ord) [(k, v) | (Ord k, v) <- xs]
-	fromDistAscListAlg xs = Map.fromDistinctAscList [(k, v) | (Ord k, v) <- xs]
-	getMinAlg m = do	(~(k, v), m') <- Map.minViewWithKey m
-				return ((Ord k, v), m')
-	getMaxAlg m = do	(~(k, v), m') <- Map.maxViewWithKey m
-				return ((Ord k, v), m')
-	updateMinAlg f m
-		| Map.null m	= (False, m)
-		| otherwise	= case Map.findMin m of
-			(k, v)	-> let (ans, v') = f (Ord k) v in (ans, Map.updateMin (const v') m)
-	updateMaxAlg f m
-		| Map.null m	= (False, m)
-		| otherwise	= case Map.findMin m of
-			(k, v)	-> let (ans, v') = f (Ord k) v in (ans, Map.updateMax (const v') m)
-	isSubmapAlg = Map.isSubmapOfBy
-	splitLookupAlg f (Ord k) m = case Map.splitLookup k m of
-		(mL, Nothing, mR)	-> (mL, Nothing, mR)
-		(mL, Just v, mR) -> case f v of
-			(vL, ans, vR) -> (maybe mL (flip (Map.insert k) mL) vL, ans, maybe mR (flip (Map.insert k) mR) vR) 
-
-instance TrieKey () Maybe where
-	compareKey _ _ = EQ
-	emptyAlg = Nothing
-	nullAlg = isNothing
-	sizeAlg = maybe 0 getSize
-	getSingleAlg = fmap ((,) ())
-	lookupAlg _ = id
-	alterLookupAlg f _ = f
-	foldWithKeyAlg f = foldr (f ())
-	mapAppAlg f = traverse (f ())
-	mapMaybeAlg f = (>>= f ())
-	mapEitherAlg f = maybe (Nothing, Nothing) (f ())
-	unionMaybeAlg f = unionMaybe (f ())
-	intersectAlg f = intersectMaybe (f ())
-	differenceAlg f = differenceMaybe (f ())
-	fromListAlg _ [] = Nothing
-	fromListAlg f ((_, v):xs) = Just (foldr (f () . snd) v xs)
-	fromAscListAlg = fromListAlg
-	fromDistAscListAlg = fmap snd . listToMaybe
-	getMinAlg = fmap g where
-		g v = (((), v), Nothing)
-	getMaxAlg = fmap g where
-		g v = (((), v), Nothing)
-	updateMinAlg f = maybe (False, Nothing) (f ())
-	updateMaxAlg f = maybe (False, Nothing) (f ())
-	isSubmapAlg _ Nothing _ = True
-	isSubmapAlg _ _ Nothing = False
-	isSubmapAlg (<=) (Just x) (Just y) = x <= y
-	splitLookupAlg f _ = maybe (Nothing, Nothing, Nothing) f
-
-{-# RULES
-	"sizeAlg/Map/Elem" forall (m :: Map k (Elem v)) . sizeAlg m = Map.size m;
-	"sizeAlg/IMap/Elem" forall (m :: IntMap (Elem v)) . sizeAlg m = IMap.size m;
-	#-}
-
-instance (TrieKeyT f t, TrieKey k m) => TrieKey (App f k) (App (t k m)) where
-	compareKey (App a) (App b) = compareKeyT a b
-	emptyAlg = App emptyT
-	nullAlg (App m) = nullT m
-	getSingleAlg (App m) = do
-		(k, v) <- getSingleT m
-		return (App k, v)
-	alterLookupAlg f (App k) (App m) = App <$> alterLookupT f k m
-	foldWithKeyAlg f z (App m) = foldWithKeyT (f . App) z m
-	mapAppAlg f (App m) = App <$> mapAppT (f . App) m
-	mapMaybeAlg f (App m) = App (mapMaybeT (f . App) m)
-	mapEitherAlg f (App m) = (App *** App) (mapEitherT (f . App) m)
-	fromListAlg f xs = App (fromListT (f . App) [(k, v) | (App k, v) <- xs])
-	fromAscListAlg f xs = App (fromAscListT (f . App) [(k, v) | (App k, v) <- xs])
-	fromDistAscListAlg xs = App (fromDistAscListT [(k, v) | (App k, v) <- xs])
-	unionMaybeAlg f (App m1) (App m2) = App (unionT (f . App) m1 m2)
-	intersectAlg f (App m1) (App m2) = App (intersectT (f . App) m1 m2)
-	differenceAlg f (App m1) (App m2) = App (differenceT (f . App) m1 m2)
-	getMinAlg (App m) = do
-		((k, v), m') <- getMinT m
-		return ((App k, v), App m')
-	getMaxAlg (App m) = do
-		((k, v), m') <- getMaxT m
-		return ((App k, v), App m')
-	updateMinAlg f (App m) = App <$> updateMinT (f . App) m
-	updateMaxAlg f (App m) = App <$> updateMaxT (f . App) m
-	isSubmapAlg (<=) (App m1) (App m2) = isSubmapT (<=) m1 m2
-	splitLookupAlg f (App k) (App m) = case splitLookupT f k m of
-		(mL, ans, mR)	-> (App mL, ans, App mR)
-
-instance (TrieKeyT f1 t1, TrieKeyT f2 t2) => TrieKeyT (f1 `O` f2) (CompMap t1 f2 t2) where
-	compareKeyT (O a) (O b) = compareKeyT a b
-	emptyT = CompMap emptyT
-	nullT (CompMap m) = nullT m
-	guardNullT (CompMap m) = CompMap <$> guardNullT m
-	sizeT (CompMap m) = sizeT m
-	getSingleT (CompMap m) = do
-		(k, v) <- getSingleT m
-		return (O k, v)
-	lookupT (O k) (CompMap m) = lookupT k m
-	alterLookupT f (O k) (CompMap m) = CompMap <$> alterLookupT f k m
-	foldWithKeyT f z (CompMap m) = foldWithKeyT (f . O) z m
-	mapAppT f (CompMap m) = CompMap <$> mapAppT (f . O) m
-	mapMaybeT f (CompMap m) = CompMap (mapMaybeT (f . O) m)
-	mapEitherT f (CompMap m) = (CompMap *** CompMap) (mapEitherT (f . O) m)
-	unionT f (CompMap m1) (CompMap m2) = CompMap (unionT (f . O) m1 m2)
-	intersectT f (CompMap m1) (CompMap m2) = CompMap (intersectT (f . O) m1 m2)
-	differenceT f (CompMap m1) (CompMap m2) = CompMap (differenceT (f . O) m1 m2)
-	fromDistAscListT xs = CompMap (fromDistAscListT [(k, v) | (O k, v) <- xs])
-	fromAscListT f xs = CompMap (fromAscListT (f . O) [(k, v) | (O k, v) <- xs])
-	fromListT f xs = CompMap (fromListT (f . O) [(k, v) | (O k, v) <- xs])
-	getMinT (CompMap m) = do
-		((k, v), m') <- getMinT m
-		return ((O k, v), CompMap m')
-	getMaxT (CompMap m) = do
-		((k, v), m') <- getMaxT m
-		return ((O k, v), CompMap m')
-	updateMinT f (CompMap m) = CompMap <$> updateMinT (f . O) m
-	updateMaxT f (CompMap m) = CompMap <$> updateMaxT (f . O) m
-	isSubmapT (<=) (CompMap m1) (CompMap m2) = isSubmapT (<=) m1 m2
-	splitLookupT f (O k) (CompMap m) = case splitLookupT f k m of
-		(mL, ans, mR)	-> (CompMap mL, ans, CompMap mR)
-
-instance (TrieKey k m, TrieKeyT f1 t1, TrieKeyT f2 t2) => TrieKey ((f1 `O` f2) k) (CompMap t1 f2 t2 k m) where
-	compareKey = compareKeyT
-	emptyAlg = emptyT
-	nullAlg = nullT
-	getSingleAlg = getSingleT
-	guardNullAlg = guardNullT
-	sizeAlg = sizeT
-	lookupAlg = lookupT
-	alterLookupAlg = alterLookupT
-	mapAppAlg = mapAppT
-	mapMaybeAlg = mapMaybeT
-	mapEitherAlg = mapEitherT
-	foldWithKeyAlg = foldWithKeyT
-	unionMaybeAlg = unionT
-	intersectAlg = intersectT
-	differenceAlg = differenceT
-	getMinAlg = getMinT
-	getMaxAlg = getMaxT
-	updateMinAlg = updateMinT
-	updateMaxAlg = updateMaxT
-	isSubmapAlg = isSubmapT
-	splitLookupAlg = splitLookupT