diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
--- a/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/TrieMap.cabal b/TrieMap.cabal
--- a/TrieMap.cabal
+++ b/TrieMap.cabal
@@ -1,5 +1,5 @@
 name:		TrieMap
-version:	0.0.1.0
+version:	0.0.1.1
 license:	BSD3
 license-file:	LICENSE
 maintainer:	wasserman.louis@gmail.com
@@ -21,7 +21,7 @@
  
 build-type:	Simple
 build-depends:
-	base >= 4 && <= 5, containers
+	base >= 4 && <= 5, containers == 0.2.0.1
 exposed-modules:
 	TrieMap
 	TrieMap.Algebraic
diff --git a/TrieMap.hs b/TrieMap.hs
--- a/TrieMap.hs
+++ b/TrieMap.hs
@@ -157,6 +157,7 @@
 import Control.Monad
 import Data.Monoid
 import Data.Traversable
+import TrieMap.MapTypes
 import TrieMap.Applicative
 import TrieMap.Algebraic
 import TrieMap.TrieAlgebraic
@@ -175,7 +176,7 @@
 import qualified Prelude as Prelude
 
 -- | A 'TrieMap' is a size-tracking wrapper around a generalized trie map.
-data TrieMap k m a = TrieMap {sizeMap :: Int, trieMap :: m a}
+data TrieMap k m a = TrieMap {sizeMap :: Int, trieMap :: m (Elem a)}
 
 instance (Eq k, Eq a, Algebraic k, TrieKey (Alg k) m) => Eq (TrieMap k m a) where
 	(==) = (==) `on` assocs
@@ -187,26 +188,26 @@
 	show m = "fromList " ++ show (assocs m)
 
 instance (Algebraic k, Algebraic a, TrieKey (Alg k) m) => Algebraic (TrieMap k m a) where
-	type Alg (TrieMap k m a) = (Int, [(Alg k, Alg a)])
-	toAlg (TrieMap n m) = (n, build (\ c n -> foldWithKeyAlg (\ k a -> c (k, toAlg a)) n m))
-	fromAlg (n, xs) = TrieMap n $ fromDistAscListAlg [(k, fromAlg a) | (k, a) <- xs]
+	type Alg (TrieMap k m a) = ([(Alg k, Alg a)], Int)
+	toAlg (TrieMap n m) = (build (\ c n -> foldWithKeyAlg (\ k a -> c (k, toAlg a)) n m), n)
+	fromAlg (xs, n) = TrieMap n $ fromDistAscListAlg [(k, fromAlg a) | (k, a) <- xs]
 
 instance Functor m => Functor (TrieMap k m) where
-	fmap f (TrieMap n m) = TrieMap n (fmap f m)
+	fmap f (TrieMap n m) = TrieMap n (fmap (fmap f) m)
 
 instance Foldable m => Foldable (TrieMap k m) where
-	foldr f z = foldr f z . trieMap
-	foldl f z = foldl f z . trieMap
-	foldMap f = foldMap f . trieMap
+	foldr f z = foldr (\ (Elem x) z -> f x z) z . trieMap
+	foldl f z = foldl (\ z (Elem x) -> f z x) z . trieMap
+	foldMap f = foldMap (f . getElem) . trieMap
 
 instance Traversable m => Traversable (TrieMap k m) where
-	traverse f (TrieMap n m) = TrieMap n <$> traverse f m
+	traverse f (TrieMap n m) = TrieMap n <$> traverse (traverse f) m
 
 instance (Algebraic k, TrieKey (Alg k) m) => Monoid (TrieMap k m a) where
 	mempty = empty
 	mappend = union
 
-mkTrieMap :: (Algebraic k, TrieKey (Alg k) m) => m a -> TrieMap k m a
+mkTrieMap :: (Algebraic k, TrieKey (Alg k) m) => m (Elem a) -> TrieMap k m a
 mkTrieMap m = TrieMap (sizeAlg m) m
 
 -- | Lookup the value of a key in the map.
@@ -214,7 +215,7 @@
 -- The function will return the corresponding value as @('Just' value)@,
 -- or 'Nothing' if the key isn't in the map.
 lookup :: (Algebraic k, TrieKey (Alg k) m) => k -> TrieMap k m a -> Maybe a
-lookup k = lookupAlg (toAlg k) . trieMap
+lookup k = fmap getElem . lookupAlg (toAlg k) . trieMap
 
 -- | Is the key a member of the map? See also 'notMember'.
 --
@@ -249,7 +250,7 @@
 --
 -- > singleton 1 'a'        == fromList [(1, 'a')]
 singleton :: (Algebraic k, TrieKey (Alg k) m) => k -> a -> TrieMap k m a
-singleton k v = TrieMap 1 (insertAlg (toAlg k) v emptyAlg)
+singleton k v = TrieMap 1 (insertAlg (toAlg k) (Elem v) emptyAlg)
 
 -- | Find the value at a key.
 -- Calls 'error' when the element can not be found.
@@ -293,7 +294,7 @@
 -- > fromListWithKey f [(5,"a"), (5,"b"), (3,"b"), (3,"a"), (5,"a")] == fromList [(3, "3ab"), (5, "5a5ba")]
 -- > fromListWithKey f [] == empty
 fromListWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> a -> a) -> [(k, a)] -> TrieMap k m a
-fromListWithKey f xs = mkTrieMap $ fromListAlg (f . fromAlg) [(toAlg k, v) | (k, v) <- xs]
+fromListWithKey f xs = mkTrieMap $ fromListAlg (\ k (Elem v1) (Elem v2) -> Elem (f (fromAlg k) v1 v2)) [(toAlg k, Elem v) | (k, v) <- xs]
 
 -- | /O(n)/. Build a map from an ascending list in linear time.
 -- /The precondition (input list is ascending) is not checked./
@@ -317,14 +318,15 @@
 -- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2
 -- > fromAscListWithKey f [(3,"b"), (5,"a"), (5,"b"), (5,"b")] == fromList [(3, "b"), (5, "5:b5:ba")]
 fromAscListWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> a -> a) -> [(k, a)] -> TrieMap k m a
-fromAscListWithKey f xs = mkTrieMap $ fromAscListAlg (f . fromAlg) [(toAlg k, v) | (k, v) <- xs]
+fromAscListWithKey f xs = mkTrieMap $ fromAscListAlg g [(toAlg k, Elem v) | (k, v) <- xs] where
+	g k (Elem v1) (Elem v2) = Elem (f (fromAlg k) v1 v2)
 
 -- | /O(n)/. Build a map from an ascending list of distinct elements in linear time.
 -- /The precondition is not checked./
 --
 -- > fromDistinctAscList [(3,"b"), (5,"a")] == fromList [(3, "b"), (5, "a")]
 fromDistinctAscList :: (Algebraic k, TrieKey (Alg k) m) => [(k, a)] -> TrieMap k m a
-fromDistinctAscList xs = TrieMap (length xs) $ fromDistAscListAlg [(toAlg k, v) | (k, v) <- xs]
+fromDistinctAscList xs = TrieMap (length xs) $ fromDistAscListAlg [(toAlg k, Elem v) | (k, v) <- xs]
 
 -- | Insert a new key and value in the map.
 -- If the key is already present in the map, the associated value is
@@ -368,8 +370,9 @@
 -- is a pair where the first element is equal to (@'lookup' k map@)
 -- and the second element equal to (@'insertWithKey' f k x map@).
 insertLookupWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> a -> a) -> k -> a -> TrieMap k m a -> (Maybe a, TrieMap k m a)
-insertLookupWithKey f k v (TrieMap n m) = case alterLookupAlg (\ v' -> (v', Just $ maybe v (f k v) v')) (toAlg k) m of
+insertLookupWithKey f k v (TrieMap n m) = case alterLookupAlg g (toAlg k) m of
 	(old, m')	-> (old, TrieMap (if isJust old then n else n + 1) m')
+	where	g v' = (fmap getElem v', Just $ Elem $ maybe v (f k v . getElem) v')
 
 -- | The expression (@'update' f k map@) updates the value @x@
 -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
@@ -404,8 +407,9 @@
 -- > updateLookupWithKey f 3 (fromList [(5,"a"), (3,"b")]) == (Just "b", singleton 5 "a")
 updateLookupWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> Maybe a) -> k -> TrieMap k m a -> (Maybe a, TrieMap k m a)
 updateLookupWithKey f k (TrieMap n m) = 
-	case alterLookupAlg (\ v -> let v' = v >>= f k in ((isNothing v' && isJust v, maybe v Just v'), v')) (toAlg k) m of
+	case alterLookupAlg g (toAlg k) m of
 		((del, res), m')	-> (res, TrieMap (if del then n - 1 else n) m')
+	where	g v = let v' = v >>= f k . getElem in ((isNothing v' && isJust v, maybe (fmap getElem v) Just v'), fmap Elem v')
 
 -- | Delete a key and its value from the map. When the key is not
 -- a member of the map, the original map is returned.
@@ -439,7 +443,8 @@
 alterLookup :: (Algebraic k, TrieKey (Alg k) m) => (Maybe a -> Maybe a) -> k -> TrieMap k m a -> (Maybe a, TrieMap k m a)
 alterLookup f k (TrieMap n m) = case alterLookupAlg g (toAlg k) m of
 	((old, delta), m')	-> (old, TrieMap (n + delta) m')
-	where	g v = let fv = f v in ((v, just1 fv - just1 v), fv)
+	where	g Nothing = let fv = f Nothing in ((Nothing, just1 fv), fmap Elem fv)
+		g (Just (Elem v)) = let fv = f (Just v) in ((Just v, just1 fv - 1), fmap Elem fv)
 		just1 = maybe 0 (const 1)
 
 -- | /O(n)/. Map a function over all values in the map.
@@ -458,7 +463,7 @@
 -- | Essentially equivalent to 'traverse' with a function that takes both the key and the value as arguments.
 mapAppWithKey :: (Algebraic k, TrieKey (Alg k) m, Applicative f) =>
 	(k -> a -> f b) -> TrieMap k m a -> f (TrieMap k m b)
-mapAppWithKey f (TrieMap n m) = TrieMap n <$> mapAppAlg (f . fromAlg) m
+mapAppWithKey f (TrieMap n m) = TrieMap n <$> mapAppAlg (\ k (Elem v) -> Elem <$> f (fromAlg k) v) m
 
 -- | Equivalent to 'traverse'.
 mapApp :: (Algebraic k, TrieKey (Alg k) m, Applicative f) => (a -> f b) -> TrieMap k m a -> f (TrieMap k m b)
@@ -469,7 +474,7 @@
 -- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing
 -- > mapMaybeWithKey f (fromList [(5,"a"), (3,"b")]) == singleton 3 "key : 3"
 mapMaybeWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> Maybe b) -> TrieMap k m a -> TrieMap k m b
-mapMaybeWithKey f = mkTrieMap . mapMaybeAlg (f . fromAlg) . trieMap
+mapMaybeWithKey f = mkTrieMap . mapMaybeAlg (\ k (Elem v) -> Elem <$> f (fromAlg k) v) . trieMap
 
 -- | /O(n)/. Map values and collect the 'Just' results.
 --
@@ -499,7 +504,7 @@
 -- >     == (empty, fromList [(1,"x"), (3,"b"), (5,"a"), (7,"z")])
 mapEitherWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> Either b c) -> TrieMap k m a -> (TrieMap k m b, TrieMap k m c)
 mapEitherWithKey f (TrieMap _ m) = (mkTrieMap mL, mkTrieMap mR)
-	where	(mL, mR) = mapEitherAlg (f . fromAlg) m
+	where	(mL, mR) = mapEitherAlg (\ k (Elem v) -> either (Left . Elem) (Right . Elem) (f (fromAlg k) v)) m
 
 -- |
 -- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
@@ -626,11 +631,11 @@
 -- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"
 -- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"
 foldWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> b -> b) -> b -> TrieMap k m a -> b
-foldWithKey f z = foldWithKeyAlg (f . fromAlg) z . trieMap
+foldWithKey f z = foldWithKeyAlg (\ k (Elem v) -> f (fromAlg k) v) z . trieMap
 
 -- | /O(n+m)/.  Union with a combining function that may discard some elements.
 unionMaybeWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> a -> Maybe a) -> TrieMap k m a -> TrieMap k m a -> TrieMap k m a
-unionMaybeWithKey f = mkTrieMap .: unionMaybeAlg (f . fromAlg) `on` trieMap
+unionMaybeWithKey f = mkTrieMap .: unionMaybeAlg (\ k (Elem v1) (Elem v2) -> Elem <$> f (fromAlg k) v1 v2) `on` trieMap
 
 -- | /O(n+m)/.
 -- Union with a combining function. 
@@ -666,7 +671,7 @@
 unionsWith = unionsWithKey . const
 
 unionsWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> a -> a) -> [TrieMap k m a] -> TrieMap k m a
-unionsWithKey f = mkTrieMap . foldl' (unionMaybeAlg (\ k x y -> Just (f (fromAlg k) x y))) emptyAlg 
+unionsWithKey f = mkTrieMap . foldl' (unionMaybeAlg (\ k (Elem x) (Elem y) -> Just $ Elem $ f (fromAlg k) x y)) emptyAlg 
 			. Prelude.map trieMap
 
 -- | O(n+m).  Symmetric difference.  Equivalent to @'unionMaybeWith' (\ _ _ -> Nothing)@.
@@ -676,7 +681,8 @@
 -- | /O(n+m)/.  Intersection of two maps with a combining function that may discard some elements.
 intersectionMaybeWithKey :: (Algebraic k, TrieKey (Alg k) m) => 
 	(k -> a -> b -> Maybe c) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m c
-intersectionMaybeWithKey f (TrieMap _ m1) (TrieMap _ m2) = mkTrieMap $ intersectAlg (f . fromAlg) m1 m2
+intersectionMaybeWithKey f (TrieMap _ m1) (TrieMap _ m2) = mkTrieMap $ 
+	intersectAlg (\ k (Elem a) (Elem b) -> Elem <$> f (fromAlg k) a b) m1 m2
 
 -- | /O(n+m)/. Intersection with a combining function.
 --
@@ -712,7 +718,8 @@
 -- > differenceWithKey f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (10, "C")])
 -- >     == singleton 3 "3:b|B"
 differenceWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> b -> Maybe a) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m a
-differenceWithKey f (TrieMap _ m1) (TrieMap _ m2) = mkTrieMap $ differenceAlg (f . fromAlg) m1 m2
+differenceWithKey f (TrieMap _ m1) (TrieMap _ m2) = mkTrieMap $ 
+	differenceAlg (\ k (Elem x) (Elem y) -> Elem <$> f (fromAlg k) x y) m1 m2
 
 -- | /O(n+m)/. Difference with a combining function. 
 -- When two equal keys are
@@ -724,7 +731,7 @@
 -- > differenceWith f (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (3, "B"), (7, "C")])
 -- >     == singleton 3 "b:B"
 differenceWith :: (Algebraic k, TrieKey (Alg k) m) => (a -> b -> Maybe a) -> TrieMap k m a -> TrieMap k m b -> TrieMap k m a
-differenceWith f (TrieMap _ m1) (TrieMap _ m2) = mkTrieMap $ differenceAlg (const f) m1 m2
+differenceWith = differenceWithKey . const
 
 -- | /O(n+m)/. Difference of two maps. 
 -- Return elements of the first map not existing in the second map.
@@ -802,7 +809,8 @@
 -- > updateMin (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
 updateMin :: (Algebraic k, TrieKey (Alg k) m) => (a -> Maybe a) -> TrieMap k m a -> TrieMap k m a
 updateMin f (TrieMap n m) = TrieMap (if del then n-1 else n) m'
-	where	(del, m') = updateMinAlg (const (checkNothing . f)) m
+	where	(del, m') = updateMinAlg (const (checkNothing . g)) m
+		g (Elem x) = Elem <$> f x
 
 -- | Update the value at the maximal key.
 --
@@ -810,7 +818,8 @@
 -- > updateMax (\ _ -> Nothing)         (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
 updateMax :: (Algebraic k, TrieKey (Alg k) m) => (a -> Maybe a) -> TrieMap k m a -> TrieMap k m a
 updateMax f (TrieMap n m) = TrieMap (if del then n-1 else n) m'
-	where	(del, m') = updateMaxAlg (const (checkNothing . f)) m
+	where	(del, m') = updateMaxAlg (const (checkNothing . g)) m
+		g (Elem x) = Elem <$> f x
 
 -- | Update the value at the minimal key.
 --
@@ -818,7 +827,8 @@
 -- > updateMinWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 5 "a"
 updateMinWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> Maybe a) -> TrieMap k m a -> TrieMap k m a
 updateMinWithKey f (TrieMap n m) = TrieMap (if del then n-1 else n) m'
-	where	(del, m') = updateMinAlg (checkNothing .: f . fromAlg) m
+	where	(del, m') = updateMinAlg (checkNothing .: g) m
+		g k (Elem v) = Elem <$> f (fromAlg k) v
 
 -- | Update the value at the maximal key.
 --
@@ -826,7 +836,8 @@
 -- > updateMaxWithKey (\ _ _ -> Nothing)                     (fromList [(5,"a"), (3,"b")]) == singleton 3 "b"
 updateMaxWithKey :: (Algebraic k, TrieKey (Alg k) m) => (k -> a -> Maybe a) -> TrieMap k m a -> TrieMap k m a
 updateMaxWithKey f (TrieMap n m) = TrieMap (if del then n-1 else n) m'
-	where	(del, m') = updateMaxAlg (checkNothing .: f . fromAlg) m
+	where	(del, m') = updateMaxAlg (checkNothing .: g) m
+		g k (Elem v) = Elem <$>  f (fromAlg k) v
 
 -- | Retrieves the value associated with the minimal key of the
 -- map, and the map stripped of that element, or 'Nothing' if passed an
@@ -836,7 +847,7 @@
 -- > minView empty == Nothing
 minView :: (Algebraic k, TrieKey (Alg k) m) => TrieMap k m a -> Maybe (a, TrieMap k m a)
 minView (TrieMap n m) = do
-	(~(_, v), m') <- getMinAlg m
+	(~(_, Elem v), m') <- getMinAlg m
 	return (v, TrieMap (n-1) m')
 
 -- | Retrieves the value associated with the maximal key of the
@@ -846,7 +857,7 @@
 -- > maxView empty == Nothing
 maxView :: (Algebraic k, TrieKey (Alg k) m) => TrieMap k m a -> Maybe (a, TrieMap k m a)
 maxView (TrieMap n m) = do
-	(~(_, v), m') <- getMaxAlg m
+	(~(_, Elem v), m') <- getMaxAlg m
 	return (v, TrieMap (n-1) m')
 
 -- | Retrieves the minimal (key,value) pair of the map, and
@@ -856,7 +867,7 @@
 -- > minViewWithKey empty == Nothing
 minViewWithKey :: (Algebraic k, TrieKey (Alg k) m) => TrieMap k m a -> Maybe ((k, a), TrieMap k m a)
 minViewWithKey (TrieMap n m) = do
-	(~(k, v), m') <- getMinAlg m
+	(~(k, Elem v), m') <- getMinAlg m
 	return ((fromAlg k, v), TrieMap (n-1) m')
 
 -- | Retrieves the maximal (key,value) pair of the map, and
@@ -866,7 +877,7 @@
 -- > maxViewWithKey empty == Nothing
 maxViewWithKey :: (Algebraic k, TrieKey (Alg k) m) => TrieMap k m a -> Maybe ((k, a), TrieMap k m a)
 maxViewWithKey (TrieMap n m) = do
-	~(~(k, v), m') <- getMaxAlg m
+	~(~(k, Elem v), m') <- getMaxAlg m
 	return ((fromAlg k, v), TrieMap (n-1) m')
 
 -- | /O(n+m)/.
@@ -893,7 +904,8 @@
  
 -}
 isSubmapOfBy :: (Algebraic k, TrieKey (Alg k) m) => (a -> b -> Bool) -> TrieMap k m a -> TrieMap k m b -> Bool
-isSubmapOfBy (<=) (TrieMap n1 m1) (TrieMap n2 m2) = (Prelude.<=) n1 n2 && isSubmapAlg (<=) m1 m2
+isSubmapOfBy (<=) (TrieMap n1 m1) (TrieMap n2 m2) = (Prelude.<=) n1 n2 && isSubmapAlg (<<=) m1 m2
+	where	Elem x <<= Elem y = x <= y
 
 -- | The expression (@'split' k map@) is a pair @(map1,map2)@ where
 -- the keys in @map1@ are smaller than @k@ and the keys in @map2@ larger than @k@.
@@ -917,7 +929,7 @@
 -- > splitLookup 5 (fromList [(5,"a"), (3,"b")]) == (singleton 3 "b", Just "a", empty)
 -- > splitLookup 6 (fromList [(5,"a"), (3,"b")]) == (fromList [(3,"b"), (5,"a")], Nothing, empty)
 splitLookup :: (Algebraic k, TrieKey (Alg k) m) => k -> TrieMap k m a -> (TrieMap k m a, Maybe a, TrieMap k m a)
-splitLookup k (TrieMap n m) = case splitLookupAlg (\ v -> (Nothing, Just v, Nothing)) (toAlg k) m of
+splitLookup k (TrieMap n m) = case splitLookupAlg (\ (Elem v) -> (Nothing, Just v, Nothing)) (toAlg k) m of
 	(mL, v, mR) -> (mkTrieMap mL, v, mkTrieMap mR)
 -- TODO: Somehow, avoid the mkTrieMap call.  Is this possible?  I don't think so, without a sophisticated range-mconcat operation
 -- with monoids or some crazy shit like that.
diff --git a/TrieMap/MapTypes.hs b/TrieMap/MapTypes.hs
--- a/TrieMap/MapTypes.hs
+++ b/TrieMap/MapTypes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeOperators, FlexibleContexts, StandaloneDeriving #-}
+{-# LANGUAGE IncoherentInstances, TypeOperators, FlexibleContexts, StandaloneDeriving #-}
 
 module TrieMap.MapTypes where
 
@@ -6,6 +6,7 @@
 import Data.Traversable
 import Control.Applicative
 import Prelude hiding (foldl, foldr)
+import qualified Data.IntMap as IMap
 
 -- | 'ProdMap' is used to hold a map on the product of two key types.
 newtype ProdMap m1 m2 v = PMap {unPMap :: m1 (m2 v)} deriving (Eq, Ord)
@@ -13,15 +14,33 @@
 -- | 'UnionMap' is used to hold a map on the sum of two key types.
 data UnionMap m1 m2 v = m1 v :+: m2 v deriving (Eq, Ord)
 
-data Edge k m v = Edge [k] (Maybe v) (m (Edge k m v))
+data Edge k m v = Edge {-# UNPACK #-} !Int [k] (Maybe v) (m (Edge k m v))
 type MEdge k m v = Maybe (Edge k m v)
 
 -- | 'RadixTrie' is used to hold a map on a list of keys.
 newtype RadixTrie k m v = Radix {unRad :: MEdge k m v} 
 
+newtype Elem a = Elem {getElem :: a} deriving (Eq, Ord)
+
+instance Functor Elem where
+	fmap f (Elem x) = Elem (f x)
+
+instance Foldable Elem where
+	foldr f z (Elem a) = a `f` z
+	foldl f z (Elem a) = z `f` a
+
+instance Traversable Elem where
+	traverse f (Elem x) = Elem <$> f x
+
 infixr 5 `ProdMap`
 infixr 5 :+:
 
+class Sized a where
+	getSize :: a -> Int
+
+instance Sized (Elem a) where
+	getSize _ = 1
+
 instance (Functor m1, Functor m2) => Functor (ProdMap m1 m2) where
 	fmap f (PMap m) = PMap (fmap (fmap f) m)
 
@@ -43,22 +62,25 @@
 	traverse f (m1 :+: m2) = liftA2 (:+:) (traverse f m1) (traverse f m2)
 
 instance Functor m => Functor (Edge k m) where
-	fmap f (Edge ks v ts) = Edge ks (fmap f v) (fmap (fmap f) ts)
+	fmap f (Edge n ks v ts) = Edge n ks (fmap f v) (fmap (fmap f) ts)
 
 instance Functor m => Functor (RadixTrie k m) where
 	fmap f (Radix e) = Radix (fmap (fmap f) e)
 
 instance Foldable m => Foldable (Edge k m) where
-	foldr f z (Edge _ v ts) = foldr (flip (foldr f)) (foldr f z v) ts
-	foldl f z (Edge _ v ts) = foldl f (foldl (foldl f) z ts) v
+	foldr f z (Edge _ _ v ts) = foldr (flip (foldr f)) (foldr f z v) ts
+	foldl f z (Edge _ _ v ts) = foldl f (foldl (foldl f) z ts) v
 
 instance Foldable m => Foldable (RadixTrie k m) where
 	foldr f z (Radix e) = foldr (flip (foldr f)) z e
 	foldl f z (Radix e) = foldl (foldl f) z e
 
 instance Traversable m => Traversable (Edge k m) where
-	traverse f (Edge ks v ts) = 
-		liftA2 (Edge ks) (traverse f v) (traverse (traverse f) ts)
+	traverse f (Edge n ks v ts) = 
+		liftA2 (Edge n ks) (traverse f v) (traverse (traverse f) ts)
 
 instance Traversable m => Traversable (RadixTrie k m) where
 	traverse f (Radix e) = Radix <$> traverse (traverse f) e
+
+instance Traversable IMap.IntMap where
+	traverse f m = IMap.fromDistinctAscList <$> traverse (\ (k, v) -> ((,) k) <$> f v) (IMap.assocs m)
diff --git a/TrieMap/RadixTrie.hs b/TrieMap/RadixTrie.hs
--- a/TrieMap/RadixTrie.hs
+++ b/TrieMap/RadixTrie.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FlexibleContexts, StandaloneDeriving, PatternGuards #-}
+{-# LANGUAGE IncoherentInstances, MultiParamTypeClasses, UndecidableInstances, FlexibleContexts, StandaloneDeriving, PatternGuards #-}
 
 module TrieMap.RadixTrie (RadixTrie) where
 
@@ -19,10 +19,10 @@
 import Prelude hiding (null, foldr, all)
 
 instance (Eq k, Eq v, TrieKey k m) => Eq (Edge k m v) where
-	Edge ks1 v1 ts1 == Edge ks2 v2 ts2 = ks1 == ks2 && v1 == v2 && assocsAlg ts1 == assocsAlg ts2
+	Edge n1 ks1 v1 ts1 == Edge n2 ks2 v2 ts2 = n1 == n2 && ks1 == ks2 && v1 == v2 && assocsAlg ts1 == assocsAlg ts2
 
 instance (Ord k, Ord v, TrieKey k m) => Ord (Edge k m v) where
-	Edge ks1 v1 ts1 `compare` Edge  ks2 v2 ts2 = 
+	Edge _ ks1 v1 ts1 `compare` Edge _ ks2 v2 ts2 = 
 		compare ks1 ks2 `mappend` compare v1 v2 `mappend` comparing assocsAlg ts1 ts2
 
 deriving instance (Eq k, Eq v, TrieKey k m) => Eq (RadixTrie k m v)
@@ -30,11 +30,15 @@
 deriving instance (Show k, Show v, Functor m, Show (m String)) => Show (RadixTrie k m v)
 
 instance (Show k, Show v, Functor m, Show (m String)) => Show (Edge k m v) where
-	show (Edge k v ts) = "Edge " ++ show k ++ " " ++ show v ++ " " ++ show (fmap show ts)
+	show (Edge _ k v ts) = "Edge " ++ show k ++ " " ++ show v ++ " " ++ show (fmap show ts)
 
+instance Sized (Edge k m v) where
+	getSize (Edge n _ _ _) = n
+
 instance (Ord k, TrieKey k m) => TrieKey [k] (RadixTrie k m) where
 	emptyAlg = Radix Nothing
 	nullAlg = isNothing . unRad
+	sizeAlg (Radix e) = maybe 0 getSize e
 	getSingleAlg (Radix e) = e >>= getSingleEdge
 	guardNullAlg (Radix e) = do	e <- guardNullEdge =<< e
 					return (Radix (Just e))
@@ -63,7 +67,8 @@
 	fromAscListAlg f xs = Radix (edgeFromAscList f xs)
 	fromDistAscListAlg = fromAscListAlg (\ _ v _ -> v)
 
-	isSubmapAlg (<=) (Radix e1) (Radix e2) = isSubmapAlg (isSubmapEdge (<=)) e1 e2
+	isSubmapAlg (<=) (Radix e1) (Radix e2) = isSubmapAlg subEdge e1 e2 -- hehe, using the Maybe instance here!
+		where	subEdge = isSubmapEdge (==) (<=) lookupAlg $! isSubmapAlg subEdge
 
 	valid (Radix e) = maybe True validEdge e
 
@@ -74,52 +79,58 @@
 -- sizeEdge :: Edge k m v -> Int
 -- sizeEdge (Edge n _ _ _) = n
 
--- edge :: TrieKey k m => [k] -> Maybe v -> m (Edge k m v) -> Edge k m v
--- edge ks v ts = Edge (maybe id (const (+1)) v $ foldl' (\ n e -> n + sizeEdge e) 0 ts) ks v ts
+{-# INLINE edge #-}
+edge :: (Sized v, TrieKey k m) => [k] -> Maybe v -> m (Edge k m v) -> Edge k m v
+edge ks v ts = Edge (getSize v + getSize ts) ks v ts
 
 lookupEdge :: TrieKey k m => (k -> k -> Bool) -> [k] -> Edge k m v -> Maybe v
-lookupEdge (==) ks (Edge ls v ts) = procEdge ks ls where
+lookupEdge (==) ks (Edge _ ls v ts) = procEdge ks ls where
 	procEdge (k:ks) (l:ls)
-		| k == l	= procEdge ks ls
+		| k == l  = procEdge ks ls
 	procEdge (k:ks) [] = lookupAlg k ts >>= lookupEdge (==) ks
 	procEdge [] [] = v
 	procEdge _ _ = Nothing
 
-edgeFromList :: (Eq k, TrieKey k m) => ([k] -> v -> v -> v) -> [([k], v)] -> MEdge k m v
-edgeFromList f xs = guardNullEdge $ Edge [] v0 $ mapMaybeAlg (\ k -> edgeFromList (f . (k:))) $ fromListAlg (const (flip (++))) ys
+edgeFromList :: (Eq k, TrieKey k m, Sized v) => ([k] -> v -> v -> v) -> [([k], v)] -> MEdge k m v
+edgeFromList f xs = guardNullEdge $ edge [] v0 $ mapMaybeAlg (\ k (Elem xs)-> edgeFromList (f . (k:)) xs) $ 
+	fromListAlg (\ _ (Elem xs) (Elem ys) -> Elem (ys ++ xs)) ys
 	where	part ([], v) (v0, ys) = (Just $ maybe v (flip (f []) v) v0, ys)
-		part (k:ks, v) (v0, ys) = (v0, (k, [(ks, v)]):ys)
+		part (k:ks, v) (v0, ys) = (v0, (k, Elem [(ks, v)]):ys)
 		(v0, ys) = foldr part (Nothing, []) xs
 
-edgeFromAscList :: (Eq k, TrieKey k m) => ([k] -> v -> v -> v) -> [([k], v)] -> MEdge k m v
+edgeFromAscList :: (Eq k, TrieKey k m, Sized v) => ([k] -> v -> v -> v) -> [([k], v)] -> MEdge k m v
 edgeFromAscList _ [] = Nothing
-edgeFromAscList f xs = Just $ case groupHead f xs of
-	(Nothing, [(k, ~(Edge ks v ts))])
-			-> Edge (k:ks) v ts
-	(ans, xs')	-> Edge [] ans (fromDistAscListAlg xs')
+edgeFromAscList f (x:xs) = Just $ edgeFromAscList' f x xs
 
-groupHead :: (Eq k, TrieKey k m) => ([k] -> v -> v -> v) -> [([k], v)] -> (Maybe v, [(k, Edge k m v)])
+edgeFromAscList' :: (Eq k, TrieKey k m, Sized v) => ([k] -> v -> v -> v) -> ([k], v) -> [([k], v)] -> Edge k m v
+edgeFromAscList' f (ks, v) [] = Edge (getSize v) ks (Just v) emptyAlg
+edgeFromAscList' f x xs = case groupHead f (x:xs) of
+	(Nothing, [(k, ~(Edge n ks v ts))])
+			-> Edge n (k:ks) v ts
+	(ans, xs')	-> edge [] ans (fromDistAscListAlg xs')
+
+groupHead :: (Eq k, TrieKey k m, Sized v) => ([k] -> v -> v -> v) -> [([k], v)] -> (Maybe v, [(k, Edge k m v)])
 groupHead f (([], v):xs) = case groupHead f xs of
 	(v', ans)	-> (Just $ maybe v (f [] v) v', ans)
-groupHead f ((k:ks, v):xs) = (Nothing, groupHead' k (Seq.singleton (ks, v)) xs) where
-	groupHead' k0 xs ((k:ks, v):ys)
-		| k == k0	= groupHead' k0 (xs |> (ks, v)) ys
-		| otherwise	= (k0, fromJust $ edgeFromAscList (f . (k0:)) (toList xs)):groupHead' k (Seq.singleton (ks, v)) ys
-	groupHead' k0 xs [] = [(k0, fromJust $ edgeFromAscList (f . (k0:)) (toList xs))]
-	groupHead' _ _ _ = error "Violation of ascending invariant!"
+groupHead f ((k:ks, v):xs) = (Nothing, groupHead' k (ks, v) Seq.empty xs) where
+	groupHead' k0 x xs ((k:ks, v):ys)
+		| k == k0	= groupHead' k0 x (xs |> (ks, v)) ys
+		| otherwise	= (k0, edgeFromAscList' (f . (k0:)) x (toList xs)):groupHead' k (ks, v) Seq.empty ys
+	groupHead' k0 x xs [] = [(k0, edgeFromAscList' (f . (k0:)) x (toList xs))]
+	groupHead' _ _ _ _ = error "Violation of ascending invariant!"
 groupHead _ [] = (Nothing, [])
  {-guardNullEdge $ Edge [] v0 $ mapMaybeAlg (\ k -> edgeFromAscList (f . (k:))) $ fromAscListAlg (const (flip (++))) ys
 	where	part ([], v) (v0, ys) = (Just $ maybe v (flip (f []) v) v0, ys)
 		part (k:ks, v) (v0, ys) = (v0, (k, [(ks, v)]):ys)
 		(v0, ys) = foldr part (Nothing, []) xs-}
 
-maybeSingleEdge :: TrieKey k m => [k] -> Maybe v -> MEdge k m v
-maybeSingleEdge ks = fmap (\ v -> Edge ks (Just v) emptyAlg)
+maybeSingleEdge :: Sized v => TrieKey k m => [k] -> Maybe v -> MEdge k m v
+maybeSingleEdge ks = fmap (\ v -> Edge (getSize v) ks (Just v) emptyAlg)
 
 getSingleEdge :: (TrieKey k m) => Edge k m v -> Maybe ([k], v)
-getSingleEdge (Edge ks (Just v) ts)
+getSingleEdge (Edge _ ks (Just v) ts)
 	| nullAlg ts	= Just (ks, v)
-getSingleEdge (Edge ks Nothing ts) = do
+getSingleEdge (Edge _ ks Nothing ts) = do
 	(x, e') <- getSingleAlg ts
 	(xs, v) <- getSingleEdge e'
 	return (ks ++ x:xs, v) 
@@ -127,158 +138,164 @@
 
 {-# INLINE guardNullEdge #-}
 guardNullEdge :: TrieKey k m => Edge k m v -> MEdge k m v
-guardNullEdge (Edge ks Nothing ts)
+guardNullEdge (Edge n ks Nothing ts)
 	| nullAlg ts	= Nothing
-	| Just (x, Edge xs v ts') <- getSingleAlg ts
-		= Just (Edge (ks ++ x:xs) v ts')
+	| Just (x, Edge n' xs v ts') <- getSingleAlg ts
+		= Just (Edge n' (ks ++ x:xs) v ts')
 guardNullEdge e = Just e
 
-alterLookupEdge :: (TrieKey k m) => (k -> k -> Bool) ->
+alterLookupEdge :: (TrieKey k m, Sized v) => (k -> k -> Bool) ->
 	(Maybe v -> (a, Maybe v)) -> [k] -> Edge k m v -> (a, MEdge k m v)
-alterLookupEdge (==) f ks0 e@(Edge ls0 v ts) = procEdge 0 ks0 ls0 where
+alterLookupEdge (==) f ks0 e@(Edge n0 ls0 v ts) = procEdge 0 ks0 ls0 where
 	procEdge i _ _ | i `seq` False = undefined
 	procEdge i (k:ks) (l:ls)
 		| k == l	= procEdge (i+1) ks ls
-		| otherwise	= fmap (Just . g) $ f Nothing
+		| otherwise	= fmap (Just . g) (f Nothing)
 		where	g Nothing = e
-			g (Just v') = Edge (take i ks0) Nothing $
-						fromListAlg' [(k, Edge ks (Just v') emptyAlg), (l, Edge ls v ts)]
+			g (Just v') = let nV = getSize v' in Edge (n0 + nV) (take i ks0) Nothing $
+						fromListAlg' [(k, Edge nV ks (Just v') emptyAlg), (l, Edge n0 ls v ts)]
 	procEdge i (k:ks) [] = proc (alterLookupAlg g k ts) where
 		g Nothing = maybeSingleEdge ks <$> f Nothing
 		g (Just e') = alterLookupEdge (==) f ks e'
-		proc = fmap (guardNullEdge . Edge ls0 v)
+		proc = fmap (guardNullEdge . edge ls0 v)
 	procEdge i [] (l:ls) = fmap (Just . g) $ f Nothing
 		where	g Nothing = e
-			g (Just v') = Edge ks0 (Just v') $ insertAlg l (Edge ls v ts) emptyAlg
-	procEdge i [] [] = (ans, guardNullEdge (Edge ks0 fv ts))
+			g (Just v') = Edge (getSize v' + n0) ks0 (Just v') $ insertAlg l (Edge n0 ls v ts) emptyAlg
+	procEdge i [] [] = (ans, guardNullEdge (Edge (getSize fv - getSize v + n0) ks0 fv ts))
 		where	(ans, fv) = f v
 
 foldWithKeyEdge :: TrieKey k m => ([k] -> v -> x -> x) -> x -> Edge k m v -> x
-foldWithKeyEdge f z (Edge ks v ts) =
+foldWithKeyEdge f z (Edge _ ks v ts) =
 	foldr (f ks) (foldWithKeyAlg (\ x -> flip (foldWithKeyEdge (\ xs -> f (ks ++ x:xs)))) z ts) v
 
-mapMaybeEdge :: (TrieKey k m) => ([k] -> v -> Maybe w) -> Edge k m v -> MEdge k m w
-mapMaybeEdge f (Edge ks v ts) = guardNullEdge $
-	Edge ks (join $ traverse (f ks) v) (mapMaybeAlg (\ x -> mapMaybeEdge (\ xs -> f (ks ++ x:xs))) ts)
+mapMaybeEdge :: (TrieKey k m, Sized w) => ([k] -> v -> Maybe w) -> Edge k m v -> MEdge k m w
+mapMaybeEdge f (Edge _ ks v ts) = guardNullEdge $
+	edge ks (join $ traverse (f ks) v) (mapMaybeAlg (\ x -> mapMaybeEdge (\ xs -> f (ks ++ x:xs))) ts)
 
-mapEitherEdge :: TrieKey k m => ([k] -> a -> Either b c) -> Edge k m a -> (MEdge k m b, MEdge k m c)
-mapEitherEdge f (Edge ks v ts) =
-	(guardNullEdge $ Edge ks vL tsL, guardNullEdge $ Edge ks vR tsR) 
+mapEitherEdge :: (TrieKey k m, Sized b, Sized c) => ([k] -> a -> Either b c) -> Edge k m a -> (MEdge k m b, MEdge k m c)
+mapEitherEdge f (Edge _ ks v ts) =
+	(guardNullEdge $ edge ks vL tsL, guardNullEdge $ edge ks vR tsR) 
 	where	(vL, vR) = case fmap (f ks) v of
 			Nothing	-> (Nothing, Nothing)
 			Just (Left v)	-> (Just v, Nothing)
 			Just (Right v)	-> (Nothing, Just v)
-		ts' = mapWithKeyAlg (\ x -> mapEitherEdge (\ xs -> f (ks ++ x:xs))) ts
-		tsL = mapMaybeAlg (const fst) ts'
-		tsR = mapMaybeAlg (const snd) ts'
+		ts' = mapWithKeyAlg (\ x -> Elem . mapEitherEdge (\ xs -> f (ks ++ x:xs))) ts
+		tsL = mapMaybeAlg (\ _ (Elem (tsL, _)) -> tsL) ts'
+		tsR = mapMaybeAlg (\ _ (Elem (_, tsR)) -> tsR) ts'
 
-mapAppEdge :: (Applicative f, TrieKey k m) => ([k] -> v -> f w) -> Edge k m v -> f (Edge k m w)
-mapAppEdge f (Edge ks v ts) = liftA2 (Edge ks) (traverse (f ks) v) (mapAppAlg (\ x -> mapAppEdge (\ xs -> f (ks ++ x:xs))) ts)
+mapAppEdge :: (Applicative f, TrieKey k m, Sized w) => ([k] -> v -> f w) -> Edge k m v -> f (Edge k m w)
+mapAppEdge f (Edge _ ks v ts) = liftA2 (edge ks) (traverse (f ks) v) (mapAppAlg (\ x -> mapAppEdge (\ xs -> f (ks ++ x:xs))) ts)
 
-unionMaybeEdge :: (Eq k, TrieKey k m) => ([k] -> v -> v -> Maybe v) -> Edge k m v -> Edge k m v -> MEdge k m v
-unionMaybeEdge f (Edge ks0 vK tsK) (Edge ls0 vL tsL) = procEdge 0 ks0 ls0 where
+unionMaybeEdge :: (Eq k, TrieKey k m, Sized v) => ([k] -> v -> v -> Maybe v) -> Edge k m v -> Edge k m v -> MEdge k m v
+unionMaybeEdge f (Edge nK ks0 vK tsK) (Edge nL ls0 vL tsL) = procEdge 0 ks0 ls0 where
 	procEdge i _ _ | i `seq` False = undefined
 	procEdge i (k:ks) (l:ls)
 		| k == l	= procEdge (i+1) ks ls
-		| otherwise	= Just $ Edge (take i ks0) Nothing $ fromListAlg' [(k, Edge ks vK tsK), (l, Edge ls vL tsL)]
-	procEdge _ [] (l:ls) = guardNullEdge $ Edge ks0 vK $ alterAlg g l tsK
-	  where	g Nothing = Just (Edge ls vL tsL)
-		g (Just e') = unionMaybeEdge (\ ls' -> f (ks0 ++ l:ls')) e' (Edge ls vL tsL)
-	procEdge _ (k:ks) [] = guardNullEdge $ Edge ls0 vL $ alterAlg g k tsL 
-	  where	g Nothing = Just $ Edge ks vK tsK
-		g (Just e') = unionMaybeEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge ks vK tsK) e'
-	procEdge _ [] [] = guardNullEdge $ Edge ks0 (unionMaybe (f ks0) vK vL) $
+		| otherwise	= Just $ Edge (nK + nL) (take i ks0) Nothing $ fromListAlg' [(k, Edge nK ks vK tsK), (l, Edge nL ls vL tsL)]
+	procEdge _ [] (l:ls) = guardNullEdge $ edge ks0 vK $ alterAlg g l tsK
+	  where	g Nothing = Just (Edge nL ls vL tsL)
+		g (Just e') = unionMaybeEdge (\ ls' -> f (ks0 ++ l:ls')) e' (Edge nL ls vL tsL)
+	procEdge _ (k:ks) [] = guardNullEdge $ edge ls0 vL $ alterAlg g k tsL 
+	  where	g Nothing = Just $ Edge nK ks vK tsK
+		g (Just e') = unionMaybeEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge nK ks vK tsK) e'
+	procEdge _ [] [] = guardNullEdge $ edge ks0 (unionMaybe (f ks0) vK vL) $
 		unionMaybeAlg (\ x -> unionMaybeEdge (\ xs -> f (ks0 ++ x:xs))) tsK tsL
 
-intersectEdge :: (Eq k, TrieKey k m) => ([k] -> a -> b -> Maybe c) -> Edge k m a -> Edge k m b -> MEdge k m c
-intersectEdge f (Edge ks0 vK tsK) (Edge ls0 vL tsL) = procEdge ks0 ls0 where
+intersectEdge :: (Eq k, TrieKey k m, Sized c) => ([k] -> a -> b -> Maybe c) -> Edge k m a -> Edge k m b -> MEdge k m c
+intersectEdge f (Edge nK ks0 vK tsK) (Edge nL ls0 vL tsL) = procEdge ks0 ls0 where
 	procEdge (k:ks) (l:ls)
 		| k == l	= procEdge ks ls
 		| otherwise	= Nothing
 	procEdge (k:ks) [] = do
 		e' <- lookupAlg k tsL
-		Edge xs vX tsX <- intersectEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge ks vK tsK) e'
-		return (Edge (ls0 ++ k:xs) vX tsX)
+		Edge nX xs vX tsX <- intersectEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge nK ks vK tsK) e'
+		return (Edge nX (ls0 ++ k:xs) vX tsX)
 	procEdge [] (l:ls) = do
 		e' <- lookupAlg l tsK
-		Edge xs vX tsX <- intersectEdge (\ ls' -> f (ks0 ++ l:ls')) e' (Edge ls vL tsL)
-		return (Edge (ks0 ++ l:xs) vX tsX)
-	procEdge [] [] = guardNullEdge $ Edge ks0 (intersectMaybe (f ks0) vK vL) $
+		Edge nX xs vX tsX <- intersectEdge (\ ls' -> f (ks0 ++ l:ls')) e' (Edge nL ls vL tsL)
+		return (Edge nX (ks0 ++ l:xs) vX tsX)
+	procEdge [] [] = guardNullEdge $ edge ks0 (intersectMaybe (f ks0) vK vL) $
 		intersectAlg (\ x -> intersectEdge (\ xs -> f (ks0 ++ x:xs))) tsK tsL
 
-differenceEdge :: (Eq k, TrieKey k m) => ([k] -> v -> w -> Maybe v) -> Edge k m v -> Edge k m w -> MEdge k m v
-differenceEdge f e@(Edge ks0 vK tsK) (Edge ls0 vL tsL) = procEdge ks0 ls0 where
+{-# SPECIALIZE differenceEdge :: (Eq k, TrieKey k m) => ([k] -> Elem v -> w -> Maybe (Elem v)) -> 
+	Edge k m (Elem v) -> Edge k m w -> MEdge k m (Elem v) #-}
+differenceEdge :: (Eq k, TrieKey k m, Sized v) => ([k] -> v -> w -> Maybe v) -> Edge k m v -> Edge k m w -> MEdge k m v
+differenceEdge f e@(Edge nK ks0 vK tsK) (Edge nL ls0 vL tsL) = procEdge ks0 ls0 where
 	procEdge (k:ks) (l:ls)
 		| k == l	= procEdge ks ls
 	procEdge (k:ks) []
 		| Just e' <- lookupAlg k tsL
-		= do	Edge xs vX tsX <- differenceEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge ks vK tsK) e'
-			return (Edge (ls0 ++ k:xs) vX tsX)
-	procEdge [] (l:ls) = guardNullEdge $ Edge ks0 vK $ alterAlg g l tsK
+		= do	Edge nX xs vX tsX <- differenceEdge (\ ks' -> f (ls0 ++ k:ks')) (Edge nK ks vK tsK) e'
+			return (Edge nX (ls0 ++ k:xs) vX tsX)
+	procEdge [] (l:ls) = guardNullEdge $ edge ks0 vK $ alterAlg g l tsK
 	  where	g Nothing = Nothing
-	  	g (Just e') = differenceEdge (\ ls' -> f (ks0 ++ l:ls')) e' (Edge ls vL tsL)
-	procEdge [] [] = guardNullEdge $ Edge ks0 (differenceMaybe (f ks0) vK vL) $
+	  	g (Just e') = differenceEdge (\ ls' -> f (ks0 ++ l:ls')) e' (Edge nL ls vL tsL)
+	procEdge [] [] = guardNullEdge $ edge ks0 (differenceMaybe (f ks0) vK vL) $
 		differenceAlg (\ x -> differenceEdge (\ xs -> f (ks0 ++ x:xs))) tsK tsL
 	procEdge _ _ = Just e
 
-getMinEdge :: TrieKey k m => Edge k m v -> (([k], v), MEdge k m v)
-getMinEdge (Edge ks (Just v) ts) = ((ks, v), guardNullEdge $ Edge ks Nothing ts)
-getMinEdge (Edge ks _ ts) 
+{-# SPECIALIZE getMinEdge :: TrieKey k m => Edge k m (Elem v) -> (([k], Elem v), MEdge k m (Elem v)) #-}
+getMinEdge :: (Sized v, TrieKey k m) => Edge k m v -> (([k], v), MEdge k m v)
+getMinEdge (Edge nK ks (Just v) ts) = ((ks, v), guardNullEdge $ Edge (nK - getSize v) ks Nothing ts)
+getMinEdge (Edge nK ks _ ts) 
 	| Just ((l, e), ts') <- getMinAlg ts, ((ls, v), e') <- getMinEdge e
-		= ((ks ++ l:ls, v), guardNullEdge $ Edge ks Nothing $ maybe ts' (\ e' -> snd $ updateMinAlg (\ _ _ -> (False, Just e')) ts) e')
+		= ((ks ++ l:ls, v), guardNullEdge $ edge ks Nothing $ maybe ts' (\ e' -> snd $ updateMinAlg (\ _ _ -> (False, Just e')) ts) e')
 getMinEdge _ = error "Uncompacted edge"
 
-getMaxEdge :: TrieKey k m => Edge k m v -> (([k], v), MEdge k m v)
-getMaxEdge (Edge ks v0 ts)
+getMaxEdge :: (Sized v, TrieKey k m) => Edge k m v -> (([k], v), MEdge k m v)
+getMaxEdge (Edge nK ks v0 ts)
 	| Just ((l, e), ts') <- getMaxAlg ts, ((ls, v), e') <- getMaxEdge e
-		= ((ks ++ l:ls, v), guardNullEdge $ Edge ks v0 $ maybe ts' (\ e' -> snd $ updateMaxAlg (\ _ _ -> (False, Just e')) ts) e')
-getMaxEdge (Edge ks (Just v) ts) = ((ks, v), guardNullEdge $ Edge ks Nothing ts)
+		= ((ks ++ l:ls, v), guardNullEdge $ edge ks v0 $ maybe ts' (\ e' -> snd $ updateMaxAlg (\ _ _ -> (False, Just e')) ts) e')
+getMaxEdge (Edge nK ks (Just v) ts) = ((ks, v), guardNullEdge $ Edge (nK - getSize v) ks Nothing ts)
 getMaxEdge _ = error "Uncompacted edge"
 
-updateMinEdge :: TrieKey k m => ([k] -> v -> (Bool, Maybe v)) -> Edge k m v -> (Bool, MEdge k m v)
-updateMinEdge f (Edge ks (Just v) ts) = fmap (\ v' -> guardNullEdge $ Edge ks v' ts) (f ks v)
-updateMinEdge f (Edge ks Nothing ts)
-	= fmap (guardNullEdge . Edge ks Nothing) $ updateMinAlg (\ l -> updateMinEdge (\ ls -> f (ks ++ l:ls))) ts
+updateMinEdge :: (TrieKey k m, Sized v) => ([k] -> v -> (Bool, Maybe v)) -> Edge k m v -> (Bool, MEdge k m v)
+updateMinEdge f (Edge _ ks (Just v) ts) = fmap (\ v' -> guardNullEdge $ edge ks v' ts) (f ks v)
+updateMinEdge f (Edge _ ks Nothing ts)
+	= fmap (guardNullEdge . edge ks Nothing) $ updateMinAlg (\ l -> updateMinEdge (\ ls -> f (ks ++ l:ls))) ts
 
-updateMaxEdge :: TrieKey k m => ([k] -> v -> (Bool, Maybe v)) -> Edge k m v -> (Bool, MEdge k m v)
-updateMaxEdge f (Edge ks (Just v) ts)
-	| nullAlg ts	= fmap (\ v' -> guardNullEdge $ Edge ks v' ts) (f ks v)
-updateMaxEdge f (Edge ks v ts) = 
-	fmap (guardNullEdge . Edge ks v) $ updateMaxAlg (\ l -> updateMaxEdge (\ ls -> f (ks ++ l:ls))) ts
+updateMaxEdge :: (TrieKey k m, Sized v) => ([k] -> v -> (Bool, Maybe v)) -> Edge k m v -> (Bool, MEdge k m v)
+updateMaxEdge f (Edge _ ks (Just v) ts)
+	| nullAlg ts	= fmap (\ v' -> guardNullEdge $ edge ks v' ts) (f ks v)
+updateMaxEdge f (Edge _ ks v ts) = 
+	fmap (guardNullEdge . edge ks v) $ updateMaxAlg (\ l -> updateMaxEdge (\ ls -> f (ks ++ l:ls))) ts
 
-isSubmapEdge :: TrieKey k m => (a -> b -> Bool) -> Edge k m a -> Edge k m b -> Bool
-isSubmapEdge (<=) (Edge ks vK tsK) (Edge ls vL tsL) = procEdge ks ls where
+isSubmapEdge :: TrieKey k m => (k -> k -> Bool) -> (a -> b -> Bool) -> (k -> m (Edge k m b) -> MEdge k m b) -> (m (Edge k m a) -> m (Edge k m b) -> Bool) -> 
+	Edge k m a -> Edge k m b -> Bool
+isSubmapEdge (==) (<=) lookup (<<=) (Edge nK ks vK tsK) (Edge nL ls vL tsL) = procEdge ks ls where
 	procEdge (k:ks) (l:ls)
 		| k == l	= procEdge ks ls
 	procEdge (k:ks) []
-		| Just e <- lookupAlg k tsL
-			= isSubmapEdge (<=) (Edge ks vK tsK) e
+		| Just e <- lookup k tsL
+			= isSubmapEdge (==) (<=) lookup (<<=) (Edge nK ks vK tsK) e
 	procEdge [] [] 
-		| Nothing <- vK	= isSubmapAlg (isSubmapEdge (<=)) tsK tsL
+		| Nothing <- vK	= tsK <<= tsL
 		| Just x <- vK, Just y <- vL, x <= y
-				= isSubmapAlg (isSubmapEdge (<=)) tsK tsL
+				= tsK <<= tsL
 	procEdge _ _ = False
 validEdge :: TrieKey k m => Edge k m v -> Bool
-validEdge (Edge _ Nothing m)
+validEdge (Edge _ _ Nothing m)
 	| nullAlg m	= False
 	| Just{} <- getSingleAlg m
 			= False
-validEdge (Edge _ _ m)
+validEdge (Edge _ _ _ m)
 	= valid m && all validEdge m
 
 
-splitEdge :: (Ord k, TrieKey k m) => (a -> (Maybe a, Maybe b, Maybe a)) -> [k] -> Edge k m a -> (MEdge k m a, Maybe b, MEdge k m a)
-splitEdge f ks0 (Edge ls0 v ts) = procEdge ks0 ls0 where
+splitEdge :: (Ord k, TrieKey k m, Sized a) => (a -> (Maybe a, Maybe b, Maybe a)) -> [k] -> Edge k m a -> (MEdge k m a, Maybe b, MEdge k m a)
+splitEdge f ks0 e@(Edge nL ls0 v ts) = procEdge ks0 ls0 where
+	answerLess = (Nothing, Nothing, Just e) -- if ks0 < ls0
+	answerMore = (Just e, Nothing, Nothing) -- if ks0 > ls0 
 	procEdge (k:ks) (l:ls) = case compare k l of
-		LT	-> (Nothing, Nothing, Just (Edge ls0 v ts))
+		LT	-> answerLess
 		EQ	-> procEdge ks ls
-		GT	-> (Just (Edge ks0 v ts), Nothing, Nothing)
+		GT	-> answerMore
 	procEdge (k:ks) [] = case splitLookupAlg (splitEdge f ks) k ts of
-		(tsL, ans, tsR)	-> (guardNullEdge $ Edge ls0 Nothing tsL, ans, guardNullEdge $ Edge ls0 v tsR)
-	procEdge [] (l:ls) = (Nothing, Nothing, Just $ Edge ls0 v ts)
+		(tsL, ans, tsR)	-> (guardNullEdge $ edge ls0 Nothing tsL, ans, guardNullEdge $ edge ls0 v tsR)
+	procEdge [] (l:ls) = answerLess
 	procEdge [] [] 
 		| Just v <- v, (vL, ans, vR) <- f v
-			= (fmap (\ v' -> Edge ls0 (Just v') emptyAlg) vL, ans, 
-				guardNullEdge $ Edge ls0 vR ts)
-		| otherwise = (Nothing, Nothing, Just (Edge ls0 v ts))
+			= (fmap (\ v' -> edge ls0 (Just v') emptyAlg) vL, ans, 
+				guardNullEdge $ edge ls0 vR ts)
+		| otherwise	= answerLess -- all children of e match ks0 initially but are longer, and v is Nothing
 		
diff --git a/TrieMap/Reflection.hs b/TrieMap/Reflection.hs
--- a/TrieMap/Reflection.hs
+++ b/TrieMap/Reflection.hs
@@ -3,12 +3,18 @@
 module TrieMap.Reflection where
 
 -- import TrieMap.Fixpoint
+import TrieMap.MapTypes
 import TrieMap.TrieAlgebraic
 import TrieMap.Algebraic
 import TrieMap.Applicative
 import TrieMap.RadixTrie()
 import qualified TrieMap.TrieAlgebraic as TA
 
+instance Algebraic v => Algebraic (Elem v) where
+	type Alg (Elem v) = Alg v
+	toAlg (Elem v) = toAlg v
+	fromAlg v = Elem (fromAlg v)
+
 instance Algebraic (m1 (m2 v)) => Algebraic (ProdMap m1 m2 v) where
 	type Alg (ProdMap m1 m2 v) = Alg (m1 (m2 v))
 	toAlg (PMap m) = toAlg m
@@ -19,7 +25,7 @@
 	toAlg (m1 :+: m2) = (toAlg m1, toAlg m2)
 	fromAlg (m1, m2) = fromAlg m1 :+: fromAlg m2
 
-instance (Ord k, Algebraic k, Algebraic v, TrieKey k m) => Algebraic (RadixTrie k m v) where
+instance (Ord k, Algebraic k, Sized v, Algebraic v, TrieKey k m) => Algebraic (RadixTrie k m v) where
 	type Alg (RadixTrie k m v) = Alg [([k], v)]
 	toAlg m = toAlg (build (\ c n -> foldWithKeyAlg (curry c) n m))
 	fromAlg = fromDistAscListAlg . fromAlg
diff --git a/TrieMap/TrieAlgebraic.hs b/TrieMap/TrieAlgebraic.hs
--- a/TrieMap/TrieAlgebraic.hs
+++ b/TrieMap/TrieAlgebraic.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, PatternGuards #-}
+{-# LANGUAGE FlexibleInstances, TypeOperators, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, PatternGuards, IncoherentInstances #-}
 
 module TrieMap.TrieAlgebraic (TrieKey (..), ProdMap (..), UnionMap(..), RadixTrie(..), Edge (..), Ordered (..), unionMaybe, intersectMaybe, differenceMaybe, mapWithKeyAlg, assocsAlg, insertAlg, alterAlg, fromListAlg') where
 
@@ -35,36 +35,40 @@
 
 -- | TrieKey defines a bijection between map types and algebraic key types.
 class (Eq a, Foldable m, Traversable m) => TrieKey a m | a -> m, m -> a where
-	emptyAlg :: m v
-	nullAlg :: m v -> Bool
-	sizeAlg :: m v -> Int
-	getSingleAlg :: m v -> Maybe (a, v)
-	guardNullAlg :: m v -> Maybe (m v)
-	{-# SPECIALIZE alterAlg :: (Maybe v -> Id (b, Maybe v)) -> a -> m v -> Id (b, m v) #-}
-	alterLookupAlg :: (Maybe v -> (b, Maybe v)) -> a -> m v -> (b, m v)
-	lookupAlg :: a -> m v -> Maybe v
-	foldWithKeyAlg :: (a -> v -> x -> x) -> x -> m v -> x
-	mapAppAlg :: Applicative f => (a -> v -> f w) -> m v -> f (m w)
-	mapMaybeAlg :: (a -> v -> Maybe w) -> m v -> m w
-	mapEitherAlg :: (a -> v -> Either x y) -> m v -> (m x, m y)
-	unionMaybeAlg :: (a -> v -> v -> Maybe v) -> m v -> m v -> m v
-	intersectAlg :: (a -> v -> w -> Maybe x) -> m v -> m w -> m x
-	differenceAlg :: (a -> v -> w -> Maybe v) -> m v -> m w -> m v
-	fromDistAscListAlg :: [(a, v)] -> m v
-	fromAscListAlg :: (a -> v -> v -> v) -> [(a, v)] -> m v
-	fromListAlg :: (a -> v -> v -> v) -> [(a, v)] -> m v
-	getMinAlg :: m v -> Maybe ((a, v), m v)
-	getMaxAlg :: m v -> Maybe ((a, v), m v)
-	updateMinAlg :: (a -> v -> (Bool, Maybe v)) -> m v -> (Bool, m v)
-	updateMaxAlg :: (a -> v -> (Bool, Maybe v)) -> m v -> (Bool, m v)
-	valid :: m v -> Bool
-	isSubmapAlg :: (v -> w -> Bool) -> m v -> m w -> Bool
-	splitLookupAlg :: (v -> (Maybe v, Maybe x, Maybe v)) -> a -> m v -> (m v, Maybe x, m v)
+	emptyAlg :: Sized v => m v
+	nullAlg :: Sized v => m v -> Bool
+	sizeAlg :: Sized v => m v -> Int
+	getSingleAlg :: Sized v => m v -> Maybe (a, v)
+	guardNullAlg :: Sized v => m v -> Maybe (m v)
+-- 	{-# SPECIALIZE alterAlg :: Sized v => (Maybe v -> Id (b, Maybe v)) -> a -> m v -> Id (b, m v) #-}
+	alterLookupAlg :: Sized v => (Maybe v -> (b, Maybe v)) -> a -> m v -> (b, m v)
+	lookupAlg :: Sized v => a -> m v -> Maybe v
+	foldWithKeyAlg :: Sized v => (a -> v -> x -> x) -> x -> m v -> x
+	mapAppAlg :: (Applicative f, Sized v, Sized w) => (a -> v -> f w) -> m v -> f (m w)
+	mapMaybeAlg :: (Sized v, Sized w) => (a -> v -> Maybe w) -> m v -> m w
+	mapEitherAlg :: (Sized v, Sized x, Sized y) => (a -> v -> Either x y) -> m v -> (m x, m y)
+	unionMaybeAlg :: Sized v => (a -> v -> v -> Maybe v) -> m v -> m v -> m v
+	intersectAlg :: (Sized v, Sized w, Sized x) => (a -> v -> w -> Maybe x) -> m v -> m w -> m x
+	differenceAlg :: (Sized v, Sized w) => (a -> v -> w -> Maybe v) -> m v -> m w -> m v
+	fromDistAscListAlg :: Sized v => [(a, v)] -> m v
+	fromAscListAlg :: Sized v => (a -> v -> v -> v) -> [(a, v)] -> m v
+	fromListAlg :: Sized v => (a -> v -> v -> v) -> [(a, v)] -> m v
+	getMinAlg :: Sized v => m v -> Maybe ((a, v), m v)
+	getMaxAlg :: Sized v => m v -> Maybe ((a, v), m v)
+	updateMinAlg :: Sized v => (a -> v -> (Bool, Maybe v)) -> m v -> (Bool, m v)
+	updateMaxAlg :: Sized v => (a -> v -> (Bool, Maybe v)) -> m v -> (Bool, m v)
+	valid :: Sized v =>  m v -> Bool
+	isSubmapAlg :: (Sized v, Sized w) => (v -> w -> Bool) -> m v -> m w -> Bool
+	splitLookupAlg :: (Sized v) => (v -> (Maybe v, Maybe x, Maybe v)) -> a -> m v -> (m v, Maybe x, m v)
 
 	lookupAlg k = fst . alterLookupAlg (\ v -> (v, v)) k
 	guardNullAlg m
 		| nullAlg m	= Nothing
 		| otherwise	= Just m
+	getSingleAlg m = do
+		((k, v), m') <- getMinAlg m
+		guard (nullAlg m')
+		return (k, v)
 	fromListAlg f = foldr (\ (k, v) -> alterAlg (Just . maybe v (f k v)) k) emptyAlg
 	fromAscListAlg _ [] = emptyAlg
 	fromAscListAlg f ((k, v):xs) = fromDistAscListAlg (distinct k v xs) where
@@ -79,28 +83,36 @@
 	updateMaxAlg f m = maybe (False, m) (\ ((k, v), m') -> maybe m' (\ v' -> insertAlg k v' m) <$> f k v) (getMaxAlg m)
 	valid = (`seq` True)
 
-fromListAlg' :: TrieKey k m => [(k, v)] -> m v
+instance (TrieKey k m, Sized a) => Sized (m a) where
+	{-# SPECIALIZE instance (Sized a, TrieKey k1 m1, TrieKey k2 m2) => Sized (ProdMap m1 m2 a) #-}
+	{-# SPECIALIZE instance (Sized a, TrieKey k1 m1, TrieKey k2 m2) => Sized (UnionMap m1 m2 a) #-}
+	{-# SPECIALIZE instance Sized a => Sized (Maybe a) #-}
+	{-# SPECIALIZE instance Sized a => Sized (IntMap a) #-}
+	{-# SPECIALIZE instance (Ord k, Sized a) => Sized (Map k a) #-}
+	getSize = sizeAlg
+
+fromListAlg' :: (Sized v, TrieKey k m) => [(k, v)] -> m v
 fromListAlg' = fromListAlg (const const)
 
-singletonAlg :: TrieKey k m => k -> v -> m v
+singletonAlg :: (Sized v, TrieKey k m) => k -> v -> m v
 singletonAlg k v = insertAlg k v emptyAlg
 
-mapWithKeyAlg :: TrieKey k m => (k -> v -> w) -> m v -> m w
+mapWithKeyAlg :: (Sized v, Sized w, TrieKey k m) => (k -> v -> w) -> m v -> m w
 mapWithKeyAlg f m = unId (mapAppAlg (\ k v -> Id (f k v)) m)
 
 -- mapMaybeWithKeyAlg :: TrieKey k m => (k -> v -> Maybe w) -> m v -> m w
 -- mapMaybeWithKeyAlg f m = unId (mapAppMaybeAlg (\ k v -> Id (f k v)) m)
 
-insertAlg :: TrieKey k m => k -> v -> m v -> m v
+insertAlg :: (Sized v, TrieKey k m) => k -> v -> m v -> m v
 insertAlg k v = alterAlg (const (Just v)) k
 
-alterAlg :: TrieKey k m => (Maybe v -> Maybe v) -> k -> m v -> m v
+alterAlg :: (Sized v, TrieKey k m) => (Maybe v -> Maybe v) -> k -> m v -> m v
 alterAlg f k = snd . alterLookupAlg (\ x -> ((), f x)) k
 
 -- alterLookupAlg :: TrieKey k m => (Maybe a -> (b, Maybe a)) -> k -> m a -> (b, m a)
 -- alterLookupAlg f = unId .: alterAppAlg (Id . f)
 
-foldrAlg :: TrieKey k m => (a -> b -> b) -> b -> m a -> b
+foldrAlg :: (Sized a, TrieKey k m) => (a -> b -> b) -> b -> m a -> b
 foldrAlg = foldWithKeyAlg . const
 
 unionMaybe :: (a -> a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a
@@ -126,13 +138,13 @@
 filterRight _ _ = Nothing
 
 {-# INLINE assocsAlg #-}
-assocsAlg :: TrieKey k m => m a -> [(k, a)]
+assocsAlg :: (Sized a, TrieKey k m) => m a -> [(k, a)]
 assocsAlg m = build (\ c n -> foldWithKeyAlg (\ k v xs -> (k,v) `c` xs) n m)
 
 instance (Eq a1, Eq a2, TrieKey a1 m1, TrieKey a2 m2) => TrieKey (a1, a2) (m1 `ProdMap` m2) where
 	emptyAlg = PMap emptyAlg
 	nullAlg (PMap m) = nullAlg m
-	sizeAlg (PMap m) = foldl' (\ n m -> n + sizeAlg m) 0 m
+	sizeAlg (PMap m) = sizeAlg m
 	getSingleAlg (PMap m) = do	(k1, m') <- getSingleAlg m
 					(k2, v) <- getSingleAlg m'
 					return ((k1, k2), v)
@@ -144,16 +156,16 @@
 		PMap <$> mapAppAlg (\ k1 -> mapAppAlg (\ k2 -> f (k1, k2))) m
 	mapMaybeAlg f (PMap m) =
 		PMap $ mapMaybeAlg (\ k1 -> guardNullAlg . mapMaybeAlg (\ k2 -> f (k1, k2))) m
-	mapEitherAlg f (PMap m) = (PMap (fmap fst m'), PMap (fmap snd m'))
-		where	m' = mapWithKeyAlg (\ k1 -> mapEitherAlg (\ k2 -> f (k1, k2))) m
+	mapEitherAlg f (PMap m) = (PMap (fmap (\ (Elem (mL, _)) -> mL) m'), PMap (fmap (\ (Elem (_, mR)) -> mR) m'))
+		where	m' = mapWithKeyAlg (\ k1 -> Elem . mapEitherAlg (\ k2 -> f (k1, k2))) m
 	unionMaybeAlg f (PMap m1) (PMap m2) = 
 		PMap (unionMaybeAlg (\ k1 -> guardNullAlg .: unionMaybeAlg (\ k2 -> f (k1, k2))) m1 m2)
 	intersectAlg f (PMap m1) (PMap m2) =
 		PMap (intersectAlg (\ k1 -> guardNullAlg .: intersectAlg (\ k2 -> f (k1, k2))) m1 m2)
 	differenceAlg f (PMap m1) (PMap m2) =
 		PMap (differenceAlg (\ k1 -> guardNullAlg .: differenceAlg (\ k2 -> f (k1, k2))) m1 m2)
-	fromListAlg f xs = PMap $ mapWithKeyAlg (\ k1 -> fromListAlg (\ k2 -> f (k1, k2))) $
-		fromListAlg (const (++)) [(k1, [(k2, v)]) | ((k1, k2), v) <- xs]
+	fromListAlg f xs = PMap $ mapWithKeyAlg (\ k1 (Elem xs) -> fromListAlg (\ k2 -> f (k1, k2)) xs) $
+		fromListAlg (\ _ (Elem x) (Elem y) -> Elem (x ++ y)) [(k1, Elem [(k2, v)]) | ((k1, k2), v) <- xs]
 	fromDistAscListAlg xs = PMap $ fromDistAscListAlg [(k1, fromDistAscListAlg ys) | (k1, ys) <- breakFst xs]		
 	fromAscListAlg f xs = PMap $ fromDistAscListAlg [(k1, fromAscListAlg (\ k2 -> f (k1, k2)) ys) | (k1, ys) <- breakFst xs]
 	getMinAlg (PMap m) = do
@@ -195,9 +207,9 @@
 		(Nothing, Just (k, v))	-> Just (Right k, v)
 		_			-> Nothing
 	alterLookupAlg f (Left k) (m1 :+: m2) = 
-		fmap (:+: m2) $ alterLookupAlg f k m1
+		(:+: m2) <$> alterLookupAlg f k m1
 	alterLookupAlg f (Right k) (m1 :+: m2) =
-		fmap (m1 :+:) $ alterLookupAlg f k m2
+		(m1 :+:) <$> alterLookupAlg f k m2
 	lookupAlg k (m1 :+: m2) = either (`lookupAlg` m1) (`lookupAlg` m2) k
 	foldWithKeyAlg f z (m1 :+: m2) = foldWithKeyAlg (f . Left) (foldWithKeyAlg (f . Right) z m2) m1
 	mapAppAlg f (m1 :+: m2) = 
@@ -250,7 +262,7 @@
 instance TrieKey Int IntMap where
 	emptyAlg = IMap.empty
 	nullAlg = IMap.null
-	sizeAlg = IMap.size
+	sizeAlg = foldl' (\ n x -> n + getSize x) 0
 	getSingleAlg m
 		| IMap.size m == 1, [(k, v)] <- IMap.toList m
 			= Just (k, v)
@@ -290,7 +302,7 @@
 instance Ord k => TrieKey (Ordered k) (Map k) where
 	emptyAlg = Map.empty
 	nullAlg = Map.null
-	sizeAlg = Map.size
+	sizeAlg = foldl' (\ n x -> n + getSize x) 0
 	getSingleAlg m
 		| Map.size m == 1, (k, v) <- Map.findMin m
 			= Just (Ord k, v)
@@ -331,7 +343,7 @@
 instance TrieKey () Maybe where
 	emptyAlg = Nothing
 	nullAlg = isNothing
-	sizeAlg = maybe 0 (const 1)
+	sizeAlg = maybe 0 getSize
 	getSingleAlg = fmap ((,) ())
 	lookupAlg _ = id
 	alterLookupAlg f _ = f
@@ -348,6 +360,7 @@
 	fromListAlg _ [] = Nothing
 	fromListAlg f ((_, v):xs) = Just (foldr (f () . snd) v xs)
 	fromAscListAlg = fromListAlg
+	fromDistAscListAlg = fmap snd . listToMaybe
 	getMinAlg = fmap g where
 		g v = (((), v), Nothing)
 	getMaxAlg = fmap g where
@@ -357,8 +370,12 @@
 	isSubmapAlg _ Nothing _ = True
 	isSubmapAlg _ _ Nothing = False
 	isSubmapAlg (<=) (Just x) (Just y) = x <= y
-	splitLookupAlg f _ (Just v) = f v
-	splitLookupAlg _ _ _ = (Nothing, Nothing, Nothing)
+	splitLookupAlg f _ = maybe (Nothing, Nothing, Nothing) f
 
 first :: (a -> c) -> (a, b) -> (c, b)
 first f (x, y) = (f x, y)
+
+{-# RULES
+	"sizeAlg/Map/Elem" forall (m :: Map k (Elem v)) . sizeAlg m = Map.size m;
+	"sizeAlg/IMap/Elem" forall (m :: IntMap (Elem v)) . sizeAlg m = IMap.size m;
+	#-}