diff --git a/Data/TrieMap.hs b/Data/TrieMap.hs
--- a/Data/TrieMap.hs
+++ b/Data/TrieMap.hs
@@ -16,7 +16,7 @@
 	findWithDefault,
 	-- * Construction
 	empty,
-	showMap,
+-- 	showMap,
 	singleton,
 	-- ** Insertion
 	insert,
@@ -87,6 +87,16 @@
 	-- * Submap
 	isSubmapOf,
 	isSubmapOfBy,
+	-- * Indexed
+	predecessor,
+	lookupWithIndex,
+	successor,
+	neighborhood,
+	lookupIndex,
+	predecessorAt,
+	lookupAt,
+	successorAt,
+	neighborhoodAt,	
 	-- * Min/Max
 	findMin,
 	findMax,
@@ -108,9 +118,12 @@
 import Data.TrieMap.Class.Instances()
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Applicative
+import Data.TrieMap.Rep
+import Data.TrieMap.Sized
 
 import Control.Applicative hiding (empty)
 import Control.Arrow
+import Control.Monad
 import Data.Maybe hiding (mapMaybe)
 import Data.Monoid(First(..), Last(..))
 -- import Data.Foldable
@@ -143,7 +156,7 @@
 null (TMap m) = nullM m
 
 lookup :: TKey k => k -> TMap k a -> Maybe a
-lookup k (TMap m) = unK0 <$> lookupM (toRep k) m
+lookup k (TMap m) = getElem <$> lookupM (toRep k) m
 
 findWithDefault :: TKey k => a -> k -> TMap k a -> a
 findWithDefault a = fromMaybe a .: lookup
@@ -152,8 +165,35 @@
 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)
+alter f k (TMap m) = TMap (alterM elemSize (fmap Elem . f . fmap getElem) (toRep k) m)
 
+-- | Projects information out of an individual association pair, over all alternatives in the map.
+-- For example, 
+-- 
+-- > minViewWithKey == getFirst (extract (\ k a -> return ((k, a), Nothing)))
+-- > updateMaxWithKey f m == maybe m snd (getLast (extract (\ k a -> return ((), f k a)) m))
+-- 
+-- In addition,
+-- 
+-- > getFirst (extract (\ k a -> if p k a then return ((k, a), Nothing) else mzero) m)
+-- 
+-- finds and removes the first association pair satisfying the predicate |p|.
+
+extract :: (TKey k, MonadPlus m) => (k -> a -> m (x, Maybe a)) -> TMap k a -> m (x, TMap k a)
+extract f m = unwrapMonad (extractA (WrapMonad .: f) m)
+
+-- | Generalization of 'extract' for 'Alternative' functors.
+extractA :: (TKey k, Alternative f) => (k -> a -> f (x, Maybe a)) -> TMap k a -> f (x, TMap k a)
+extractA f (TMap m) = second TMap <$> extractM elemSize (\ k (Elem a) -> second (fmap Elem) <$> f (fromRep k) a) m
+
+-- | Like 'extract', but does not modify the map.
+about :: (TKey k, MonadPlus m) => (k -> a -> m x) -> TMap k a -> m x
+about f = unwrapMonad . aboutA (WrapMonad .: f)
+
+-- | Generalization of 'about' for 'Alternative' functors.
+aboutA :: (TKey k, Alternative f) => (k -> a -> f x) -> TMap k a -> f x
+aboutA f = fst <.> extractA (\ k a -> flip (,) Nothing <$> f k a)
+
 insert :: TKey k => k -> a -> TMap k a -> TMap k a
 insert = insertWith const
 
@@ -183,20 +223,20 @@
 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
+foldWithKey f z (TMap m) = foldWithKeyM (\ k (Elem 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
+foldlWithKey f z (TMap m) = foldlWithKeyM (\ k z (Elem 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
+traverseWithKey f (TMap m) = TMap <$> traverseWithKeyM elemSize (\ k (Elem a) -> Elem <$> 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)
+mapWithKey f (TMap m) = TMap (mapWithKeyM elemSize (\ k (Elem a) -> Elem (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]
@@ -220,8 +260,8 @@
 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
+unionMaybeWithKey f (TMap m1) (TMap m2) = TMap (unionM elemSize f' m1 m2) where
+	f' k (Elem a) (Elem b) = Elem <$> f (fromRep k) a b
 
 symmetricDifference :: TKey k => TMap k a -> TMap k a -> TMap k a
 symmetricDifference = unionMaybeWith (\ _ _ -> Nothing)
@@ -239,8 +279,8 @@
 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
+intersectionMaybeWithKey f (TMap m1) (TMap m2) = TMap (isectM elemSize f' m1 m2) where
+	f' k (Elem a) (Elem b) = Elem <$> f (fromRep k) a b
 
 difference, (\\) :: TKey k => TMap k a -> TMap k b -> TMap k a
 difference = differenceWith (\ x _ -> Nothing)
@@ -251,8 +291,8 @@
 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
+differenceWithKey f (TMap m1) (TMap m2) = TMap (diffM elemSize f' m1 m2) where
+	f' k (Elem a) (Elem b) = Elem <$> f (fromRep k) a b
 
 minView, maxView :: TKey k => TMap k a -> Maybe (a, TMap k a)
 minView m = first snd <$> minViewWithKey m
@@ -271,20 +311,16 @@
 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)
+updateMinWithKey f m = maybe m snd (getFirst (extract (\ k a -> return ((), f k a)) m))
+updateMaxWithKey f m = maybe m snd (getLast (extract (\ k a -> return ((), f 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')
+minViewWithKey = getFirst . extract (\ k a -> return ((k, a), Nothing))
+maxViewWithKey = getLast . extract (\ k a -> return ((k, a), Nothing))
 
 elems :: TKey k => TMap k a -> [a]
 elems = fmap snd . assocs
@@ -299,18 +335,18 @@
 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
+mapEitherWithKey f (TMap m) = case mapEitherM elemSize elemSize 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))
+	where	f' k (Elem a) = case f (fromRep k) a of
+			Left b	-> (Just (Elem b), Nothing)
+			Right c	-> (Nothing, Just (Elem c))
 
 mapMaybe :: TKey k => (a -> Maybe b) -> TMap k a -> TMap k b
 mapMaybe = mapMaybeWithKey . const
 
 mapMaybeWithKey :: TKey k => (k -> a -> Maybe b) -> TMap k a -> TMap k b
-mapMaybeWithKey f (TMap m) = TMap (snd (mapEitherM sizeK0 sizeK0 f' m)) where
-	f' k (K0 a) = (Nothing, K0 <$> f (fromRep k) a)
+mapMaybeWithKey f (TMap m) = TMap (snd (mapEitherM elemSize elemSize f' m)) where
+	f' k (Elem a) = (Nothing, Elem <$> f (fromRep k) a)
 
 partition :: TKey k => (a -> Bool) -> TMap k a -> (TMap k a, TMap k a)
 partition = partitionWithKey . const
@@ -329,16 +365,16 @@
 	(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
+splitLookup k (TMap m) = case splitLookupM elemSize f (toRep k) m of
 	(mL, x, mR) -> (TMap mL, x, TMap mR) 
-	where	f (K0 x) = (Nothing, Just x, Nothing)
+	where	f (Elem 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
+	Elem a <<= Elem b = a <= b
 
 fromList, fromAscList :: TKey k => [(k, a)] -> TMap k a
 fromList = fromListWith const
@@ -349,14 +385,14 @@
 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])
+fromListWithKey f xs = TMap (fromListM elemSize (\ k (Elem a) (Elem b) -> Elem (f (fromRep k) a b)) [(toRep k, Elem a) | (k, a) <- xs])
+fromAscListWithKey f xs = TMap (fromAscListM elemSize (\ k (Elem a) (Elem b) -> Elem (f (fromRep k) a b)) [(toRep k, Elem a) | (k, a) <- xs])
 
 fromDistinctAscList :: TKey k => [(k, a)] -> TMap k a
-fromDistinctAscList xs = TMap (fromDistAscListM sizeK0 [(toRep k, K0 a) | (k, a) <- xs])
+fromDistinctAscList xs = TMap (fromDistAscListM elemSize [(toRep k, Elem a) | (k, a) <- xs])
 
 size :: TKey k => TMap k a -> Int
-size (TMap m) = sizeM sizeK0 m
+size (TMap m) = sizeM elemSize m
 
 member :: TKey k => k -> TMap k a -> Bool
 member = isJust .: lookup
@@ -364,5 +400,48 @@
 notMember :: TKey k => k -> TMap k a -> Bool
 notMember = not .: member
 
-showMap :: (TKey k, Show (TrieMap (Rep k) (K0 a) (Rep k))) => TMap k a -> String
-showMap (TMap m) = show m
+-- showMap :: (TKey k, Show (TrieMap (Rep k) (Elem a) (Rep k))) => TMap k a -> String
+-- showMap (TMap m) = show m
+
+-- | @'predecessor' k a@ returns the index, key, and value of the immediate predecessor of @k@ in the map.  
+-- The predecessor is the element with the largest key @< k@.
+predecessor :: TKey k => k -> TMap k a -> Maybe (Int, k, a)
+predecessor k m = fst3 (neighborhood k m)
+
+lookupIndex :: TKey k => k -> TMap k a -> Maybe Int
+lookupIndex k m = fst3 <$> lookupWithIndex k m 
+
+fst3 (a, b, c) = a
+snd3 (a, b, c) = b
+thd3 (a, b, c) = c
+
+findIndex :: TKey k => k -> TMap k a -> Int
+findIndex k m = fromMaybe (error "element is not in the map") (lookupIndex k m)
+
+lookupWithIndex :: TKey k => k -> TMap k a -> Maybe (Int, k, a)
+lookupWithIndex k m = snd3 (neighborhood k m)
+
+successor :: TKey k => k -> TMap k a -> Maybe (Int, k, a)
+successor k m = thd3 (neighborhood k m)
+
+neighborhood :: TKey k => k -> TMap k a -> (Maybe (Int, k, a), Maybe (Int, k, a), Maybe (Int, k, a))
+neighborhood k (TMap m) = case lookupIxM elemSize (toRep k) m of
+		(pr, x, su) -> (fix <$> getLast pr, fix <$> x, fix <$> getFirst su)
+	where	fix (Asc i k (Elem a)) = (i, fromRep k, a)
+
+predecessorAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)
+predecessorAt k m = fst3 (neighborhoodAt k m)
+
+lookupAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)
+lookupAt k m = snd3 (neighborhoodAt k m)
+
+successorAt :: TKey k => Int -> TMap k a -> Maybe (Int, k, a)
+successorAt k m = thd3 (neighborhoodAt k m)
+
+neighborhoodAt :: TKey k => Int -> TMap k a -> (Maybe (Int, k, a), Maybe (Int, k, a), Maybe (Int, k, a))
+neighborhoodAt i (TMap m) = case assocAtM elemSize i m of
+		(pr, x, su) -> (fix <$> getLast pr, fix <$> x, fix <$> getFirst su)
+	where	fix (Asc i k (Elem a)) = (i, fromRep k, a)
+
+keysSet :: TKey k => TMap k a -> TSet k
+keysSet = TSet . map (const ())
diff --git a/Data/TrieMap/Applicative.hs b/Data/TrieMap/Applicative.hs
--- a/Data/TrieMap/Applicative.hs
+++ b/Data/TrieMap/Applicative.hs
@@ -3,17 +3,33 @@
 module Data.TrieMap.Applicative where
 
 import Control.Applicative
+import Control.Arrow
 import Control.Monad
 
-import Data.Monoid
+import Data.Monoid hiding (Dual)
 
 newtype Id a = Id {unId :: a}
+newtype WM w m a = WM {runWM :: m (w, a)}
 
 deriving instance Functor First
 deriving instance Functor Last
 deriving instance Monad First
 deriving instance Monad Last
 
+instance Functor m => Functor (WM w m) where
+	fmap f (WM x) = WM (fmap (second f) x)
+
+instance (Applicative m, Monoid w) => Applicative (WM w m) where
+	pure x = WM (pure (mempty, x))
+	WM f <*> WM x = WM (fmap (\ (fW, ff) (xW, xx) -> (fW `mappend` xW, ff xx)) f <*> x)
+
+instance (Alternative m, Monoid w) => Alternative (WM w m) where
+	empty = WM empty
+	WM a <|> WM b = WM (a <|> b)
+
+write :: (Functor m, Monoid w) => w -> WM w m a -> WM w m a
+write w (WM m) = WM (fmap (\ (v, xx) -> (v `mappend` w, xx)) m)
+
 instance Applicative Id where
 	pure = Id
 	Id f <*> Id x = Id (f x)
@@ -44,3 +60,35 @@
 
 (<.:>) :: Functor f => (c -> d) -> (a -> b -> f c) -> a -> b -> f d
 (f <.:> g) x y = f <$> g x y
+{-
+(<|>) :: MonadPlus m => m a -> m a -> m a
+(<|>) = mplus-}
+
+instance Applicative First where
+	pure = return
+	(<*>) = ap
+
+instance Alternative First where
+	empty = mempty
+	(<|>) = mplus
+
+instance Applicative Last where
+	pure = return
+	(<*>) = ap
+
+instance Alternative Last where
+	empty = mempty
+	(<|>) = mplus
+
+newtype Dual f a = Dual {runDual :: f a}
+
+instance Functor f => Functor (Dual f) where
+	fmap f (Dual x) = Dual (fmap f x)
+
+instance Applicative f => Applicative (Dual f) where
+	pure = Dual . pure
+	Dual f <*> Dual x = Dual (flip ($) <$> x <*> f)
+
+instance Alternative f => Alternative (Dual f) where
+	empty = Dual empty
+	Dual a <|> Dual b = Dual (b <|> a)
diff --git a/Data/TrieMap/Class.hs b/Data/TrieMap/Class.hs
--- a/Data/TrieMap/Class.hs
+++ b/Data/TrieMap/Class.hs
@@ -1,36 +1,41 @@
 {-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances #-}
 
-module Data.TrieMap.Class (TMap(..), TKey(..), Rep, Ordered (..), TrieMap, TrieKey) where
+module Data.TrieMap.Class (TMap(..), TSet (..), TKey, TKeyT, Rep, TrieMap, TrieKey) where
 
 import Data.TrieMap.TrieKey
 import Data.TrieMap.OrdMap
+import Data.TrieMap.Rep
+import Data.TrieMap.Sized
 
 import Control.Applicative
 import Data.Foldable
 import Data.Traversable
 
 -- import Generics.MultiRec.Base
+import Data.TrieMap.Regular.Class
 import Data.TrieMap.Regular.Base
 import Data.TrieMap.Regular.Sized
 
 import Prelude hiding (foldr)
 
-newtype TMap k a = TMap {getTMap :: TrieMap (Rep k) (K0 a) (Rep k)}
+newtype TMap k a = TMap {getTMap :: TrieMap (Rep k) (Elem a)}
+newtype TSet a = TSet (TMap a ())
 
-type family Rep k
+class (Repr k, TrieKey (Rep k) (TrieMap (Rep k))) => TKey k
+-- 	toRep :: k -> Rep k
+-- 	fromRep :: Rep k -> k
 
-class TrieKey (Rep k) (TrieMap (Rep k)) => TKey k where
-	toRep :: k -> Rep k
-	fromRep :: Rep k -> k
+class (ReprT f, TrieKeyT (RepT f) (TrieMapT (RepT f))) => TKeyT f
 
 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
+	foldr f z (TMap m) = foldWithKeyM (\ _ (Elem a) -> f a) m z
 
 instance TKey k => Traversable (TMap k) where
 	traverse = trv
+
 -- 	traverse f (TMap m) = TMap <$> traverseWithKeyM (\ _ (K0 a) -> K0 <$> f a) m
 trv :: (Applicative f, TKey k) => (a -> f b) -> TMap k a -> f (TMap k b)
-trv f (TMap m) = TMap <$> traverseWithKeyM sizeK0 (\ _ (K0 a) -> K0 <$> f a) m
+trv f (TMap m) = TMap <$> traverseWithKeyM elemSize (\ _ (Elem a) -> Elem <$> f a) m
diff --git a/Data/TrieMap/Class/Instances.hs b/Data/TrieMap/Class/Instances.hs
--- a/Data/TrieMap/Class/Instances.hs
+++ b/Data/TrieMap/Class/Instances.hs
@@ -1,14 +1,22 @@
-{-# LANGUAGE CPP, Rank2Types, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE TemplateHaskell, CPP, Rank2Types, TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}
 
 module Data.TrieMap.Class.Instances where
 
 import Data.TrieMap.Class
 import Data.TrieMap.TrieKey
+import Data.TrieMap.Rep
+import Data.TrieMap.Rep.TH
+import Data.TrieMap.Rep.Instances
+import Data.TrieMap.Sized
 -- import Data.TrieMap.RadixTrie()
 import Data.TrieMap.MultiRec.Instances
-import Data.TrieMap.IntMap()
-import Data.TrieMap.OrdMap(Ordered(..))
+import Data.TrieMap.IntMap
+import Data.TrieMap.OrdMap
+import Data.TrieMap.ReverseMap
+import Data.TrieMap.ProdMap
+import Data.TrieMap.UnionMap
 import Data.TrieMap.Class
+import Data.TrieMap.Modifiers
 import Data.TrieMap.Regular.Base
 import Data.TrieMap.Regular.Class
 import Data.TrieMap.Regular.Instances
@@ -23,6 +31,9 @@
 import Data.Int 
 import Data.List hiding (foldr)
 import Data.Word
+import Data.Array.IArray
+import Data.Map(Map)
+import Data.Set(Set)
 
 import Prelude hiding (foldr)
 
@@ -39,164 +50,62 @@
 	toRep = map toRep
 	fromRep = map fromRep-}
 
-type instance Rep Int = Int
-instance TKey Int where
-	toRep = id
-	fromRep = id
-
-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 = (I0 :+: I0) (Rep [Int32])
-instance TKey Integer where
-	toRep x = (if x >= 0 then R . I0 else L . I0) (toRep (unroll x))
-	fromRep (L (I0 xs)) = - roll (map negate (fromRep xs))
-	fromRep (R (I0 xs)) = roll (fromRep xs)
-
-unroll :: Integer -> [Int32]
-unroll x = if x >= 0 then unfoldr step x else map negate (unfoldr step (negate x)) 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 Bool = (U0 :+: U0) (U0 ())
-instance TKey Bool where
-	toRep False = L U0
-	toRep True = R U0
-	fromRep L{} = False
-	fromRep R{} = True
-
-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
+instance TKey Int
+instance TKey Double
+instance TKey Char
+instance TKey Bool
+instance TKey Word
+instance TKey Int32
+instance TKey Word32
+instance TKey Word16
+instance TKey Word8
+instance TKey Int8
+instance TKey Int16
+instance TKey Word64
+instance TKey Int64
+instance TKey ()
+instance TKey a => TKeyT ((,) a)
+instance (TKey a, TKey b) => TKey (a, b)
+instance (TKey a, TKey b) => TKeyT ((,,) a b)
+instance (TKey a, TKey b, TKey c) => TKey (a, b, c)
+instance (TKey a, TKey b, TKey c) => TKeyT ((,,,) a b c)
+instance (TKey a, TKey b, TKey c, TKey d) => TKey (a, b, c, d)
+instance TKey a => TKey (I0 a)
+instance TKeyT I0
+instance TKey (U0 a)
+instance TKeyT U0
+instance TKey a => TKey (K0 a b)
+instance TKey a => TKeyT (K0 a)
+instance TKeyT f => TKeyT (L f)
+instance (TKeyT f, TKey a) => TKey (L f a)
+instance (Functor f, TKeyT f, TKeyT g) => TKeyT (f `O` g)
+instance (TKeyT f, TKeyT g, TKey a) => TKey ((f `O` g) a)
+instance (TKeyT f, TKeyT g) => TKeyT (f :*: g)
+instance (TKeyT f, TKeyT g, TKey a) => TKey ((f :*: g) a)
+instance (TKey a, TKey b) => TKey (Either a b)
+instance TKey a => TKeyT (Either a)
+instance TKey a => TKey [a]
+instance TKeyT []
+instance TKey a => TKey (Maybe a)
+instance TKeyT Maybe
+instance (TKey k, TKey a) => TKey (TMap k a)
+instance TKey k => TKeyT (TMap k)
+instance TKeyT Set
+instance TKeyT Rev
+instance TKey a => TKey (Rev a)
+instance TKey a => TKey (Set a)
+instance TKey k => TKeyT (Map k)
+instance (TKey k, TKey a) => TKey (Map k a)
+instance (TKey i, Ix i) => TKeyT (Array i)
+instance (TKey i, Ix i, TKey e) => TKey (Array i e)
 
-type instance 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 RepT (TMap k) = L (K0 (Rep k) :*: I0)
+type instance Rep (TMap k a) = RepT (TMap k) (Rep a)
 
-type instance Rep (I0 r) = I0 (Rep r)
-instance TKey r => TKey (I0 r) where
-	toRep = fmap toRep
-	fromRep = fmap fromRep
+instance TKey k => ReprT (TMap k) where
+	toRepTMap f (TMap m) = List (foldWithKeyM (\ k (Elem a) xs -> (K0 k :*: I0 (f a)):xs) m [])
+	fromRepTMap f (List xs) = TMap (fromDistAscListM (const 1) [(k, Elem (f a)) | (K0 k :*: I0 a) <- xs])
 
-type instance Rep (TMap k a) = L (K0 (Rep k) :*: I0) (Rep a)
-instance (TKey k, TKey a) => TKey (TMap k a) where
-	toRep (TMap m) = List [K0 k :*: I0 (toRep a) | (k, K0 a) <- foldWithKeyM (curry (:)) m []]
-	fromRep (List xs) = TMap (fromDistAscListM (const 1) [(k, K0 (fromRep a)) | K0 k :*: I0 a <- xs])
+instance (TKey k, Repr a) => Repr (TMap k a) where
+	toRep = toRepTMap toRep
+	fromRep = fromRepTMap fromRep
diff --git a/Data/TrieMap/IntMap.hs b/Data/TrieMap/IntMap.hs
--- a/Data/TrieMap/IntMap.hs
+++ b/Data/TrieMap/IntMap.hs
@@ -1,18 +1,24 @@
-{-# LANGUAGE BangPatterns, Rank2Types, CPP, MagicHash, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE TemplateHaskell, TypeOperators, UndecidableInstances, BangPatterns, Rank2Types, CPP, MagicHash, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}
 
 module Data.TrieMap.IntMap () where
 
 import Data.TrieMap.TrieKey
+import Data.TrieMap.MultiRec.Base
 import Data.TrieMap.Applicative
 import Data.TrieMap.Sized
+import Data.TrieMap.ReverseMap
+-- import Data.TrieMap.Rep
+-- import Data.TrieMap.Rep.TH
 
-import Control.Applicative (Applicative(..), (<$>))
+import Control.Applicative (Applicative(..), Alternative(..), (<$>))
 import Control.Arrow
+import Control.Monad (MonadPlus(..))
 
 import Data.Bits
 import Data.Maybe
 import Data.Monoid
 import Data.Word
+import Data.Int
 
 #if __GLASGOW_HASKELL__ >= 503
 import GHC.Exts ( Word(..), Int(..), shiftRL# )
@@ -25,27 +31,46 @@
 
 import Prelude hiding (lookup, null, foldl, foldr)
 
-type Nat = Word
+type Nat = Word32
 
-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) 
+data WordMap a = Nil
+              | Tip {-# UNPACK #-} !Size {-# UNPACK #-} !Key (a)
+              | Bin {-# UNPACK #-} !Size {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !(WordMap a) !(WordMap a) 
 		deriving (Show)
-type instance TrieMap Int = IntMap
+-- data IntMap a = IMap (WordMap a) (WordMap a)
+type instance TrieMap Word32 = WordMap
+-- type instance TrieMap Int32 = IntMap
 
-type Prefix = Int
-type Mask   = Int
-type Key    = Int
+type Prefix = Word32
+type Mask   = Word32
+type Key    = Word32
 type Size   = Int
 
-instance TrieKey Int IntMap where
+-- type instance RepT WordMap = FamT KeyFam (HFix (U :+: (K Size :*: K Key :*: X) :+:
+-- 				(K Size :*: K Prefix :*: K Mask :*: A0 :*: A0)))
+-- type instance Rep (WordMap a) = RepT WordMap (Rep a)
+-- 
+-- -- $(genRepT [d|
+--    instance ReprT WordMap where
+-- 	toRepT = FamT . toFix where
+-- 		toFix = HIn . toFix'
+-- 		toFix' Nil = L U
+-- 		toFix' (Tip s kx x) = R (L (K s :*: K kx :*: X x))
+-- 		toFix' (Bin s p m l r) = R (R (K s :*: K p :*: K m :*: A0 (toFix l) :*: A0 (toFix r)))
+-- 	fromRepT (FamT m) = fromFix m where
+-- 		fromFix (HIn x) = fromFix' x
+-- 		fromFix' L{} = Nil
+-- 		fromFix' (R (L (K s :*: K kx :*: X x))) = Tip s kx x
+-- 		fromFix' (R (R (K s :*: K p :*: K m :*: A0 l :*: A0 r))) = Bin s p m (fromFix l) (fromFix r) |])
+
+instance TrieKey Word32 WordMap where
 	emptyM = Nil
 	nullM = null
 	sizeM _ = size
-	lookupM = lookup . natFromInt
-	lookupIxM _ = lookupIx . natFromInt
-	assocAtM _ = fromJust .: assocAt
-	updateAtM = updateAt
+	lookupM = lookup
+	lookupIxM s = lookupIx s 0
+	assocAtM s = assocAt s 0
+-- 	updateAtM s r = updateAt s r 0
 	alterM = alter
 	traverseWithKeyM = traverseWithKey
 	foldWithKeyM = foldr
@@ -55,98 +80,154 @@
 	unionM = unionWithKey
 	isectM = intersectionWithKey
 	diffM = differenceWithKey
-	extractMinM _ = First . minViewWithKey
-	extractMaxM _ = Last . maxViewWithKey
-	alterMinM = updateMinWithKey
-	alterMaxM = updateMaxWithKey
+	extractM s f = extract s f
+-- 	extractMinM s f = First . minViewWithKey s f
+-- 	extractMaxM s f = Last . maxViewWithKey s f
+-- 	alterMinM = updateMinWithKey
+-- 	alterMaxM = updateMaxWithKey
 	isSubmapM = isSubmapOfBy
 
-natFromInt :: Int -> Nat
-natFromInt = fromIntegral
+{-instance TrieKey Int32 IntMap where
+	emptyM = IMap Nil Nil
+	nullM (IMap mN mP) = nullM mN && nullM mP
+	sizeM s (IMap mN mP) = sizeM s mN + sizeM s mP
+	lookupM k (IMap mN mP)
+		| k < 0		= lookupM (fromIntegral (-k)) mN
+		| otherwise	= lookupM (fromIntegral k) mP
+	lookupIxM s k (IMap mN mP)
+		| k < 0		= do	(i, v) <- lookupIx' 0 s (fromIntegral (-k)) mN
+					return (sizeM s mN - 1 - i, v)
+		| otherwise	= do	(i, v) <- lookupIxM s (fromIntegral k) mP
+					return (i + sizeM s mN, v)
+	assocAtM s i (IMap mN mP)
+		| i < sN, (i', k, a) <- assocAt' s i mN
+			= (i', - fromIntegral k, a)
+		| (i', k, a) <-assocAtM s (i - sN) mP
+			= (i' + sN, fromIntegral k, a)
+		where	sN = sizeM s mN
+	updateAtM s f i (IMap mN mP)
+		| i < sN	= updateAtM s (\ i' k -> f i' (- fromIntegral k)) (sN - 1 - i) mN `IMap` mP
+		| otherwise	= mN `IMap` updateAtM s (\ i' k -> f (i' + sN) (fromIntegral k)) (i - sN) mP
+		where	sN = sizeM s mN
+	alterM s f k (IMap mN mP)
+		| k < 0		= alterM s f (fromIntegral (- k)) mN `IMap` mP
+		| otherwise	= mN `IMap` alterM s f (fromIntegral k) mP
+	traverseWithKeyM s f (IMap mN mP) =
+		IMap <$> traverseWithKeyM s (\ k -> f (- fromIntegral k)) mN <*>
+			traverseWithKeyM s (f . fromIntegral) mP
+	foldWithKeyM f (IMap mN mP) =
+		foldlWithKeyM (\ k -> flip (f (- fromIntegral k))) mN . foldWithKeyM (f . fromIntegral) mP
+	foldlWithKeyM f (IMap mN mP) =
+		foldlWithKeyM (f . fromIntegral) mP . foldWithKeyM (\ k -> flip (f (- fromIntegral k))) mN
+	mapEitherM s1 s2 f (IMap mN mP) = (IMap mNL mPL, IMap mNR mPR)
+		where	(mNL, mNR) = mapEitherM s1 s2 (\ k -> f (- fromIntegral k)) mN
+			(mPL, mPR) = mapEitherM s1 s2 (f . fromIntegral) mP
+	splitLookupM s f k (IMap mN mP)
+		| k < 0, (mNL, ans, mNR) <- splitLookupM s ((\ (l, x, r) -> (r, x, l)) . f) (fromIntegral (-k)) mN
+			= (IMap mNR emptyM, ans, IMap mNL mP)
+		| (mPL, ans, mPR) <- splitLookupM s f (fromIntegral k) mP
+			= (IMap mN mPL, ans, IMap emptyM mPR)-}
 
-intFromNat :: Nat -> Int
-intFromNat = fromIntegral
+natFromInt :: Word32 -> Nat
+natFromInt = id
 
+intFromNat :: Nat -> Word32
+intFromNat = id
+
 shiftRL :: Nat -> Key -> Nat
-#if __GLASGOW_HASKELL__
+-- #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
+-- shiftRL (W# x) (I# i)
+--   = W# (shiftRL# x i)
+-- #else
+shiftRL x i   = shiftR x (fromIntegral i)
+-- #endif
 
 
-size :: IntMap a ix -> Int
+size :: WordMap a -> Int
 size Nil = 0
 size (Tip s _ _) = s
 size (Bin s _ _ _ _) = s
 
-null :: IntMap a ix -> Bool
+null :: WordMap a -> 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 :: Nat -> WordMap a -> Maybe (a)
+lookup k (Bin _ _ m l r) = lookup k (if zeroN k m then l else r)
 lookup k (Tip _ kx x)
-	| k == natFromInt kx	= Just x
+	| k == kx	= Just x
 lookup _ _ = Nothing
 
-lookupIx :: Nat -> IntMap a ix -> Maybe (Int, a ix)
+{-
+lookupIx :: Nat -> WordMap a -> Maybe (Int, a)
 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
+	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 -> WordMap a -> Maybe (Int, Key, a)
+-- 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
+assocAt :: Sized a -> Int -> Int -> WordMap a -> IndexPos Key a
+assocAt s !i0 !i (Bin _ _ _ l r)
+	| i < sl, (lb, x, ub) <- assocAt s i0 i l
+		= (lb, x, ub <|> fst <$> First (minViewWithKey s (\ k a -> (Asc (i0 + size l) k a, Just a)) r))
+	| (lb, x, ub) <- assocAt s (i0 + sl) (i - sl) r
+		= (fst <$> Last (maxViewWithKey s (\ k a -> (Asc (i0 + size l - s a) k a, Just a)) l) <|> lb, x, ub)
 	where	sl = size l
-assocAt' i0 _ (Tip _ k x) = return (i0, k, x)
-assocAt' _ _ _ = Nothing
+assocAt _ i0 _ (Tip _ k x) = (mzero, return (Asc i0 k x), mzero)
+assocAt _ _ _ _ = (mzero, mzero, mzero)
 
-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 -> Key -> a -> Maybe (a)) -> Int -> WordMap a -> WordMap a
+-- 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
+updateAt :: Sized a -> Round -> Int -> (Int -> Key -> a -> Maybe (a)) -> Int -> WordMap a -> WordMap a
+updateAt s True !i0 f !i t = case t of
 	Bin _ p m l r -> let sl = size l in
-		if i < sl then bin p m (updateAt' s i0 f i l) r 
-			else bin p m l (updateAt' s (i0 + sl) f (i - sl) r)
+		if i < sl then bin p m (updateAt s True i0 f i l) r 
+			else bin p m l (updateAt s True (i0 + sl) f (i - sl) r)
+	Tip _ kx x -> singletonMaybe s kx (f i0 kx x)
+	_	-> t
+updateAt s False !i0 f !i t = case t of
+	Bin sz p m l r -> let {sl = size l; mI = maxIx l} in
+		if i < mI then bin p m (updateAt s False i0 f i l) r
+			else bin p m l (updateAt s False (i0 + sl) f (i - sl) r)
+	Tip _ kx x -> singletonMaybe s kx (f i0 kx x)
+	_	-> t
+	where	maxIx m = maybe (size m) fst (maxViewWithKey s (\ _ a -> (size m - s a, Just a)) m)
 
-lookupIx' :: Int -> Nat -> IntMap a ix -> Maybe (Int, a ix)
-lookupIx' !i k t = case t of
+lookupIx :: Sized a -> Int -> Nat -> WordMap a -> IndexPos Nat a
+lookupIx s !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
+		| zeroN k m, (lb, x, ub) <- lookupIx s i k l
+			-> (lb, x, ub <|> fst <$> First (minViewWithKey s (\ k a -> (Asc (i + size l) k a, Just a)) r))
+		| (lb, x, ub) <- lookupIx s (i + size l) k r
+			-> (fst <$> Last (maxViewWithKey s (\ k a -> (Asc (i + size l - s a) k a, Just a)) l) <|> lb, x, ub)
 	Tip _ kx x
-		| k == natFromInt kx		-> Just (i, x)
-	_ -> Nothing
+		| k == kx	-> (mzero, return (Asc i kx x), mzero)
+	_ -> (mzero, mzero, mzero)
 
-singleton :: Sized a -> Key -> a ix -> IntMap a ix
+singleton :: Sized a -> Key -> a -> WordMap a
 singleton s k a = Tip (s a) k a
 
-singletonMaybe :: Sized a -> Key -> Maybe (a ix) -> IntMap a ix
+singletonMaybe :: Sized a -> Key -> Maybe (a) -> WordMap a
 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 :: Sized a -> (Maybe (a) -> Maybe (a)) -> Key -> WordMap a -> WordMap a
 alter s f k t = case t of
 	Bin sz p m l r
 		| nomatch k p m	-> join k (singletonMaybe s k (f Nothing)) p t
@@ -159,48 +240,48 @@
 		| 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 :: Applicative f => Sized b -> (Key -> a -> f (b)) -> WordMap a -> f (WordMap b)
 traverseWithKey s f t = case t of
 	Nil		-> pure Nil
 	Tip _ kx x	-> singleton s kx <$> f kx x
 	Bin _ p m l r	-> bin p m <$> traverseWithKey s f l <*> traverseWithKey s f r
 
-foldr :: (Key -> a 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 -> b -> b) -> WordMap a -> 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
+foldr :: (Key -> a -> b -> b) -> WordMap a -> b -> b
+foldr f t
   = case t of
-      Bin _ _ _ l r -> foldr' f l . foldr' f r
+      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
+foldl{-, foldl' -}:: (Key -> b -> a -> b) -> WordMap a -> 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
+      Nil           -> id-}
+foldl f t
   = case t of
-      Bin _ _ _ l r -> foldl' f r . foldl' f l
+      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 :: Sized b -> Sized c -> EitherMap Key (a) (b) (c) ->
+	WordMap a -> (WordMap b, WordMap c)
 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
+splitLookup :: Sized a -> SplitMap (a) x -> Key -> WordMap a -> (WordMap a ,Maybe x,WordMap a)
+{-splitLookup s f k t
   = case t of
       Bin _ _ m l r
           | m < 0 -> (if k >= 0 -- handle negative numbers.
@@ -213,8 +294,8 @@
         | 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
+splitLookup' :: Sized a -> SplitMap (a) x -> Key -> WordMap a -> (WordMap a ,Maybe x,WordMap a)-}
+splitLookup s f k t
   = case t of
       Bin _ p m l r
         | nomatch k p m -> if k>p then (t,Nothing,Nil) else (Nil,Nothing,t)
@@ -226,7 +307,7 @@
         | otherwise -> singletonMaybe s k `sides` f y
       Nil -> (Nil,Nothing,Nil)
 
-union :: Sized a -> IntMap a ix -> IntMap a ix -> IntMap a ix
+union :: Sized a -> WordMap a -> WordMap a -> WordMap a
 union s t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = union1
   | shorter m2 m1  = union2
@@ -245,7 +326,7 @@
 union _ Nil t       = t
 union _ t Nil       = t
 
-unionWithKey :: Sized a -> UnionFunc Key (a ix) -> IntMap a ix -> IntMap a ix -> IntMap a ix
+unionWithKey :: Sized a -> UnionFunc Key (a) -> WordMap a -> WordMap a -> WordMap a
 unionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = union1
   | shorter m2 m1  = union2
@@ -264,7 +345,7 @@
 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 :: Sized c -> IsectFunc Key (a) (b) (c) -> WordMap a -> WordMap b -> WordMap c
 intersectionWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = intersection1
   | shorter m2 m1  = intersection2
@@ -286,7 +367,7 @@
 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 :: Sized a -> (Key -> a -> b -> Maybe (a)) -> WordMap a -> WordMap b -> WordMap a
 differenceWithKey s f t1@(Bin _ p1 m1 l1 r1) t2@(Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = difference1
   | shorter m2 m1  = difference2
@@ -307,7 +388,7 @@
 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 :: LEq (a) (b) -> LEq (WordMap a) (WordMap b)
 isSubmapOfBy (<=) t1@(Bin _ p1 m1 l1 r1) (Bin _ p2 m2 l2 r2)
   | shorter m1 m2  = False
   | shorter m2 m1  = match p1 p2 m2 && (if zero p1 m2 then isSubmapOfBy (<=) t1 l2
@@ -317,62 +398,68 @@
 isSubmapOfBy (<=) (Tip _ k x) t     = maybe False (x <=) (lookup (natFromInt k) t)
 isSubmapOfBy _         Nil _           = True
 
+extract :: Alternative f => Sized a -> (Key -> a -> f (x, Maybe a)) -> WordMap a -> f (x, WordMap a)
+extract s f t = case t of
+	Bin _ p m l r -> second (\ l' -> bin p m l' r) <$> extract s f l
+				<|> second (bin p m l) <$> extract s f r
+	Tip _ k x -> second (singletonMaybe s k) <$> f k x
+	Nil -> empty
 
-maxViewWithKey, minViewWithKey :: IntMap a ix -> Maybe ((Key, a ix), IntMap a ix)
-maxViewWithKey t
+maxViewWithKey, minViewWithKey :: Sized a -> (Key -> a -> (x, Maybe a)) -> WordMap a -> Maybe (x, WordMap a)
+maxViewWithKey s f t
     = case t of
-        Bin _ p m l r | 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)
+--         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 s f r in Just (result, bin p m l t')
+        Tip _ k y -> let (result, x) = f k y in Just (result, singletonMaybe s k x)
         Nil -> Nothing
 
-maxViewUnsigned, minViewUnsigned :: IntMap a ix -> ((Key, a ix), IntMap a ix)
-maxViewUnsigned t 
+maxViewUnsigned, minViewUnsigned :: Sized a -> (Key -> a -> (x, Maybe a)) -> WordMap a -> (x, WordMap a)
+maxViewUnsigned s f t 
     = case t of
-        Bin _ p m l r -> let (result,t') = maxViewUnsigned r in (result,bin p m l t')
-        Tip _ k y -> ((k,y), Nil)
+        Bin _ p m l r -> let (result,t') = maxViewUnsigned s f r in (result,bin p m l t')
+        Tip _ k y -> let (result, x) = f k y in (result, singletonMaybe s k x)
         Nil -> error "maxViewUnsigned Nil"
 
 -- 
--- minViewWithKey :: IntMap a ix -> Maybe ((Key, a ix), IntMap a ix)
-minViewWithKey t
+-- minViewWithKey :: WordMap a -> Maybe ((Key, a), WordMap a)
+minViewWithKey s f 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)
+--         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 s f l in Just (result, bin p m t' r)
+        Tip _ k y -> let (result, x) = f k y in Just (result, singletonMaybe s k x)
         Nil -> Nothing
 
--- minViewUnsigned :: IntMap a ix -> ((Key, a ix), IntMap a ix)
-minViewUnsigned t 
+-- minViewUnsigned :: WordMap a -> ((Key, a), WordMap a)
+minViewUnsigned s f 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)
+        Bin _ p m l r -> let (result,t') = minViewUnsigned s f l in (result,bin p m t' r)
+        Tip _ k y -> let (result, x) = f k y in (result, singletonMaybe s k x)
         Nil -> error "minViewUnsigned Nil"
 
-updateMinWithKey :: Sized a -> (Key -> a ix -> Maybe (a ix)) -> IntMap a ix -> IntMap a ix
+updateMinWithKey :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a
 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 | 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 :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a
 updateMinWithKeyUnsigned s f t
     = case t of
         Bin _ p m l r -> let t' = updateMinWithKeyUnsigned s f l in bin p m t' r
         Tip _ k y -> singletonMaybe s k (f k y)
         Nil -> Nil
 
-updateMaxWithKey :: Sized a -> (Key -> a ix -> Maybe (a ix)) -> IntMap a ix -> IntMap a ix
+updateMaxWithKey :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a
 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 | 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 :: Sized a -> (Key -> a -> Maybe (a)) -> WordMap a -> WordMap a
 updateMaxWithKeyUnsigned s f t
     = case t of
         Bin _ p m l r -> let t' = updateMaxWithKeyUnsigned s f r in bin p m l t'
@@ -419,7 +506,7 @@
          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 :: Prefix -> WordMap a -> Prefix -> WordMap a -> WordMap a
 join p1 t1 p2 t2
   | zero p1 m = bin p m t1 t2
   | otherwise = bin p m t2 t1
@@ -427,19 +514,19 @@
     m = branchMask p1 p2
     p = mask p1 m
 
-bin :: Prefix -> Mask -> IntMap a ix -> IntMap a ix -> IntMap a ix
+bin :: Prefix -> Mask -> WordMap a -> WordMap a -> WordMap a
 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.WordMap
+-- import qualified Data.WordMap as IMap
 -- import Data.Traversable
 -- 
--- newtype IntTMap a ix = ITMap (IntMap (a ix))
+-- newtype IntTMap a = ITMap (WordMap (a))
 -- type instance TrieMap Int = IntTMap
--- newtype MaybeF a ix = MF {unF :: Maybe (a ix)}
+-- newtype MaybeF a = MF {unF :: Maybe (a)}
 -- 
 -- instance TrieKey Int IntTMap where
 -- 	emptyM = ITMap empty
diff --git a/Data/TrieMap/Modifiers.hs b/Data/TrieMap/Modifiers.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Modifiers.hs
@@ -0,0 +1,12 @@
+module Data.TrieMap.Modifiers where
+
+newtype Ordered a = Ord {unOrd :: a} deriving (Eq, Ord)
+newtype Rev k = Rev {getRev :: k} deriving (Eq)
+instance Ord k => Ord (Rev k) where
+	compare (Rev a) (Rev b) = compare b a
+
+instance Functor Ordered where
+	fmap f (Ord a) = Ord (f a)
+
+instance Functor Rev where
+	fmap f (Rev a) = Rev (f a)
diff --git a/Data/TrieMap/MultiRec.hs b/Data/TrieMap/MultiRec.hs
--- a/Data/TrieMap/MultiRec.hs
+++ b/Data/TrieMap/MultiRec.hs
@@ -1,6 +1,7 @@
 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.FamMap
 import Data.TrieMap.MultiRec.Eq
+import Data.TrieMap.MultiRec.Base
 import Data.TrieMap.MultiRec.Ord
diff --git a/Data/TrieMap/MultiRec/Base.hs b/Data/TrieMap/MultiRec/Base.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/Base.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, ExistentialQuantification, KindSignatures, FlexibleInstances, MultiParamTypeClasses #-}
+
+module Data.TrieMap.MultiRec.Base (module Generics.MultiRec.Base, module Generics.MultiRec.HFix, {-A0(..), X(..), -}Family(..), FamT(..), KeyFam(..), FunctorT (..), breakEither) where
+
+import Data.TrieMap.TrieKey
+
+import Generics.MultiRec
+import Generics.MultiRec.Base
+import Generics.MultiRec.HFix
+
+import Control.Applicative
+
+-- newtype A f (r :: * -> *) ix = A {unA :: f r ix}
+-- newtype A0 (r :: * -> *) ix = A0 {unA0 :: r ix}
+-- newtype R (r1 :: * -> *) (r :: * -> *) ix = Rec {unRec :: r1 (r ix)}
+-- newtype X (r :: * -> *) ix = X {unX :: ix}
+newtype Family (phi :: * -> *) ix = F ix
+
+data KeyFam k = TrieKey k (TrieMap k) => KF
+newtype FamT (phi :: * -> *) f ix = FamT (f ix)
+
+instance TrieKey k (TrieMap k) => El KeyFam k where
+	proof = KF
+
+-- instance HFunctor phi f => HFunctor phi (A f) where
+-- 	hmapA f pf (A x) = A <$> hmapA f pf x
+
+-- instance HFunctor phi A0 where
+-- 	hmapA f pf (A0 x) = A0 <$> f pf x
+
+-- instance HEq phi f => HEq phi (A f) where
+-- 	heq f pf (A x) (A y) = heq f pf x y
+
+-- instance HEq phi A0 where
+-- 	heq f pf (A0 x) (A0 y) = f pf x y
+
+class FunctorT f where
+	fmapp :: Functor r => (a -> b) -> f r a -> f r b
+
+instance FunctorT (FamT phi) where
+	fmapp f (FamT x) = FamT (fmap f x)
+
+instance Functor (Family phi) where
+	fmap f (F x) = F (f x)
+
+instance Functor f => Functor (FamT phi f) where
+	fmap = fmapp
+
+instance FunctorT (K k) where
+	fmapp = fmap
+
+instance Functor (K k r) where
+	fmap f (K a) = K a
+
+instance FunctorT (I ix) where
+	fmapp = fmap
+
+instance Functor (I ix r) where
+	fmap f (I a) = I a
+
+instance FunctorT U where
+	fmapp f U = U 
+
+instance Functor (U r) where
+	fmap f U = U
+
+instance (FunctorT f, FunctorT g) => FunctorT (f :*: g) where	
+	fmapp f (x :*: y) = fmapp f x :*: fmapp f y
+
+instance (Functor (f r), Functor (g r)) => Functor ((f :*: g) r) where
+	fmap f (x :*: y) = fmap f x :*: fmap f y
+
+instance (FunctorT f, FunctorT g) => FunctorT (f :+: g) where
+	fmapp f (L l) = L (fmapp f l)
+	fmapp f (R r) = R (fmapp f r)
+
+instance (Functor (f r), Functor (g r)) => Functor ((f :+: g) r) where
+	fmap f (L l) = L (fmap f l)
+	fmap f (R r) = R (fmap f r)
+
+-- instance FunctorT f => FunctorT (A f) where
+-- 	fmapp f (A x) = A (fmapp f x)
+
+-- instance FunctorT A0 where
+-- 	fmapp f (A0 x) = A0 (fmap f x)
+
+-- instance (FunctorT f, Functor r) => Functor (A f r) where
+-- 	fmap = fmapp
+
+-- instance Functor r => Functor (A0 r) where
+-- 	fmap = fmapp
+
+-- instance FunctorT X where
+-- 	fmapp = fmap
+
+-- instance Functor (X r) where
+-- 	fmap f (X x) = X (f x)
+
+instance FunctorT f => Functor (HFix f) where
+	fmap f (HIn x) = HIn (fmapp f x)
+
+breakEither :: [((f :+: g) r ix, a)] -> ([(f r ix, a)], [(g r ix, a)])
+breakEither = foldr breakEither' ([], []) where
+	breakEither' (L k, a) (xs, ys) = ((k, a):xs, ys)
+	breakEither' (R k, a) (xs, ys) = (xs, (k, a):ys)
diff --git a/Data/TrieMap/MultiRec/Class.hs b/Data/TrieMap/MultiRec/Class.hs
--- a/Data/TrieMap/MultiRec/Class.hs
+++ b/Data/TrieMap/MultiRec/Class.hs
@@ -12,111 +12,124 @@
 import Data.Monoid
 import Generics.MultiRec.Eq
 
-type family HTrieMapT (phi :: * -> *) (f :: (* -> *) -> * -> *) :: (* -> *) -> (* -> *) -> * -> *
-type family HTrieMap (phi :: * -> *) (r :: * -> *) :: (* -> *) -> * -> *
+type family HTrieMapT (phi :: * -> *) (f :: (* -> *) -> * -> *) :: (* -> *) -> * -> * -> *
+type family HTrieMap (phi :: * -> *) (r :: * -> *) :: * -> * -> *
 
 class HOrd phi f => HTrieKeyT (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
+	emptyT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r ix a
+	nullT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> m r ix a -> Bool
+	sizeT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> m r ix a -> Int
+	lookupT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> f r ix -> m r ix a -> Maybe a
+	lookupIxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> f r ix -> m r ix a -> IndexPos (f r ix) a
+	assocAtT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> Int -> m r ix a -> IndexPos (f r ix) a
+-- 	updateAtT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+-- 		phi ix -> HSized phi a -> Round -> (Int -> f r ix -> a -> Maybe a) -> Int -> m r ix a -> m r ix a
 	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
+		phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> f r ix ->
+			m r ix a -> m r ix a
 	{-# 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) #-}
+		phi ix -> HSized phi b -> (f r ix -> ix a -> Id b) -> m r ix a -> Id (m r ix b) #-}
 	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)
+		phi ix -> HSized phi b -> (f r ix -> a -> t b) -> m r ix a -> t (m r ix b)
 	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
+		phi ix -> (f r ix -> a -> b -> b) -> m r ix a -> 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
+		phi ix -> (f r ix -> b -> a -> b) -> m r ix a -> 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)
+		HSized phi b -> HSized phi c -> EitherMap (f r ix) a b c -> m r ix a -> (m r ix b, m r ix c)
 	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)
+		phi ix -> HSized phi a -> SplitMap a x -> f r ix ->
+			m r ix a -> (m r ix a, Maybe x, m r ix a)
 	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
+		phi ix -> HSized phi a -> UnionFunc (f r ix) a ->
+			m r ix a -> m r ix a -> m r ix a
 	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
+		phi ix -> HSized phi c -> IsectFunc (f r ix) a b c -> m r ix a -> m r ix b -> m r ix c
 	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
+		phi ix -> HSized phi a -> DiffFunc (f r ix) a b -> m r ix a -> m r ix b -> m r ix a
+	extractT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r), Alternative t) =>
+		phi ix -> HSized phi a -> ExtractFunc t (m r ix a) (f r ix) a x
+-- 	extractMinT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+-- 		phi ix -> HSized phi a -> ExtractFunc (f r ix) First a (m r ix a) x
+-- 	extractMaxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+-- 		phi ix -> HSized phi a -> ExtractFunc (f r ix) Last a (m r ix a) x
+-- 	alterMinT:: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+-- 		phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> First (m r ix a)
+-- 	alterMaxT :: (m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
+-- 		phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> Last (m r ix a)
 	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)
+		phi ix -> LEq a b -> LEq (m r ix a) (m r ix b)
 	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
+		phi ix -> HSized phi a -> (f r ix -> a -> a -> a ) -> [(f r ix, a )] -> m r ix a
 	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
+		phi ix -> HSized phi a -> [(f r ix, a )] -> m r ix a
+	sizeT pf s m = foldWithKeyT pf (\ _ x n -> s 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 | 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) #-}
+	emptyH :: m ~ HTrieMap phi r => phi ix -> m ix a
+	nullH :: m ~ HTrieMap phi r => phi ix -> m ix a -> Bool
+	sizeH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> m ix a -> Int
+	lookupH :: m ~ HTrieMap phi r => phi ix -> r ix -> m ix a -> Maybe a
+	alterH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (Maybe a -> Maybe a) -> r ix -> m ix a -> m ix a
+	lookupIxH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> r ix -> m ix a -> IndexPos (r ix) a
+	assocAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Int -> m ix a -> IndexPos (r ix) a
+-- 	updateAtH :: m ~ HTrieMap phi r => phi ix -> HSized phi a -> Round -> (Int -> r ix -> a -> Maybe a) -> Int -> m ix a -> m ix a
+	{-# SPECIALIZE traverseWithKeyH :: phi ix -> (r ix -> ix a -> Id b) ->
+		m ix a -> Id (m ix b) #-}
 	traverseWithKeyH :: (m ~ HTrieMap phi r, Applicative f) => 
-		phi ix -> HSized phi b -> (r ix -> a 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
+		phi ix -> HSized phi b -> (r ix -> a -> f b) -> m ix a -> f (m ix b)
+	foldWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> a -> b -> b) -> m ix a -> b -> b
+	foldlWithKeyH :: m ~ HTrieMap phi r => phi ix -> (r ix -> b -> a -> b) -> m ix a -> b -> b
 	mapEitherH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi b -> HSized phi c ->
-		EitherMap (r ix) (a 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
+		EitherMap (r ix) a b c -> m ix a -> (m ix b, m ix c)
+	splitLookupH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> SplitMap a x -> r ix -> m ix a ->
+				(m ix a, Maybe x, m ix a)
+	unionH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> UnionFunc (r ix) a -> m ix a -> m ix a
+			-> m ix a
+	isectH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi c -> IsectFunc (r ix) a b c ->
+			m ix a -> m ix b -> m ix c
+	diffH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> DiffFunc (r ix) a b ->
+			m ix a -> m ix b -> m ix a
+	extractH :: (m ~ HTrieMap phi r, Alternative t) =>
+		phi ix -> HSized phi a -> ExtractFunc t (m ix a) (r ix) a x
+-- 	extractMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) First a (m ix a) x
+-- 	extractMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> ExtractFunc (r ix) Last a (m ix a) x
+-- 	alterMinH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> Maybe a) ->
+-- 		m ix a -> First (m ix a)
+-- 	alterMaxH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> Maybe a) ->
+-- 		m ix a -> Last (m ix a)
 	isSubmapH :: m ~ HTrieMap phi r => 
-		phi ix -> LEq (a 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
+		phi ix -> LEq a b -> LEq (m ix a) (m ix b)
+	fromListH, fromAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> (r ix -> a -> a -> a) ->
+		[(r ix, a)] -> m ix a
+	fromDistAscListH :: (m ~ HTrieMap phi r) => phi ix -> HSized phi a -> [(r ix, a)] -> m ix a
+	sizeH pf s m = foldWithKeyH pf (\ _ x n -> s x + n) m 0
 	fromListH pf s f = foldr (\ (k, a) -> alterH pf s (Just . maybe a (f k a)) k) (emptyH pf)
 	fromAscListH = fromListH
 	fromDistAscListH pf s = fromAscListH pf s (const const)
-	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
+	phi ix -> HSized phi b -> (f r ix -> a -> b ) -> HTrieMapT phi f r ix a -> HTrieMapT phi f r ix b
 mapWithKeyT pf s f m = unId (traverseWithKeyT pf s (Id .: f) m)
 
 mapWithKeyH :: (HTrieKey phi r (HTrieMap phi r)) =>
-	phi ix -> HSized phi b -> (r ix -> a ix -> b ix) -> HTrieMap phi r a ix -> HTrieMap phi r b ix
+	phi ix -> HSized phi b -> (r ix -> a -> b) -> HTrieMap phi r ix a -> HTrieMap phi r ix b
 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)
+	phi ix -> m r ix a -> Maybe (m r ix a)
 guardNullT pf m
 	| nullT pf m	= Nothing
 	| otherwise	= Just m
+
+-- alterMaxT, alterMinT :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r)) =>
+-- 	phi ix -> HSized phi a -> (f r ix -> a -> Maybe a) -> m r ix a -> m r ix a
+-- alterMaxT pf s f m = maybe m snd $ getLast (extractMaxT pf s (\ k a -> ((), f k a)) m)
+-- alterMinT pf s f m = maybe m snd $ getFirst (extractMinT pf s (\ k a -> ((), f k a)) m)
+
+aboutT :: (m ~ HTrieMapT phi f, HTrieKeyT phi f m, HTrieKey phi r (HTrieMap phi r), Alternative t) =>
+	phi ix -> (f r ix -> a -> t z) -> m r ix a -> t z
+aboutT pf f m = fst <$> extractT pf (const 0) (\ k a -> fmap (flip (,) Nothing) (f k a)) m
diff --git a/Data/TrieMap/MultiRec/ConstMap.hs b/Data/TrieMap/MultiRec/ConstMap.hs
--- a/Data/TrieMap/MultiRec/ConstMap.hs
+++ b/Data/TrieMap/MultiRec/ConstMap.hs
@@ -1,12 +1,14 @@
-{-# LANGUAGE KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE TemplateHaskell, KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
 
-module Data.TrieMap.MultiRec.ConstMap where
+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 Data.TrieMap.Rep
+-- import Data.TrieMap.Rep.TH
 
 import Control.Applicative
 import Control.Arrow
@@ -16,10 +18,18 @@
 import Data.Foldable
 import Generics.MultiRec
 
-newtype KMap (phi :: * -> *) m (r :: * -> *) (a :: * -> *) ix = KMap (m a ix)
+newtype KMap (phi :: * -> *) m (r :: * -> *) ix a = KMap (m a)
 type instance HTrieMapT phi (K k) = KMap phi (TrieMap k)
 type instance HTrieMap phi (K k r) = HTrieMapT phi (K k) r
 
+-- type instance RepT (KMap phi m r ix) = RepT m
+-- type instance Rep (KMap phi m r ix a) = RepT m (Rep a)
+-- 
+-- -- $(genRepT [d|
+--    instance ReprT m => ReprT (KMap phi m r ix) where
+-- 	toRepT (KMap m) = toRepT m
+-- 	fromRepT = KMap . fromRepT |])
+
 instance TrieKey k m => HTrieKeyT phi (K k) (KMap phi m) where
 	emptyT = emptyH
 	nullT = nullH
@@ -27,7 +37,7 @@
 	lookupT = lookupH
 	lookupIxT = lookupIxH
 	assocAtT = assocAtH
-	updateAtT = updateAtH
+-- 	updateAtT = updateAtH
 	alterT = alterH
 	traverseWithKeyT = traverseWithKeyH
 	foldWithKeyT = foldWithKeyH
@@ -37,10 +47,11 @@
 	unionT = unionH
 	isectT = isectH
 	diffT = diffH
-	extractMinT = extractMinH
-	extractMaxT = extractMaxH
-	alterMinT = alterMinH
-	alterMaxT = alterMaxH
+	extractT = extractH
+-- 	extractMinT = extractMinH
+-- 	extractMaxT = extractMaxH
+-- 	alterMinT = alterMinH
+-- 	alterMaxT = alterMaxH
 	isSubmapT = isSubmapH
 	fromListT = fromListH
 	fromAscListT = fromAscListH
@@ -49,12 +60,11 @@
 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
+	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)
+	lookupIxH _ s (K k) (KMap m) = onKey K (lookupIxM s k m)
+	assocAtH _ s i (KMap m) = onKey K (assocAtM s i m)
+-- 	updateAtH _ s r f i (KMap m) = KMap (updateAtM s r (\ 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
@@ -64,14 +74,11 @@
 	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)
+	extractH pf s f (KMap m) = second KMap <$> extractM s (f . K) m
+-- 	extractMinH pf s f (KMap m) = second KMap <$> extractMinM (s) (f . K) m
+-- 	extractMaxH pf s f (KMap m) = second KMap <$> extractMaxM s (f . K) 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])
diff --git a/Data/TrieMap/MultiRec/Eq.hs b/Data/TrieMap/MultiRec/Eq.hs
--- a/Data/TrieMap/MultiRec/Eq.hs
+++ b/Data/TrieMap/MultiRec/Eq.hs
@@ -2,7 +2,8 @@
 
 module Data.TrieMap.MultiRec.Eq where
 
-import Generics.MultiRec
+import Data.TrieMap.MultiRec.Base
+import Generics.MultiRec.HFix
 import Generics.MultiRec.Eq
 
 class HEq0 phi r where
@@ -13,6 +14,12 @@
 
 instance Eq k => HEq0 phi (K k r) where
 	heqH _ (K x) (K y) = x == y
+{-
+instance HEq0 phi r => HEq0 phi (A0 r) where
+	heqH pf (A0 x) (A0 y) = heqH pf x y-}
+
+-- instance (HEq phi f, HEq0 phi r) => HEq0 phi (A f r) where
+-- 	heqH pf (A x) (A y) = heqT pf x y
 
 instance (El phi xi, HEq0 phi r) => HEq0 phi (I xi r) where
 	heqH pf (I x) (I y) = heqH (proofOn pf) x y where
diff --git a/Data/TrieMap/MultiRec/FamMap.hs b/Data/TrieMap/MultiRec/FamMap.hs
--- a/Data/TrieMap/MultiRec/FamMap.hs
+++ b/Data/TrieMap/MultiRec/FamMap.hs
@@ -1,14 +1,16 @@
-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, Rank2Types, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE PatternGuards, TypeFamilies, MultiParamTypeClasses, Rank2Types, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
 
-module Data.TrieMap.MultiRec.FamMap where
+module Data.TrieMap.MultiRec.FamMap () where
 
 import Data.TrieMap.MultiRec.Class
 import Data.TrieMap.MultiRec.Eq
 import Data.TrieMap.MultiRec.Ord
 import Data.TrieMap.MultiRec.Sized
+import Data.TrieMap.MultiRec.Base
 import Data.TrieMap.Sized
 import Data.TrieMap.Applicative
 import Data.TrieMap.TrieKey
+import qualified Data.TrieMap.Regular.Class as Reg
 
 import Control.Applicative
 import Control.Arrow
@@ -20,8 +22,7 @@
 
 import Generics.MultiRec
 
-newtype Family phi ix = F ix
-newtype FamMap (phi :: * -> *) m (a :: * -> *) ix = FamMap (m (Family phi) a ix)
+newtype FamMap (phi :: * -> *) m ix a = FamMap (m (Family phi) ix a)
 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
@@ -36,6 +37,21 @@
 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
 
+instance HEq0 phi r => HEq0 phi (FamT phi r) where
+	heqH pf (FamT x) (FamT y) = heqH pf x y
+
+instance HOrd0 phi r => HOrd0 phi (FamT phi r) where
+	compareH0 pf (FamT x) (FamT y) = compareH0 pf x y
+
+instance (El phi ix, HEq0 phi r) => Eq (FamT phi r ix) where
+	x == y = heqH (prove' x) x y
+
+instance (El phi ix, HOrd0 phi r) => Ord (FamT phi r ix) where
+	x `compare` y = compareH0 (prove' x) x y
+
+prove' :: El phi ix => FamT phi r ix -> phi ix
+prove' _ = proof
+
 prove :: El phi ix => Family phi ix -> phi ix
 prove _ = proof
 
@@ -51,12 +67,11 @@
 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
+	sizeH pf s (FamMap m) = sizeT pf 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)
+	lookupIxH pf s (F k) (FamMap m) = onKey (F . to' pf) (lookupIxT pf s (from' pf k) m)
+	assocAtH pf s i (FamMap m) = onKey (F . to' pf) (assocAtT pf s i m)
+-- 	updateAtH pf s r f i (FamMap m) = FamMap (updateAtT pf s r (\ 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
@@ -67,59 +82,75 @@
 	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)
+	extractH pf s f (FamMap m) = second FamMap <$> extractT pf s (f . F . to' pf) m
+-- 	extractMinH pf s f (FamMap m) = second FamMap <$> extractMinT pf s (f . F . to' pf) m
+-- 	extractMaxH pf s f (FamMap m) = second FamMap <$> extractMaxT pf s (f . F . to' pf) 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)
+newtype FMap (phi :: * -> *) m ix a = FMap (m ix a)
 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
+	sizeM s (FMap m) = sizeH proof s m
+	lookupM k (FMap m) = lookupH proof k m
+	lookupIxM s k (FMap m) = lookupIxH proof s k m
+	assocAtM s i (FMap m) = assocAtH proof s i m
+-- 	updateAtM s r f i (FMap m) = FMap (updateAtH proof s r f i m)
+	alterM s f k (FMap m) = FMap (alterH proof s f k m)
+	traverseWithKeyM s f (FMap m) = FMap <$> traverseWithKeyH proof s f m
+	foldWithKeyM f (FMap m) = foldWithKeyH proof f m
+	foldlWithKeyM f (FMap m) = foldlWithKeyH proof f 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])
+		(FMap *** FMap) (mapEitherH proof s1 s2 f m)
+	splitLookupM s f k (FMap m) = FMap `sides` splitLookupH proof s (f) k m
+	unionM s f (FMap m1) (FMap m2) = FMap (unionH proof s f m1 m2) 
+	isectM s f (FMap m1) (FMap m2) = FMap (isectH proof s f m1 m2) 
+	diffM s f (FMap m1) (FMap m2) = FMap (diffH proof s f m1 m2) 
+	extractM s f (FMap m) = second FMap <$> extractH proof s f m
+-- 	extractMinM s f (FMap m) = second FMap <$> extractMinH proof s f m
+-- 	extractMaxM s f (FMap m) = second FMap <$> extractMaxH proof s f m
+-- 	alterMinM s f (FMap m) = FMap (alterMinH proof s f m)
+-- 	alterMaxM s f (FMap m) = FMap (alterMaxH proof s f m)
+	isSubmapM (<=) (FMap m1) (FMap m2) = isSubmapH proof (<=) m1 m2 
+	fromListM s f xs = FMap (fromListH proof s f xs)
+	fromAscListM s f xs = FMap (fromAscListH proof s f xs)
+	fromDistAscListM s xs = FMap (fromDistAscListH proof s xs)
+
+newtype FTMap (phi :: * -> *) (r :: * -> *) ix a = FTMap (HTrieMap phi r ix a)
+type instance TrieMap (FamT phi r ix) = FTMap phi r ix
+
+-- instance (HTrieKey KeyFam r (HTrieMap KeyFam r)) => Reg.TrieKeyT (FamT KeyFam r) (FTMap KeyFam r) where
+-- 	emptyT = FTMap (emptyH KF)
+
+instance (El phi ix, HTrieKey phi r (HTrieMap phi r)) => TrieKey (FamT phi r ix) (FTMap phi r ix) where
+	emptyM = FTMap (emptyH proof)
+	nullM (FTMap m) = nullH proof m
+	sizeM s (FTMap m) = sizeH proof s m
+	lookupM (FamT k) (FTMap m) = lookupH proof k m
+	lookupIxM s (FamT k) (FTMap m) = onKey FamT (lookupIxH proof s k m)
+	assocAtM s i (FTMap m) = onKey FamT (assocAtH proof s i m)
+-- 	updateAtM s r f i (FTMap m) = FTMap (updateAtH proof s r (\ i' -> f i' . FamT) i m)
+	alterM s f (FamT k) (FTMap m) = FTMap (alterH proof s f k m)
+	foldWithKeyM f (FTMap m) = foldWithKeyH proof (f . FamT) m
+	foldlWithKeyM f (FTMap m) = foldlWithKeyH proof (f . FamT) m
+	traverseWithKeyM s f (FTMap m) = FTMap <$> traverseWithKeyH proof s (f . FamT) m
+	mapEitherM s1 s2 f (FTMap m) = (FTMap *** FTMap) (mapEitherH proof s1 s2 (f . FamT) m)
+	splitLookupM s f (FamT k) (FTMap m) = FTMap `sides` splitLookupH proof s f k m
+	unionM s f (FTMap m1) (FTMap m2) = FTMap (unionH proof s (f . FamT) m1 m2)
+	isectM s f (FTMap m1) (FTMap m2) = FTMap (isectH proof s (f . FamT) m1 m2)
+	diffM s f (FTMap m1) (FTMap m2) = FTMap (diffH proof s (f . FamT) m1 m2)
+	isSubmapM (<=) (FTMap m1) (FTMap m2) = isSubmapH proof (<=) m1 m2
+	extractM s f (FTMap m) = second FTMap <$> extractH proof s (f . FamT) m
+-- 	extractMinM s f (FTMap m){--} = second FTMap <$> extractMinH proof s (f . FamT) m
+-- 	extractMaxM s f (FTMap m) = second FTMap <$> extractMaxH proof s (f . FamT) m
+-- 	alterMinM s f (FTMap m) = FTMap (alterMinH proof s (f . FamT) m)
+-- 	alterMaxM s f (FTMap m) = FTMap (alterMaxH proof s (f . FamT) m)
diff --git a/Data/TrieMap/MultiRec/FixMap.hs b/Data/TrieMap/MultiRec/FixMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/FixMap.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeFamilies, MultiParamTypeClasses #-}
+
+module Data.TrieMap.MultiRec.FixMap () where
+
+import Data.TrieMap.MultiRec.Base
+import Data.TrieMap.MultiRec.Class
+import Data.TrieMap.TrieKey
+
+import Control.Applicative
+import Control.Arrow
+
+newtype HFixMap (phi :: * -> *) (f :: (* -> *) -> * -> *) a ix = HFixMap (HTrieMapT phi f (HFix f) a ix)
+type instance HTrieMap phi (HFix f) = HFixMap phi f
+
+instance HTrieKeyT phi f (HTrieMapT phi f) => HTrieKey phi (HFix f) (HFixMap phi f) where
+	emptyH = HFixMap . emptyT
+	nullH pf (HFixMap m) = nullT pf m
+	sizeH pf s (HFixMap m) = sizeT pf s m
+	lookupH pf (HIn k) (HFixMap m) = lookupT pf k m
+	lookupIxH pf s (HIn k) (HFixMap m) = onKey HIn (lookupIxT pf s k m)
+	assocAtH pf s i (HFixMap m) = onKey HIn (assocAtT pf s i m)
+-- 	updateAtH pf s r f i (HFixMap m) = HFixMap (updateAtT pf s r (\ i' -> f i' . HIn) i m)
+	alterH pf s f (HIn k) (HFixMap m) = HFixMap (alterT pf s f k m)
+	traverseWithKeyH pf s f (HFixMap m) = HFixMap <$> traverseWithKeyT pf s (f . HIn) m
+	foldWithKeyH pf f (HFixMap m) = foldWithKeyT pf (f . HIn) m
+	foldlWithKeyH pf f (HFixMap m) = foldlWithKeyT pf (f . HIn) m
+	unionH pf s f (HFixMap m1) (HFixMap m2) = HFixMap (unionT pf s (f . HIn) m1 m2)
+	isectH pf s f (HFixMap m1) (HFixMap m2) = HFixMap (isectT pf s (f . HIn) m1 m2)
+	diffH pf s f (HFixMap m1) (HFixMap m2) = HFixMap (diffT pf s (f . HIn) m1 m2)
+	isSubmapH pf (<=) (HFixMap m1) (HFixMap m2) = isSubmapT pf (<=) m1 m2
+	mapEitherH pf s1 s2 f (HFixMap m) = (HFixMap *** HFixMap) (mapEitherT pf s1 s2 (f . HIn) m)
+	splitLookupH pf s f (HIn k) (HFixMap m) = HFixMap `sides` splitLookupT pf s f k m
+	extractH pf s f (HFixMap m) = second HFixMap <$> extractT pf s (f . HIn) m
+-- 	extractMinH pf s f (HFixMap m) = second HFixMap <$> extractMinT pf s (f . HIn) m
+-- 	extractMaxH pf s f (HFixMap m) = second HFixMap <$> extractMaxT pf s (f . HIn) m
+-- 	alterMinH pf s f (HFixMap m) = HFixMap <$> alterMinT pf s (f . HIn) m
+-- 	alterMaxH pf s f (HFixMap m) = HFixMap <$> alterMaxT pf s (f . HIn) m
diff --git a/Data/TrieMap/MultiRec/IMap.hs b/Data/TrieMap/MultiRec/IMap.hs
--- a/Data/TrieMap/MultiRec/IMap.hs
+++ b/Data/TrieMap/MultiRec/IMap.hs
@@ -1,9 +1,12 @@
-{-# LANGUAGE Rank2Types, TypeFamilies, FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, Rank2Types, TypeFamilies, FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses #-}
 
-module Data.TrieMap.MultiRec.IMap where
+module Data.TrieMap.MultiRec.IMap () where
 
 import Data.TrieMap.MultiRec.Class
 import Data.TrieMap.MultiRec.Sized
+import Data.TrieMap.MultiRec.TH
+-- import Data.TrieMap.Rep.TH
+-- import Data.TrieMap.Rep
 import Data.TrieMap.TrieKey
 
 import Control.Applicative
@@ -11,76 +14,43 @@
 
 import Generics.MultiRec
 
-newtype IMap phi xi r a ix = IMap (HTrieMap phi r (I ix a) xi)
+newtype IMap phi xi r ix a = IMap (HTrieMap phi r xi a)
 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
+-- type instance RepT (IMap phi xi r ix) = RepT (HTrieMap phi r xi)
+-- type instance Rep (IMap phi xi r ix a) = RepT (IMap phi xi r ix) (Rep a)
+-- 
+-- -- $(genRepT [d|
+--   instance ReprT (HTrieMap phi r xi) => ReprT (IMap phi xi r ix) where
+-- 	toRepT (IMap m) = toRepT m
+-- 	fromRepT = IMap . fromRepT |] )
 
-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
+$(inferH [d|
+   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
+	sizeT _ s (IMap m) = sizeH proof s m
+	lookupT _ (I k) (IMap m) = lookupH proof k m
+	lookupIxT _ s (I k) (IMap m) = onKey I (lookupIxH proof s k m)
+	assocAtT _ s i (IMap m) = onKey I (assocAtH proof s i m)
+-- 	updateAtT _ s r f i (IMap m) = IMap (updateAtH proof s r (\ i' -> f i' . I) i m)
+	alterT _ s f (I k) (IMap m) = IMap (alterH proof s f k m)
+	traverseWithKeyT _ s f (IMap m) = IMap <$> traverseWithKeyH proof s (f . I) m
+	foldWithKeyT _ f (IMap m) = foldWithKeyH proof (f . I) m
+	foldlWithKeyT _ f (IMap m) = foldlWithKeyH proof (f . I) m
+	mapEitherT _ s1 s2 f (IMap m) = (IMap *** IMap) (mapEitherH proof s1 s2 (f . I) m)
+	splitLookupT pf s f (I k) (IMap m) = IMap `sides` splitLookupH proof s (f) k m
+	unionT pf s f (IMap m1) (IMap m2) = IMap (unionH proof s (f . I) m1 m2)
+	isectT pf s f (IMap m1) (IMap m2) = IMap (isectH proof s (f . I) m1 m2)
+	diffT pf s f (IMap m1) (IMap m2) = IMap (diffH proof s (f . I) m1 m2)
+	extractT pf s f (IMap m) = second IMap <$> extractH proof s (f . I) m
+-- 	extractMinT pf s f (IMap m) = second IMap <$> extractMinH proof s (f . I) m
+-- 	extractMaxT pf s f (IMap m) = second IMap <$> extractMaxH proof s (f . I) m
+-- 	alterMinT pf s f (IMap m) = IMap <$> alterMinH proof s (f . I) m
+-- 	alterMaxT pf s f (IMap m) = IMap <$> alterMaxH proof s (f . I) m
+	isSubmapT pf (<=) (IMap m1) (IMap m2) = isSubmapH proof (<=) m1 m2 
+	fromListT _ s f xs = IMap (fromListH proof s (f . I) [(k, a) | (I k, a) <- xs])
+	fromAscListT _ s f xs = IMap (fromAscListH proof s (f . I) [(k, a) | (I k, a) <- xs])
+	fromDistAscListT _ s xs = IMap (fromDistAscListH proof s [(k, a) | (I k, a) <- xs]) |])
diff --git a/Data/TrieMap/MultiRec/Instances.hs b/Data/TrieMap/MultiRec/Instances.hs
--- a/Data/TrieMap/MultiRec/Instances.hs
+++ b/Data/TrieMap/MultiRec/Instances.hs
@@ -7,3 +7,6 @@
 import Data.TrieMap.MultiRec.ConstMap
 import Data.TrieMap.MultiRec.UnitMap
 import Data.TrieMap.MultiRec.FamMap
+-- import Data.TrieMap.MultiRec.AppMap
+-- import Data.TrieMap.MultiRec.XMap
+import Data.TrieMap.MultiRec.FixMap
diff --git a/Data/TrieMap/MultiRec/Ord.hs b/Data/TrieMap/MultiRec/Ord.hs
--- a/Data/TrieMap/MultiRec/Ord.hs
+++ b/Data/TrieMap/MultiRec/Ord.hs
@@ -3,7 +3,7 @@
 module Data.TrieMap.MultiRec.Ord where
 
 import Data.TrieMap.MultiRec.Eq
-
+import Data.TrieMap.MultiRec.Base
 import Generics.MultiRec
 
 import Data.Monoid
@@ -18,6 +18,15 @@
 
 class HEq0 phi r => HOrd0 phi r where
 	compareH0 :: phi ix -> Comparator (r ix)
+
+-- instance HOrd0 phi r => HOrd0 phi (A0 r) where
+-- 	compareH0 pf (A0 a) (A0 b) = compareH0 pf a b
+
+-- instance (HOrd phi f, HOrd0 phi r) => HOrd0 phi (A f r) where
+-- 	compareH0 pf (A a) (A b) = hcompare pf a b
+
+-- instance HOrd phi A0 where
+-- 	compareH cmp pf (A0 a) (A0 b) = cmp pf a b
 
 instance Ord k => HOrd phi (K k) where
 	compareH _ = compareH0
diff --git a/Data/TrieMap/MultiRec/ProdMap.hs b/Data/TrieMap/MultiRec/ProdMap.hs
--- a/Data/TrieMap/MultiRec/ProdMap.hs
+++ b/Data/TrieMap/MultiRec/ProdMap.hs
@@ -1,126 +1,138 @@
-{-# LANGUAGE TypeOperators, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards, TemplateHaskell, TypeOperators, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}
 
-module Data.TrieMap.MultiRec.ProdMap where
+module Data.TrieMap.MultiRec.ProdMap () where
 
 import Data.TrieMap.MultiRec.Class
 import Data.TrieMap.MultiRec.Eq
+import Data.TrieMap.MultiRec.Ord
 import Data.TrieMap.MultiRec.Sized
+import Data.TrieMap.MultiRec.TH
+import Data.TrieMap.Regular.Base (O(..))
 import Data.TrieMap.Applicative
 import Data.TrieMap.TrieKey
+-- import Data.TrieMap.Rep
+-- import Data.TrieMap.Rep.TH
 
 import Control.Applicative
 import Control.Arrow
 
 import Data.Maybe
+import Data.Monoid
 import Data.Foldable
 import Data.Sequence ((|>))
 import qualified Data.Sequence as Seq
 
 import Generics.MultiRec
 
-newtype ProdMap (phi :: * -> *) 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)
+newtype ProdMap (phi :: * -> *) f g (r :: * -> *) ix a = PMap (HTrieMapT phi f r ix (HTrieMapT phi g r ix a))
+type instance HTrieMapT phi (f :*: g) = ProdMap phi f g--(HTrieMapT phi f) (HTrieMapT phi g)
 type instance HTrieMap phi ((f :*: g) r) = HTrieMapT phi (f :*: g) r
 
--- 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
+-- type instance RepT (ProdMap phi f g r ix) = RepT (HTrieMapT phi f r ix) `O` RepT (HTrieMapT phi g r ix)
+-- type instance Rep (ProdMap phi f g r ix a) = RepT (ProdMap phi f g r ix) (Rep a)
 
-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])
+-- -- $(genRepT [d|
+-- 	instance (ReprT (HTrieMapT phi f r ix), ReprT (HTrieMapT phi g r ix)) =>
+-- 			ReprT (ProdMap phi f g r ix) where
+-- 		toRepT (PMap m) = O (fmap toRepT (toRepT m))
+-- 		fromRepT (O m) = PMap (fromRepT (fmap fromRepT m)) |] )
 
-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)]
+maxIx :: (HTrieKeyT phi f (HTrieMapT phi f), HTrieKey phi r (HTrieMap phi r)) => phi ix -> HSized phi a -> 
+		HTrieMapT phi f r ix a -> Int
+maxIx pf s m = fromMaybe (sizeT pf s m) (getFirst (aboutT pf (\ _ a -> return (sizeT pf s m - s a)) m))
 
-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
+$(inferH [d|
+	instance (HTrieKeyT phi f (HTrieMapT phi f), HTrieKeyT phi g (HTrieMapT phi g)) => 
+			HTrieKeyT phi (f :*: g) (ProdMap phi f g) where
+		emptyT = PMap . emptyT
+		nullT pf (PMap m) = nullT pf m
+		sizeT pf s (PMap m) = sizeT pf (sizeT pf s) m
+		lookupT pf (a :*: b) (PMap m) = lookupT pf a m >>= lookupT pf b
+		lookupIxT pf s (a :*: b) (PMap m) = case lookupIxT pf (sizeT pf s) a m of
+			(lb, x, rb) -> let lookupX = do	Asc i a' m' <- x
+							let (lb', x', rb') = lookupIxT pf s b m'
+							let f = onIndexA (i +) . onKeyA (a' :*:)
+							return (f <$> lb', f <$> x', f <$> rb')
+			   in 	((do	Asc iA aL mL <- lb
+					fmap (onIndexA (iA +) . onKeyA (aL :*:)) (getLast pf s mL)) <|>
+				 (do	(lb', _, _) <- Last lookupX
+					lb'),
+				 (do	(_, x', _) <- lookupX
+					x'),
+				 (do	(_, _, rb') <- First lookupX
+					rb') <|>
+				 (do	Asc iA aR mR <- rb
+				  	fmap (onIndexA (iA +) . onKeyA (aR :*:)) (getFirst pf s mR)))
+			where 	getLast pf s m = aboutT pf (\ k a -> return (Asc (sizeT pf s m - s a) k a)) m
+				getFirst pf s m = aboutT pf (\ k a -> return (Asc 0 k a)) m
+		assocAtT pf s i (PMap m) = case assocAtT pf (sizeT pf s) i m of
+			(lb, x, rb) -> let lookupX = do	Asc i' a' m' <- x
+							let (lb', x', rb') = assocAtT pf s (i - i') m'
+							let f = onIndexA (i' +) . onKeyA (a' :*:)
+							return (f <$> lb', f <$> x', f <$> rb')
+				in ((do	Asc iA aL mL <- lb
+					fmap (onIndexA (iA +) . onKeyA (aL :*:)) (getLast pf s mL)) <|>
+				    (do	(lb', _, _) <- Last lookupX
+				    	lb'),
+				    (do	(_, x', _) <- lookupX
+				    	x'),
+				    (do	(_, _, rb') <- First lookupX
+				    	rb') <|>
+				    (do	Asc iA aR mR <- rb
+				    	fmap (onIndexA (iA +) . onKeyA (aR :*:)) (getFirst pf s mR)))
+			where 	getLast pf s m = aboutT pf (\ k a -> return (Asc (sizeT pf s m - s a) k a)) m
+				getFirst pf s m = aboutT pf (\ k a -> return (Asc 0 k a)) m
+-- 		updateAtT pf s r f i (PMap m) = PMap (updateAtT pf (sizeT pf s) r g i m) where
+-- 			g iA a m 
+-- 				| i >= iA && i <= iA + maxIx pf s m
+-- 					= (guardNullT pf . updateAtT pf s r (\ iB b -> f (iA + iB) (a :*: b)) (i - iA)) m
+-- 				| i < iA
+-- 					= guardNullT pf $
+-- 						alterMaxT pf s (\ b v -> f (iA + sizeT pf s m - s v) (a :*: b) v) m
+-- 				| otherwise
+-- 					= guardNullT pf $ alterMinT pf s (f iA . (a :*:)) m
+		alterT pf s f (a :*: b) (PMap m) = PMap (alterT pf (sizeT pf 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 pf 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 pf s1) (sizeT pf 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 pf 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 pf 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 pf 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 pf s) g m1 m2) where
+			g a = guardNullT pf .: diffT pf s (\ b -> f (a :*: b))
+		extractT pf s f (PMap m) = second PMap <$> extractT pf (sizeT pf s) g m where
+			g a = second (guardNullT pf) <.> extractT pf s (\ b -> f (a :*: b))
+-- 		extractMinT pf s f (PMap m) = second PMap <$> extractMinT pf (sizeT pf s) g m where 
+-- 			g a m1 = fromJust $ getFirst $ second (guardNullT pf) <$> extractMinT pf s (f . (a :*:)) m1
+-- 		extractMaxT pf s f (PMap m) = second PMap <$> extractMaxT pf (sizeT pf s) g m where 
+-- 			g a m1 = fromJust $ getLast $ second (guardNullT pf) <$> extractMaxT pf s (f . (a :*:)) m1
+-- 		alterMinT pf s f (PMap m) = PMap (alterMinT pf (sizeT pf 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 pf 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 pf s) (\ a -> fromListT pf s (\ b -> f (a :*: b)))
+					(fromListT pf (const 1) (\ _ (xs) (ys) -> (xs ++ ys))
+						[(a, ts) | (a, ts) <- breakFst pf xs]))
+		fromAscListT pf s f xs = PMap (fromDistAscListT pf (sizeT pf s)
+			[(a, fromAscListT pf s (\ b -> f (a :*: b)) ts) | (a, ts) <- breakFst pf xs])
+		fromDistAscListT pf s xs = PMap (fromDistAscListT pf (sizeT pf 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)] -> [(f r ix, [(g r ix, a)])]
+	breakFst pf [] = []
+	breakFst pf ((a :*: b, x):xs) = breakFst' a (Seq.singleton (b, x)) xs where
+		breakFst' a0 ts ((a :*: b, x):xs)
+			| heqT pf a0 a	= breakFst' a0 (ts |> (b, x)) xs
+			| otherwise	= (a0, toList ts):breakFst' a (Seq.singleton (b,x)) xs
+		breakFst' a ts [] = [(a, toList ts)]
+	|])
diff --git a/Data/TrieMap/MultiRec/Sized.hs b/Data/TrieMap/MultiRec/Sized.hs
--- a/Data/TrieMap/MultiRec/Sized.hs
+++ b/Data/TrieMap/MultiRec/Sized.hs
@@ -12,9 +12,9 @@
 -- 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
+type HSized (phi :: * -> *) a = a -> Int
 
 newtype Elem a = Elem {getElem :: a}
 
-sizeElem :: HSized phi Elem
+sizeElem :: HSized phi (Elem a)
 sizeElem _ = 1
diff --git a/Data/TrieMap/MultiRec/TH.hs b/Data/TrieMap/MultiRec/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/MultiRec/TH.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, QuasiQuotes, TemplateHaskell #-}
+
+module Data.TrieMap.MultiRec.TH where
+
+import Data.TrieMap.MultiRec.Class
+import Data.TrieMap.MultiRec.Ord
+import Language.Haskell.TH
+import Language.Haskell.TH.Ppr
+import Control.Monad
+import Debug.Trace
+
+data Scheme = Sch {empt, nul, siz, look, lookIx, assocAt, updateAt, alter, traverse, fold, foldl, mapE, splitL, union, isect, diff, extractMi, extractMa, alterMi, alterMa, isSub, fromL, fromAL, fromDAL :: String}
+
+htriekeyT :: Scheme
+htriekeyT = Sch "emptyT" "nullT" "sizeT" "lookupT" "lookupIxT" "assocAtT" "updateAtT" "alterT" "traverseWithKeyT" "foldWithKeyT" "foldlWithKeyT"
+	"mapEitherT" "splitLookupT" "unionT" "isectT" "diffT" "extractMinT" "extractMaxT" "alterMinT" "alterMaxT" "isSubmapT" 
+	"fromListT" "fromAscListT" "fromDistAscListT"
+
+htriekey :: Scheme
+htriekey = Sch "emptyH" "nullH" "sizeH" "lookupH" "lookupIxH" "assocAtH" "updateAtH" "alterH" "traverseWithKeyH" "foldWithKeyH" "foldlWithKeyH"
+	"mapEitherH" "splitLookupH" "unionH" "isectH" "diffH" "extractHinH" "extractHaxH" "alterHinH" "alterHaxH" "isSubmapH" 
+	"fromListH" "fromAscListH" "fromDistAscListH"
+
+{-inferNewtype :: Name -> Name -> Scheme -> Scheme -> Q [Dec] -> Q [Dec]
+inferNewtype kCon mCon sch1 sch2 decl = do
+	decs@(InstanceD cxt t _:_) <- decl
+	let fund = FunD . mkName
+	let mcon = ConE mCon
+	mapV <- newName "m"
+	let mapVar = VarE mapV
+	let mapPat = ConP mCon [VarP mapV]
+	pfV <- newName "pf"
+	let pfPat = VarP pfV
+	let pfVar = VarE pfV
+	szV <- newName "s"
+	let szPat = VarP szV
+	let szVar = VarE szV
+	let empty = fund (empt sch1) [pfPat] (AppE mcon (AppE (VarE (empt sch2)) pfVar))
+	let null = fund (nul sch1) [pfPat, mapPat] (VarE (nul sch2) `AppE` pfVar `AppE` mapVar)
+	let size = fund (siz sch1) [pfPat, szPat, mapPat] (VarE (siz sch2) `AppE` pfVar `AppE` szPat `AppE` mapVar
+	return [InstanceD cxt t [empty, null, size]]-}
+	
+
+inferH :: Q [Dec] -> Q [Dec]
+inferH instanceT = do
+	iT@(InstanceD cxt0 (htriekeyt `AppT` phi `AppT` f `AppT` m) _:_) <- instanceT
+	(InstanceD _ _ decs:_) <- [d|
+	  instance (HTrieKeyT phi f m, HTrieKey phi r mm, HOrd0 phi (f r)) => HTrieKey phi (f r) (m 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
+		extractH = extractT
+-- 		alterMinH = alterMinT
+-- 		alterMaxH = alterMaxT
+-- 		extractMinH = extractMinT
+-- 		extractMaxH = extractMaxT
+		isSubmapH = isSubmapT
+		fromListH = fromListT
+		fromAscListH = fromAscListT
+		fromDistAscListH = fromDistAscListT |]
+	let r = mkName "r"
+	let mm = mkName "mm"
+-- 	let phiT = varT phi
+	let rT = varT r
+	let mmT = varT mm
+-- 	let mT = varT m
+	let htriekey = conT ''HTrieKey
+	let hord = conT ''HOrd
+	let hord0 = conT ''HOrd0
+	let htriemap = conT ''HTrieMap
+	ans <- instanceD (cxt (map return cxt0 ++ [htriekey `appQ` phi `appT` rT `appT` (htriemap `appQ` phi `appT` rT)]))
+		(htriekey `appT` return phi `appT` (return f `appT` rT) `appT` (return m `appT` rT)) (map return decs)
+	return (ans:iT)
+
+appQ :: TypeQ -> Type -> TypeQ
+t1 `appQ` t2 = t1 `appT` return t2
diff --git a/Data/TrieMap/MultiRec/TagMap.hs b/Data/TrieMap/MultiRec/TagMap.hs
--- a/Data/TrieMap/MultiRec/TagMap.hs
+++ b/Data/TrieMap/MultiRec/TagMap.hs
@@ -1,12 +1,14 @@
-{-# LANGUAGE Rank2Types, TypeOperators, KindSignatures, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, GADTs, MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell, Rank2Types, TypeOperators, KindSignatures, FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeFamilies, GADTs, MultiParamTypeClasses #-}
 
-module Data.TrieMap.MultiRec.TagMap where
+module Data.TrieMap.MultiRec.TagMap () where
 
 import Data.TrieMap.MultiRec.Class
 import Data.TrieMap.MultiRec.Eq
 import Data.TrieMap.MultiRec.Sized
+import Data.TrieMap.MultiRec.TH
 import Data.TrieMap.Applicative
 import Data.TrieMap.TrieKey
+-- import Data.TrieMap.Rep
 
 import Control.Applicative
 import Control.Arrow
@@ -17,88 +19,98 @@
 import Data.Foldable
 import Generics.MultiRec
 
-data TagF a ix :: * -> * where
-	TagF :: a ix -> TagF a ix ix
+data TagF a ix xi where
+	TagF :: a -> TagF a ix ix
 
-unTagF :: TagF a ix xi -> a xi
+unTagF :: TagF a ix xi -> a
 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
+newtype TagMap (phi :: * -> *) f ix (r :: * -> *) xi a = TagMap (HTrieMapT phi f r xi (TagF a ix xi))
+type instance HTrieMapT phi (f :>: ix) = TagMap phi f ix
 type instance HTrieMap phi ((f :>: ix) r) = HTrieMapT phi (f :>: ix) r
 
-combineTag :: IsectFunc ((f :>: ix) r xi) (a xi) (b xi) (c xi) ->
+-- type instance RepT (TagMap phi f ix r xi) = RepT (HTrieMapT phi f r xi)
+-- type instance Rep (TagMap phi f ix r xi a) = RepT (HTrieMapT phi f r xi) (Rep a)
+
+-- instance (ReprT (HTrieMapT phi f r xi), ix ~ xi) => ReprT (TagMap phi f ix r xi) where
+-- 	toRepT (TagMap m) = fmap unTagF (toRepT m)
+-- 	fromRepT = TagMap . fromRepT . fmap TagF
+-- 
+-- instance (ReprT (HTrieMapT phi f r xi), ix ~ xi, Repr a) => Repr (TagMap phi f ix r xi a) where
+-- 	toRep (TagMap m) = fmap (toRep . unTagF) (toRepT m)
+-- 	fromRep = TagMap . fromRepT . fmap (TagF . fromRep)
+
+combineTag :: IsectFunc ((f :>: ix) r xi) (a) (b) (c) ->
 	IsectFunc (f r xi) (TagF a ix xi) (TagF b ix xi) (TagF c ix xi)
 combineTag f k (TagF a) (TagF b) = TagF <$> f (Tag k) a b
 
-mapTag :: Functor t => ((f :>: ix) r xi -> a xi -> t (b xi)) -> f r xi -> TagF a ix xi -> t (TagF b ix xi)
+mapTag :: Functor t => ((f :>: ix) r xi -> a -> t (b)) -> f r xi -> TagF a ix xi -> t (TagF b ix xi)
 mapTag f k (TagF a) = TagF <$> f (Tag k) a
 
-sizeTag :: HSized phi a -> HSized phi (TagF a ix)
+sizeTag :: HSized phi a -> HSized phi (TagF a ix xi)
 sizeTag s (TagF x) = s x
 
-instance (HTrieKeyT phi f m, m ~ HTrieMapT phi f) => HTrieKeyT phi (f :>: ix) (TagMap phi m ix) where
+restructure :: HTrieKeyT phi f (HTrieMapT phi f) =>
+	((f r ix, TagF a xi ix), HTrieMapT phi f r ix (TagF a xi ix)) -> (((f :>: xi) r ix, a), TagMap phi f xi r ix a)
+restructure ((k, TagF a), m) = ((Tag k, a), TagMap m)
+
+restructure' :: Applicative t => ((f :>: xi) r ix -> a -> t (x, Maybe a)) -> f r ix -> TagF a xi ix -> t (x, Maybe (TagF a xi ix))
+restructure' f k (TagF a) = second (fmap TagF) <$> f (Tag k) a
+
+retag :: (f r ix, TagF a xi ix) -> ((f :>: xi) r ix, a)
+retag (k, TagF a) = (Tag k, a)
+
+$(inferH [d|
+  instance (HTrieKeyT phi f (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
+	sizeT pf s (TagMap m) = sizeT pf (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
+	lookupIxT pf s (Tag k) (TagMap m) = onValue retag (lookupIxT pf (sizeTag s) k m)
+	assocAtT pf s i (TagMap m) = onValue retag (assocAtT pf (sizeTag s) i m) 
+-- 	updateAtT pf s r f i (TagMap m) = TagMap (updateAtT pf (sizeTag s) r (f' f) i m) where
+-- 		f' :: (Int -> (f :>: xi) r ix -> a -> Maybe (a)) -> Int -> f r ix -> TagF a xi ix -> Maybe (TagF a xi ix)
+-- 		f' f i k (TagF a) = TagF <$> f i (Tag k) a
 	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' :: Applicative t => ((f :>: ix) r xi -> a -> t (b )) -> f r xi -> TagF a ix xi -> t (TagF b ix xi)
 		f' f k (TagF a) = TagF <$> f (Tag k) a
 	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 :>: ix) r xi -> a -> 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 :>: ix) r xi -> b -> a -> b) -> f r xi -> b -> TagF a ix xi -> b
 		f' f k z (TagF a) = f (Tag k) z a
 	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' :: EitherMap ((f :>: ix) r xi) (a ) (b) (c) -> EitherMap (f r xi) (TagF a ix xi) (TagF b ix xi) (TagF c ix xi)
 		f' f k (TagF a) = (fmap TagF *** fmap TagF) (f (Tag k) a)
 	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' :: SplitMap (a) 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) 
+-- 	extractMinT pf s f (TagMap m) = second TagMap <$> extractMinT pf (sizeTag s) (restructure' f) m
+-- 	extractMaxT pf s f (TagMap m) = second TagMap <$> extractMaxT pf (sizeTag s) (restructure' f) m
+	extractT pf s f (TagMap m) = second TagMap <$> extractT pf (sizeTag s) (restructure' f) m
+-- 	alterMinT pf s f (TagMap m) = TagMap <$> alterMinT pf (sizeTag s) (mapTag f) m
+-- 	alterMaxT pf s f (TagMap m) = TagMap <$> alterMaxT pf (sizeTag s) (mapTag f) m
 	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 :: LEq a b -> 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 :>: ix) r xi -> a -> a -> a) -> f r xi -> TagF a ix xi -> TagF a ix xi -> TagF a ix xi
 		f' f k (TagF a) (TagF b) = TagF (f (Tag k) a b)
 	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 :>: ix) r xi -> a -> a -> a ) -> f r xi -> TagF a ix xi -> TagF a ix xi -> TagF a ix xi
 		f' f k (TagF a) (TagF b) = TagF (f (Tag k) a b)
 	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 :: ((f :>: ix) r xi, a) -> (f r xi, TagF a ix xi)
 		f (Tag k, a) = (k, TagF a)
-
+  |] )
+{-
 instance (HTrieKeyT phi f m, m ~ HTrieMapT phi f, HTrieKey phi r (HTrieMap phi r)) => 
-		HTrieKey phi ((f :>: ix) r) (TagMap phi m ix r) where
+		HTrieKey phi ((f :>: ix) r) (TagMap phi f ix r) where
 	emptyH = emptyT
 	nullH = nullT
 	sizeH = sizeT
@@ -122,4 +134,4 @@
 	isSubmapH = isSubmapT
 	fromListH = fromListT
 	fromAscListH = fromAscListT
-	fromDistAscListH = fromDistAscListT
+	fromDistAscListH = fromDistAscListT-}
diff --git a/Data/TrieMap/MultiRec/UnionMap.hs b/Data/TrieMap/MultiRec/UnionMap.hs
--- a/Data/TrieMap/MultiRec/UnionMap.hs
+++ b/Data/TrieMap/MultiRec/UnionMap.hs
@@ -1,46 +1,75 @@
-{-# LANGUAGE TypeFamilies, KindSignatures, FlexibleContexts, FlexibleInstances, UndecidableInstances, PatternGuards, MultiParamTypeClasses, TypeOperators #-}
+{-# LANGUAGE TemplateHaskell, TypeFamilies, KindSignatures, FlexibleContexts, FlexibleInstances, UndecidableInstances, PatternGuards, MultiParamTypeClasses, TypeOperators #-}
 
-module Data.TrieMap.MultiRec.UnionMap where
+module Data.TrieMap.MultiRec.UnionMap () where
 
 import Data.TrieMap.MultiRec.Class
 import Data.TrieMap.MultiRec.Eq
+import Data.TrieMap.MultiRec.Base
 import Data.TrieMap.Applicative
 import Data.TrieMap.TrieKey
+-- import Data.TrieMap.Rep
+-- import Data.TrieMap.Rep.TH
+import Data.TrieMap.MultiRec.TH
+import qualified Data.TrieMap.Regular.Base as Reg
 
 import Control.Applicative
 import Control.Arrow
 import Control.Monad
 
 import Data.Maybe
+import Data.Monoid
 import Data.Foldable
 import Generics.MultiRec
 
 import Prelude hiding (foldr)
 
-data UnionMap (phi :: * -> *) 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)
+data UnionMap (phi :: * -> *) f g (r :: * -> *) ix a = HTrieMapT phi f r ix a :&: HTrieMapT phi g r ix a
+type instance HTrieMapT phi (f :+: g) = UnionMap phi f g--HTrieMap phi (f r) :*: HTrieMap phi (g r)
 type instance HTrieMap phi ((f :+: g) r) = HTrieMapT phi (f :+: g) r
 
-instance (HTrieKeyT phi f m1, HTrieKeyT phi g m2) => HTrieKeyT phi (f :+: g) (UnionMap phi m1 m2) where
+-- type instance RepT (UnionMap phi f g r ix) = (Reg.:*:) (RepT (HTrieMapT phi f r ix)) (RepT (HTrieMapT phi g r ix))
+-- type instance Rep (UnionMap phi f g r ix a) = RepT (UnionMap phi f g r ix) (Rep a)
+
+-- -- $(genRepT [d|
+--     instance (ReprT (HTrieMapT phi f r ix), ReprT (HTrieMapT phi g r ix)) => ReprT (UnionMap phi f g r ix) where
+-- 	toRepT (m1 :&: m2) = (Reg.:*:) (toRepT m1) (toRepT m2)
+-- 	fromRepT ((Reg.:*:) m1 m2) = fromRepT m1 :&: fromRepT m2
+-- 	|])
+
+$(inferH [d|
+    instance (HTrieKeyT phi f (HTrieMapT phi f), HTrieKeyT phi g (HTrieMapT phi g)) => HTrieKeyT phi (f :+: g) (UnionMap phi f g) 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
+	sizeT pf s (m1 :&: m2) = sizeT pf s m1 + sizeT pf 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
+		| L k <- k	= case onKey L (lookupIxT pf s k m1) of
+			(lb, x, ub) -> (lb, x, ub <|> ((onKeyA R . onIndexA (+ sizeT pf s m1)) <$> getMin pf s m2))
+		| R k <- k	= case onIndex (sizeT pf s m1 +) (onKey R (lookupIxT pf s k m2)) of
+			(lb, x, ub) -> ((onKeyA L <$> getMax pf s m1) <|> lb, x, ub)
+			where	getMin pf s m = aboutT pf (\ k a -> return $ Asc 0 k a) m
+				getMax pf s m = aboutT pf (\ k a -> return $ Asc (sizeT pf s m - s a) k a) m
 	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
+		| i < s1	= case onKey L (assocAtT pf s i m1) of
+			(lb, x, ub) -> (lb, x, ub <|> ((onKeyA R . onIndexA (+ s1)) <$> getMin pf s m2))
+		| otherwise	= case onKey R (onIndex (s1 +) (assocAtT pf s (i - s1) m2)) of
+			(lb, x, ub) -> ((onKeyA L <$> getMax pf s m1) <|> lb, x, ub)
+		where	getMin pf s m = aboutT pf (\ k a -> return $ Asc 0 k a) m
+			getMax pf s m = aboutT pf (\ k a -> return $ Asc (sizeT pf s m - s a) k a) m
+			s1 = sizeT pf s m1
+{-	updateAtT pf s r f i (m1 :&: m2)
+		| not r && i >= lastIx m1
+			= m1 :&: updateAtT pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2
+		| i < s1
+			= updateAtT pf s r (\ i' -> f i' . L) i m1 :&: m2
+		| otherwise
+			= m1 :&: updateAtT pf s r (\ i' -> f (i' + s1) . R) (i - s1) m2
+		where	s1 = sizeT pf s m1
+			lastIx m = case extractMaxT pf s (\ _ v -> (v, Just v)) m of
+				Last (Just (v, _)) -> sizeT pf s m - s v
+				_			-> sizeT pf s m-}
 	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
@@ -63,22 +92,18 @@
 		= 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
+	extractT pf s f (m1 :&: m2) = second (:&: m2) <$> extractT pf s (f . L) m1 <|>
+		second (m1 :&:) <$> extractT pf s (f . R) m2
+-- 	extractMinT pf s f (m1 :&: m2) = second (:&: m2) <$> extractMinT pf s (f . L) m1 <|>
+-- 		second (m1 :&:) <$> extractMinT pf s (f . R) m2
+-- 	extractMaxT pf s f (m1 :&: m2) = second (:&: m2) <$> extractMaxT pf s (f . L) m1 <|>
+-- 		second (m1 :&:) <$> extractMaxT pf s (f . R) 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
@@ -86,36 +111,4 @@
 	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
+		(ys, zs) -> fromDistAscListT pf s ys :&: fromDistAscListT pf s zs |])
diff --git a/Data/TrieMap/MultiRec/UnitMap.hs b/Data/TrieMap/MultiRec/UnitMap.hs
--- a/Data/TrieMap/MultiRec/UnitMap.hs
+++ b/Data/TrieMap/MultiRec/UnitMap.hs
@@ -1,11 +1,14 @@
-{-# LANGUAGE KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances, TemplateHaskell, KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
 
-module Data.TrieMap.MultiRec.UnitMap where
+module Data.TrieMap.MultiRec.UnitMap () where
 
 import Data.TrieMap.MultiRec.Class
 import Data.TrieMap.MultiRec.Eq
 import Data.TrieMap.Applicative
 import Data.TrieMap.TrieKey
+-- import Data.TrieMap.Rep
+-- import Data.TrieMap.Rep.Instances
+-- import Data.TrieMap.Rep.TH
 
 import Control.Applicative
 import Control.Arrow
@@ -19,10 +22,18 @@
 
 import Prelude hiding (foldr, foldl)
 
-newtype UMap (phi :: * -> *) (r :: * -> *) a ix = UMap (Maybe (a ix))
+newtype UMap (phi :: * -> *) (r :: * -> *) ix a = UMap (Maybe a)
 type instance HTrieMapT phi U = UMap phi
 type instance HTrieMap phi (U r) = UMap phi r
 
+-- type instance RepT (UMap phi r ix) = RepT Maybe
+-- type instance Rep (UMap phi r ix a) = RepT Maybe (Rep a)
+-- 
+-- -- $(genRepT [d|
+--   instance ReprT (UMap phi r ix) where
+-- 	toRepT (UMap m) = toRepT m
+-- 	fromRepT = UMap . fromRepT |])
+
 instance HTrieKeyT phi U (UMap phi) where
 	emptyT = emptyH
 	nullT = nullH
@@ -30,7 +41,7 @@
 	lookupT = lookupH
 	lookupIxT = lookupIxH
 	assocAtT = assocAtH
-	updateAtT = updateAtH
+-- 	updateAtT = updateAtH
 	alterT = alterH
 	traverseWithKeyT = traverseWithKeyH
 	foldWithKeyT = foldWithKeyH
@@ -40,10 +51,11 @@
 	unionT = unionH
 	isectT = isectH
 	diffT = diffH
-	extractMinT = extractMinH
-	extractMaxT = extractMaxH
-	alterMinT = alterMinH
-	alterMaxT = alterMaxH
+	extractT = extractH
+-- 	extractMinT = extractMinH
+-- 	extractMaxT = extractMaxH
+-- 	alterMinT = alterMinH
+-- 	alterMaxT = alterMaxH
 	isSubmapT = isSubmapH
 	fromListT = fromListH
 	fromAscListT = fromAscListH
@@ -52,11 +64,15 @@
 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
+	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)
+	lookupIxH _ _ _ (UMap m) = (mempty, Asc 0 U <$> m, mempty)
+	assocAtH _ _ _ (UMap m) = (mempty, Asc 0 U <$> m, mempty)
+-- 	updateAtH _ s r f i (UMap m)
+-- 		| r == (i >= 0)
+-- 			= UMap (m >>= f 0 U)
+-- 		| otherwise
+-- 			= UMap m
 	alterH _ _ f _ (UMap m) = UMap (f m)
 	traverseWithKeyH _ _ f (UMap m) = UMap <$> traverse (f U) m
 	foldWithKeyH _ f (UMap m) z = foldr (f U) z m
@@ -66,12 +82,11 @@
 	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
+	extractH _ _ f (UMap m) = maybe empty (second UMap <.> f U) m
+-- 	extractMinH _ _ f (UMap m) = fmap (second UMap . f U) (First m)
+-- 	extractMaxH _ _ f (UMap m) = fmap (second UMap . f U) (Last m)
+-- 	alterMinH _ _ f (UMap m) = (UMap . f U) <$> (First m)
+-- 	alterMaxH _ _ f (UMap m) = (UMap . f U) <$> (Last m)
 	isSubmapH _ _ (UMap Nothing) _ = True
 	isSubmapH _ (<=) (UMap m1) (UMap m2) = subMaybe (<=) m1 m2
 	fromListH _ _ f xs = UMap (foldr (\ (_, a) -> Just . maybe a (f U a)) Nothing xs)
diff --git a/Data/TrieMap/OrdMap.hs b/Data/TrieMap/OrdMap.hs
--- a/Data/TrieMap/OrdMap.hs
+++ b/Data/TrieMap/OrdMap.hs
@@ -1,12 +1,16 @@
-{-# LANGUAGE Rank2Types, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances, TemplateHaskell, FlexibleContexts, TypeOperators, Rank2Types, PatternGuards, MultiParamTypeClasses, TypeFamilies #-}
 
-module Data.TrieMap.OrdMap (Ordered (..)) where
+module Data.TrieMap.OrdMap () where
 
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Sized
 import Data.TrieMap.Applicative
+import Data.TrieMap.Modifiers
+import Data.TrieMap.MultiRec.Base
+-- import Data.TrieMap.Rep
+-- import Data.TrieMap.Rep.TH
 
-import Control.Applicative (Applicative(..), (<$>))
+import Control.Applicative (Applicative(..), Alternative(..), (<$>))
 import Control.Arrow
 import Control.Monad hiding (join)
 
@@ -18,33 +22,45 @@
 
 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) 
+data OrdMap k a = Tip 
+              | Bin {-# UNPACK #-} !Int k (a) !(OrdMap k a) !(OrdMap k a) 
 
 type instance TrieMap (Ordered k) = OrdMap k
 
+-- type instance RepT (OrdMap k) = FamT KeyFam (HFix (U :+: (K Int :*: K k :*: X :*: A0 :*: A0)))
+-- type instance Rep (OrdMap k a) = RepT (OrdMap k) (Rep a)
+
+-- -- $(genRepT [d|
+--    instance ReprT (OrdMap k) where
+-- 	toRepT = FamT . toFix where
+-- 		toFix Tip = HIn (L U)
+-- 		toFix (Bin s kx x l r) = HIn (R (K s :*: K kx :*: X x :*: A0 (toFix l) :*: A0 (toFix r)))
+-- 	fromRepT (FamT x) = fromFix x where
+-- 		fromFix (HIn L{}) = Tip
+-- 		fromFix (HIn (R (K s :*: K kx :*: X x :*: A0 l :*: A0 r)))
+-- 			= Bin s kx x (fromFix l) (fromFix r) |])
+
 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)
+	lookupIxM s (Ord k) = onKey Ord . lookupIx s 0 k
+	assocAtM s i = onKey Ord . assocAt s 0 i
+-- 	updateAtM s r f = updateAt s 0 r (\ i -> f i . Ord)
 	alterM s f (Ord k) = alter s f k
 	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)
+	extractM s f m = extract s (f . Ord) m
+-- 	extractMinM _ _ Tip = mzero
+-- 	extractMinM s f m = return (deleteFindMin s (f . Ord) m)
+-- 	extractMaxM _ _ Tip = mzero
+-- 	extractMaxM s f m = return (deleteFindMax s (f . Ord) m)
+-- 	alterMinM s f = updateMin s (f . Ord)
+-- 	alterMaxM s f = updateMax s (f . Ord)
 	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]
@@ -59,44 +75,70 @@
 		(_, Tip) -> m1
 		_	 -> hedgeDiffWithKey s (f . Ord) (const LT) (const GT) m1 m2
 
-lookup :: Ord k => k -> OrdMap k a ix -> Maybe (a ix)
+lookup :: Ord k => k -> OrdMap k a -> Maybe (a)
 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
+lookupIx :: Ord k => Sized a -> Int -> k -> OrdMap k a -> IndexPos k a
+lookupIx _ i _ _ | i `seq` False = undefined
+lookupIx _ _ _ Tip = (mzero, mzero, mzero)
+lookupIx s i k (Bin sz kx x l r) = case compare k kx of
+	LT	-> case lookupIx s i k l of
+		(lb, ans, ub) -> (lb, ans, ub <|> return (Asc (i + size l) kx x))
+	EQ	-> (extractMax (\ k v -> Asc (i + size l - s v) k v) l,
+			return (Asc (i + size l) kx x),
+		    extractMin (Asc (i + sz - size r)) r)
+	GT	-> case lookupIx s (i + sz - size r) k r of
+		(lb, ans, ub) -> (return (Asc (i + size l) kx x) <|> lb, ans, ub)
+	where	extractMin f Tip = mzero
+		extractMin f b = return (fst $ deleteFindMin s (\ k x -> (f k x, Just x)) b)
+		extractMax f Tip = mzero
+		extractMax f b = return (fst $ deleteFindMax s (\ k x -> (f k x, Just x)) b)
 
-assocAt :: 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
+assocAt :: Sized a -> Int -> Int -> OrdMap k a -> IndexPos k a
+assocAt _ i0 i _ | i0 `seq` i `seq` False = undefined
+assocAt _ _ _ Tip = (mzero, mzero, mzero)
+assocAt s i0 i (Bin sz k a l r)
+	| i < sL, (lb, ans, ub) <- assocAt s i0 i l
+			= (lb, ans, ub <|> return (Asc (i0 + size l) k a))
+	| i < sK	= (extractMax (\ k v -> Asc (i0 + sL - s v) k v) l,
+				return (Asc (i0 + sL) k a),
+			   extractMin (Asc sK) r)
+	| (lb, ans, ub) <- assocAt s (i0 + sK) (i - sK) r
+			= (return (Asc (i0 + sL) k a) <|> lb, ans, ub)
 	where	sL = size l
 		sK = sz - size r
+		extractMin f Tip = mzero
+		extractMin f b = return (fst $ deleteFindMin s (\ k x -> (f k x, Just x)) b)
+		extractMax f Tip = mzero
+		extractMax f b = return (fst $ deleteFindMax s (\ k x -> (f k x, Just x)) b)
 
-updateAt :: Sized a -> (Int -> 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
+updateAt :: Sized a -> Int -> Round -> (Int -> k -> a -> Maybe (a)) -> Int -> OrdMap k a -> OrdMap k a
+updateAt _ i0 _ _ i _ | i0 `seq` i `seq` False = undefined
+updateAt _ _ _ _ _ Tip = Tip
+updateAt s i0 True f i (Bin sz k a l r)
+	| i < sL	= balance s k a (updateAt s i0 True f i l) r
+	| i < sK	= case f (i0 + sL) k a of
 		Nothing	-> glue s l r
 		Just a'	-> bin s k a' l r
-	| otherwise	= balance s k a l (updateAt s (f . (+ sK)) (i - sK) r)
+	| otherwise	= balance s k a l (updateAt s (i0 + sK) True f (i - sK) r)
 	where	sL = size l
 		sK = sz - size r 
+updateAt s i0 False f i (Bin sz k a l r)
+	| i < maxIxL	= balance s k a (updateAt s i0 False f i l) r
+	| i <= sL	= case f (i0 + sL) k a of
+		Nothing	-> glue s l r
+		Just a' -> bin s k a' l r
+	| otherwise	= balance s k a l (updateAt s (i0 + sK) False f (i - sK) r)
+	where	sL = size l
+		maxIxL = case l of	Tip	-> 0
+					_ 	-> fst (deleteFindMax s (\ _ a -> (size l - s a, Just a)) l)
+		sK = sz - size r
 
-alter :: Ord k => Sized a -> (Maybe (a ix) -> Maybe (a ix)) -> k -> OrdMap k a ix -> OrdMap k a ix
+alter :: Ord k => Sized a -> (Maybe (a) -> Maybe (a)) -> k -> OrdMap k a -> OrdMap k a
 alter s f k Tip = case f Nothing of
 	Nothing	-> Tip
 	Just x	-> singleton s k x
@@ -107,30 +149,30 @@
 		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 :: Sized a -> k -> a -> OrdMap k a
 singleton s k a = Bin (s a) k a Tip Tip
 
-traverseWithKey :: Applicative f => Sized b -> (k -> a ix -> f (b ix)) -> OrdMap k a ix -> f (OrdMap k b ix)
+traverseWithKey :: Applicative f => Sized b -> (k -> a -> f (b)) -> OrdMap k a -> f (OrdMap k b)
 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 :: (k -> a -> b -> b) -> OrdMap k a -> 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 :: (k -> b -> a -> b) -> OrdMap k a -> 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 :: Ord k => Sized b -> Sized c -> EitherMap k (a) (b) (c) ->
+	OrdMap k a -> (OrdMap k b, OrdMap k c)
 mapEither s1 s2 f m = case m of
 	Tip	-> (Tip, Tip)
 	Bin _ k a l r -> case (f k a, mapEither s1 s2 f l, mapEither s1 s2 f r) of
 		((aL, aR), (lL, lR), (rL, rR)) ->
 			(joinMaybe s1 k aL lL rL, joinMaybe s2 k aR lR rR)
 
-updateMin :: Ord k => Sized a -> (k -> a ix -> Maybe (a ix)) -> OrdMap k a ix -> OrdMap k a ix
+updateMin :: Ord k => Sized a -> (k -> a -> Maybe (a)) -> OrdMap k a -> OrdMap k a
 updateMin s f m = case m of
 	Tip	-> Tip
 	Bin _ k a Tip r -> case f k a of
@@ -138,7 +180,7 @@
 		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 :: Ord k => Sized a -> (k -> a -> Maybe (a)) -> OrdMap k a -> OrdMap k a
 updateMax s f m = case m of
 	Tip	-> Tip
 	Bin _ k a l Tip	-> case f k a of
@@ -146,7 +188,7 @@
 		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 :: Ord k => Sized a -> SplitMap (a) x -> k -> OrdMap k a -> (OrdMap k a, Maybe x, OrdMap k a)
 splitLookup s f k m = case m of
 	Tip	-> (Tip, Nothing, Tip)
 	Bin _ kx x l r -> case compare k kx of
@@ -158,7 +200,7 @@
 		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 :: Ord k => LEq (a) (b) -> LEq (OrdMap k a) (OrdMap k b)
 isSubmap (<=) Tip _ = True
 isSubmap (<=) _ Tip = False
 isSubmap (<=) (Bin _ kx x l r) t = case found of
@@ -166,7 +208,7 @@
 	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 :: Eq k => Sized a -> (k -> a -> a -> a) -> [(k, a)] -> OrdMap k a
 fromAscList s f xs = fromDistinctAscList s (combineEq xs) where
 	combineEq (x:xs) = combineEq' x xs
 	combineEq [] = []
@@ -176,7 +218,7 @@
 		| 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 :: Sized a -> [(k, a)] -> OrdMap k a
 fromDistinctAscList s xs = build const (length xs) xs
   where
     -- 1) use continutations so that we use heap space instead of stack space.
@@ -196,9 +238,9 @@
     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))
+                  => Sized a -> (k -> a -> a -> Maybe (a))
                   -> (k -> Ordering) -> (k -> Ordering)
-                  -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+                  -> OrdMap k a -> OrdMap k a -> OrdMap k a
 hedgeUnionWithKey _ _ _     _     t1 Tip
   = t1
 hedgeUnionWithKey s _ cmplo cmphi Tip (Bin _ kx x l r)
@@ -214,7 +256,7 @@
                     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 :: Ord k => Sized a -> (k -> Ordering) -> OrdMap k a -> OrdMap k a
 filterGt _ _   Tip = Tip
 filterGt s cmp (Bin _ kx x l r)
   = case cmp kx of
@@ -222,7 +264,7 @@
       GT -> filterGt s cmp r
       EQ -> r
       
-filterLt :: Ord k => Sized a -> (k -> Ordering) -> OrdMap k a ix -> OrdMap k a ix
+filterLt :: Ord k => Sized a -> (k -> Ordering) -> OrdMap k a -> OrdMap k a
 filterLt _ _   Tip = Tip
 filterLt s cmp (Bin _ kx x l r)
   = case cmp kx of
@@ -230,7 +272,7 @@
       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 :: (k -> Ordering) -> (k -> Ordering) -> OrdMap k a -> OrdMap k a
 trim _     _     Tip = Tip
 trim cmplo cmphi t@(Bin _ kx _ l r)
   = case cmplo kx of
@@ -239,7 +281,7 @@
               _  -> 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 :: Ord k => k -> (k -> Ordering) -> OrdMap k a -> (Maybe (k,a), OrdMap k a)
 trimLookupLo _  _     Tip = (Nothing,Tip)
 trimLookupLo lo cmphi t@(Bin _ kx x l r)
   = case compare lo kx of
@@ -249,7 +291,7 @@
       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 :: Ord k => Sized c -> IsectFunc k (a) (b) (c) -> OrdMap k a -> OrdMap k b -> OrdMap k c
 isect s f Tip _ = Tip
 isect s f _ Tip = Tip
 isect s f t1@(Bin _ k1 x1 l1 r1) t2@(Bin _ k2 x2 l2 r2) =
@@ -260,9 +302,9 @@
 
 
 hedgeDiffWithKey :: Ord k
-                 => Sized a -> (k -> a ix -> b ix -> Maybe (a ix))
+                 => Sized a -> (k -> a -> b -> Maybe (a))
                  -> (k -> Ordering) -> (k -> Ordering)
-                 -> OrdMap k a ix -> OrdMap k b ix -> OrdMap k a ix
+                 -> OrdMap k a -> OrdMap k b -> OrdMap k a
 hedgeDiffWithKey _ _ _     _     Tip _
   = Tip
 hedgeDiffWithKey s _ cmplo cmphi (Bin _ kx x l r) Tip
@@ -281,10 +323,10 @@
     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 :: Ord k => Sized a -> k -> Maybe (a) -> OrdMap k a -> OrdMap k a -> OrdMap k a
 joinMaybe s kx = maybe (merge s) (join s kx)
 
-join :: Ord k => Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+join :: Ord k => Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 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)
@@ -294,7 +336,7 @@
 
 
 -- 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,insertMin :: Sized a -> k -> a -> OrdMap k a -> OrdMap k a
 insertMax s kx x t
   = case t of
       Tip -> singleton s kx x
@@ -310,7 +352,7 @@
 {--------------------------------------------------------------------
   [merge l r]: merges two trees.
 --------------------------------------------------------------------}
-merge :: Sized a -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+merge :: Sized a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 merge _ Tip r   = r
 merge _ l Tip   = l
 merge s l@(Bin sizeL kx x lx rx) r@(Bin sizeR ky y ly ry)
@@ -322,36 +364,43 @@
   [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 :: Sized a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 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'
+  | size l > size r = let (f,l') = deleteFindMax s (\ k a -> (balance s k a, Nothing)) l in f l' r
+  | otherwise       = let (f,r') = deleteFindMin s (\ k a -> (balance s k a, Nothing)) r in f l r'
 
-deleteFindMin :: Sized a -> OrdMap k a ix -> ((k, a ix), OrdMap k a ix)
-deleteFindMin s t 
+extract :: Alternative t => Sized a -> (k -> a -> t (z, Maybe a)) -> OrdMap k a -> t (z, OrdMap k a)
+extract s f t = case t of
+	Bin _ k x l r -> 
+		second (\ l' -> balance s k x l' r) <$> extract s f l <|>
+		second (maybe (glue s l r) (\ x' -> balance s k x' l r))  <$> f k x <|>
+		second (balance s k x l) <$> extract s f r
+
+deleteFindMin :: Sized a -> (k -> a -> (x, Maybe a)) -> OrdMap k a -> (x, OrdMap k a)
+deleteFindMin s f 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)
+      Bin _ k x Tip r -> let (ans, x') = f k x in (ans, maybe r (\ y' -> bin s k y' Tip r) x')
+      Bin _ k x l r   -> let (km,l') = deleteFindMin s f 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
+deleteFindMax :: Sized a -> (k -> a -> (x, Maybe a)) -> OrdMap k a -> (x, OrdMap k a)
+deleteFindMax s f 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')
+      Bin _ k x l Tip -> let (ans, x') = f k x in (ans, maybe l (\ y -> bin s k y l Tip) x')
+      Bin _ k x l r   -> let (km,r') = deleteFindMax s f 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 :: OrdMap k a -> 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 :: Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 balance s k x l r
   | sizeL + sizeR <= 1    = Bin sizeX k x l r
   | sizeR >= delta*sizeL  = rotateL s k x l r
@@ -363,31 +412,31 @@
     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 :: Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 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 :: Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 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, singleR :: Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 singleL s k1 x1 t1 (Bin _ k2 x2 t2 t3)  = bin s k2 x2 (bin s k1 x1 t1 t2) t3
 singleL s k1 x1 t1 Tip = bin s k1 x1 t1 Tip
 singleR s k1 x1 (Bin _ k2 x2 t1 t2) t3  = bin s k2 x2 t1 (bin s k1 x1 t2 t3)
 singleR s k1 x1 Tip t2 = bin s k1 x1 Tip t2
 
-doubleL, doubleR :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+doubleL, doubleR :: Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 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 s k1 x1 t1 t2 = singleL s k1 x1 t1 t2
 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 s k1 x1 t1 t2 = singleR s k1 x1 t1 t2
 
-bin :: Sized a -> k -> a ix -> OrdMap k a ix -> OrdMap k a ix -> OrdMap k a ix
+bin :: Sized a -> k -> a -> OrdMap k a -> OrdMap k a -> OrdMap k a
 bin s k x l r
   = Bin (size l + size r + s x) k x l r
diff --git a/Data/TrieMap/Regular/Base.hs b/Data/TrieMap/Regular/Base.hs
--- a/Data/TrieMap/Regular/Base.hs
+++ b/Data/TrieMap/Regular/Base.hs
@@ -10,12 +10,16 @@
 data (f :*: g) r = f r :*: g r deriving (Show)
 data (f :+: g) r = L (f r) | R (g r) deriving (Show)
 newtype L f r = List [f r] deriving (Show)
+newtype (f `O` g) r = O (f (g r))
 newtype Reg r = Reg {unReg :: r} deriving (Show)
 
 newtype Fix f = In {out :: f (Fix f)}
 
 type family PF a :: * -> *
 
+instance (Functor f, Functor g) => Functor (f `O` g) where
+	fmap f (O x) = O (fmap (fmap f) x)
+
 class Regular a where
 	from :: a -> PF a a
 	to :: PF a a -> a
@@ -60,3 +64,8 @@
 
 infixr 7 :*:
 infixr 6 :+:
+
+partEithers :: [((f :+: g) r, a)] -> ([(f r, a)], [(g r, a)])
+partEithers = foldr part ([], []) where
+	part (L k, a) (xs, ys) = ((k, a):xs, ys)
+	part (R k, a) (xs, ys) = (xs, (k, a):ys)
diff --git a/Data/TrieMap/Regular/Class.hs b/Data/TrieMap/Regular/Class.hs
--- a/Data/TrieMap/Regular/Class.hs
+++ b/Data/TrieMap/Regular/Class.hs
@@ -12,58 +12,76 @@
 
 import Control.Applicative
 
-type family TrieMapT (f :: * -> *) :: * -> (* -> *) -> * -> *
+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
+class OrdT f => TrieKeyT (f :: * -> *) (m :: * -> * -> *) | m -> f, f -> m where
+	emptyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => m k a
+	nullT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => m k a -> Bool
+	sizeT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> m k a -> Int
+	lookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => f k -> m k a -> Maybe (a)
+	lookupIxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> f k -> m k a -> IndexPos (f k) a
+	assocAtT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> Int -> m k a -> IndexPos (f k) a
+-- 	updateAtT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> Round -> (Int -> f k -> a -> Maybe (a)) -> Int -> m k a -> m k a
+	alterT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (Maybe (a) -> Maybe (a)) -> f k -> m k a -> m k a
 	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)
+		Sized b -> (f k -> a -> t (b)) -> m k a -> t (m k b)
 	foldWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => 
-		(f k -> a ix -> b -> b) -> m k a ix -> b -> b
+		(f k -> a -> b -> b) -> m k a -> b -> b
 	foldlWithKeyT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) =>
-		(f k -> b -> a ix -> b) -> m k a ix -> b -> b
+		(f k -> b -> a -> b) -> m k a -> b -> b
 	mapEitherT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => 
-		Sized b -> Sized c -> EitherMap (f k) (a 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
+		Sized b -> Sized c -> EitherMap (f k) (a) (b) (c) -> m k a -> (m k b, m k c)
+	splitLookupT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> SplitMap (a) x -> f k ->
+		m k a -> (m k a, Maybe x, m k a)
+	unionT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> UnionFunc (f k) (a) ->
+		m k a -> m k a -> m k a
+	isectT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized c -> IsectFunc (f k) (a) (b) (c) ->
+		m k a -> m k b -> m k c
+	diffT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> DiffFunc (f k) (a) (b) ->
+		m k a -> m k b -> m k a
+	extractT :: (TrieMapT f ~ m, TrieKey k (TrieMap k), Alternative t) => 
+		Sized a -> ExtractFunc t (m k a) (f k) a x
+-- 	extractMinT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> ExtractFunc (f k) First a (m k a) x
+-- 	extractMaxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> ExtractFunc (f k) Last a (m k a) x
+-- 	alterMinT, alterMaxT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (f k -> a -> Maybe (a)) ->
+-- 		m k a -> m k a
+	isSubmapT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => LEq (a) (b) -> LEq (m k a) (m k b)
+	fromListT, fromAscListT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> (f k -> a -> a -> a) ->
+		[(f k, a)] -> m k a
+	fromDistAscListT :: (TrieMapT f ~ m, TrieKey k (TrieMap k)) => Sized a -> [(f k, a)] -> m k a
 	fromListT s f = foldr (\ (k, a) -> alterT s (Just . maybe a (f k a)) k) emptyT
 	fromAscListT = fromListT
 	fromDistAscListT s = fromAscListT s (const const)
-	updateAtT s f i m = case assocAtT s i m of
-		(i, k, a) -> alterT s (const (f i k a)) k m
+-- 	updateAtT s f i m = case assocAtT s i m of
+-- 		(i, k, a) -> alterT s (const (f i k a)) k m
 
-guardNullT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a ix -> Maybe (TrieMapT f k a ix)
+-- mapWithKeyT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
+-- 	Sized b -> (f k -> a -> b) -> TrieMapT f k a -> TrieMapT f k b
+-- mapWithKeyT s f m = unId (traverseWithKeyT s (\ k a -> Id (f k a)) m)
+
+guardNullT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a -> Maybe (TrieMapT f k a)
 guardNullT m
 	| nullT m	= Nothing
 	| otherwise	= Just m
 
-assocsT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a ix -> [(f k, a ix)]
+assocsT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => TrieMapT f k a -> [(f k, a)]
 assocsT m = foldWithKeyT (\ k a -> ((k, a):)) m []
 
-singletonT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> f k -> a ix -> TrieMapT f k a ix
+singletonT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> f k -> a -> TrieMapT f k a
 singletonT s k a = alterT s (const (Just a)) k emptyT
 
 mapWithKeyT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 
-	Sized b -> (f k -> a ix -> b ix) -> TrieMapT f k a ix -> TrieMapT f k b ix
+	Sized b -> (f k -> a -> b) -> TrieMapT f k a -> TrieMapT f k b
 mapWithKeyT s f m = unId (traverseWithKeyT s (Id .: f) m)
+
+aboutT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) =>
+	(f k -> a -> t z) -> TrieMapT f k a -> t z
+aboutT f m = fst <$> extractT (const 0) (\ k a -> fmap (flip (,) Nothing) (f k a)) m
+
+{-alterMinT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
+	Sized a -> (f k -> a -> Maybe a) -> TrieMapT f k a -> TrieMapT f k a
+alterMinT s f m = maybe m snd (getFirst (extractMinT s (\ k a -> ((), f k a)) m))
+
+alterMaxT :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
+	Sized a -> (f k -> a -> Maybe a) -> TrieMapT f k a -> TrieMapT f k a-}
+-- alterMaxT s f m = maybe m snd (getLast (extractMaxT s (\ k a -> ((), f k a)) m))
diff --git a/Data/TrieMap/Regular/CompMap.hs b/Data/TrieMap/Regular/CompMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/CompMap.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE TemplateHaskell, PatternGuards, UndecidableInstances, FlexibleContexts, TypeOperators, TypeFamilies, MultiParamTypeClasses #-}
+
+module Data.TrieMap.Regular.CompMap () where
+
+import Data.TrieMap.Regular.Base
+import Data.TrieMap.Regular.Class
+import Data.TrieMap.Regular.Ord
+import Data.TrieMap.Regular.Eq
+import Data.TrieMap.Regular.TH
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Rep
+import Data.TrieMap.Rep.TH
+
+import Control.Applicative
+import Control.Arrow
+
+import Prelude hiding (lookup)
+
+newtype CompMap m g k a = CMap (m (App g k) a)
+newtype App f a = A {unA :: f a}
+newtype AppMap m k a = AMap (m k a)
+
+type instance TrieMapT (App f) = AppMap (TrieMapT f)
+type instance TrieMap (App f r) = AppMap (TrieMapT f) r
+type instance TrieMapT (f `O` g) = CompMap (TrieMapT f) g
+type instance TrieMap ((f `O` g) r) = CompMap (TrieMapT f) g r
+
+instance EqT f => EqT (App f) where
+	eqT0 (==) (A a) (A b) = eqT0 (==) a b
+
+instance OrdT f => OrdT (App f) where
+	compareT0 cmp (A a) (A b) = compareT0 cmp a b
+
+instance (EqT f, Eq r) => Eq (App f r) where
+	(==) = eqT
+
+instance (OrdT f, Ord g) => Ord (App f g) where
+	compare = compareT
+
+$(deriveM [d|
+   instance (TrieKeyT f m, Functor f, TrieKeyT g (TrieMapT g)) => TrieKeyT (f `O` g) (CompMap m g) where
+	emptyT = CMap emptyT
+	nullT (CMap m) = nullT m
+	sizeT s (CMap m) = sizeT s m
+	lookupT (O x) (CMap m) = lookupT (fmap A x) m
+	lookupIxT s (O x) (CMap m) = onKey (O . fmap unA) (lookupIxT s (fmap A x) m)
+	assocAtT s i (CMap m) = onKey (O . fmap unA) (assocAtT s i m)
+-- 	updateAtT s r f i (CMap m)
+-- 		= CMap (updateAtT s r (\ i' -> f i' . O . fmap unA) i m)
+	alterT s f (O x) (CMap m) = CMap (alterT s f (fmap A x) m)
+	traverseWithKeyT s f (CMap m) = CMap <$> traverseWithKeyT s (f . O . fmap unA) m
+	foldWithKeyT f (CMap m) = foldWithKeyT (f . O . fmap unA) m
+	foldlWithKeyT f (CMap m) = foldlWithKeyT (f . O . fmap unA) m
+	mapEitherT s1 s2 f (CMap m) = (CMap *** CMap) (mapEitherT s1 s2 (f . O . fmap unA) m)
+	splitLookupT s f (O k) (CMap m) = CMap `sides` splitLookupT s f (fmap A k) m
+	isSubmapT (<=) (CMap m1) (CMap m2) = isSubmapT (<=) m1 m2
+	extractT s f (CMap m) = second CMap <$> extractT s (f . O . fmap unA) m
+-- 	extractMinT s f (CMap m) = second CMap <$> extractMinT s (f . O . fmap unA) m
+-- 	extractMaxT s f (CMap m) = second CMap <$> extractMaxT s (f . O . fmap unA) m
+-- 	alterMinT s f (CMap m) = CMap (alterMinT s (f . O . fmap unA) m)
+-- 	alterMaxT s f (CMap m) = CMap (alterMaxT s (f . O . fmap unA) m)
+	unionT s f (CMap m1) (CMap m2) = CMap (unionT s (f . O . fmap unA) m1 m2)
+	isectT s f (CMap m1) (CMap m2) = CMap (isectT s (f . O . fmap unA) m1 m2)
+	diffT s f (CMap m1) (CMap m2) = CMap (diffT s (f . O . fmap unA) m1 m2) |])
+
+$(deriveM [d| 
+   instance TrieKeyT f m => TrieKeyT (App f) (AppMap m) where
+	emptyT = AMap emptyT
+	nullT (AMap m) = nullT m
+	sizeT s (AMap m) = sizeT s m
+	lookupT (A k) (AMap m) = lookupT k m
+	lookupIxT s (A k) (AMap m) = onKey A (lookupIxT s k m)
+	assocAtT s i (AMap m) = onKey A (assocAtT s i m)
+-- 	updateAtT s r f i (AMap m) = AMap (updateAtT s r (\ i' -> f i' . A) i m)
+	alterT s f (A k) (AMap m) = AMap (alterT s f k m)
+	traverseWithKeyT s f (AMap m) = AMap <$> traverseWithKeyT s (f . A) m
+	foldWithKeyT f (AMap m) = foldWithKeyT (f . A) m
+	foldlWithKeyT f (AMap m) = foldlWithKeyT (f . A) m
+	mapEitherT s1 s2 f (AMap m) = (AMap *** AMap) (mapEitherT s1 s2 (f . A) m)
+	splitLookupT s f (A k) (AMap m) = AMap `sides` splitLookupT s f k m
+	extractT s f (AMap m) = second AMap <$> extractT s (f . A) m
+-- 	extractMinT s f (AMap m) = second AMap <$> extractMinT s (f . A) m
+-- 	extractMaxT s f (AMap m) = second AMap <$> extractMaxT s (f . A) m
+-- 	alterMinT s f (AMap m) = AMap (alterMinT s (f . A) m)
+-- 	alterMaxT s f (AMap m) = AMap (alterMaxT s (f . A) m)
+	unionT s f (AMap m1) (AMap m2) = AMap (unionT s (f . A) m1 m2)
+	isectT s f (AMap m1) (AMap m2) = AMap (isectT s (f . A) m1 m2)
+	diffT s f (AMap m1) (AMap m2) = AMap (diffT s (f . A) m1 m2)
+	isSubmapT (<=) (AMap m1) (AMap m2) = isSubmapT (<=) m1 m2 |])
diff --git a/Data/TrieMap/Regular/ConstMap.hs b/Data/TrieMap/Regular/ConstMap.hs
--- a/Data/TrieMap/Regular/ConstMap.hs
+++ b/Data/TrieMap/Regular/ConstMap.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TypeFamilies, MultiParamTypeClasses, UndecidableInstances #-}
 
-module Data.TrieMap.Regular.ConstMap where
+module Data.TrieMap.Regular.ConstMap() where
 
 import Data.TrieMap.Regular.Class
 import Data.TrieMap.Regular.Base
@@ -12,24 +12,18 @@
 
 -- import Data.Monoid
 
-newtype KMap m k (a :: * -> *) ix = KMap (m a ix)
+newtype KMap m k a = KMap (m a)
 type instance TrieMapT (K0 a) = KMap (TrieMap a)
 type instance TrieMap (K0 a r) = TrieMapT (K0 a) r
-type instance PF (KMap m k a ix) = PF (m a ix)
 
-instance (Regular (m a ix), Functor (PF (m a ix))) => Regular (KMap m k a ix) where
-	from (KMap m) = fmap KMap (from m)
-	to = KMap . to . fmap (\ (KMap m) -> m)
-
 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)
+	lookupIxM s (K0 k) (KMap m) = onKey K0 (lookupIxM s k m)
+	assocAtM s i (KMap m) = onKey K0 (assocAtM s i m)
+-- 	updateAtM s r f i (KMap m) = KMap (updateAtM s r (\ i -> f i . K0) i m)
 	alterM s f (K0 k) (KMap m) = KMap (alterM s f k m)
 	traverseWithKeyM s f (KMap m) = KMap <$> traverseWithKeyM s (f . K0) m
 	foldWithKeyM f (KMap m) = foldWithKeyM (f . K0) m
@@ -39,10 +33,11 @@
 	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)
+	extractM s f (KMap m) = second KMap <$> extractM s (f . K0) m
+-- 	extractMinM s f (KMap m) = second KMap <$> extractMinM s (f . K0) m
+-- 	extractMaxM s f (KMap m) = second KMap <$> extractMaxM s (f . K0) m
+-- 	alterMinM s f (KMap m) = KMap (alterMinM s (f . K0) m) 
+-- 	alterMaxM s f (KMap m) = KMap (alterMaxM s (f . K0) m)
 	isSubmapM (<=) (KMap m1) (KMap m2) = isSubmapM (<=) m1 m2
 	fromListM s f xs = KMap (fromListM s (f . K0) [(k, a) | (K0 k, a) <- xs])
 	fromAscListM s f xs = KMap (fromAscListM s (f . K0) [(k, a) | (K0 k, a) <- xs])
@@ -55,7 +50,7 @@
 	lookupT = lookupM
 	lookupIxT = lookupIxM
 	assocAtT = assocAtM
-	updateAtT = updateAtM
+-- 	updateAtT = updateAtM
 	alterT = alterM
 	traverseWithKeyT = traverseWithKeyM
 	foldWithKeyT = foldWithKeyM
@@ -65,10 +60,11 @@
 	unionT = unionM
 	isectT = isectM
 	diffT = diffM
-	extractMinT = extractMinM
-	extractMaxT = extractMaxM
-	alterMinT = alterMinM
-	alterMaxT = alterMaxM
+	extractT = extractM
+-- 	extractMinT = extractMinM
+-- 	extractMaxT = extractMaxM
+-- 	alterMinT = alterMinM
+-- 	alterMaxT = alterMaxM
 	isSubmapT = isSubmapM
 	fromListT = fromListM
 	fromAscListT = fromAscListM
diff --git a/Data/TrieMap/Regular/Eq.hs b/Data/TrieMap/Regular/Eq.hs
--- a/Data/TrieMap/Regular/Eq.hs
+++ b/Data/TrieMap/Regular/Eq.hs
@@ -1,8 +1,11 @@
-{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeOperators #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances, TypeOperators #-}
 
 module Data.TrieMap.Regular.Eq where
 
 import Data.TrieMap.Regular.Base
+import Data.TrieMap.MultiRec.Base(FamT(..), KeyFam(..))
+import Data.TrieMap.MultiRec.Eq(HEq0(..))
+import Data.TrieMap.Modifiers
 
 class EqT f where
 	eqT0 :: (a -> a -> Bool) -> f a -> f a -> Bool
@@ -54,6 +57,12 @@
 instance (EqT f, EqT g, Eq r) => Eq ((f :+: g) r) where
 	(==) = eqT
 
+instance (EqT f, EqT g) => EqT (f `O` g) where
+	eqT0 (==) (O x) (O y) = eqT0 (eqT0 (==)) x y
+
+instance (EqT f, EqT g, Eq r) => Eq ((f `O` g) r) where
+	(==) = eqT
+
 instance Eq a => Eq (K0 a r) where
 	K0 a == K0 b = a == b
 
@@ -62,3 +71,17 @@
 
 instance Eq (U0 r) where
 	_ == _ = True
+
+instance Eq a => EqT ((,) a) where
+	eqT0 (=#=) (a, b) (c, d) = a == c && b =#= d
+
+instance Eq a => EqT (Either a) where
+	eqT0 _ (Left a) (Left b) = a == b
+	eqT0 (==) (Right a) (Right b) = a == b
+	eqT0 _ _ _ = False
+
+instance EqT Ordered where
+	eqT0 (==) (Ord x) (Ord y) = x == y
+
+instance EqT Rev where
+	eqT0 (==) (Rev x) (Rev y) = y == x
diff --git a/Data/TrieMap/Regular/IdMap.hs b/Data/TrieMap/Regular/IdMap.hs
--- a/Data/TrieMap/Regular/IdMap.hs
+++ b/Data/TrieMap/Regular/IdMap.hs
@@ -10,7 +10,7 @@
 import Control.Arrow
 import Control.Monad
 
-newtype IMap k a ix = IMap (TrieMap k a ix)
+newtype IMap k a = IMap (TrieMap k a)
 type instance TrieMapT I0 = IMap
 type instance TrieMap (I0 k) = IMap k
 
@@ -19,10 +19,9 @@
 	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)
+	lookupIxT s (I0 k) (IMap m) = onKey I0 (lookupIxM s k m)
+	assocAtT s i (IMap m) = onKey I0 (assocAtM s i m)
+-- 	updateAtT s r f i (IMap m) = IMap (updateAtM s r (\ i -> f i . I0) i m)
 	alterT s f (I0 k) (IMap m) = IMap (alterM s f k m)
 	traverseWithKeyT s f (IMap m) = IMap <$> traverseWithKeyM s (f . I0) m
 	foldWithKeyT f (IMap m) = foldWithKeyM (f . I0) m
@@ -32,10 +31,11 @@
 	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)
+	extractT s f (IMap m) = second IMap <$> extractM s (f . I0) m
+-- 	extractMinT s f (IMap m) = second IMap <$> extractMinM s (f . I0) m
+-- 	extractMaxT s f (IMap m) = second IMap <$> extractMaxM s (f . I0) m
+-- 	alterMinT s f (IMap m) = IMap (alterMinM s (f . I0) m)
+-- 	alterMaxT s f (IMap m) = IMap (alterMaxM s (f . I0) m)
 	isSubmapT (<=) (IMap m1) (IMap m2) = isSubmapM (<=) m1 m2
 	fromListT s f xs = IMap (fromListM s (f . I0) [(k, a) | (I0 k, a) <- xs])
 	fromAscListT s f xs = IMap (fromAscListM s (f . I0) [(k, a) | (I0 k, a) <- xs])
@@ -48,7 +48,7 @@
 	lookupM = lookupT
 	lookupIxM = lookupIxT
 	assocAtM = assocAtT
-	updateAtM = updateAtT
+-- 	updateAtM = updateAtT
 	alterM = alterT
 	traverseWithKeyM = traverseWithKeyT
 	foldWithKeyM = foldWithKeyT
@@ -58,10 +58,11 @@
 	unionM = unionT
 	isectM = isectT
 	diffM = diffT
-	extractMinM = extractMinT
-	extractMaxM = extractMaxT
-	alterMinM = alterMinT
-	alterMaxM = alterMaxT
+	extractM = extractT
+-- 	extractMinM = extractMinT
+-- 	extractMaxM = extractMaxT
+-- 	alterMinM = alterMinT 
+-- 	alterMaxM = alterMaxT
 	isSubmapM = isSubmapT
 	fromListM = fromListT
 	fromAscListM = fromAscListT
diff --git a/Data/TrieMap/Regular/Instances.hs b/Data/TrieMap/Regular/Instances.hs
--- a/Data/TrieMap/Regular/Instances.hs
+++ b/Data/TrieMap/Regular/Instances.hs
@@ -7,3 +7,5 @@
 import Data.TrieMap.Regular.RadixTrie
 import Data.TrieMap.Regular.IdMap
 import Data.TrieMap.Regular.RegMap
+import Data.TrieMap.Regular.CompMap
+import Data.TrieMap.Regular.Rep
diff --git a/Data/TrieMap/Regular/Ord.hs b/Data/TrieMap/Regular/Ord.hs
--- a/Data/TrieMap/Regular/Ord.hs
+++ b/Data/TrieMap/Regular/Ord.hs
@@ -1,10 +1,13 @@
-{-# LANGUAGE UndecidableInstances, FlexibleContexts, TypeOperators #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, FlexibleContexts, TypeOperators #-}
 
 module Data.TrieMap.Regular.Ord where
 
 import Data.TrieMap.Regular.Base
 import Data.TrieMap.Regular.Eq
-
+import Data.TrieMap.MultiRec.Base(FamT(..), KeyFam(..))
+import Data.TrieMap.MultiRec.Ord(HOrd0(..))
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Modifiers
 import Data.Monoid
 
 type Comparator a = a -> a -> Ordering
@@ -15,6 +18,9 @@
 compareT :: (OrdT f, Ord a) => Comparator (f a)
 compareT = compareT0 compare
 
+-- instance HOrd0 KeyFam r => OrdT (FamT KeyFam r) where
+	
+
 instance Ord a => OrdT (K0 a) where
 	compareT0 _ (K0 a) (K0 b) = compare a b
 
@@ -33,6 +39,12 @@
 instance (OrdT f, OrdT g, Ord r) => Ord ((f :*: g) r) where
 	compare = compareT
 
+instance (OrdT f, OrdT g) => OrdT (f `O` g) where
+	compareT0 cmp (O x) (O y) = compareT0 (compareT0 cmp) x y
+
+instance (OrdT f, OrdT g, Ord r) => Ord ((f `O` g) r) where
+	compare = compareT
+
 instance (OrdT f, OrdT g) => OrdT (f :+: g) where
 	compareT0 cmp x y = case (x, y) of
 		(L x, L y)	-> compareT0 cmp x y
@@ -69,3 +81,19 @@
 
 instance (Regular a, Functor (PF a), OrdT (PF a)) => Ord (Reg a) where
 	compare a b = compareT (from' a) (from' b)
+
+instance Ord a => OrdT ((,) a) where
+	compareT0 cmp (a, b) (c, d) = compare a c `mappend` cmp b d
+	
+instance Ord a => OrdT (Either a) where
+	compareT0 cmp x y = case (x, y) of
+		(Left a, Left b) -> compare a b
+		(Right a, Right b) -> cmp a b
+		(Left{}, Right{}) -> LT
+		(Right{}, Left{}) -> GT
+
+instance OrdT Rev where
+	compareT0 cmp (Rev x) (Rev y) = cmp y x
+
+instance OrdT Ordered where
+	compareT0 cmp (Ord x) (Ord y) = cmp x y
diff --git a/Data/TrieMap/Regular/ProdMap.hs b/Data/TrieMap/Regular/ProdMap.hs
--- a/Data/TrieMap/Regular/ProdMap.hs
+++ b/Data/TrieMap/Regular/ProdMap.hs
@@ -1,41 +1,81 @@
-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleContexts,  TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE TemplateHaskell, PatternGuards, TypeFamilies, MultiParamTypeClasses, FlexibleContexts,  TypeOperators, UndecidableInstances #-}
 
 module Data.TrieMap.Regular.ProdMap() where
 
 import Data.TrieMap.Regular.Class
 import Data.TrieMap.Regular.Base
+import Data.TrieMap.Regular.Eq
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Applicative
+import Data.TrieMap.Sized
+import Data.TrieMap.Regular.TH
 
 import Control.Applicative
 import Control.Arrow
 
 import Data.Maybe
+import Data.Monoid
+import Data.Sequence (Seq, (|>))
+import qualified Data.Sequence as Seq
+import Data.Foldable
 
-newtype PMap m1 (m2 :: * -> (* -> *) -> * -> *) k (a :: * -> *) ix = PMap (m1 k (m2 k a) ix)
+newtype PMap m1 (m2 :: * -> * -> *) k a = PMap (m1 k (m2 k a))
 type instance TrieMapT (f :*: g) = PMap (TrieMapT f) (TrieMapT g)
 type instance TrieMap ((f :*: g) r) = TrieMapT (f :*: g) r
 
-type instance PF (PMap m1 m2 k a ix) = PF (m1 k (m2 k a) ix)
+lastIx :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> TrieMapT f k a -> Int
+lastIx s m = fromMaybe (sizeT s m) (getLast (aboutT (\ _ a -> return $ sizeT s m - s a) m))
 
-instance (Regular (m1 k (m2 k a) ix), Functor (PF (m1 k (m2 k a) ix))) => Regular (PMap m1 m2 k a ix) where
-	from (PMap m) = fmap PMap (from m)
-	to = PMap . to . fmap (\ (PMap m) -> m)
+--maybe (sizeT s m) fst (getLast (extractMaxT s (\ _ a -> (sizeT s m - s a, Just a)) m))
 
-instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :*: g) (PMap m1 m2) where
+$(deriveM [d|
+   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)
+	lookupIxT s (a :*: b) (PMap m) = case lookupIxT (sizeT s) a m of
+		(lb, x, ub) -> let lookupX = do	Asc i' a' m' <- x
+						let (lb', x', ub') = lookupIxT s b m'
+						let f = onKeyA (a' :*:) . onIndexA (i' +)
+						return (f <$> lb', f <$> x', f <$> ub')
+			in ((do	Asc iL aL mL <- lb
+				fmap (onKeyA (aL :*:) . onIndexA (iL +)) (getMax s mL)) <|>
+			    (do	(lb', _, _) <- Last lookupX
+			    	lb'),
+			    (do	(_, x', _) <- lookupX
+			    	x'),
+			    (do	(_, _, ub') <- First lookupX
+			    	ub') <|>
+			    (do Asc iR aR mR <- ub
+			    	fmap (onKeyA (aR :*:) . onIndexA (iR +)) (getMin s mR))) 
+		where	getMin s m = aboutT (\ k a -> return (Asc 0 k a)) m
+			getMax s m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m
 	assocAtT s i (PMap m) = case assocAtT (sizeT s) i m of
-		(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)
+		(lb, x, ub) -> let lookupX = do	Asc i' a' m' <- x
+						let (lb', x', ub') = assocAtT s (i - i') m'
+						let f = onKeyA (a' :*:) . onIndexA (i' +)
+						return (f <$> lb', f <$> x', f <$> ub')
+			in ((do	Asc iL aL mL <- lb
+				fmap (onKeyA (aL :*:) . onIndexA (iL +)) (getMax mL)) <|>
+			    (do	(lb', _, _) <- Last lookupX
+			    	lb'),
+			    (do	(_, x', _) <- lookupX
+			    	x'),
+			    (do	(_, _, ub') <- First lookupX
+			    	ub') <|>
+			    (do	Asc iR aR mR <- ub
+			    	fmap (onKeyA (aR :*:) . onIndexA (iR +)) (getMin mR)))
+		where	getMin m = aboutT (\ k a -> return (Asc 0 k a)) m
+			getMax m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m
+-- 	updateAtT s r f i (PMap m) = PMap (updateAtT (sizeT s) r g i m) where
+-- 		g iA a m'
+-- 			| not r && i < iA
+-- 				= guardNullT (alterMinT s (f iA . (a :*:)) m')
+-- 			| r && i >= iA + lastIx s m'
+-- 				= guardNullT (alterMaxT s (f (lastIx s m') . (a :*:)) m')
+-- 			| otherwise
+-- 				= guardNullT (updateAtT s r (\ i' -> f (iA + i') . (a :*:)) (i - iA) m')
 	alterT s f (a :*: b) (PMap m) = PMap (alterT (sizeT s) g a m) where
 		g = guardNullT . alterT s f b . fromMaybe emptyT
 	traverseWithKeyT s f (PMap m) = PMap <$> traverseWithKeyT (sizeT s) g m where
@@ -51,40 +91,25 @@
 	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
+	extractT s f (PMap m) = second PMap <$> extractT (sizeT s) g m where
+		g a = second guardNullT <.> extractT s (\ b -> f (a :*: b))
+-- 	extractMinT s f (PMap m) = second PMap <$> extractMinT (sizeT s) g m where
+-- 		g a = second guardNullT . fromJust . getFirst . extractMinT s (f . (a :*:))
+-- 	extractMaxT s f (PMap m) = second PMap <$> extractMaxT (sizeT s) g m where
+-- 		g a = second guardNullT . fromJust . getLast . extractMaxT s (f . (a :*:))
+-- 	alterMinT s f (PMap m) = PMap (alterMinT (sizeT s) (\ a -> guardNullT . alterMinT s (\ b -> f (a :*: b))) m)
+-- 	alterMaxT s f (PMap m) = PMap (alterMaxT (sizeT s) (\ a -> guardNullT . alterMaxT s (\ b -> f (a :*: b))) m)
+	isSubmapT (<=) (PMap m1) (PMap m2) = isSubmapT (isSubmapT (<=)) m1 m2 
+	fromListT s f xs = PMap (mapWithKeyT (sizeT s) (\ a -> fromListT s (\ b -> f (a :*: b))) 
+		(fromListT (const 1) (const (++)) (breakFst xs)))
+	fromAscListT s f xs = PMap (fromDistAscListT (sizeT s)
+		[(a, fromAscListT s (\ b -> f (a :*: b)) ys) | (a, ys) <- breakFst xs])
+	
+   breakFst :: (EqT f, Eq k) => [((f :*: g) k, a)] -> [(f k, [(g k, a)])]
+   breakFst [] = []
+   breakFst ((a :*: b, v):xs) = breakFst' a (Seq.singleton (b, v)) xs where
+   	breakFst' a vs ((a' :*: b', v):xs)
+		| a `eqT` a'	= breakFst' a (vs |> (b', v)) xs
+		| otherwise	= (a, toList vs):breakFst' a' (Seq.singleton (b', v)) xs
+	breakFst' a vs [] = [(a, toList vs)]
+	|])
diff --git a/Data/TrieMap/Regular/RadixTrie.hs b/Data/TrieMap/Regular/RadixTrie.hs
--- a/Data/TrieMap/Regular/RadixTrie.hs
+++ b/Data/TrieMap/Regular/RadixTrie.hs
@@ -1,14 +1,18 @@
-{-# LANGUAGE Rank2Types, PatternGuards, FlexibleContexts, TypeFamilies, UndecidableInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell, Rank2Types, PatternGuards, FlexibleContexts, TypeFamilies, UndecidableInstances, MultiParamTypeClasses #-}
 
-module Data.TrieMap.Regular.RadixTrie where
+module Data.TrieMap.Regular.RadixTrie () where
 
 import Data.TrieMap.Regular.Class
 import Data.TrieMap.Regular.Base
 import Data.TrieMap.Regular.Ord
 import Data.TrieMap.Regular.Eq
+import Data.TrieMap.Regular.TH
 import Data.TrieMap.Sized
 import Data.TrieMap.TrieKey
 import Data.TrieMap.Applicative
+import Data.TrieMap.Rep
+import Data.TrieMap.Rep.TH
+import qualified Data.TrieMap.MultiRec.Base as MR
 
 import Control.Arrow
 import Control.Applicative
@@ -21,28 +25,27 @@
 
 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)
+data Edge f (m :: * -> * -> *) k a = Edge {-# UNPACK #-} !Int [f k] (Maybe (a)) (m k (Edge f m k a))
+type Edge' f k a = Edge f (TrieMapT f) k a
+type MEdge f k m a = Maybe (Edge f m k a)
+type MEdge' f k a = Maybe (Edge' f k a)
 
--- type instance PF (Edge f m k a ix) = (K0 (L f k) :*: K0 (Maybe (a ix)) :*: L (K0 k :*: I0) :*: K0 Int)
--- type instance (RadixTrie f k a ix) = U0 :+: PF (Edge f m k a ix)
+-- type instance PF (Edge f m k a) = (K0 (L f k) :*: K0 (Maybe (a)) :*: L (K0 k :*: I0) :*: K0 Int)
+-- type instance (RadixTrie f k a) = U0 :+: PF (Edge f m k a)
 
--- instance (TrieKeyT f m, m ~ TrieMapT f, TrieKey k (TrieMap k)) => Regular (Edge f m k a ix) where
+-- instance (TrieKeyT f m, m ~ TrieMapT f, TrieKey k (TrieMap k)) => Regular (Edge f m k a) where
 -- 	from (Edge n ks v ts) = K0 (List ks) :*: K0 v :*: 
 
-newtype RadixTrie f k a ix = Radix (MEdge' f k a ix)
+newtype RadixTrie f k a = Radix (MEdge' f k a)
 -- newtype K0 a b = K0 a
 
 type instance TrieMapT (L f) = RadixTrie f
 type instance TrieMap (L f r) = RadixTrie f r
--- 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 :: (TrieKeyT f m, m ~ TrieMapT f, TrieKey k (TrieMap k)) => Sized a -> [f k] -> Maybe (a) -> m k (Edge f m k a) -> Edge f m k a
 edge s ks v ts = Edge (maybe 0 s v + sizeT edgeSize ts) ks v ts
 
 instance (OrdT f, TrieKeyT f m, m ~ TrieMapT f) => TrieKeyT (L f) (RadixTrie f) where
@@ -50,10 +53,9 @@
 	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)
+	lookupIxT s (List ks) (Radix m) = maybe (mzero, mzero, mzero) (onKey List . lookupIxE s 0 ks) m
+	assocAtT s i (Radix m) = maybe (mzero, mzero, mzero) (onKey List . assocAtE s 0 i) m
+-- 	updateAtT s r f i (Radix m) = Radix (m >>= updateAtE s r (\ i' -> f i' . List) i)
 	alterT s f (List ks) (Radix m) = Radix (maybe (singletonME s ks (f Nothing)) (alterE s f ks) m)
 	traverseWithKeyT s f (Radix m) = Radix <$> traverse (traverseE s (f . List)) m
 	foldWithKeyT f (Radix m) z = foldr (foldE (f . List)) z m
@@ -63,10 +65,11 @@
 	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))
+	extractT s f (Radix m) = maybe empty (second Radix <.> extractE s (f . List)) m
+-- -- 	extractMinT s f (Radix m) = First m >>= fmap (second Radix) . extractMinE s (f . List)
+-- 	extractMaxT s f (Radix m) = Last m >>= fmap (second Radix) . extractMaxE s (f . List)
+-- 	alterMinT s f (Radix m) = Radix (m >>= alterMinE s (f . List))
+-- 	alterMaxT s f (Radix m) = Radix (m >>= alterMaxE s (f . List))
 	isSubmapT (<=) (Radix m1) (Radix m2) = subMaybe (isSubEdge (<=)) m1 m2
 	fromListT s f xs = Radix (fromListE s (f . List) [(ks, a) | (List ks, a) <- xs])
 	fromAscListT s f xs = Radix (fromAscListE s (f . List) [(ks, a) | (List ks, a) <- xs])
@@ -78,7 +81,7 @@
 	lookupM = lookupT
 	lookupIxM = lookupIxT
 	assocAtM = assocAtT
-	updateAtM = updateAtT
+-- 	updateAtM = updateAtT
 	alterM = alterT
 	traverseWithKeyM = traverseWithKeyT
 	foldWithKeyM = foldWithKeyT
@@ -88,10 +91,11 @@
 	unionM = unionT
 	isectM = isectT
 	diffM = diffT
-	extractMinM = extractMinT
-	extractMaxM = extractMaxT
-	alterMinM = alterMinT
-	alterMaxM = alterMaxT
+	extractM = extractT
+-- 	extractMinM = extractMinT
+-- 	extractMaxM = extractMaxT
+-- 	alterMinM = alterMinT
+-- 	alterMaxM = alterMaxT
 	isSubmapM = isSubmapT
 	fromListM = fromListT
 	fromAscListM = fromAscListT
@@ -117,7 +121,7 @@
 -- 	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 :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Edge' f k a -> MEdge' f k a
 compact e@(Edge s ks Nothing ts) = case assocsT ts of
 	[]	-> Nothing
 	[~(k, e'@(Edge s' ls v ts'))]
@@ -125,16 +129,16 @@
 	_	-> Just e
 compact e = Just e
 
-cons :: f k -> Edge' f k a ix -> Edge' f k a ix
+cons :: f k -> Edge' f k a -> Edge' f k a
 l `cons` Edge s ls v ts = Edge s (l:ls) v ts
 
-cat :: [f k] -> Edge' f k a ix -> Edge' f k a ix
+cat :: [f k] -> Edge' f k a -> Edge' f k a
 ks `cat` Edge s ls v ts = Edge s (ks ++ ls) v ts
 
-singletonME :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> [f k] -> Maybe (a ix) -> MEdge' f k a ix
+singletonME :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> [f k] -> Maybe (a) -> MEdge' f k a
 singletonME s ks = fmap (\ v -> Edge (s v) ks (Just v) emptyT)
 
-lookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => [f k] -> Edge' f k a ix -> Maybe (a ix)
+lookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => [f k] -> Edge' f k a -> Maybe (a)
 lookupE ks (Edge _ ls v ts) = match ks ls where
 	match (k:ks) (l:ls)
 		| k `eqT` l	= match ks ls
@@ -144,7 +148,7 @@
 	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
+	Sized a -> (Maybe (a) -> Maybe (a)) -> [f k] -> Edge' f k a -> MEdge' f k a
 alterE s f ks0 e@(Edge sz ls0 v0 ts0) = match 0 ks0 ls0 where
 	match i _ _ | i `seq` False = undefined
 	match i (k:ks) (l:ls)
@@ -162,23 +166,23 @@
 	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)
+	Sized b -> ([f k] -> a -> t (b)) -> Edge' f k a -> t (Edge' f k b)
 traverseE s f (Edge _ ks v ts) =
 	edge s ks <$> traverse (f ks) v <*> traverseWithKeyT edgeSize (\ l -> traverseE s (\ ls -> f (ks ++ l:ls))) ts
 
-foldE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => ([f k] -> a ix -> b -> b) -> Edge' f k a ix -> b -> b
+foldE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => ([f k] -> a -> b -> b) -> Edge' f k a -> b -> b
 foldE f (Edge _ ks v ts) z = foldr (f ks) (foldWithKeyT (\ l -> foldE (\ ls -> f (ks ++ l:ls))) ts z) v
 
-foldlE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => ([f k] -> b -> a ix -> b) -> Edge' f k a ix -> b -> b
+foldlE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => ([f k] -> b -> a -> b) -> Edge' f k a -> b -> b
 foldlE f (Edge _ ks v ts) z = foldlWithKeyT (\ l z m -> foldlE (\ ls -> f (ks ++ l:ls)) m z) ts (foldl (f ks) z v)
 
 mapEitherE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized b -> Sized c -> 
-	EitherMap (EitherMap [f k] (a ix) (b ix) (c ix)) (Edge' f k a ix) (Edge' f k b ix) (Edge' f k c ix)
+	EitherMap (EitherMap [f k] (a) (b) (c)) (Edge' f k a) (Edge' f k b) (Edge' f k c)
 mapEitherE s1 s2 f (Edge _ ks v ts) = case (maybe (Nothing, Nothing) (f ks) v, mapEitherT edgeSize edgeSize 
 					(\ l -> mapEitherE s1 s2 (\ ls -> f (ks ++ l:ls))) ts) of 
 	((vL, vR), (tsL, tsR)) -> (compact (edge s1 ks vL tsL), compact (edge s2 ks vR tsR))
 
-splitLookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> SplitMap (a ix) x -> [f k] -> SplitMap (Edge' f k a ix) x
+splitLookupE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> SplitMap (a) x -> [f k] -> SplitMap (Edge' f k a) x
 splitLookupE s f ks e@(Edge _ ls v ts) = match ks ls where
 	match (k:ks) (l:ls) = case compareT k l of
 		LT	-> (Nothing, Nothing, Just e)
@@ -193,7 +197,7 @@
 		(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 :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> UnionFunc (UnionFunc [f k] (a)) (Edge' f k a)
 unionE s f (Edge szK ks0 vK tsK) (Edge szL ls0 vL tsL) = match 0 ks0 ls0 where
 	match i _ _ | i `seq` False = undefined
 	match i (k:ks) (l:ls)
@@ -209,34 +213,37 @@
 	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''))))
+extractE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) => Sized a -> ([f k] -> a -> t (x, Maybe a)) -> 
+	Edge' f k a -> t (x, MEdge' f k a)
+extractE s f (Edge _ ks v ts) = (maybe empty (second (\ v' -> compact (edge s ks v' ts)) <.> f ks) v) <|>
+  		(second (compact . edge s ks Nothing) <$> extractT edgeSize g ts)
+	where	g l = extractE s (\ ls -> f (ks ++ l:ls))
 
-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''))))
+aboutE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k), Alternative t) => ([f k] -> a -> t x) ->
+	Edge' f k a -> t x
+aboutE f = fst <.> extractE (const 0) (\ k a -> fmap (flip (,) Nothing) (f k a))
 
-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))
+-- extractMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> ([f k] -> a -> (x, Maybe a)) -> 
+-- 	Edge' f k a -> Last (x, MEdge' f k a)
+-- extractMaxE s f (Edge _ ks v ts) = (do
+-- 		v <- Last v
+-- 		let (x, v') = f ks v
+-- 		return (x, compact (edge s ks v' ts))) <|> 
+--  			(second (compact . edge s ks v) <.> extractMaxT edgeSize g ts)
+-- 	where	g x = fromJust . getLast . extractMaxE s (\ xs -> f (ks ++ x:xs))
 
-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))
+-- alterMinE, alterMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a ->
+-- 	([f k] -> a -> Maybe (a)) -> Edge' f k a -> MEdge' f k a
+-- alterMinE s f (Edge _ ks (Just v) ts) = compact (edge s ks (f ks v) ts)
+-- alterMinE s f (Edge _ ks Nothing ts) = compact (edge s ks Nothing (alterMinT edgeSize (\ x -> alterMinE s (\ xs -> f (ks ++ x:xs))) ts))
+-- 
+-- alterMaxE s f (Edge _ ks v ts)
+-- 	| nullT ts	= do	v' <- v >>= f ks
+-- 				return (Edge (s v') ks (Just v') ts)
+-- 	| otherwise	= compact (edge s ks v (alterMaxT edgeSize (\ x -> alterMaxE s (\ xs -> f (ks ++ x:xs))) ts))
 
 isectE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized c ->
-	IsectFunc (IsectFunc [f k] (a ix) (b ix) (c ix)) (Edge' f k a ix) (Edge' f k b ix) (Edge' f k c ix)
+	IsectFunc (IsectFunc [f k] (a) (b) (c)) (Edge' f k a) (Edge' f k b) (Edge' f k c)
 isectE s f (Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where
 	match (k:ks) (l:ls)
 		| k `eqT` l	= match ks ls
@@ -248,7 +255,7 @@
 		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)
+	DiffFunc (DiffFunc [f k] (a) (b)) (Edge' f k a) (Edge' f k b)
 diffE s f e@(Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where
 	match (k:ks) (l:ls)
 		| k `eqT` l	= match ks ls
@@ -260,7 +267,7 @@
 	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 :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => LEq (a) (b) -> LEq (Edge' f k a) (Edge' f k b)
 isSubEdge (<=) (Edge szK ks vK tsK) (Edge szL ls vL tsL) = match ks ls where
 	match (k:ks) (l:ls)
 		| k `eqT` l	= match ks ls
@@ -281,7 +288,7 @@
 		| 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 :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => Sized a -> ([f k] -> a -> a -> a) -> [([f k], a)] -> MEdge' f k a
 fromListE _ _ [] = Nothing
 fromListE s f xs = case filterer eqT (f []) xs of
 	(Nothing, [(k, xs)]) -> cons k <$> fromListE s (f . (k:)) xs
@@ -289,42 +296,101 @@
 				(fromListT (const 1) (\ _ (K0 xs) (K0 ys) -> K0 (ys ++ xs)) [(k, K0 xs) | (k, xs) <- xss])))
 
 fromAscListE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 
-	Sized a -> ([f k] -> a ix -> a ix -> a ix) -> [([f k], a ix)] -> MEdge' f k a ix
+	Sized a -> ([f k] -> a -> a -> a) -> [([f k], a)] -> MEdge' f k a
 fromAscListE _ _ [] = Nothing
 fromAscListE s f xs = case filterer eqT (f []) xs of
 	(Nothing, [(k, xs)]) -> cons k <$> fromAscListE s (f . (k:)) xs
 	(v, xss) -> Just (edge s [] v (fromDistAscListT edgeSize [(k, fromJust (fromAscListE s (f . (k:)) xs)) | (k, xs) <- xss]))
 
 lookupIxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
-	Sized a -> Int -> [f k] -> Edge' f k a ix -> Maybe (Int, a ix)
+	Sized a -> Int -> [f k] -> Edge' f k a -> IndexPos [f k] a
 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
+lookupIxE s i ks e@(Edge _ ls v ts) = match ks ls where
+	match (k:ks) (l:ls) = case compareT k l of
+		LT	-> (mzero, mzero, getMin (Asc i) e)
+		EQ	-> match ks ls
+		GT	-> (getMax (Asc i) e, mzero, mzero)
+	match (k:ks) [] = case lookupIxT edgeSize k ts of
+		(lb, x, ub) -> let lookupX = do	Asc iK k' e' <- x
+						let (lb', x', ub') = lookupIxE s (i + iK) ks e'
+						let f = onKeyA ((ls ++) . (k' :))
+						return (f <$> lb', f <$> x', f <$> ub')
+			in ((do	Asc iL kL eL <- lb
+				getMax (\ ksL -> Asc (i + iL) (ls ++ kL:ksL)) eL) <|>
+			    (do	(lb', _, _) <- Last lookupX
+			    	lb'),
+			    (do	(_, x', _) <- lookupX
+			    	x'),
+			    (do (_, _, ub') <- First lookupX
+			    	ub') <|>
+			    (do	Asc iR kR eR <- ub
+			    	getMin (\ ksR -> Asc (i + iR) (ls ++ kR:ksR)) eR))
+	match [] [] = (mzero, Asc i ls <$> v, aboutT
+				(\ x -> aboutE (\ xs v' -> return (Asc (i + maybe 0 s v) (ls ++ x:xs) v'))) ts)
+	match [] _ = (mzero, mzero, getMin (Asc i) e)
+	getMin f = aboutE (return .: f)
+	getMax f = aboutE (return .: f)
 
 assocAtE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
-	Sized a -> Int -> 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
+	Sized a -> Int -> Int -> Edge' f k a -> IndexPos [f k] a
+assocAtE s i0 i (Edge _ ks Nothing ts) = case assocAtT edgeSize i ts of
+	(lb, x, ub) -> let lookupX = do	Asc i' l e' <- x
+					return (onKey ((ks ++) . (l:)) (assocAtE s (i0 + i') (i - i') e'))
+		in ((do	Asc iL lL eL <- lb
+			getMax (\ ls -> Asc (i0 + iL) (ks ++ lL:ls)) eL) <|>
+		    (do	(lb', _, _) <- Last lookupX
+		    	lb'),
+		    (do	(_, x', _) <- lookupX
+		    	x'),
+		    (do	(_, _, ub') <- First lookupX
+		    	ub') <|>
+		    (do	Asc iR lR eR <- ub
+		    	getMin (\ ls -> Asc (i0 + iR) (ks ++ lR:ls)) eR))
+	where 	getMin f e = aboutE (return .: f) e
+		getMax f e = aboutE (return .: f) e
+assocAtE s i0 i (Edge _ ks (Just v) ts)
+	| i < sv	= (mzero, return (Asc i ks v), aboutT (\ l -> aboutE (\ ls v' -> return (Asc (i0 + sv) (ks ++ l:ls) v'))) ts)
+	| (lb, x, ub) <- assocAtT edgeSize (i - sv) ts
+		= let lookupX = do	Asc i' l e' <- x
+					return (onKey ((ks ++) . (l:)) (assocAtE s (i0 + i' + sv) (i - sv - i') e'))
+		in ((do	Asc iL lL eL <- lb
+			getMax (\ ls -> Asc (i0 + iL + sv) (ks ++ lL:ls)) eL) <|>
+		    (do	(lb', _, _) <- Last lookupX
+		    	lb'),
+		    (do	(_, x', _) <- lookupX
+		    	x'),
+		    (do	(_, _, ub') <- First lookupX
+		    	ub') <|>
+		    (do	Asc iR lR eR <- ub
+		    	getMin (\ ls -> Asc (i0 + iR + sv) (ks ++ lR:ls)) eR))
+	where 	getMin f = aboutE (return .: f)
+		getMax f = aboutE (return .: f)
+		sv = s v
 
-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)
+-- alterMinE, alterMaxE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) => 
+-- 	Sized a -> ([f k] -> a -> Maybe a) -> Edge' f k a -> MEdge' f k a
+-- alterMinE s f e = maybe (Just e) snd $ getFirst (extractMinE s (\ k a -> ((), f k a)) e)
+-- alterMaxE s f e = maybe (Just e) snd $ getLast (extractMaxE s (\ k a -> ((), f k a)) e)
+
+-- updateAtE :: (TrieKeyT f (TrieMapT f), TrieKey k (TrieMap k)) =>
+-- 	Sized a -> Round -> (Int -> [f k] -> a -> Maybe (a)) -> Int -> Edge' f k a -> MEdge' f k a
+-- updateAtE s r f i (Edge sz ks Nothing ts) = compact (edge s ks Nothing (updateAtT edgeSize r g i ts)) where
+-- 	g iT l e
+-- 		| not r, i < iT
+-- 			= alterMinE s (f iT . (ks++) . (l:)) e
+-- 		| r, i >= iT + edgeSize e
+-- 			= alterMaxE s (\ ls a -> f (edgeSize e + iT - s a) (ks ++ l:ls) a) e
+-- 		| otherwise
+-- 			= updateAtE s r (\ i' ls -> f (i' + iT) (ks ++ l:ls)) (i - iT) e
+-- updateAtE s r f i (Edge sz ks (Just v) ts)
+-- 	| i < sv	= compact (edge s ks (f 0 ks v) ts)
+-- 	| otherwise	= compact (edge s ks (Just v) (updateAtT edgeSize r g i1 ts))
+-- 	where	sv = s v
+-- 		i1 = i - sv
+-- 		g iT l e 
+-- 			| not r, i1 < iT 
+-- 				= alterMinE s (f (iT + sv) . (ks ++) . (l:)) e
+-- 			| r, i1 >= iT + edgeSize e
+-- 				= alterMaxE s (\ ls a -> f (iT + sv + edgeSize e + iT - s a) (ks ++ l:ls) a) e
+-- 			| otherwise
+-- 				= updateAtE s r (\ i' ls -> f (sv + iT + i') (ks ++ l:ls)) (i - sv - iT) e
diff --git a/Data/TrieMap/Regular/RegMap.hs b/Data/TrieMap/Regular/RegMap.hs
--- a/Data/TrieMap/Regular/RegMap.hs
+++ b/Data/TrieMap/Regular/RegMap.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies, MultiParamTypeClasses #-}
 
-module Data.TrieMap.Regular.RegMap where
+module Data.TrieMap.Regular.RegMap() where
 
 import Data.TrieMap.Regular.Class
 import Data.TrieMap.Regular.Base
@@ -10,17 +10,16 @@
 import Control.Arrow
 import Control.Monad
 
-newtype RegMap k m (a :: * -> *) ix = RegMap (m (Reg k) a ix)
+newtype RegMap k m a = RegMap (m (Reg k) a)
 
 instance (Regular k, Functor (PF k), TrieKeyT (PF k) m, m ~ TrieMapT (PF k)) => TrieKey (Reg k) (RegMap k m) where
 	emptyM = RegMap emptyT	
 	nullM (RegMap m) = nullT m
 	sizeM s (RegMap m) = sizeT s m
 	lookupM k (RegMap m) = lookupT (from' k) m
-	lookupIxM s k (RegMap m) = 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)
+	lookupIxM s k (RegMap m) = onKey to' (lookupIxT s (from' k) m)
+	assocAtM s i (RegMap m) = onKey to' (assocAtT s i m)
+-- 	updateAtM s r f i (RegMap m) = RegMap (updateAtT s r (\ i' -> f i' . to') i m)
 	alterM s f k (RegMap m) = RegMap (alterT s f (from' k) m)
 	traverseWithKeyM s f (RegMap m) = RegMap <$> traverseWithKeyT s (f . to') m
 	foldWithKeyM f (RegMap m) = foldWithKeyT (f . to') m
@@ -30,10 +29,11 @@
 	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)
+	extractM s f (RegMap m) = second RegMap <$> extractT s (f . to') m
+-- 	extractMinM s f (RegMap m) = second RegMap <$> extractMinT s (f . to') m
+-- 	extractMaxM s f (RegMap m) = second RegMap <$> extractMaxT s (f . to') m
+-- 	alterMinM s f (RegMap m) = RegMap (alterMinT s (f . to') m)
+-- 	alterMaxM s f (RegMap m) = RegMap (alterMaxT s (f . to') m)
 	isSubmapM (<=) (RegMap m1) (RegMap m2) = isSubmapT (<=) m1 m2
 	fromListM s f xs = RegMap (fromListT s (f . to') [(from' k, a) | (k, a) <- xs])
 	fromAscListM s f xs = RegMap (fromAscListT s (f . to') [(from' k, a) | (k, a) <- xs])
diff --git a/Data/TrieMap/Regular/Rep.hs b/Data/TrieMap/Regular/Rep.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/Rep.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE UndecidableInstances, TypeOperators, TypeFamilies, TemplateHaskell #-}
+
+module Data.TrieMap.Regular.Rep where
+
+import Data.TrieMap.Rep
+import Data.TrieMap.Rep.TH
+import Data.TrieMap.Regular.Base
+
+type instance RepT (K0 a) = K0 (Rep a)
+type instance RepT I0 = I0
+type instance RepT U0 = U0
+type instance RepT (L f) = L (RepT f)
+type instance RepT (f :*: g) = RepT f :*: RepT g
+type instance RepT (f :+: g) = RepT f :+: RepT g
+type instance RepT (f `O` g) = RepT f `O` RepT g
+
+type instance Rep (K0 a b) = RepT (K0 a) b
+type instance Rep (I0 a) = I0 (Rep a)
+type instance Rep (U0 a) = U0 a
+type instance Rep (L f a) = L (RepT f) (Rep a)
+type instance Rep ((f :*: g) a) = RepT (f :*: g) (Rep a)
+type instance Rep ((f :+: g) a) = RepT (f :+: g) (Rep a)
+type instance Rep ((f `O` g) a) = RepT (f `O` g) (Rep a)
+type instance Rep (Fix f) = Fix (RepT f)
+
+instance Repr a => ReprT (K0 a) where
+	toRepTMap _ (K0 a) = K0 (toRep a)
+	fromRepTMap _ (K0 a) = K0 (fromRep a)
+
+instance Repr a => Repr (K0 a b) where
+	toRep = toRepT
+	fromRep = fromRepT
+
+$(genRepT [d|
+   instance ReprT I0 where
+	toRepTMap = fmap
+	fromRepTMap = fmap |])
+
+instance ReprT U0 where
+	toRepTMap _ _ = U0
+	fromRepTMap _ _ = U0
+
+instance Repr (U0 a) where
+	toRep _ = U0
+	fromRep _ = U0
+
+$(genRepT [d|
+   instance ReprT f => ReprT (L f) where
+	toRepTMap f (List xs) = List (map (toRepTMap f) xs)
+	fromRepTMap f (List xs) = List (map (fromRepTMap f) xs) |])
+
+$(genRepT [d|
+   instance (ReprT f, ReprT g) => ReprT (f :*: g) where
+	toRepTMap f (x :*: y) = toRepTMap f x :*: toRepTMap f y
+	fromRepTMap f (x :*: y) = fromRepTMap f x :*: fromRepTMap f y |])
+
+$(genRepT [d|
+   instance (ReprT f, ReprT g) => ReprT (f :+: g) where
+	toRepTMap f (L a) = L (toRepTMap f a)
+	toRepTMap f (R b) = R (toRepTMap f b)
+	fromRepTMap f (L a) = L (fromRepTMap f a)
+	fromRepTMap f (R b) = R (fromRepTMap f b) |])
+
+$(genRepT [d|
+   instance (ReprT f, ReprT g) => ReprT (f `O` g) where
+	toRepTMap f (O x) = O (toRepTMap (toRepTMap f) x)
+	fromRepTMap f (O x) = O (fromRepTMap (fromRepTMap f) x) |])
+
+instance ReprT f => Repr (Fix f) where
+	toRep (In x) = In (toRepTMap toRep x)
+	fromRep (In x) = In (fromRepTMap fromRep x)
diff --git a/Data/TrieMap/Regular/Sized.hs b/Data/TrieMap/Regular/Sized.hs
--- a/Data/TrieMap/Regular/Sized.hs
+++ b/Data/TrieMap/Regular/Sized.hs
@@ -5,5 +5,5 @@
 import Data.TrieMap.Regular.Base
 import Data.TrieMap.Sized
 
-sizeK0 :: Sized (K0 a)
+sizeK0 :: Sized (K0 a b)
 sizeK0 _ = 1
diff --git a/Data/TrieMap/Regular/TH.hs b/Data/TrieMap/Regular/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Regular/TH.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, QuasiQuotes #-}
+
+module Data.TrieMap.Regular.TH where
+
+import Data.TrieMap.Regular.Class
+import Data.TrieMap.TrieKey
+import Language.Haskell.TH
+
+deriveM :: Q [Dec] -> Q [Dec]
+deriveM decs = do
+	iT@(InstanceD cxt (triekeyt `AppT` f `AppT` m) _:_) <- decs
+	(InstanceD _ _ myDecs:_) <- [d|
+	  instance (TrieKeyT f m, Ord (f k), TrieKey k mm) => TrieKey (f k) (m 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
+		extractM = extractT
+-- 		extractMinM = extractMinT
+-- 		extractMaxM = extractMaxT
+-- 		alterMinM = alterMinT
+-- 		alterMaxM = alterMaxT
+		isSubmapM = isSubmapT
+		fromListM = fromListT
+		fromAscListM = fromAscListT
+		fromDistAscListM = fromDistAscListT |]
+	k <- mkVar "k"
+	let triekey = ConT ''TrieKey
+	let triemap = ConT ''TrieMap
+	let ordT = ConT ''Ord
+	return (InstanceD (triekey `AppT` k `AppT` (triemap `AppT` k):ordT `AppT` (f `AppT` k):cxt)
+			(triekey `AppT` (f `AppT` k) `AppT` (m `AppT` k)) myDecs:iT)
+
+mkVar :: String -> TypeQ
+mkVar x = varT =<< newName x
diff --git a/Data/TrieMap/Regular/UnionMap.hs b/Data/TrieMap/Regular/UnionMap.hs
--- a/Data/TrieMap/Regular/UnionMap.hs
+++ b/Data/TrieMap/Regular/UnionMap.hs
@@ -1,24 +1,38 @@
-{-# LANGUAGE TypeOperators, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE PatternGuards, FlexibleInstances, TemplateHaskell, TypeOperators, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
 
 module Data.TrieMap.Regular.UnionMap() where
 
 import Data.TrieMap.Regular.Class
 import Data.TrieMap.Regular.Base
+import Data.TrieMap.Regular.TH
 import Data.TrieMap.TrieKey
+import Data.TrieMap.Applicative
+-- import Data.TrieMap.Rep
+-- import Data.TrieMap.Rep.TH
 
 import Control.Applicative
 import Control.Arrow
 import Control.Monad
 
 import Data.Either
+import Data.Monoid
 
 -- import Generics.MultiRec.Base
-data UnionMap m1 m2 k (a :: * -> *) ix = m1 k a ix :&: m2 k a ix
+data UnionMap m1 m2 k a = m1 k a :&: m2 k a
 
 type instance TrieMapT (f :+: g) = UnionMap (TrieMapT f) (TrieMapT g)
 type instance TrieMap ((f :+: g) r) = TrieMapT (f :+: g) r
 
-instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (f :+: g) (UnionMap m1 m2) where
+-- type instance RepT (UnionMap m1 m2 k) = RepT (m1 k) :*: RepT (m2 k)
+-- type instance Rep (UnionMap f g k a) = RepT (UnionMap f g k) (Rep a)
+-- 
+-- -- $(genRepT [d|
+--    instance (ReprT (m1 k), ReprT (m2 k)) => ReprT (UnionMap m1 m2 k) where
+-- 	toRepT (m1 :&: m2) = toRepT m1 :*: toRepT m2
+-- 	fromRepT (m1 :*: m2) = fromRepT m1 :&: fromRepT m2 |])
+
+$(deriveM [d| 
+   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
@@ -26,18 +40,23 @@
 		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
+		L k | (lb, x, ub) <- onKey L (lookupIxT s k m1)
+			-> (lb, x, ub <|> fmap (onKeyA R . onIndexA (sizeT s m1 +)) (getMin m2))
+		R k | (lb, x, ub) <- onIndex (sizeT s m1 +) (onKey R (lookupIxT s k m2))
+			-> (fmap (onKeyA L) (getMax m1) <|> lb, x, ub)
+		where	getMin = aboutT (return .: Asc 0)
+			getMax m = aboutT (\ k a -> return (Asc (sizeT s m - s a) k a)) m
 	assocAtT s i (m1 :&: m2)
-		| i < s1	= 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
+		| i < s1	= onKey L (assocAtT s i m1)
+		| otherwise	= onKey R (onIndex (s1 +) (assocAtT s (i - s1) m2))
 		where s1 = sizeT s m1
+{-	updateAtT s r f i (m1 :&: m2)
+		| not r, i >= maxIx m1
+				= m1 :&: updateAtT s r (\ i' -> f (i' + s1) . R) (i - s1) m2
+		| i < s1	= updateAtT s r (\ i' -> f i' . L) i m1 :&: m2
+		| otherwise	= m1 :&: updateAtT s r (\ i' -> f (i' + s1) . R) (i - s1) m2
+		where 	s1 = sizeT s m1
+			maxIx m = maybe (sizeT s m) fst $ getLast (extractMaxT s (\ _ v -> (sizeT s m - s v, Just v)) m)-}
 	alterT s f k (m1 :&: m2) = case k of
 		L k -> alterT s f k m1 :&: m2
 		R k -> m1 :&: alterT s f k m2
@@ -54,56 +73,22 @@
 	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
+	extractT s f (m1 :&: m2) = second (:&: m2) <$> extractT s (f . L) m1 <|>
+		second (m1 :&:) <$> extractT s (f . R) m2
+-- 	extractMinT s f (m1 :&: m2) = second (:&: m2) <$> extractMinT s (f . L) m1 <|>
+-- 		second (m1 :&:) <$> extractMinT s (f . R) m2
+-- 	extractMaxT s f (m1 :&: m2) = second (:&: m2) <$> extractMaxT s (f . L) m1 <|>
+-- 		second (m1 :&:) <$> extractMaxT s (f . R) m2
+-- 	alterMinT s f (m1 :&: m2)
+-- 		| nullT m1	= m1 :&: alterMinT s (f . R) m2
+-- 		| otherwise	= alterMinT s (f . L) m1 :&: m2
+-- 	alterMaxT s f (m1 :&: m2)
+-- 		| nullT m2	= alterMaxT s (f . L) m1 :&: m2
+-- 		| otherwise	= m1 :&: alterMaxT s (f . R) m2
 	isSubmapT (<=) (m11 :&: m12) (m21 :&: m22) = isSubmapT (<=) m11 m21 && isSubmapT (<=) m12 m22
 	fromListT s f xs = case partEithers xs of
 		(ys, zs) -> fromListT s (f . L) ys :&: fromListT s (f . R) zs
 	fromAscListT s f xs = case partEithers xs of
 		(ys, zs) -> fromAscListT s (f . L) ys :&: fromAscListT s (f . R) zs
 	fromDistAscListT s xs = case partEithers xs of
-		(ys, zs) -> fromDistAscListT s ys :&: fromDistAscListT s zs
-
-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
+		(ys, zs) -> fromDistAscListT s ys :&: fromDistAscListT s zs |])
diff --git a/Data/TrieMap/Regular/UnitMap.hs b/Data/TrieMap/Regular/UnitMap.hs
--- a/Data/TrieMap/Regular/UnitMap.hs
+++ b/Data/TrieMap/Regular/UnitMap.hs
@@ -1,13 +1,18 @@
-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances, TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-}
 
 module Data.TrieMap.Regular.UnitMap() where
 
 import Data.TrieMap.Regular.Class
 import Data.TrieMap.Regular.Base
 import Data.TrieMap.TrieKey
+import Data.TrieMap.Rep
+import Data.TrieMap.Rep.Instances
+import Data.TrieMap.Rep.TH
+import Data.TrieMap.Applicative
 
 import Control.Applicative
 import Control.Arrow
+import Control.Monad
 
 import Data.Foldable
 import Data.Maybe
@@ -16,18 +21,34 @@
 
 import Prelude hiding (foldr, foldl)
 
-newtype M k a ix = M (Maybe (a ix))
+newtype M k a = M (Maybe a)
 type instance TrieMapT U0 = M
 type instance TrieMap (U0 r) = M r
 
+type instance RepT (M k) = RepT Maybe
+type instance Rep (M k a) = RepT Maybe (Rep a)
+
+$(genRepT [d|
+   instance ReprT (M k) where
+	toRepT (M a) = toRepT a
+	fromRepT = M . fromRepT |])
+
 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)
+	lookupIxM s _ (M a) = (mzero, Asc 0 U0 <$> a, mzero)
+	assocAtM s i (M a)
+		| i < 0	= (mzero, mzero, Asc 0 U0 <$> First a)
+		| i > maybe 0 s a
+			= (Asc 0 U0 <$> Last a, mzero, mzero)
+		| otherwise
+			= (mzero, Asc 0 U0 <$> a, mzero)
+-- 	updateAtM s r f i (M v) = case v of
+-- 		Just a	| not r && i <= 0	-> M (v >>= f 0 U0)
+-- 			| r && i >= 0		-> M (v >>= f 0 U0)
+-- 		_ -> M v
 	alterM _ f _ (M a) = M (f a)
 	traverseWithKeyM _ f (M a) = M <$> traverse (f U0) a
 	foldWithKeyM f (M a) z = foldr (f U0) z a
@@ -38,12 +59,11 @@
 	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
+	extractM _ f (M a) = maybe empty (second M <.> f U0) a
+-- 	extractMinM _ f (M a) = fmap (second M . f U0) (First a)
+-- 	extractMaxM _ f (M a) = fmap (second M . f U0) (Last a)
+-- 	alterMinM _ f (M a) = M (a >>= f U0)
+-- 	alterMaxM = alterMinM
 	isSubmapM (<=) (M a) (M b) = subMaybe (<=) a b
 	fromListM _ f = M . foldr (\ (_, a) -> Just . maybe a (f U0 a)) Nothing
 	fromDistAscListM _ = M . fmap snd . listToMaybe
@@ -55,7 +75,7 @@
 	lookupT = lookupM
 	lookupIxT = lookupIxM
 	assocAtT = assocAtM
-	updateAtT = updateAtM
+-- 	updateAtT = updateAtM
 	alterT = alterM
 	traverseWithKeyT = traverseWithKeyM
 	foldWithKeyT = foldWithKeyM
@@ -65,10 +85,11 @@
 	unionT = unionM
 	isectT = isectM
 	diffT = diffM
-	extractMinT = extractMinM
-	extractMaxT = extractMaxM
-	alterMinT = alterMinM
-	alterMaxT = alterMaxM
+	extractT = extractM
+-- 	extractMinT = extractMinM
+-- 	extractMaxT = extractMaxM
+-- 	alterMinT = alterMinM
+-- 	alterMaxT = alterMaxM
 	isSubmapT = isSubmapM
 	fromListT = fromListM
 	fromAscListT = fromAscListM
diff --git a/Data/TrieMap/Rep.hs b/Data/TrieMap/Rep.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Rep.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE UndecidableInstances, FlexibleContexts, TypeFamilies, KindSignatures #-}
+
+module Data.TrieMap.Rep where
+
+type family Rep a
+type family RepT (f :: * -> *) :: * -> *
+
+class Repr a where
+	toRep :: a -> Rep a
+	fromRep :: Rep a -> a
+
+class Functor (RepT f) => ReprT f where
+	toRepT :: f a -> RepT f a
+	fromRepT :: RepT f a -> f a
+	toRepTMap :: (a -> b) -> f a -> RepT f b
+	fromRepTMap :: (b -> a) -> RepT f b -> f a
+
+	toRepT = toRepTMap id
+	fromRepT = fromRepTMap id
+	toRepTMap f = fmap f . toRepT
+	fromRepTMap f = fromRepT . fmap f
+
+{-# RULES
+	"toRep/fromRep" forall x . toRep (fromRep x) = x;
+-- 	"fromRep/toRep" forall x . fromRep (toRep x) = x;
+	#-}
diff --git a/Data/TrieMap/Rep/Instances.hs b/Data/TrieMap/Rep/Instances.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Rep/Instances.hs
@@ -0,0 +1,236 @@
+{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeFamilies, TypeOperators, TemplateHaskell #-}
+
+module Data.TrieMap.Rep.Instances()  where
+
+import Data.TrieMap.Rep
+import Data.TrieMap.Rep.TH
+import Data.TrieMap.Regular.Base
+import Data.TrieMap.OrdMap
+import Data.TrieMap.Modifiers
+-- import Language.Haskell.TH
+
+import Control.Arrow
+
+import Data.Char
+import Data.Int
+import Data.Word
+import Data.Foldable (toList)
+import Data.Bits
+import Data.Array.IArray
+import Data.ByteString hiding (map)
+import qualified Data.ByteString as BS
+
+import Data.Sequence (Seq, (|>))
+import qualified Data.Sequence as Seq
+import qualified Data.Foldable as Fold
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import Prelude hiding (concat, take, length)
+
+type Pair a = (,) a
+type Sum a = Either a
+
+type instance RepT Maybe = U0 :+: I0
+type instance Rep (Maybe a) = RepT Maybe (Rep a)
+
+$(genRepT [d|
+   instance ReprT Maybe where
+	toRepTMap f = maybe (L U0) (R . I0 . f)
+	fromRepTMap _ L{} = Nothing
+	fromRepTMap f (R (I0 a)) = Just (f a) |])
+
+type instance RepT [] = L I0
+type instance Rep [a] = L I0 (Rep a)
+
+$(genRepT [d| 
+   instance ReprT [] where
+	toRepTMap f = List . map (I0 . f)
+	fromRepTMap f (List xs) = map (f . unI0) xs |])
+
+type instance RepT ((,) a) = Pair (Rep a)
+type instance Rep (a, b) = RepT ((,) a) (Rep b)
+
+$(genRepT [d|
+    instance Repr a => ReprT ((,) a) where
+	toRepTMap f = toRep *** f
+	fromRepTMap f = fromRep *** f |])
+
+-- instance (ReprT ((,) a), Repr b) => Repr ((,) a b) where
+
+-- instance (Repr a, Repr b) => Repr (a, b) where
+-- 	toRep = fmap toRep . toRepT
+-- 	fromRep = fromRepT . fmap fromRep
+
+type instance RepT ((,,) a b) = K0 (Rep a) :*: K0 (Rep b) :*: I0
+type instance Rep (a, b, c) = RepT ((,,) a b) (Rep c)
+
+$(genRepT [d|
+   instance (Repr a, Repr b) => ReprT ((,,) a b) where
+	toRepTMap f (a, b, c) = K0 (toRep a) :*: K0 (toRep b) :*: I0 (f c)
+	fromRepTMap f (K0 a :*: K0 b :*: I0 c) = (fromRep a, fromRep b, f c) |])
+
+type instance RepT ((,,,) a b c) = K0 (Rep a) :*: K0 (Rep b) :*: K0 (Rep c) :*: I0
+type instance Rep (a, b, c, d) = RepT ((,,,) a b c) (Rep d)
+
+$(genRepT [d|
+   instance (Repr a, Repr b, Repr c) => ReprT ((,,,) a b c) where
+	toRepTMap f (a, b, c, d) = K0 (toRep a) :*: K0 (toRep b) :*: K0 (toRep c) :*: I0 (f d)
+	fromRepTMap f (K0 a :*: K0 b :*: K0 c :*: I0 d) = (fromRep a, fromRep b, fromRep c, f d) |])
+
+type instance RepT (Either a) = Sum (Rep a)
+type instance Rep (Either a b) = RepT (Either a) (Rep b)
+
+$(genRepT [d|
+  instance Repr a => ReprT (Either a) where
+	toRepTMap f = either (Left . toRep) (Right . f)
+	fromRepTMap f = either (Left . fromRep) (Right . f) |])
+
+type instance Rep Bool = (U0 :+: U0) (U0 ())
+instance Repr Bool where
+	toRep False = L U0
+	toRep True = R U0
+	fromRep L{} = False
+	fromRep R{} = True
+
+type instance Rep Char = Word32
+instance Repr Char where
+	toRep = fromIntegral . ord
+	fromRep = chr . fromIntegral
+
+type instance Rep () = U0 ()
+instance Repr () where
+	toRep _ = U0
+	fromRep _ = ()
+
+type instance Rep Double = Ordered Double
+instance Repr Double where
+	toRep = Ord
+	fromRep = unOrd
+
+type instance Rep Int = Rep Int32
+instance Repr Int where
+	toRep = toSigned
+	fromRep = fromSigned
+
+type instance Rep Word8 = Word32
+instance Repr Word8 where
+	toRep = fromIntegral
+	fromRep = fromIntegral
+
+type instance Rep Word16 = Word32
+instance Repr Word16 where
+	toRep = fromIntegral
+	fromRep = fromIntegral
+
+type instance Rep Word = Word32
+instance Repr Word where
+	toRep = fromIntegral
+	fromRep = fromIntegral
+
+type instance Rep Int8 = Rep Int32
+
+instance Repr Int8 where
+	toRep = toSigned
+	fromRep = fromSigned
+
+type instance Rep Int16 = Rep Int32
+instance Repr Int16 where
+	toRep = toSigned
+	fromRep = fromSigned
+
+type instance Rep Int32 = Sum (Rev Word32) Word32
+instance Repr Int32 where
+	toRep = toSigned
+	fromRep = fromSigned
+
+type instance Rep Word64 = Pair Word32 Word32
+instance Repr Word64 where
+	toRep x = (fromIntegral (x `shiftR` 32), fromIntegral x)
+	fromRep (x, y) = fromIntegral x `shiftL` 32 .|. fromIntegral y
+
+type instance Rep Int64 = Sum (Rev (Rep Word64)) (Rep Word64)
+instance Repr Int64 where
+	toRep x | x < 0	= Left (Rev (toRep' (fromIntegral (-x))))
+		| otherwise = Right (toRep' (fromIntegral x))
+		where toRep' = toRep :: Word64 -> Rep Word64
+	fromRep (Left (Rev x)) = - fromIntegral ((fromRep :: Rep Word64 -> Word64) x)
+	fromRep (Right x) = fromIntegral ((fromRep :: Rep Word64 -> Word64) x)
+
+{-# INLINE toSigned #-}
+toSigned :: Integral a => a -> Sum (Rev Word32) Word32
+toSigned x
+	| x < 0		= Left (Rev (fromIntegral (-x)))
+	| otherwise	= Right (fromIntegral x)
+
+{-# INLINE fromSigned #-}
+fromSigned :: Integral a => Sum (Rev Word32) Word32 -> a
+fromSigned = either (\ (Rev x) -> - fromIntegral x) fromIntegral
+
+type instance Rep Word32 = Word32
+instance Repr Word32 where
+	toRep = id
+	fromRep = id
+
+type instance Rep ByteString = (L I0 :*: I0) Word32
+instance Repr ByteString where
+	toRep xs = List (toList64 xs) :*: I0 (fromIntegral (length xs))
+	fromRep (List xs :*: I0 n) = case xs of
+		[]	-> BS.empty
+		(I0 x:xs) -> fst (unfoldrN (fromIntegral n) toBlock (W (Words 3 x) xs))
+
+data Words = Words {ix :: {-# UNPACK #-} !Int, word32 :: {-# UNPACK #-} !Word32}
+data Words' = W {-# UNPACK #-} !Words [I0 Word32]
+
+toList64 :: ByteString -> [I0 Word32]
+toList64 xs = case BS.foldl c (Words 4 0, Seq.empty) xs of
+	(Words i w32, ys) -> toList ys ++ [I0 w32]
+	where	fS :: Word8 -> Int -> Word32
+		fS w x = fromIntegral w `shiftL` x
+		(Words 0 w, xs) `c` w8
+			= (Words 3 (w .|. sL w8 24), xs |> I0 w)
+		(Words (i+1) w, xs) `c` w8
+			= (Words i (w .|. sL w8 (8 * i)), xs)
+		sL :: Word8 -> Int -> Word32
+		w `sL` x = fromIntegral w `shiftL` x
+
+toBlock :: Words' -> Maybe (Word8, Words')
+toBlock (W (Words i0@(i+1) w) xs) = Just (extract w (8 * i0), (W (Words i w) xs))
+	where	extract :: Word32 -> Int -> Word8
+		extract w x = fromIntegral (w `shiftR` x)
+toBlock (W (Words 0 w) (I0 x:xs)) = Just (fromIntegral w, (W (Words 3 x) xs))
+toBlock _ = Nothing
+
+type instance RepT (Array i) = L (Pair (Rep i)) :*: K0 (Pair (Rep i) (Rep i))
+type instance Rep (Array i e) = RepT (Array i) (Rep e)
+
+$(genRepT [d| 
+   instance (Repr i, Ix i) => ReprT (Array i) where
+	toRepTMap f arr = List [(toRep i, f a) | (i, a) <- assocs arr] :*: K0 (toRep l, toRep u)
+		where (l, u) = bounds arr
+	fromRepTMap f (List xs :*: K0 (l, r))
+		= array (fromRep l, fromRep r) [(fromRep k, f a) | (k, a) <- xs] |])
+
+type instance RepT Set.Set = L I0
+type instance RepT (Map.Map k) = L (Pair (Rep k))
+type instance Rep (Set.Set a) = L I0 (Rep a)
+type instance Rep (Map.Map k a) = RepT (Map.Map k) (Rep a)
+
+$(genRepT [d|
+   instance ReprT Set.Set where
+	toRepTMap f s = List (Fold.foldr (\ a xs -> I0 (f a):xs) [] s)
+	fromRepTMap f (List xs) = Set.fromDistinctAscList [f x | I0 x <- xs] |])
+
+$(genRepT [d|
+   instance Repr k => ReprT (Map.Map k) where
+	toRepTMap f m = List (Map.foldWithKey (\ k a xs -> (toRep k, f a):xs) [] m)
+	fromRepTMap f (List xs) = Map.fromDistinctAscList [(fromRep k, f x) | (k, x) <- xs] |])
+
+type instance RepT Rev = Rev
+type instance Rep (Rev a) = Rev (Rep a)
+
+$(genRepT [d|
+   instance ReprT Rev where
+   	toRepTMap f (Rev m) = Rev (f m)
+	fromRepTMap f (Rev m) = Rev (f m) |])
diff --git a/Data/TrieMap/Rep/TH.hs b/Data/TrieMap/Rep/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Rep/TH.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, TemplateHaskell, QuasiQuotes #-}
+
+module Data.TrieMap.Rep.TH (genRepT, mkCon, conT, mkVar, appT, Type(..)) where
+
+import Language.Haskell.TH
+import Data.TrieMap.Rep
+import Language.Haskell.TH.Ppr
+import Debug.Trace
+{-
+genRepT ::  TypeQ -> Q [Dec]
+genRepT ff = do
+	f <- ff
+	a <- newName "a"
+	b <- newName "b"
+	g <- newName "g"
+	let reprt = ConT (mkName "ReprT")
+	let repr = ConT (mkName "Repr")
+	let rept = ConT (mkName "RepT")
+	let rep = ConT (mkName "Rep")
+	torep <- [| fmap toRep . toRepT |]
+	fromrep <- [| fromRepT . fmap fromRep |]
+	let toRepType = ForallT [g, b] [AppT reprt (VarT g), AppT repr (VarT b)]
+		(AppT (VarT g) (VarT b) ~> AppT (AppT rept (VarT g)) (AppT rep (VarT b)))
+	let fromRepType = ForallT [g, b] [AppT reprt (VarT g), AppT repr (VarT b)] 
+		(AppT (AppT rept (VarT g)) (AppT rep (VarT b)) ~> AppT (VarT g) (VarT b))
+	let ans = [InstanceD [AppT reprt f, AppT repr (VarT a)] (AppT repr (AppT f (VarT a)))
+		[FunD (mkName "toRep") [Clause [] (NormalB ( torep )) []],
+			FunD (mkName "fromRep") [Clause [] (NormalB ( fromrep )) []]]]
+	return ans-}
+
+genRepT :: Q [Dec] -> Q [Dec]
+genRepT decs = do
+	iT@(InstanceD cxt (reprt `AppT` f) _:_) <- decs
+	(InstanceD _ _ myDecs:_) <- [d|
+		instance (ReprT f, Repr a) => Repr (f a) where
+			toRep = toRepTMap toRep
+			fromRep = fromRepTMap fromRep
+		|]
+	a <- mkVar "a"
+	repr <- conT ''Repr
+	return (InstanceD (repr `AppT` a:cxt) (repr `AppT` (f `AppT` a)) myDecs :iT)
+
+(~>) :: Type -> Type -> Type
+a ~> b = AppT (AppT ArrowT a) b
+
+mkCon :: String -> TypeQ
+mkCon = conT . mkName
+
+mkVar :: String -> TypeQ
+mkVar x = varT =<< newName x
+
+-- f :: Q [Dec]
+-- f = do	ans <- [d| instance (ReprT ((,) a), Repr b) => Repr (a, b) where |]
+-- 	traceShow ans $ return ans
diff --git a/Data/TrieMap/Representation.hs b/Data/TrieMap/Representation.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Representation.hs
@@ -0,0 +1,6 @@
+module Data.TrieMap.Representation (Repr(..), ReprT(..), Rep, RepT) where
+
+import Data.TrieMap.Rep
+import Data.TrieMap.Rep.Instances
+import Data.TrieMap.Regular.Rep
+
diff --git a/Data/TrieMap/Representation/TH.hs b/Data/TrieMap/Representation/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/Representation/TH.hs
@@ -0,0 +1,3 @@
+module Data.TrieMap.Representation.TH (module Data.TrieMap.Rep.TH) where
+
+import Data.TrieMap.Rep.TH
diff --git a/Data/TrieMap/ReverseMap.hs b/Data/TrieMap/ReverseMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieMap/ReverseMap.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE TemplateHaskell, UndecidableInstances, TypeFamilies, MultiParamTypeClasses, FlexibleContexts #-}
+
+module Data.TrieMap.ReverseMap() where
+
+import Data.TrieMap.TrieKey
+import Data.TrieMap.Modifiers
+import Data.TrieMap.Applicative
+import Data.TrieMap.Regular.Class
+import Data.TrieMap.Regular.TH
+
+import Control.Applicative
+import Control.Arrow
+
+import Data.Monoid hiding (Dual)
+
+newtype ReverseMap k a = RMap (TrieMap k a)
+
+type instance TrieMapT Rev = ReverseMap
+type instance TrieMap (Rev k) = ReverseMap k
+
+$(deriveM [d|
+   instance TrieKeyT Rev ReverseMap where
+	emptyT = RMap emptyM
+	nullT (RMap m) = nullM m
+	sizeT s (RMap m) = sizeM s m
+	lookupT (Rev k) (RMap m) = lookupM k m
+	lookupIxT s (Rev k) (RMap m) = case lookupIxM s k m of
+		(Last lb, x, First ub) -> onKey Rev (onIndex (sizeM s m - 1 -) (Last ub, x, First lb))
+	assocAtT s i (RMap m) = case assocAtM s (sz - 1 - i) m of
+		(Last lb, x, First ub) -> onKey Rev (onIndex (sz -) (Last ub, x, First lb))
+		where 	sz = sizeM s m
+-- 	updateAtM s r f i (RMap m) = RMap (updateAtM s r' f' (sz - i) m) where
+-- 		r' = not r
+-- 		f' i = f (sz - 1 - i) . Rev
+-- 		sz = sizeM s m
+	traverseWithKeyT s f (RMap m) = RMap <$> runDual (traverseWithKeyM s (\ k a -> Dual (f (Rev k) a)) m)
+	alterT s f (Rev k) (RMap m) = RMap (alterM s f k m)
+	splitLookupT s f (Rev k) (RMap m) = case splitLookupM s f' k m of
+		(mL, x, mR) -> (RMap mR, x, RMap mL)
+		where f' x = case f x of
+			(xL, ans, xR) -> (xR, ans, xL)
+	mapEitherT s1 s2 f (RMap m) = (RMap *** RMap) (mapEitherM s1 s2 (f . Rev) m)
+	foldWithKeyT f (RMap m) = foldlWithKeyM (flip . f . Rev) m
+	foldlWithKeyT f (RMap m) = foldWithKeyM (flip . f . Rev) m
+	unionT s f (RMap m1) (RMap m2) = RMap (unionM s (f . Rev) m1 m2)
+	isectT s f (RMap m1) (RMap m2) = RMap (isectM s (f . Rev) m1 m2)
+	diffT s f (RMap m1) (RMap m2) = RMap (diffM s (f . Rev) m1 m2)
+	extractT s f (RMap m) = second RMap <$> runDual (extractM s (\ k a -> Dual (f (Rev k) a)) m)
+-- 	extractMinM s f (RMap m) = second RMap <$> First (getLast (extractMaxM s (f . Rev) m))
+-- 	extractMaxM s f (RMap m) = second RMap <$> Last (getFirst (extractMinM s (f . Rev) m))
+-- 	alterMinM s f (RMap m) = RMap (alterMaxM s (f . Rev) m)
+-- 	alterMaxM s f (RMap m) = RMap (alterMinM s (f . Rev) m)
+	isSubmapT (<=) (RMap m1) (RMap m2) = isSubmapM (<=) m1 m2
+
+   reverse :: TrieMap k a -> TrieMap (Rev k) a
+   reverse = RMap |])
+
+unreverse :: TrieMap (Rev k) a -> TrieMap k a
+unreverse (RMap m) = m
diff --git a/Data/TrieMap/Sized.hs b/Data/TrieMap/Sized.hs
--- a/Data/TrieMap/Sized.hs
+++ b/Data/TrieMap/Sized.hs
@@ -10,9 +10,9 @@
 -- instance Sized Elem where
 -- 	getSize _ = 1
 
-type Sized f = forall ix . f ix -> Int
+type Sized a = a -> Int
 
 newtype Elem a = Elem {getElem :: a}
 
-elemSize :: Sized Elem
+elemSize :: Sized (Elem a)
 elemSize _ = 1
diff --git a/Data/TrieMap/TrieKey.hs b/Data/TrieMap/TrieKey.hs
--- a/Data/TrieMap/TrieKey.hs
+++ b/Data/TrieMap/TrieKey.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE Rank2Types, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, KindSignatures #-}
+{-# LANGUAGE PatternGuards, Rank2Types, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, TypeFamilies, KindSignatures #-}
 
 module Data.TrieMap.TrieKey where
 
@@ -6,13 +6,14 @@
 import Data.TrieMap.Sized
 
 import Control.Applicative
+import Control.Arrow
 
 import Data.Monoid
 import Data.List
 
-type family TrieMap k :: (* -> *) -> * -> *
+type family TrieMap k :: * -> *
 
-type family MapPF (m :: (* -> *) -> * -> *) ix :: (* -> *) -> *
+-- type family MapPF (m :: (* -> *) -> * -> *) ix :: (* -> *) -> *
 -- data Fixer f
 
 type EitherMap k a b c = k -> a -> (Maybe b, Maybe c)
@@ -20,47 +21,81 @@
 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 ExtractFunc f m k a x = (k -> a -> f (x, Maybe a)) -> m -> f (x, m)
 type LEq a b = a -> b -> Bool
+
+data Assoc k a = Asc {-# UNPACK #-} !Int k a
+-- data IndexPos k a = Between {-# UNPACK #-} !(Assoc k a) {-# UNPACK #-} !(Assoc k a)
+-- 			| Exact {-# UNPACK #-} !(Assoc k a) (Last (Assoc k a)) (First (Assoc k a))
+-- 			| Above {-# UNPACK #-} !(Assoc k a) | Below {-# UNPACK #-} !(Assoc k a) | Nada
+type IndexPos k a = (Last (Assoc k a), Maybe (Assoc k a), First (Assoc k a))
+
+onIndexA :: (Int -> Int) -> Assoc k a -> Assoc k a
+onIndexA f (Asc i k a) = Asc (f i) k a
+
+onIndex :: (Int -> Int) -> IndexPos k a -> IndexPos k a
+onIndex f (l, x, r) = (onIndexA f <$> l, onIndexA f <$> x, onIndexA f <$> r)
+
+onKey :: (k -> k') -> IndexPos k a -> IndexPos k' a
+onKey = onValue . first
+
+onVal :: (a -> a') -> IndexPos k a -> IndexPos k a'
+onVal = onValue . second
+
+onKeyA :: (k -> k') -> Assoc k a -> Assoc k' a
+onKeyA = onValueA . first
+
+onValA :: (a -> a') -> Assoc k a -> Assoc k a'
+onValA = onValueA . second
+
+{-# INLINE onValueA #-}
+onValueA :: ((k, a) -> (k', a')) -> Assoc k a -> Assoc k' a'
+onValueA f (Asc i k a) = uncurry (Asc i) (f (k, a))
+
+{-# INLINE onValue #-}
+onValue :: ((k, a) -> (k', a')) -> IndexPos k a -> IndexPos k' a'
+onValue f (l, x, r) = (onValueA f <$> l, onValueA f <$> x, onValueA f <$> r)
+
+type Round = Bool
 -- type Sized f = forall ix . f ix -> Int
 
 -- toFixer :: a -> Fixer a
 -- toFixer _ = undefined
 
 class Ord k => TrieKey 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
+	emptyM :: TrieMap k ~ m => m a
+	nullM :: TrieMap k ~ m => m a -> Bool
+	sizeM :: (TrieMap k ~ m) => Sized a -> m a -> Int
+	lookupM :: TrieMap k ~ m => k -> m a -> Maybe (a)
+	lookupIxM :: TrieMap k ~ m => Sized a -> k -> m a -> IndexPos k a
+	assocAtM :: TrieMap k ~ m => Sized a -> Int -> m a -> IndexPos k a
+-- 	updateAtM :: TrieMap k ~ m => Sized a -> Round -> (Int -> k -> a -> Maybe (a)) -> Int -> m a -> m a
+	alterM :: (TrieMap k ~ m) => Sized a -> (Maybe (a) -> Maybe (a)) -> k -> m a -> m a
+	{-# SPECIALIZE traverseWithKeyM :: (k -> a -> Id (b)) -> m a -> Id (m b) #-}
+	traverseWithKeyM :: (TrieMap k ~ m, Applicative f) => Sized b ->
+		(k -> a -> f (b)) -> m a -> f (m b)
+	foldWithKeyM :: TrieMap k ~ m => (k -> a -> b -> b) -> m a -> b -> b
+	foldlWithKeyM :: TrieMap k ~ m => (k -> b -> a -> b) -> m a -> b -> b
+	mapEitherM :: (TrieMap k ~ m) => Sized b -> Sized c -> EitherMap k (a) (b) (c) -> m a -> (m b, m c)
+	splitLookupM :: (TrieMap k ~ m) => Sized a -> SplitMap (a) x -> k -> m a -> (m a, Maybe x, m a)
+	unionM :: (TrieMap k ~ m) => Sized a -> UnionFunc k (a) -> m a -> m a -> m a
+	isectM :: (TrieMap k ~ m) => Sized c -> IsectFunc k (a) (b) (c) -> m a -> m b -> m c
+	diffM :: (TrieMap k ~ m) => Sized a -> DiffFunc k (a) (b) -> m a -> m b -> m a
+	extractM :: (TrieMap k ~ m, Alternative f) => Sized a -> ExtractFunc f (m a) k a x
+-- 	extractMinM :: (TrieMap k ~ m) => Sized a -> ExtractFunc k First (a) (m a) x
+-- 	extractMaxM :: (TrieMap k ~ m) => Sized a -> ExtractFunc k Last (a) (m a) x
+-- 	alterMinM :: (TrieMap k ~ m) => Sized a -> (k -> a -> Maybe a) -> m a -> First (m a)
+-- 	alterMaxM :: (TrieMap k ~ m) => Sized a -> (k -> a -> Maybe a) -> m a -> Last (m a)
+	isSubmapM :: TrieMap k ~ m => LEq (a) (b) -> LEq (m a) (m b)
+	fromListM, fromAscListM :: (TrieMap k ~ m) => Sized a -> (k -> a -> a -> a) -> [(k, a)] -> m a
+	fromDistAscListM :: (TrieMap k ~ m) => Sized a -> [(k, a)] -> m a
 	
 	sizeM s m = foldWithKeyM (\ _ a n -> s a + n) m 0
 	fromListM s f = foldl' (flip (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 :: (TrieKey k m, m ~ TrieMap k) => m a -> Maybe (m a)
 guardNullM m
 	| nullM m	= Nothing
 	| otherwise	= Just m
@@ -68,29 +103,29 @@
 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 :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a -> Maybe (b)) -> m a -> m b
 mapMaybeM s f = snd . mapEitherM elemSize s (((,) (Nothing :: Maybe (Elem ix))) .: f)
 
-mapWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a ix -> b ix) -> m a ix -> m b ix
+mapWithKeyM :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (k -> a -> b) -> m a -> m b
 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 :: (TrieKey k m, m ~ TrieMap k) => Sized b -> (a -> b) -> m a -> m b
 mapM s = mapWithKeyM s . const
 
-assocsM :: (TrieKey k m, m ~ TrieMap k) => m a ix -> [(k, a ix)]
+assocsM :: (TrieKey k m, m ~ TrieMap k) => m a -> [(k, a)]
 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 :: (TrieKey k m, m ~ TrieMap k) => Sized a -> k -> a -> m a -> m a
 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 :: (TrieKey k m, m ~ TrieMap k) => Sized a -> (k -> a -> a -> a) -> k -> a -> m a -> m a
 insertWithKeyM s f k a = alterM s f' k where
 	f' = Just . maybe a (f k a)
 
-singletonM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> k -> a ix -> m a ix
+singletonM :: (TrieKey k m, m ~ TrieMap k) => Sized a -> k -> a -> m a
 singletonM s k a = insertM s k a emptyM
 
-fromListM' :: (TrieKey k m, m ~ TrieMap k) => Sized a -> [(k, a ix)] -> m a ix
+fromListM' :: (TrieKey k m, m ~ TrieMap k) => Sized a -> [(k, a)] -> m a
 fromListM' s = fromListM s (const const) --xs = foldr (uncurry insertM) emptyM xs
 
 unionMaybe :: (a -> a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a
@@ -110,3 +145,6 @@
 subMaybe _ Nothing _ = True
 subMaybe (<=) (Just a) (Just b) = a <= b
 subMaybe _ _ _ = False
+
+aboutM :: (TrieKey k (TrieMap k), Alternative t) => (k -> a -> t z) -> TrieMap k a -> t z
+aboutM f = fst <.> extractM (const 0) (\ k a -> fmap (flip (,) Nothing) (f k a))
diff --git a/Data/TrieSet.hs b/Data/TrieSet.hs
new file mode 100644
--- /dev/null
+++ b/Data/TrieSet.hs
@@ -0,0 +1,173 @@
+module Data.TrieSet (
+	-- * Set type
+	TSet,
+	-- * Operators
+	(\\),
+	-- * Query
+	null,
+	size,
+	member,
+	notMember,
+	isSubsetOf,
+	isProperSubsetOf,
+	-- * Construction
+	empty,
+	singleton,
+	insert,
+	delete,
+	-- * Combine
+	union,
+	symmetricDifference,
+	intersection,
+	difference,
+	-- * Filter
+	filter,
+	partition,
+	split,
+	splitMember,
+	-- * Map
+	map,
+	mapMonotonic,
+	-- * Fold
+	fold,
+	foldl,
+	foldr,
+	-- * Min/Max
+	findMin,
+	findMax,
+	deleteMin,
+	deleteMax,
+	deleteFindMin,
+	deleteFindMax,
+	minView,
+	maxView,
+	-- * Conversion
+	-- ** List
+	elems,
+	toList,
+	fromList,
+	-- ** Ordered lists
+	toAscList,
+	fromAscList,
+	fromDistinctAscList)
+ 		where
+
+import qualified Data.TrieMap as M
+import Data.TrieMap.Class
+
+import Control.Applicative hiding (empty)
+import Control.Arrow
+
+import Data.Maybe
+import Data.Monoid
+
+import Prelude hiding (foldr, foldl, map, filter, null)
+
+instance TKey a => Eq (TSet a) where
+	s1 == s2 = s1 `isSubsetOf` s2 && size s1 == size s2
+
+instance (TKey a, Ord a) => Ord (TSet a) where
+	s1 `compare` s2 = elems s1 `compare` elems s2
+
+instance (TKey a, Show a) => Show (TSet a) where
+	show s = "fromList " ++ show (elems s)
+
+instance TKey a => Monoid (TSet a) where
+	mempty = empty
+	mappend = union
+
+empty :: TKey a => TSet a
+empty = TSet M.empty
+
+insert :: TKey a => a -> TSet a -> TSet a
+insert a (TSet s) = TSet (M.insert a () s)
+
+delete :: TKey a => a -> TSet a -> TSet a
+delete a (TSet s) = TSet (M.delete a s)
+
+singleton :: TKey a => a -> TSet a
+singleton a = insert a empty
+
+union :: TKey a => TSet a -> TSet a -> TSet a
+TSet s1 `union` TSet s2 = TSet (s1 `M.union` s2)
+
+symmetricDifference :: TKey a => TSet a -> TSet a -> TSet a
+TSet s1 `symmetricDifference` TSet s2 = TSet (M.unionMaybeWith (\ _ _ -> Nothing) s1 s2)
+
+difference :: TKey a => TSet a -> TSet a -> TSet a
+TSet s1 `difference` TSet s2 = TSet (s1 `M.difference` s2)
+
+intersection :: TKey a => TSet a -> TSet a -> TSet a
+TSet s1 `intersection` TSet s2 = TSet (s1 `M.intersection` s2)
+
+filter :: TKey a => (a -> Bool) -> TSet a -> TSet a
+filter p (TSet s) = TSet (M.filterWithKey (\ k _ -> p k) s)
+
+partition :: TKey a => (a -> Bool) -> TSet a -> (TSet a, TSet a)
+partition p (TSet s) = (TSet *** TSet) (M.partitionWithKey (\ k _ -> p k) s)
+
+split :: TKey a => a -> TSet a -> (TSet a, TSet a)
+split a s = case splitMember a s of
+	(sL, _, sR) -> (sL, sR)
+
+splitMember :: TKey a => a -> TSet a -> (TSet a, Bool, TSet a)
+splitMember a (TSet s) = case M.splitLookup a s of
+	(sL, x, sR) -> (TSet sL, isJust x, TSet sR)
+
+map :: (TKey a, TKey b) => (a -> b) -> TSet a -> TSet b
+map f (TSet s) = TSet (M.mapKeys f s)
+
+mapMonotonic :: (TKey a, TKey b) => (a -> b) -> TSet a -> TSet b
+mapMonotonic f (TSet s) = TSet (M.mapKeysMonotonic f s)
+
+fold, foldr :: TKey a => (a -> b -> b) -> b -> TSet a -> b
+fold = foldr
+foldr f z (TSet s) = M.foldrWithKey (const . f) z s
+
+foldl :: TKey b => (a -> b -> a) -> a -> TSet b -> a
+foldl f z (TSet s) = M.foldlWithKey (\ z a _ -> f z a) z s
+
+findMin, findMax :: TKey a => TSet a -> a
+findMin = fst . deleteFindMin
+findMax = fst . deleteFindMax
+
+deleteMin, deleteMax :: TKey a => TSet a -> TSet a
+deleteMin s = maybe s snd (minView s)
+deleteMax s = maybe s snd (maxView s)
+
+deleteFindMin, deleteFindMax :: TKey a => TSet a -> (a, TSet a)
+deleteFindMin = fromJust . minView
+deleteFindMax = fromJust . maxView
+
+minView, maxView :: TKey a => TSet a -> Maybe (a, TSet a)
+minView (TSet s) = (fst *** TSet) <$> M.minViewWithKey s
+maxView (TSet s) = (fst *** TSet) <$> M.maxViewWithKey s
+
+elems, toList, toAscList :: TKey a => TSet a -> [a]
+elems (TSet s) = M.keys s
+toList = elems
+toAscList = toList
+
+fromList, fromAscList, fromDistinctAscList :: TKey a => [a] -> TSet a
+fromList xs = TSet (M.fromList [(x, ()) | x <- xs])
+fromAscList xs = TSet (M.fromAscList [(x, ()) | x <- xs])
+fromDistinctAscList xs = TSet (M.fromDistinctAscList [(x, ()) | x <- xs])
+
+null :: TKey a => TSet a -> Bool
+null (TSet s) = M.null s
+
+size :: TKey a => TSet a -> Int
+size (TSet s) = M.size s
+
+member :: TKey a => a -> TSet a -> Bool
+member a (TSet s) = a `M.member` s
+
+notMember :: TKey a => a -> TSet a -> Bool
+notMember a = not . member a
+
+isSubsetOf, isProperSubsetOf :: TKey a => TSet a -> TSet a -> Bool
+TSet s1 `isSubsetOf` TSet s2 = M.isSubmapOfBy (\ _ _ -> True) s1 s2
+s1 `isProperSubsetOf` s2 = size s1 < size s2 && s1 `isSubsetOf` s2
+
+(\\) :: TKey a => TSet a -> TSet a -> TSet a
+(\\) = difference
diff --git a/TrieMap.cabal b/TrieMap.cabal
--- a/TrieMap.cabal
+++ b/TrieMap.cabal
@@ -1,5 +1,5 @@
 name:		     TrieMap
-version:             0.5.1
+version:             0.5.2
 tested-with:	     GHC
 category:            Algorithms
 synopsis:	     Automatic type inference of generalized tries.
@@ -8,24 +8,36 @@
 license-file:	     LICENSE
 author:              Louis Wasserman
 maintainer:          wasserman.louis@gmail.com
-build-Depends:       base < 5.0.0.0, containers, multirec
+build-Depends:       base < 5.0.0.0, containers, multirec, template-haskell, bytestring, array
 build-type:	     Simple
 exposed-modules:  
 	Data.TrieMap,
+	Data.TrieSet,
 	Data.TrieMap.Class,
 	Data.TrieMap.Regular,
-	Data.TrieMap.MultiRec
+	Data.TrieMap.MultiRec,
+	Data.TrieMap.Representation,
+	Data.TrieMap.Representation.TH,
+	Data.TrieMap.Modifiers
 	-- Data.TrieMap.TrieKey
 other-modules:
 	Data.TrieMap.Class.Instances,
 	Data.TrieMap.TrieKey,
 	Data.TrieMap.Applicative,
+	Data.TrieMap.Rep,
+	Data.TrieMap.Rep.Instances,
+	Data.TrieMap.Rep.TH,
+	Data.TrieMap.MultiRec.TH,
 	Data.TrieMap.MultiRec.FamMap,
 	Data.TrieMap.MultiRec.Eq,
 	Data.TrieMap.MultiRec.Ord,
 	Data.TrieMap.MultiRec.Class,
 	Data.TrieMap.MultiRec.ConstMap,
 	Data.TrieMap.MultiRec.IMap,
+	Data.TrieMap.MultiRec.Base,
+	-- Data.TrieMap.MultiRec.XMap,
+	Data.TrieMap.MultiRec.FixMap,
+	-- Data.TrieMap.MultiRec.AppMap,
 	Data.TrieMap.MultiRec.Instances,
 	Data.TrieMap.MultiRec.ProdMap,
 	Data.TrieMap.MultiRec.TagMap,
@@ -43,9 +55,13 @@
 	Data.TrieMap.Regular.RadixTrie,
 	Data.TrieMap.Regular.UnitMap,
 	Data.TrieMap.Regular.RegMap,
+	Data.TrieMap.Regular.CompMap,
 	Data.TrieMap.Regular.UnionMap,
+	Data.TrieMap.Regular.TH,
 	Data.TrieMap.Regular.Sized,
+	Data.TrieMap.Regular.Rep,
 	Data.TrieMap.IntMap,
 	Data.TrieMap.OrdMap,
+	Data.TrieMap.ReverseMap,
 	Data.TrieMap.Sized,
 	Data.TrieMap.Applicative