diff --git a/Data/EnumMapMap/Base.hs b/Data/EnumMapMap/Base.hs
new file mode 100644
--- /dev/null
+++ b/Data/EnumMapMap/Base.hs
@@ -0,0 +1,715 @@
+{-# LANGUAGE MagicHash, TypeFamilies, MultiParamTypeClasses,
+    BangPatterns, FlexibleInstances, TypeOperators,
+    FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.EnumMapMap.Base
+-- Copyright   :  (c) Daan Leijen 2002
+--                (c) Andriy Palamarchuk 2008
+--                (c) Matthew West 2012
+-- License     :  BSD-style
+-- Maintainer  :
+-- Stability   :  experimental
+-- Portability :  Uses GHC extensions
+--
+-- Based on Data.IntMap.Base.
+--
+-- This defines the EnumMapMap (k :& t) v instance, and the Key data types.  The
+-- terminating key type is K, and the EnumMapMap (K k) v instances are defined
+-- in EnumMapMap.Lazy and EnumMapMap.Strict.
+-----------------------------------------------------------------------------
+
+module Data.EnumMapMap.Base(
+            -- * Key types
+            (:&)(..), K(..), N(..), Z(..),
+            d1, d2, d3, d4, d5, d6, d7, d8, d9, d10,
+            -- * Split/Join Keys
+            IsSplit(..),
+            Plus,
+            -- * Internal
+            -- ** IsEMM
+            EMM(..),
+            IsEmm(..),
+            EnumMapMap(..),
+            -- ** EMM internals
+            mergeWithKey',
+            mapWithKey_,
+            foldrWithKey_,
+            foldlStrict,
+            -- ** IntMap internals
+            Key,
+            bin,
+            tip,
+            nomatch,
+            match,
+            join,
+            zero
+) where
+
+import           Prelude hiding (lookup,
+                                 map,
+                                 filter,
+                                 foldr, foldl,
+                                 null, init,
+                                 head, tail)
+
+import           Control.DeepSeq (NFData(rnf))
+import           Data.Bits
+import           Data.Monoid (Monoid(..))
+import           GHC.Exts (Word(..), Int(..), shiftRL#)
+
+data EMM k v = Bin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask
+                     !(EMM k v) !(EMM k v)
+             | Tip {-# UNPACK #-} !Int v
+             | Nil
+               deriving (Show)
+
+type Nat    = Word
+type Key    = Int
+type Prefix = Int
+type Mask   = Int
+
+infixr 3 :&
+-- | Multiple keys are joined by the (':&') constructor and terminated with 'K'.
+--
+-- > multiKey :: Int :& Int :& K Int
+-- > multiKey = 5 :& 6 :& K 5
+--
+data k :& t = !k :& !t
+                   deriving (Show, Eq)
+-- | Keys are terminated with the 'K' type
+--
+-- > singleKey :: K Int
+-- > singleKey = K 5
+--
+data K k = K !k
+           deriving (Show, Eq)
+data Z = Z
+data N n = N n
+
+-- | Split after 1 key.
+--
+-- > emm :: EnumMapMap (T1 :& T2 :& K T3) v
+-- > splitKey d1 emm :: EnumMapMap (T1 :& K T2) (EnumMapMap (K T3) v)
+d1 ::  Z
+d1  =  Z
+-- | Split after 2 keys.
+--
+-- > emm :: EnumMapMap (T1 :& T2 :& K T3) v
+-- > splitKey d1 emm :: EnumMapMap (K T1) (EnumMapMap (T2 :& K T3) v)
+d2 ::  N(Z)
+d2  =  N d1
+d3 ::  N(N(Z))
+d3  =  N d2
+d4 ::  N(N(N(Z)))
+d4  =  N d3
+d5 ::  N(N(N(N(Z))))
+d5  =  N d4
+d6 ::  N(N(N(N(N(Z)))))
+d6  =  N d5
+d7 ::  N(N(N(N(N(N(Z))))))
+d7  =  N d6
+d8 ::  N(N(N(N(N(N(N(Z)))))))
+d8  =  N d7
+d9 ::  N(N(N(N(N(N(N(N(Z))))))))
+d9  =  N d8
+d10 :: N(N(N(N(N(N(N(N(N(Z)))))))))
+d10 =  N d9
+
+class IsSplit k z where
+    type Head k z :: *
+    type Tail k z :: *
+    -- | Split a key so that an 'EnumMapMap' becomes an 'EnumMapMap' of
+    -- 'EnumMapMap's.
+    --
+    -- > newtype ID = ID Int deriving Enum
+    -- > emm = empty :: EnumMapMap (Int :& K ID) Bool
+    -- > res :: EnumMapMap (K ID) Bool
+    -- > res = lookup (K 5) $ splitKey d1 emm
+    --
+    -- If the level is too high then the compilation will fail with an error
+    --
+    -- > emm = empty :: EnumMapMap (Int :& Int :& K Int) Bool -- 3 levels
+    -- > res1 = splitKey d4 emm -- ERROR! Instance not found...
+    -- > res2 = splitKey d3 emm -- ERROR! Instance not found...
+    -- > res3 = splitKey d2 emm -- Good
+    --
+    splitKey :: z -> EnumMapMap k v
+             -> EnumMapMap (Head k z) (EnumMapMap (Tail k z) v)
+
+instance (IsSplit t n, Enum k) => IsSplit (k :& t) (N n) where
+    type Head (k :& t) (N n) = k :& (Head t n)
+    type Tail (k :& t) (N n) = Tail t n
+    splitKey (N n) (KCC emm) = KCC $ mapWithKey_ (\_ -> splitKey n) emm
+
+type family Plus k1 k2 :: *
+type instance Plus (k1 :& t) k2 = k1 :& (Plus t k2)
+
+class IsEmm k where
+    -- | A map of keys to values.  The keys are 'Enum' types but are stored as 'Int's
+    -- so any keys with the same 'Int' value are treated as the same.  The aim is to
+    -- provide typesafe indexing.
+    data EnumMapMap k :: * -> *
+
+    -- | No subtrees should be empty.  Returns 'True' if one is.
+    emptySubTrees  :: EnumMapMap k v -> Bool
+    emptySubTrees_ :: EnumMapMap k v -> Bool
+
+    removeEmpties :: EnumMapMap k v -> EnumMapMap k v
+
+    -- | Join a key so that an 'EnumMapMap' of
+    -- 'EnumMapMap's becomes an 'EnumMapMap'.
+    --
+    -- > newtype ID = ID Int deriving Enum
+    -- > emm :: EnumMapMap (K Int) (EnumMapMap (K ID) Bool)
+    -- > res :: EnumMapMap (Int :& K ID) Bool
+    -- > res = joinKey emm
+    --
+    -- 'joinKey' is the opposite of 'splitKey'.
+    --
+    -- > emm = empty :: EnumMapMap (Int :& Int :& K ID) Bool)
+    -- > emm == joinKey $ splitKey d2 emm
+    --
+    joinKey :: (IsEmm (Plus k k2)) =>
+               EnumMapMap k (EnumMapMap k2 v)
+            -> EnumMapMap (Plus k k2) v
+    joinKey = removeEmpties . unsafeJoinKey
+
+    -- | Join a key so that an 'EnumMapMap' of
+    -- 'EnumMapMap's becomes an 'EnumMapMap'.  The unsafe version does not check
+    -- for empty subtrees, so it is faster.
+    --
+    -- > newtype ID = ID Int deriving Enum
+    -- > emm :: EnumMapMap (K Int) (EnumMapMap (K ID) Bool)
+    -- > res :: EnumMapMap (Int :& K ID) Bool
+    -- > res = unsafeJoinKey emm
+    --
+    unsafeJoinKey :: EnumMapMap k (EnumMapMap k2 v)
+                  -> EnumMapMap (Plus k k2) v
+
+    -- | The empty 'EnumMapMap'.
+    empty :: EnumMapMap k v
+    -- | Is the 'EnumMapMap' empty?
+    --
+    -- Submaps can never be empty, so the following should always hold true:
+    --
+    -- > emm :: EnumMapMap (Int :& Int :& K ID) Bool)
+    -- > null $ splitKey x emm == False
+    null :: EnumMapMap k v -> Bool
+    -- | Number of elements in the 'EnumMapMap'.
+    size :: EnumMapMap k v -> Int
+    -- | Is the key present in the 'EnumMapMap'?
+    member :: k -> EnumMapMap k v -> Bool
+    -- | An 'EnumMapMap' with one element
+    --
+    -- > singleton (5 :& K 3) "a" == fromList [(5 :& K 3, "a")]
+    singleton :: k -> v -> EnumMapMap k v
+    -- | Lookup up the value at a key in the 'EnumMapMap'.
+    --
+    -- > emm = fromList [(3 :& K 1, "a")]
+    -- > lookup (3 :& K 1) emm == Just "a"
+    -- > lookup (2 :& K 1) emm == Nothing
+    --
+    lookup :: k -> EnumMapMap k v -> Maybe v
+    -- | Insert a new Key\/Value pair into the 'EnumMapMap'.
+    insert :: k -> v -> EnumMapMap k v -> EnumMapMap k v
+    -- | Insert with a combining function.
+    insertWith :: (v -> v -> v)
+                  -> k -> v -> EnumMapMap k v -> EnumMapMap k v
+    insertWith f = insertWithKey (\_ -> f)
+    -- | Insert with a combining function.
+    insertWithKey :: (k -> v -> v -> v)
+                  -> k -> v -> EnumMapMap k v -> EnumMapMap k v
+    -- | Remove a key and it's value from the 'EnumMapMap'.  If the key is not
+    -- present the original 'EnumMapMap' is returned.
+    delete :: k -> EnumMapMap k v -> EnumMapMap k v
+    -- | The expression (@'alter' f k emm@) alters the value at @k@, or absence thereof.
+    -- 'alter' can be used to insert, delete, or update a value in an 'EnumMapMap'.
+    alter :: (Maybe v -> Maybe v) -> k -> EnumMapMap k v -> EnumMapMap k v
+    -- | Map a function over all values in the 'EnumMapMap'.
+    map :: (v -> t) -> EnumMapMap k v -> EnumMapMap k t
+    map f = mapWithKey (\_ -> f)
+    -- | Map a function over all key\/value pairs in the 'EnumMapMap'.
+    mapWithKey :: (k -> v -> t) -> EnumMapMap k v -> EnumMapMap k t
+    -- | Fold the keys and values in the map using the given right-associative
+    -- binary operator.
+    foldrWithKey :: (k -> v -> t -> t) -> t -> EnumMapMap k v -> t
+    -- |  Convert the 'EnumMapMap' to a list of key\/value pairs.
+    toList :: EnumMapMap k v -> [(k, v)]
+    toList = foldrWithKey (\k x xs -> (k, x):xs) []
+    -- | Create a 'EnumMapMap' from a list of key\/value pairs.
+    fromList :: [(k, v)] -> EnumMapMap k v
+    fromList = foldlStrict (\t (k, x) -> insert k x t) empty
+    -- | The (left-biased) union of two 'EnumMapMap's.
+    -- It prefers the first 'EnumMapMap' when duplicate keys are encountered.
+    union :: EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v
+    -- | The union of a list of maps.
+    unions :: [EnumMapMap k v] -> EnumMapMap k v
+    unions = foldlStrict union empty
+    -- | The union with a combining function.
+    unionWith :: (v -> v -> v)
+              -> EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v
+    unionWith f = unionWithKey (\_ -> f)
+    -- | The union with a combining function.
+    unionWithKey :: (k -> v -> v -> v)
+                 -> EnumMapMap k v -> EnumMapMap k v -> EnumMapMap k v
+    -- | Difference between two 'EnumMapMap's (based on keys).
+    difference ::  EnumMapMap k v1 -> EnumMapMap k v2 -> EnumMapMap k v1
+    -- | Difference with a combining function.
+    differenceWith :: (v1 -> v2 -> Maybe v1)
+                   -> EnumMapMap k v1
+                   -> EnumMapMap k v2
+                   -> EnumMapMap k v1
+    differenceWith f = differenceWithKey (\_ -> f)
+    -- | Difference with a combining function.
+    differenceWithKey :: (k -> v1 -> v2 -> Maybe v1)
+                      -> EnumMapMap k v1
+                      -> EnumMapMap k v2
+                      -> EnumMapMap k v1
+    -- | The (left-biased) intersection of two 'EnumMapMap' (based on keys).
+    intersection :: EnumMapMap k v1
+                 -> EnumMapMap k v2
+                 -> EnumMapMap k v1
+    -- | The intersection with a combining function.
+    intersectionWith :: (v1 -> v2 -> v3)
+                     -> EnumMapMap k v1
+                     -> EnumMapMap k v2
+                     -> EnumMapMap k v3
+    intersectionWith f = intersectionWithKey (\_ -> f)
+    -- | The intersection with a combining function.
+    intersectionWithKey :: (k -> v1 -> v2 -> v3)
+                        -> EnumMapMap k v1
+                        -> EnumMapMap k v2
+                        -> EnumMapMap k v3
+
+    equal ::  Eq v => EnumMapMap k v -> EnumMapMap k v -> Bool
+    nequal :: Eq v => EnumMapMap k v -> EnumMapMap k v -> Bool
+
+
+instance (Enum k, IsEmm t) => IsEmm (k :& t) where
+    data EnumMapMap (k :& t) v = KCC (EMM k (EnumMapMap t v))
+
+    emptySubTrees e@(KCC emm) =
+        case emm of
+          Nil -> False
+          _   -> emptySubTrees_ e
+    emptySubTrees_ (KCC emm) = go emm
+        where
+          go t = case t of
+                   Bin _ _ l r -> go l || go r
+                   Tip _ v     -> emptySubTrees_ v
+                   Nil         -> True
+
+    removeEmpties (KCC emm) = KCC $ go emm
+        where
+          go t = case t of
+                   Bin p m l r -> bin p m (go l) (go r)
+                   Tip k v     -> tip k (removeEmpties v)
+                   Nil         -> Nil
+
+    unsafeJoinKey (KCC emm) = KCC $ mapWithKey_ (\_ -> unsafeJoinKey) emm
+
+    empty = KCC Nil
+
+    null (KCC t) =
+        case t of
+          Nil -> True
+          _   -> False
+
+    size (KCC t) = go t
+        where
+          go (Bin _ _ l r) = go l + go r
+          go (Tip _ y)     = size y
+          go Nil           = 0
+
+    member !(key' :& nxt) (KCC emm) = go emm
+        where
+          go t = case t of
+                   Bin _ m l r -> case zero key m of
+                                    True  -> go l
+                                    False -> go r
+                   Tip kx x    -> case key == kx of
+                                    True  -> member nxt x
+                                    False -> False
+                   Nil         -> False
+          key = fromEnum key'
+
+    singleton (key :& nxt) = KCC . Tip (fromEnum key) . singleton nxt
+
+    lookup (key :& nxt) (KCC emm) = go emm
+        where
+          go (Bin _ m l r)
+              | zero (fromEnum key) m = go l
+              | otherwise = go r
+          go (Tip kx x)
+             = case kx == (fromEnum key) of
+                 True -> lookup nxt x
+                 False -> Nothing
+          go Nil = Nothing
+
+    insert (key :& nxt) val (KCC emm)
+        = KCC $ insertWith_ (insert nxt val) key (singleton nxt val) emm
+
+    insertWithKey f k@(key :& nxt) val (KCC emm) =
+        KCC $ insertWith_ go key (singleton nxt val) emm
+            where
+              go = insertWithKey (\_ -> f k) nxt val
+
+    delete !(key :& nxt) (KCC emm) =
+        KCC $ alter_ (delete nxt) (fromEnum key) emm
+
+    alter f !(key :& nxt) (KCC emm) =
+        KCC $ alter_ (alter f nxt) (fromEnum key) emm
+
+    mapWithKey f (KCC emm) = KCC $ mapWithKey_ go emm
+        where
+          go k = mapWithKey (\nxt -> f $ k :& nxt)
+
+    foldrWithKey f init (KCC emm) = foldrWithKey_ go init emm
+        where
+          go k val z = foldrWithKey (\nxt -> f $ k :& nxt) z val
+
+    union (KCC emm1) (KCC emm2) = KCC $ mergeWithKey' binD go id id emm1 emm2
+        where
+          go = \(Tip k1 x1) (Tip _ x2) -> tip k1 $ union x1 x2
+    unionWithKey f (KCC emm1) (KCC emm2) =
+        KCC $ mergeWithKey' binD go id id emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   Tip k1 $ unionWithKey (g k1) x1 x2
+              g k1 nxt = f $ (toEnum k1) :& nxt
+
+    difference (KCC emm1) (KCC emm2) =
+        KCC $ mergeWithKey' binD go id (const Nil) emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   tip k1 (difference x1 x2)
+    differenceWithKey f (KCC emm1) (KCC emm2) =
+        KCC $ mergeWithKey' binD go id (const Nil) emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   tip k1 $ differenceWithKey (\nxt ->
+                                              f $ (toEnum k1) :& nxt) x1 x2
+
+    intersection (KCC emm1) (KCC emm2) =
+        KCC $ mergeWithKey' binD go (const Nil) (const Nil) emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   tip k1 $ intersection x1 x2
+    intersectionWithKey f (KCC emm1) (KCC emm2) =
+        KCC $ mergeWithKey' binD go (const Nil) (const Nil) emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   tip k1 $ intersectionWithKey (\nxt ->
+                                                f $ (toEnum k1) :& nxt) x1 x2
+
+    equal (KCC emm1) (KCC emm2) = emm1 == emm2
+    nequal (KCC emm1) (KCC emm2) = emm1 /= emm2
+
+{--------------------------------------------------------------------
+  Helpers
+--------------------------------------------------------------------}
+
+insertWith_ :: Enum k => (v -> v) -> k -> v -> EMM k v -> EMM k v
+insertWith_ f !key' val emm = key `seq` go emm
+    where
+      go t =
+          case t of
+            Bin p m l r
+                | nomatch key p m -> join key (Tip key val) p t
+                | zero key m      -> Bin p m (go l) r
+                | otherwise       -> Bin p m l (go r)
+            Tip ky y
+                | key == ky       -> Tip key (f y)
+                | otherwise       -> join key (Tip key val) ky t
+            Nil                   -> Tip key val
+      key = fromEnum key'
+{-# INLINE insertWith_ #-}
+
+-- | 'alter_' is used to walk down the tree to find the 'EnumMapMap' to actually
+-- change.  If the new 'EnumMapMap' is null then it's removed from the containing
+-- 'EMM'.
+alter_ :: (IsEmm b) =>
+          (EnumMapMap b v -> EnumMapMap b v)
+       -> Key
+       -> EMM a (EnumMapMap b v)
+       -> EMM a (EnumMapMap b v)
+alter_ f k = go
+    where
+      go t =
+          case t of
+            Bin p m l r | nomatch k p m -> joinD k (tip k $ f empty) p t
+                        | zero k m      -> binD p m (go l) r
+                        | otherwise     -> binD p m l (go r)
+            Tip ky y    | k == ky       -> tip k $ f y
+                        | otherwise     -> joinD k (tip k $ f empty) ky t
+            Nil                         -> tip k $ f empty
+{-# INLINE alter_ #-}
+
+mapWithKey_ :: Enum k => (k -> v -> t) -> EMM k v -> EMM k t
+mapWithKey_ f = go
+    where
+      go (Bin p m l r) = Bin p m (go l) (go r)
+      go (Tip k x)     = Tip k (f (toEnum k) x)
+      go Nil           = Nil
+{-# INLINE mapWithKey_ #-}
+
+foldrWithKey_ :: (Enum k) => (k -> v -> t -> t) -> t -> EMM k v -> t
+foldrWithKey_ f z = \emm ->
+    case emm of Bin _ m l r | m < 0     -> go (go z l) r
+                            | otherwise -> go (go z r) l
+                _                       -> go z emm
+    where
+      go z' Nil           = z'
+      go z' (Tip kx tx)   = f (toEnum kx) tx z'
+      go z' (Bin _ _ l r) = go (go z' r) l
+{-# INLINE foldrWithKey_ #-}
+
+-- | See 'IntMap' documentation for an explanation of 'mergeWithKey''.
+mergeWithKey' :: (Enum a) =>
+                 (Prefix -> Mask -> EMM a v3 -> EMM a v3 -> EMM a v3)
+              -> (EMM a v1 -> EMM a v2 -> EMM a v3)
+              -> (EMM a v1 -> EMM a v3)
+              -> (EMM a v2 -> EMM a v3)
+              -> EMM a v1 -> EMM a v2 -> EMM a v3
+mergeWithKey' bin' f g1 g2 = go
+  where
+    go t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
+      | shorter m1 m2  = merge1
+      | shorter m2 m1  = merge2
+      | p1 == p2       = bin' p1 m1 (go l1 l2) (go r1 r2)
+      | otherwise      = maybe_join p1 (g1 t1) p2 (g2 t2)
+      where
+        merge1 | nomatch p2 p1 m1  = maybe_join p1 (g1 t1) p2 (g2 t2)
+               | zero p2 m1        = bin' p1 m1 (go l1 t2) (g1 r1)
+               | otherwise         = bin' p1 m1 (g1 l1) (go r1 t2)
+        merge2 | nomatch p1 p2 m2  = maybe_join p1 (g1 t1) p2 (g2 t2)
+               | zero p1 m2        = bin' p2 m2 (go t1 l2) (g2 r2)
+               | otherwise         = bin' p2 m2 (g2 l2) (go t1 r2)
+
+    go t1'@(Bin _ _ _ _) t2'@(Tip k2' _) = merge t2' k2' t1'
+      where merge t2 k2 t1@(Bin p1 m1 l1 r1)
+                | nomatch k2 p1 m1 = maybe_join p1 (g1 t1) k2 (g2 t2)
+                | zero k2 m1 = bin' p1 m1 (merge t2 k2 l1) (g1 r1)
+                | otherwise  = bin' p1 m1 (g1 l1) (merge t2 k2 r1)
+            merge t2 k2 t1@(Tip k1 _)
+                | k1 == k2 = f t1 t2
+                | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
+            merge t2 _  Nil = g2 t2
+
+    go t1@(Bin _ _ _ _) Nil = g1 t1
+
+    go t1'@(Tip k1' _) t2' = merge t1' k1' t2'
+      where merge t1 k1 t2@(Bin p2 m2 l2 r2)
+                | nomatch k1 p2 m2 = maybe_join k1 (g1 t1) p2 (g2 t2)
+                | zero k1 m2 = bin' p2 m2 (merge t1 k1 l2) (g2 r2)
+                | otherwise  = bin' p2 m2 (g2 l2) (merge t1 k1 r2)
+            merge t1 k1 t2@(Tip k2 _)
+                | k1 == k2 = f t1 t2
+                | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
+            merge t1 _  Nil = g1 t1
+
+    go Nil t2 = g2 t2
+
+    maybe_join _ Nil _ t2 = t2
+    maybe_join _ t1 _ Nil = t1
+    maybe_join p1 t1 p2 t2 = join p1 t1 p2 t2
+    {-# INLINE maybe_join #-}
+{-# INLINE mergeWithKey' #-}
+
+
+{---------------------------------------------------------------------
+ Instances
+---------------------------------------------------------------------}
+
+-- Eq
+
+instance (Eq v, IsEmm k) => Eq (EnumMapMap k v) where
+  t1 == t2  = equal t1 t2
+  t1 /= t2  = nequal t1 t2
+
+instance Eq v => Eq (EMM k v) where
+  t1 == t2  = equalE t1 t2
+  t1 /= t2  = nequalE t1 t2
+
+equalE :: Eq v => EMM k v -> EMM k v -> Bool
+equalE (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+  = (m1 == m2) && (p1 == p2) && (equalE l1 l2) && (equalE r1 r2)
+equalE (Tip kx x) (Tip ky y)
+  = (kx == ky) && (x==y)
+equalE Nil Nil = True
+equalE _   _   = False
+
+nequalE :: Eq v => EMM k v -> EMM k v -> Bool
+nequalE (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
+  = (m1 /= m2) || (p1 /= p2) || (nequalE l1 l2) || (nequalE r1 r2)
+nequalE (Tip kx x) (Tip ky y)
+  = (kx /= ky) || (x/=y)
+nequalE Nil Nil = False
+nequalE _   _   = True
+
+instance (IsEmm k) => Functor (EnumMapMap k)
+    where
+      fmap = map
+
+instance (IsEmm k) => Monoid (EnumMapMap k v) where
+    mempty = empty
+    mappend = union
+    mconcat = unions
+
+instance (Show v, Show (EnumMapMap t v)) => Show (EnumMapMap (k :& t) v) where
+    show (KCC emm) = show emm
+
+instance (NFData v, NFData (EnumMapMap t v)) => NFData (EnumMapMap (k :& t) v)
+    where
+      rnf (KCC emm) = go emm
+          where
+            go Nil           = ()
+            go (Tip _ v)     = rnf v
+            go (Bin _ _ l r) = go l `seq` go r
+
+{--------------------------------------------------------------------
+  Nat conversion
+--------------------------------------------------------------------}
+
+natFromInt :: Int -> Nat
+natFromInt = fromIntegral
+{-# INLINE natFromInt #-}
+
+intFromNat :: Nat -> Int
+intFromNat = fromIntegral
+{-# INLINE intFromNat #-}
+
+shiftRL :: Nat -> Int -> Nat
+shiftRL (W# x) (I# i)
+  = W# (shiftRL# x i)
+
+{--------------------------------------------------------------------
+  Join
+--------------------------------------------------------------------}
+join :: Prefix -> EMM a v -> Prefix -> EMM a v -> EMM a v
+join p1 t1 p2 t2
+  | zero p1 m = Bin p m t1 t2
+  | otherwise = Bin p m t2 t1
+  where
+    m = branchMask p1 p2
+    p = mask p1 m
+{-# INLINE join #-}
+
+joinD :: (IsEmm b) =>
+         Prefix -> EMM a (EnumMapMap b v)
+      -> Prefix -> EMM a (EnumMapMap b v)
+      -> EMM a (EnumMapMap b v)
+joinD p1 t1 p2 t2
+  | zero p1 m = binD p m t1 t2
+  | otherwise = binD p m t2 t1
+  where
+    m = branchMask p1 p2
+    p = mask p1 m
+{-# INLINE joinD #-}
+
+{--------------------------------------------------------------------
+  @bin@ assures that we never have empty trees within a tree.
+--------------------------------------------------------------------}
+bin :: Prefix -> Mask -> EMM k v -> EMM k v -> EMM k v
+bin _ _ l Nil = l
+bin _ _ Nil r = r
+bin p m l r   = Bin p m l r
+{-# INLINE bin #-}
+
+{--------------------------------------------------------------------
+  @binD@ assures that we never have empty trees in the next level
+--------------------------------------------------------------------}
+binD :: (IsEmm b) =>
+        Prefix -> Mask
+     -> EMM a (EnumMapMap b v)
+     -> EMM a (EnumMapMap b v)
+     -> EMM a (EnumMapMap b v)
+binD _ _ l Nil = l
+binD _ _ Nil r = r
+binD p m l r@(Tip _ y)
+    | null y    = l
+    | otherwise = Bin p m l r
+binD p m l@(Tip _ y) r
+    | null y    = r
+    | otherwise = Bin p m l r
+binD p m l r = Bin p m l r
+{-# INLINE binD #-}
+
+tip :: (IsEmm b) => Key -> EnumMapMap b v -> EMM a (EnumMapMap b v)
+tip k val
+    | null val  = Nil
+    | otherwise = Tip k val
+{-# INLINE tip #-}
+
+{--------------------------------------------------------------------
+  Endian independent bit twiddling
+--------------------------------------------------------------------}
+zero :: Key -> Mask -> Bool
+zero i m
+  = (natFromInt i) .&. (natFromInt m) == 0
+{-# INLINE zero #-}
+
+nomatch,match :: Key -> Prefix -> Mask -> Bool
+nomatch i p m
+  = (mask i m) /= p
+{-# INLINE nomatch #-}
+
+match i p m
+  = (mask i m) == p
+{-# INLINE match #-}
+
+mask :: Key -> Mask -> Prefix
+mask i m
+  = maskW (natFromInt i) (natFromInt m)
+{-# INLINE mask #-}
+
+{--------------------------------------------------------------------
+  Big endian operations
+--------------------------------------------------------------------}
+maskW :: Nat -> Nat -> Prefix
+maskW i m
+  = intFromNat (i .&. (complement (m-1) `xor` m))
+{-# INLINE maskW #-}
+
+shorter :: Mask -> Mask -> Bool
+shorter m1 m2
+  = (natFromInt m1) > (natFromInt m2)
+{-# INLINE shorter #-}
+
+branchMask :: Prefix -> Prefix -> Mask
+branchMask p1 p2
+  = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
+{-# INLINE branchMask #-}
+
+{----------------------------------------------------------------------
+  [highestBitMask] returns a word where only the highest bit is set.
+  It is found by first setting all bits in lower positions than the
+  highest bit and than taking an exclusive or with the original value.
+  Allthough the function may look expensive, GHC compiles this into
+  excellent C code that subsequently compiled into highly efficient
+  machine code. The algorithm is derived from Jorg Arndt's FXT library.
+----------------------------------------------------------------------}
+highestBitMask :: Nat -> Nat
+highestBitMask x0
+  = case (x0 .|. shiftRL x0 1) of
+     x1 -> case (x1 .|. shiftRL x1 2) of
+      x2 -> case (x2 .|. shiftRL x2 4) of
+       x3 -> case (x3 .|. shiftRL x3 8) of
+        x4 -> case (x4 .|. shiftRL x4 16) of
+         x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms
+          x6 -> (x6 `xor` (shiftRL x6 1))
+{-# INLINE highestBitMask #-}
+
+{--------------------------------------------------------------------
+  Utilities
+--------------------------------------------------------------------}
+
+foldlStrict :: (a -> b -> a) -> a -> [b] -> a
+foldlStrict f = go
+  where
+    go z []     = z
+    go z (x:xs) = let z' = f z x in z' `seq` go z' xs
+{-# INLINE foldlStrict #-}
+
diff --git a/Data/EnumMapMap/Lazy.hs b/Data/EnumMapMap/Lazy.hs
new file mode 100644
--- /dev/null
+++ b/Data/EnumMapMap/Lazy.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE CPP, MagicHash, TypeFamilies, TypeOperators, BangPatterns,
+             FlexibleInstances, MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.EnumMapMap.Lazy
+-- Copyright   :  (c) Daan Leijen 2002
+--                (c) Andriy Palamarchuk 2008
+--                (c) Matthew West 2012
+-- License     :  BSD-style
+-- Maintainer  :
+-- Stability   :  experimental
+-- Portability :  Uses GHC extensions
+--
+-----------------------------------------------------------------------------
+
+module Data.EnumMapMap.Lazy (
+
+            emptySubTrees,
+
+            -- * Key types
+            (:&)(..), K(..),
+            d1, d2, d3, d4, d5, d6, d7, d8, d9, d10,
+            -- * Map Type
+            EnumMapMap,
+            -- * Query
+            size,
+            null,
+            member,
+            lookup,
+            -- * Construction
+            empty,
+            singleton,
+            -- * Insertion
+            insert,
+            insertWith,
+            insertWithKey,
+            -- * Delete\/Update
+            delete,
+            alter,
+            -- * Combine
+            -- ** Union
+            union,
+            unionWith,
+            unionWithKey,
+            unions,
+            -- ** Difference
+            difference,
+            differenceWith,
+            differenceWithKey,
+            -- ** Intersection
+            intersection,
+            intersectionWith,
+            intersectionWithKey,
+            -- * Map
+            map,
+            mapWithKey,
+            -- * Folds
+            foldrWithKey,
+            -- * Lists
+            toList,
+            fromList,
+            -- * Split/Join Keys
+            splitKey,
+            joinKey,
+            unsafeJoinKey
+) where
+
+import           Prelude hiding (lookup,map,filter,foldr,foldl,null,init)
+
+import           Control.DeepSeq (NFData(rnf))
+
+import           Data.EnumMapMap.Base
+
+instance (Enum k) => IsEmm (K k) where
+    data EnumMapMap (K k) v = KEC (EMM k v)
+
+    emptySubTrees e@(KEC emm) =
+        case emm of
+          Nil -> False
+          _   -> emptySubTrees_ e
+    emptySubTrees_ (KEC emm) = go emm
+        where
+          go t = case t of
+                   Bin _ _ l r -> go l || go r
+                   Tip _ _     -> False
+                   Nil         -> True
+
+    removeEmpties = id
+
+    unsafeJoinKey (KEC emm) = KCC emm
+
+    empty = KEC Nil
+
+    null (KEC t) = case t of
+                     Nil -> True
+                     _   -> False
+
+    size (KEC t) = go t
+        where
+          go (Bin _ _ l r) = go l + go r
+          go (Tip _ _)     = 1
+          go Nil           = 0
+
+    member !(K key') (KEC emm) = go emm
+        where
+          go t = case t of
+                   Bin _ m l r -> case zero key m of
+                                    True  -> go l
+                                    False -> go r
+                   Tip kx _    -> key == kx
+                   Nil         -> False
+          key = fromEnum key'
+
+    singleton !(K key) = KEC . Tip (fromEnum key)
+
+    lookup !(K key') (KEC emm) = go emm
+        where
+          go (Bin _ m l r)
+              | zero key m = go l
+              | otherwise = go r
+          go (Tip kx x)
+             = case kx == key of
+                 True -> Just x
+                 False -> Nothing
+          go Nil = Nothing
+          key = fromEnum key'
+
+    insert !(K key') val (KEC emm) = KEC $ go emm
+        where
+          go t = case t of
+                   Bin p m l r
+                       | nomatch key p m -> join key (Tip key val) p t
+                       | zero key m      -> Bin p m (go l) r
+                       | otherwise       -> Bin p m l (go r)
+                   Tip ky _
+                       | key == ky       -> Tip key val
+                       | otherwise       -> join key (Tip key val) ky t
+                   Nil                   -> Tip key val
+          key = fromEnum key'
+
+    insertWithKey f k@(K key') val (KEC emm) = KEC $ go emm
+        where go t = case t of
+                     Bin p m l r
+                         | nomatch key p m -> join key (Tip key val) p t
+                         | zero key m      -> Bin p m (go l) r
+                         | otherwise       -> Bin p m l (go r)
+                     Tip ky y
+                         | key == ky       -> Tip key (f k val y)
+                         | otherwise       -> join key (Tip key val) ky t
+                     Nil                   -> Tip key val
+              key = fromEnum key'
+
+    delete !(K key') (KEC emm) = KEC $ go emm
+        where
+          go t = case t of
+                   Bin p m l r | nomatch key p m -> t
+                               | zero key m      -> bin p m (go l) r
+                               | otherwise       -> bin p m l (go r)
+                   Tip ky _    | key == ky       -> Nil
+                               | otherwise       -> t
+                   Nil                           -> Nil
+          key = fromEnum key'
+
+    alter f !(K key') (KEC emm) = KEC $ go emm
+        where
+          go t = case t of
+                Bin p m l r
+                    |nomatch key p m -> case f Nothing of
+                                          Nothing -> t
+                                          Just x  -> join key (Tip key x) p t
+                    | zero key m     -> bin p m (go l) r
+                    | otherwise      -> bin p m l (go r)
+                Tip ky y
+                    | key == ky      -> case f (Just y) of
+                                          Just x  -> Tip ky x
+                                          Nothing -> Nil
+                    | otherwise      -> case f Nothing of
+                                          Just x  -> join key (Tip key x) ky t
+                                          Nothing -> Tip ky y
+                Nil                  -> case f Nothing of
+                                          Just x  -> Tip key x
+                                          Nothing -> Nil
+            where
+              key = fromEnum key'
+
+    mapWithKey f (KEC emm) = KEC $ mapWithKey_ (\k -> f $ K k) emm
+    foldrWithKey f init (KEC emm) = foldrWithKey_ (\k -> f $ K k) init emm
+
+    union (KEC emm1) (KEC emm2) = KEC $ mergeWithKey' Bin const id id emm1 emm2
+    unionWithKey f (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' Bin go id id emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   Tip k1 $ f (K $ toEnum k1) x1 x2
+
+    difference (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' bin (\_ _ -> Nil) id (const Nil) emm1 emm2
+    differenceWithKey f (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' bin combine id (const Nil) emm1 emm2
+            where
+              combine = \(Tip k1 x1) (Tip _ x2)
+                      -> case f (K $ toEnum k1) x1 x2 of
+                           Nothing -> Nil
+                           Just x -> Tip k1 x
+
+    intersection (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' bin const (const Nil) (const Nil) emm1 emm2
+    intersectionWithKey f (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' bin go (const Nil) (const Nil) emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   Tip k1 $ f (K $ toEnum k1) x1 x2
+
+    equal (KEC emm1) (KEC emm2) = emm1 == emm2
+    nequal (KEC emm1) (KEC emm2) = emm1 /= emm2
+
+{---------------------------------------------------------------------
+ Instances
+---------------------------------------------------------------------}
+
+instance (Show v) => Show (EnumMapMap (K k) v) where
+    show (KEC emm) = show emm
+
+instance NFData v => NFData (EnumMapMap (K k) v) where
+    rnf (KEC emm) = go emm
+        where
+          go Nil           = ()
+          go (Tip _ v)     = rnf v
+          go (Bin _ _ l r) = go l `seq` go r
+
+{---------------------------------------------------------------------
+ Split/Join Keys
+---------------------------------------------------------------------}
+
+type instance Plus (K k1) k2 = k1 :& k2
+
+instance IsSplit (k :& t) Z where
+    type Head (k :& t) Z = K k
+    type Tail (k :& t) Z = t
+    splitKey Z (KCC emm) = KEC $ emm
diff --git a/Data/EnumMapMap/Strict.hs b/Data/EnumMapMap/Strict.hs
new file mode 100644
--- /dev/null
+++ b/Data/EnumMapMap/Strict.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE MagicHash, MultiParamTypeClasses, TypeFamilies, TypeOperators,
+  BangPatterns, FlexibleInstances, FlexibleContexts, CPP #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.EnumMapMap.Strict
+-- Copyright   :  (c) Daan Leijen 2002
+--                (c) Andriy Palamarchuk 2008
+--                (c) Matthew West 2012
+-- License     :  BSD-style
+-- Maintainer  :
+-- Stability   :  experimental
+-- Portability :  Uses GHC extensions
+--
+-----------------------------------------------------------------------------
+
+module Data.EnumMapMap.Strict (
+
+            emptySubTrees,
+
+            -- * Key types
+            (:&)(..), K(..),
+            d1, d2, d3, d4, d5, d6, d7, d8, d9, d10,
+            -- * Map Type
+            EnumMapMap,
+            -- * Query
+            size,
+            null,
+            member,
+            lookup,
+            -- * Construction
+            empty,
+            singleton,
+            -- * Insertion
+            insert,
+            insertWith,
+            insertWithKey,
+            -- * Delete\/Update
+            delete,
+            alter,
+            -- * Combine
+            -- ** Union
+            union,
+            unionWith,
+            unionWithKey,
+            unions,
+            -- ** Difference
+            difference,
+            differenceWith,
+            differenceWithKey,
+            -- ** Intersection
+            intersection,
+            intersectionWith,
+            intersectionWithKey,
+            -- * Traversal
+            -- ** Map
+            map,
+            mapWithKey,
+            -- * Folds
+            foldrWithKey,
+            -- * Lists
+            toList,
+            fromList,
+            -- * Split/Join Keys
+            splitKey,
+            joinKey,
+            unsafeJoinKey
+) where
+
+import           Prelude hiding (lookup,map,filter,foldr,foldl,null, init)
+
+import           Control.DeepSeq (NFData(rnf))
+
+import           Data.EnumMapMap.Base
+
+instance (Enum k) => IsEmm (K k) where
+    data EnumMapMap (K k) v = KEC (EMM k v)
+
+    emptySubTrees e@(KEC emm) =
+        case emm of
+          Nil -> False
+          _   -> emptySubTrees_ e
+    emptySubTrees_ (KEC emm) = go emm
+        where
+          go t = case t of
+                   Bin _ _ l r -> go l || go r
+                   Tip _ _     -> False
+                   Nil         -> True
+
+    removeEmpties = id
+
+    unsafeJoinKey (KEC emm) = KCC emm
+
+    empty = KEC Nil
+
+    null (KEC t) = case t of
+                     Nil -> True
+                     _   -> False
+
+    size (KEC t) = go t
+        where
+          go (Bin _ _ l r) = go l + go r
+          go (Tip _ _)     = 1
+          go Nil           = 0
+
+    member !(K key') (KEC emm) = go emm
+        where
+          go t = case t of
+                   Bin _ m l r -> case zero key m of
+                                    True  -> go l
+                                    False -> go r
+                   Tip kx _    -> key == kx
+                   Nil         -> False
+          key = fromEnum key'
+
+    singleton !(K key) !val = KEC $ Tip (fromEnum key) val
+
+    lookup !(K key') (KEC emm) = go emm
+        where
+          go (Bin _ m l r)
+              | zero key m = go l
+              | otherwise = go r
+          go (Tip kx x)
+             = case kx == key of
+                 True -> Just x
+                 False -> Nothing
+          go Nil = Nothing
+          key = fromEnum key'
+
+    insert !(K key') !val (KEC emm) = KEC $ go emm
+        where
+          go t = case t of
+                   Bin p m l r
+                       | nomatch key p m -> join key (Tip key val) p t
+                       | zero key m      -> Bin p m (go l) r
+                       | otherwise       -> Bin p m l (go r)
+                   Tip ky _
+                       | key == ky       -> Tip key val
+                       | otherwise       -> join key (Tip key val) ky t
+                   Nil                   -> Tip key val
+          key = fromEnum key'
+
+    insertWithKey f k@(K key') !val (KEC emm) = KEC $ go emm
+        where go t = case t of
+                     Bin p m l r
+                         | nomatch key p m -> join key (Tip key val) p t
+                         | zero key m      -> Bin p m (go l) r
+                         | otherwise       -> Bin p m l (go r)
+                     Tip ky y
+                         | key == ky       -> Tip key $! (f k val y)
+                         | otherwise       -> join key (Tip key val) ky t
+                     Nil                   -> Tip key val
+              key = fromEnum key'
+
+    delete !(K key') (KEC emm) = KEC $ go emm
+        where
+          go t = case t of
+                   Bin p m l r | nomatch key p m -> t
+                               | zero key m      -> bin p m (go l) r
+                               | otherwise       -> bin p m l (go r)
+                   Tip ky _    | key == ky       -> Nil
+                               | otherwise       -> t
+                   Nil                           -> Nil
+          key = fromEnum key'
+
+    alter f !(K key') (KEC emm) = KEC $ go emm
+        where
+          go t = case t of
+                Bin p m l r
+                    | nomatch key p m -> case f Nothing of
+                                           Nothing -> t
+                                           Just !x  -> join key (Tip key x) p t
+                    | zero key m      -> bin p m (go l) r
+                    | otherwise       -> bin p m l (go r)
+                Tip ky y
+                    | key == ky       -> case f (Just y) of
+                                           Just !x  -> Tip ky x
+                                           Nothing -> Nil
+                    | otherwise       -> case f Nothing of
+                                           Just !x  -> join key (Tip key x) ky t
+                                           Nothing -> Tip ky y
+                Nil                   -> case f Nothing of
+                                           Just !x  -> Tip key x
+                                           Nothing -> Nil
+            where
+              key = fromEnum key'
+
+    mapWithKey f (KEC emm) = KEC $ mapWithKey_ (\k -> id $! f $! K k) emm
+    foldrWithKey f init (KEC emm) = foldrWithKey_ (\k -> f $! K k) init emm
+
+    union (KEC emm1) (KEC emm2) = KEC $ mergeWithKey' Bin const id id emm1 emm2
+    unionWithKey f (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' Bin go id id emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   Tip k1 $! f (K $ toEnum k1) x1 x2
+
+    difference (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' bin (\_ _ -> Nil) id (const Nil) emm1 emm2
+    differenceWithKey f (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' bin combine id (const Nil) emm1 emm2
+            where
+              combine = \(Tip k1 x1) (Tip _ x2)
+                      -> case f (K $ toEnum k1) x1 x2 of
+                           Nothing -> Nil
+                           Just x -> x `seq` Tip k1 x
+
+    intersection (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' bin const (const Nil) (const Nil) emm1 emm2
+    intersectionWithKey f (KEC emm1) (KEC emm2) =
+        KEC $ mergeWithKey' bin go (const Nil) (const Nil) emm1 emm2
+            where
+              go = \(Tip k1 x1) (Tip _ x2) ->
+                   Tip k1 $! f (K $ toEnum k1) x1 x2
+
+    equal (KEC emm1) (KEC emm2) = emm1 == emm2
+    nequal (KEC emm1) (KEC emm2) = emm1 /= emm2
+
+{---------------------------------------------------------------------
+ Instances
+---------------------------------------------------------------------}
+
+instance (Show v) => Show (EnumMapMap (K k) v) where
+    show (KEC emm) = show emm
+
+instance NFData v => NFData (EnumMapMap (K k) v) where
+    rnf (KEC emm) = go emm
+        where
+          go Nil           = ()
+          go (Tip _ v)     = rnf v
+          go (Bin _ _ l r) = go l `seq` go r
+
+{---------------------------------------------------------------------
+ Split/Join Keys
+---------------------------------------------------------------------}
+
+type instance Plus (K k1) k2 = k1 :& k2
+
+instance IsSplit (k :& t) Z where
+    type Head (k :& t) Z = K k
+    type Tail (k :& t) Z = t
+    splitKey Z (KCC emm) = KEC $ emm
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) Daan Leijen 2002
+          (c) Andriy Palamarchuk 2008
+          (c) Matthew West 2012
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of the authors nor the
+      names of its contributors may be used to endorse or promote products
+      derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/enummapmap.cabal b/enummapmap.cabal
new file mode 100644
--- /dev/null
+++ b/enummapmap.cabal
@@ -0,0 +1,83 @@
+name:               enummapmap
+version:            0.0.2
+synopsis:           Map of maps using Enum types as keys
+description:        This package provides 'maps of maps' using Enum types as keys.  The code
+                    is based upon Data.IntMap in containers 5.0.
+license:            BSD3
+license-file:       LICENSE
+author:             Matthew West and authors of containers v5.0
+maintainer:         Matthew West
+category:           Data
+build-type:         Simple
+
+cabal-version:      >=1.10
+
+source-repository head
+   type:            git
+   location:        http://github.com/bovinespirit/enummapmap.git
+
+Library
+   exposed-modules: Data.EnumMapMap.Lazy, Data.EnumMapMap.Strict
+   other-modules:   Data.EnumMapMap.Base
+   build-depends:   base >= 4.0 && < 5,
+                    deepseq >= 1.2 && < 1.4
+   ghc-options:     -Wall -O2
+   default-language: Haskell2010
+
+Test-Suite test-enummapmap-lazy
+    type:             exitcode-stdio-1.0
+    main-is:          UnitEnumMapMap.hs
+    hs-source-dirs:   test
+    ghc-options:      -Wall -O2
+    default-language: Haskell2010
+    build-depends:    base >= 4.0 && < 5,
+                      HUnit,
+                      QuickCheck >= 2,
+                      hspec >= 0.9,
+                      deepseq >= 1.2 && < 1.4,
+                      enummapmap
+    cpp-options:      -DTESTING -DLAZY
+
+Test-Suite test-enummapmap-intmap-lazy
+    type:             exitcode-stdio-1.0
+    main-is:          EnumMapMapVsIntMap.hs
+    hs-source-dirs:   test
+    ghc-options:      -Wall -O2
+    default-language: Haskell2010
+    build-depends:    base >= 4.0 && < 5,
+                      HUnit,
+                      QuickCheck >= 2,
+                      hspec >= 0.9,
+                      deepseq >= 1.2 && < 1.4,
+                      containers >= 0.4.2,
+                      enummapmap
+    cpp-options:      -DTESTING -DLAZY
+
+Test-Suite test-enummapmap-strict
+    type:             exitcode-stdio-1.0
+    main-is:          UnitEnumMapMap.hs
+    hs-source-dirs:   test
+    ghc-options:      -Wall -O2
+    default-language: Haskell2010
+    build-depends:    base >= 4.0 && < 5,
+                      HUnit,
+                      QuickCheck >= 2,
+                      hspec >= 0.9,
+                      deepseq >= 1.2 && < 1.4,
+                      enummapmap
+    cpp-options:      -DTESTING -DSTRICT
+
+Test-Suite test-enummapmap-intmap-strict
+    type:             exitcode-stdio-1.0
+    main-is:          EnumMapMapVsIntMap.hs
+    hs-source-dirs:   test
+    ghc-options:      -Wall -O2
+    default-language: Haskell2010
+    build-depends:    base >= 4.0 && < 5,
+                      HUnit,
+                      QuickCheck >= 2,
+                      hspec >= 0.9,
+                      deepseq >= 1.2 && < 1.4,
+                      containers >= 0.4.2,
+                      enummapmap
+    cpp-options:      -DTESTING -DSTRICT
diff --git a/test/EnumMapMapVsIntMap.hs b/test/EnumMapMapVsIntMap.hs
new file mode 100644
--- /dev/null
+++ b/test/EnumMapMapVsIntMap.hs
@@ -0,0 +1,411 @@
+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | This uses QuickCheck to try to check that an 'EnumMapMap'
+-- behaves in the same way as an 'IntMap'.  It checks up to 4 levels of
+-- 'EnumMapMap' one by one for each function.  It does not check that empty
+-- EnumMapMaps are removed.
+
+import           Test.Hspec.Monadic
+import           Test.Hspec.QuickCheck (prop)
+import           Test.QuickCheck ()
+
+#ifdef LAZY
+import qualified Data.IntMap as IM
+
+import           Data.EnumMapMap.Lazy(EnumMapMap, (:&)(..), K(..))
+import qualified Data.EnumMapMap.Lazy as EMM
+#else
+import qualified Data.IntMap as IM
+
+import           Data.EnumMapMap.Strict(EnumMapMap, (:&)(..), K(..))
+import qualified Data.EnumMapMap.Strict as EMM
+#endif
+
+type TestMap  = EnumMapMap (K Int)                      Int
+type TestMap2 = EnumMapMap (Int :& K Int)               Int
+type TestMap3 = EnumMapMap (Int :& Int :& K Int)        Int
+type TestMap4 = EnumMapMap (Int :& Int :& Int :& K Int) Int
+
+list2l1 :: [(Int, Int)] -> [(K Int, Int)]
+list2l1 = map (\(a, b) -> (K a, b))
+
+list2l2 :: Int -> [(Int, Int)] -> [(Int :& K Int, Int)]
+list2l2 k1 = map (\(a, b) -> (a :& K k1, b))
+
+list2l3 :: Int -> Int -> [(Int, Int)] -> [(Int :& Int :& K Int, Int)]
+list2l3 k1 k2 = map (\(a, b) -> (a :& k1 :& K k2, b))
+
+list2l4 :: Int -> Int -> Int -> [(Int, Int)] -> [(Int :& Int :& Int :& K Int, Int)]
+list2l4 k1 k2 k3 = map (\(a, b) -> (a :& k1 :& k2 :& K k3, b))
+
+-- | Run functions on an 'IntMap' and an 'EnumMapMap' created from list and check
+-- that the results are equal
+runProp :: Eq t =>
+           (IM.IntMap Int -> t)
+        -> (TestMap -> t)
+        -> [(Int, Int)]
+        -> Bool
+runProp f g list =
+    (f $ IM.fromList list) == (g $ EMM.fromList $ list2l1 list)
+
+runPropDuo :: Eq t =>
+           (IM.IntMap Int -> IM.IntMap Int -> t)
+        -> (TestMap -> TestMap -> t)
+        -> [(Int, Int)]
+        -> [(Int, Int)]
+        -> Bool
+runPropDuo f g list1 list2 =
+    (f (IM.fromList list1) $ IM.fromList list2)
+    == (g (EMM.fromList $ list2l1 list1) $ EMM.fromList $ list2l1 list2)
+
+runProp2 :: Eq t =>
+            (IM.IntMap Int -> t)
+         -> (TestMap2 -> t)
+         -> Int
+         -> [(Int, Int)]
+         -> Bool
+runProp2 f g k1 list =
+    (f $ IM.fromList list) == (g $ EMM.fromList $ list2l2 k1 list)
+
+runPropDuo2 :: Eq t =>
+               (IM.IntMap Int -> IM.IntMap Int -> t)
+            -> (TestMap2 -> TestMap2 -> t)
+            -> Int
+            -> [(Int, Int)]
+            -> [(Int, Int)]
+            -> Bool
+runPropDuo2 f g k1 list1 list2 =
+    (f (IM.fromList list1) $ IM.fromList list2)
+    == (g (EMM.fromList $ list2l2 k1 list1) $
+          EMM.fromList $ list2l2 k1 list2)
+
+runProp3 :: Eq t =>
+            (IM.IntMap Int -> t)
+         -> (TestMap3 -> t)
+         -> Int
+         -> Int
+         -> [(Int, Int)]
+         -> Bool
+runProp3 f g k1 k2 list =
+    (f $ IM.fromList list) == (g $ EMM.fromList $ list2l3 k1 k2 list)
+
+runPropDuo3 :: Eq t =>
+               (IM.IntMap Int -> IM.IntMap Int -> t)
+            -> (TestMap3 -> TestMap3 -> t)
+            -> Int
+            -> Int
+            -> [(Int, Int)]
+            -> [(Int, Int)]
+            -> Bool
+runPropDuo3 f g k1 k2 list1 list2 =
+    (f (IM.fromList list1) $ IM.fromList list2)
+    == (g (EMM.fromList $ list2l3 k1 k2 list1) $
+          EMM.fromList $ list2l3 k1 k2 list2)
+
+runProp4 :: Eq t =>
+            (IM.IntMap Int -> t)
+         -> (TestMap4 -> t)
+         -> Int
+         -> Int
+         -> Int
+         -> [(Int, Int)]
+         -> Bool
+runProp4 f g k1 k2 k3 list =
+    (f $ IM.fromList list) == (g $ EMM.fromList $ list2l4 k1 k2 k3 list)
+
+runPropDuo4 :: Eq t =>
+               (IM.IntMap Int -> IM.IntMap Int -> t)
+            -> (TestMap4 -> TestMap4 -> t)
+            -> Int
+            -> Int
+            -> Int
+            -> [(Int, Int)]
+            -> [(Int, Int)]
+            -> Bool
+runPropDuo4 f g k1 k2 k3 list1 list2 =
+    (f (IM.fromList list1) $ IM.fromList list2)
+    == (g (EMM.fromList $ list2l4 k1 k2 k3 list1) $
+          EMM.fromList $ list2l4 k1 k2 k3 list2)
+
+-- | Run functions on an 'IntMap' and an 'EnumMapMap' created from 'list' and check
+-- that the resulting 'IntMap' and 'EnumMapMap' are equal
+runPropL :: (IM.IntMap Int -> IM.IntMap Int)
+         -> (TestMap -> TestMap)
+         -> [(Int, Int)]
+         -> Bool
+runPropL f g =
+    runProp (list2l1 . IM.toList . f) (EMM.toList  . g)
+
+runPropDuoL :: (IM.IntMap Int -> IM.IntMap Int -> IM.IntMap Int)
+            -> (TestMap -> TestMap -> TestMap)
+         -> [(Int, Int)]
+         -> [(Int, Int)]
+         -> Bool
+runPropDuoL f g =
+    runPropDuo (\a b -> list2l1 $ IM.toList $ f a b)
+                   (\a b -> EMM.toList $ g a b)
+
+runPropL2 :: (IM.IntMap Int -> IM.IntMap Int)
+          -> (TestMap2 -> TestMap2)
+          -> Int
+          -> [(Int, Int)]
+          -> Bool
+runPropL2 f g k1 =
+    runProp2 (list2l2 k1 . IM.toList . f) (EMM.toList . g) k1
+
+runPropDuoL2 :: (IM.IntMap Int -> IM.IntMap Int -> IM.IntMap Int)
+             -> (TestMap2 -> TestMap2 -> TestMap2)
+             -> Int
+             -> [(Int, Int)]
+             -> [(Int, Int)]
+             -> Bool
+runPropDuoL2 f g k1 =
+    runPropDuo2 (\a b -> list2l2 k1 $ IM.toList $ f a b)
+                    (\a b -> EMM.toList $ g a b) k1
+
+runPropL3 :: (IM.IntMap Int -> IM.IntMap Int)
+          -> (TestMap3 -> TestMap3)
+          -> Int
+          -> Int
+          -> [(Int, Int)]
+          -> Bool
+runPropL3 f g k1 k2 =
+    runProp3 (list2l3 k1 k2 . IM.toList . f) (EMM.toList . g) k1 k2
+
+runPropDuoL3 :: (IM.IntMap Int -> IM.IntMap Int -> IM.IntMap Int)
+             -> (TestMap3 -> TestMap3 -> TestMap3)
+             -> Int
+             -> Int
+             -> [(Int, Int)]
+             -> [(Int, Int)]
+             -> Bool
+runPropDuoL3 f g k1 k2 =
+    runPropDuo3 (\a b -> list2l3 k1 k2 $ IM.toList $ f a b)
+                    (\a b -> EMM.toList $ g a b) k1 k2
+
+runPropL4 :: (IM.IntMap Int -> IM.IntMap Int)
+          -> (TestMap4 -> TestMap4)
+          -> Int
+          -> Int
+          -> Int
+          -> [(Int, Int)]
+          -> Bool
+runPropL4 f g k1 k2 k3 =
+    runProp4 (list2l4 k1 k2 k3 . IM.toList . f) (EMM.toList . g) k1 k2 k3
+
+runPropDuoL4 :: (IM.IntMap Int -> IM.IntMap Int -> IM.IntMap Int)
+             -> (TestMap4 -> TestMap4 -> TestMap4)
+             -> Int
+             -> Int
+             -> Int
+             -> [(Int, Int)]
+             -> [(Int, Int)]
+             -> Bool
+runPropDuoL4 f g k1 k2 k3 =
+    runPropDuo4 (\a b -> list2l4 k1 k2 k3 $ IM.toList $ f a b)
+                    (\a b -> EMM.toList $ g a b) k1 k2 k3
+
+main :: IO ()
+main = hspecX $ do
+    describe "toList fromList" $ do
+        prop "Level 1" $
+             runPropL id id
+        prop "Level 2" $
+             runPropL2 id id
+        prop "Level 3" $
+             runPropL3 id id
+        prop "Level 4" $
+             runPropL4 id id
+
+    describe "lookup" $ do
+        prop "Level 1" $ \i ->
+            runProp (IM.lookup i) (EMM.lookup $ K i)
+        prop "Level 2" $ \i k1 ->
+            runProp2 (IM.lookup i) (EMM.lookup $ i :& K k1) k1
+        prop "Level 3" $ \i k1 k2 ->
+            runProp3 (IM.lookup i) (EMM.lookup $ i :& k1 :& K k2) k1 k2
+        prop "Level 4" $ \i k1 k2 k3 ->
+            runProp4 (IM.lookup i) (EMM.lookup $ i :& k1 :& k2 :& K k3) k1 k2 k3
+
+    describe "member" $ do
+        prop "Level 1" $ \i ->
+            runProp (IM.member i) (EMM.member $ K i)
+        prop "Level 2" $ \i k1 ->
+            runProp2 (IM.member i) (EMM.member $ i :& K k1) k1
+        prop "Level 3" $ \i k1 k2 ->
+            runProp3 (IM.member i) (EMM.member $ i :& k1 :& K k2) k1 k2
+        prop "Level 4" $ \i k1 k2 k3 ->
+            runProp4 (IM.member i) (EMM.member $ i :& k1 :& k2 :& K k3) k1 k2 k3
+
+    describe "insert" $ do
+        prop "Level 1" $ \i j ->
+             runPropL (IM.insert i j) (EMM.insert (K i) j)
+        prop "Level 2" $ \i j k1 ->
+             runPropL2 (IM.insert i j) (EMM.insert (i :& K k1) j) k1
+        prop "Level 3" $ \i j k1 k2 ->
+             runPropL3 (IM.insert i j) (EMM.insert (i :& k1 :& K k2) j) k1 k2
+        prop "Level 4" $ \i j k1 k2 k3 ->
+             runPropL4 (IM.insert i j)
+                           (EMM.insert (i :& k1 :& k2 :& K k3) j) k1 k2 k3
+
+    describe "insertWith" $ do
+        prop "Level 1" $ \i j ->
+             runPropL (IM.insertWith (+) i j) $
+                          (EMM.insertWith (+) (K i) j)
+        prop "Level 2" $ \i j k1 ->
+             runPropL2 (IM.insertWith (+) i j)
+                           (EMM.insertWith (+) (i :& K k1) j) k1
+        prop "Level 3" $ \i j k1 k2 ->
+             runPropL3 (IM.insertWith (+) i j)
+                           (EMM.insertWith (+) (i :& k1:& K k2) j) k1 k2
+        prop "Level 4" $ \i j k1 k2 k3 ->
+             runPropL4 (IM.insertWith (+) i j)
+                           (EMM.insertWith (+) (i :& k1 :& k2 :& K k3) j) k1 k2 k3
+
+    describe "insertWithKey" $ do
+        let f a b c = a + b + c
+        prop "Level 1" $ \i j ->
+             runPropL (IM.insertWithKey f i j) $
+                          (EMM.insertWithKey
+                           (\(K k) -> f k)
+                           (K i) j)
+        prop "Level 2" $ \i j k1 ->
+             runPropL2 (IM.insertWithKey f i j)
+                           (EMM.insertWithKey
+                            (\(k :& K _) -> f k)
+                            (i :& K k1) j) k1
+        prop "Level 3" $ \i j k1 k2 ->
+             runPropL3 (IM.insertWithKey f i j)
+                           (EMM.insertWithKey
+                            (\(k :& _ :& K _) -> f k)
+                            (i :& k1 :& K k2) j) k1 k2
+        prop "Level 4" $ \i j k1 k2 k3 ->
+             runPropL4 (IM.insertWithKey f i j)
+                           (EMM.insertWithKey
+                            (\(k :& _ :& _ :& K _) -> f k)
+                            (i :& k1 :& k2 :& K k3) j) k1 k2 k3
+
+    describe "delete" $ do
+        prop "Level 1" $ \i ->
+             runPropL (IM.delete i) (EMM.delete (K i))
+        prop "Level 2" $ \i k1 ->
+             runPropL2 (IM.delete i) (EMM.delete (i :& K k1)) k1
+        prop "Level 3" $ \i k1 k2 ->
+             runPropL3 (IM.delete i) (EMM.delete (i :& k1 :& K k2)) k1 k2
+        prop "Level 4" $ \i k1 k2 k3 ->
+             runPropL4 (IM.delete i)
+                           (EMM.delete (i :& k1 :& k2 :& K k3)) k1 k2 k3
+
+    describe "alter" $ do
+        let f b n v = case v of
+                          Just v' -> case b of
+                                       True  -> Just v'
+                                       False -> Nothing
+                          Nothing -> case b of
+                                       True -> Just n
+                                       False -> Nothing
+        prop "Level 1" $ \i b n ->
+            runPropL (IM.alter (f b n) i) $
+                     EMM.alter (f b n) (K i)
+        prop "Level 2" $ \i b n k1 ->
+            runPropL2 (IM.alter (f b n) i)
+                         (EMM.alter (f b n) (i :& K k1)) k1
+        prop "Level 3" $ \i b n k1 k2 ->
+            runPropL3 (IM.alter (f b n) i)
+                         (EMM.alter (f b n) (i :& k1 :& K k2)) k1 k2
+
+    describe "foldrWithKey" $ do
+        let f a b c = [a + b] ++ c
+        prop "Level 1" $
+             runProp (IM.foldrWithKey f []) (EMM.foldrWithKey
+                         (\(K k) -> f k) [])
+        prop "Level 2" $
+             runProp2 (IM.foldrWithKey f []) (EMM.foldrWithKey
+                         (\(k :& K _) -> f k) [])
+        prop "Level 3" $
+             runProp3 (IM.foldrWithKey f []) (EMM.foldrWithKey
+                         (\(k :& _ :& K _) -> f k) [])
+        prop "Level 3" $
+             runProp4 (IM.foldrWithKey f []) (EMM.foldrWithKey
+                         (\(k :& _ :& _ :& K _) -> f k) [])
+
+    describe "map" $ do
+        let f a = a + 1
+        prop "Level 1" $
+             runPropL (IM.map f) (EMM.map f)
+        prop "Level 2" $
+             runPropL2 (IM.map f) (EMM.map f)
+        prop "Level 3" $
+             runPropL3 (IM.map f) (EMM.map f)
+        prop "Level 4" $
+             runPropL4 (IM.map f) (EMM.map f)
+
+    describe "mapWithKey" $ do
+        let f k a = k + a
+        prop "Level 1" $
+             runPropL  (IM.mapWithKey f) (EMM.mapWithKey
+                                          (\(K k) -> f k))
+        prop "Level 2" $
+             runPropL2 (IM.mapWithKey f) (EMM.mapWithKey
+                                          (\(k :& K _) -> f k))
+        prop "Level 3" $
+             runPropL3 (IM.mapWithKey f) (EMM.mapWithKey
+                                          (\(k :& _ :& K _) -> f k))
+        prop "Level 4" $
+             runPropL4 (IM.mapWithKey f) (EMM.mapWithKey
+                                          (\(k :& _ :& _ :& K _) -> f k))
+
+    describe "union" $ do
+        prop "Level 1" $
+             runPropDuoL  IM.union EMM.union
+        prop "Level 2" $
+             runPropDuoL2 IM.union EMM.union
+        prop "Level 3" $
+             runPropDuoL3 IM.union EMM.union
+        prop "Level 4" $
+             runPropDuoL4 IM.union EMM.union
+
+    describe "unionWith" $ do
+        prop "Level 1" $
+             runPropDuoL  (IM.unionWith (+)) (EMM.unionWith (+))
+        prop "Level 2" $
+             runPropDuoL2 (IM.unionWith (+)) (EMM.unionWith (+))
+        prop "Level 3" $
+             runPropDuoL3 (IM.unionWith (+)) (EMM.unionWith (+))
+        prop "Level 4" $
+             runPropDuoL4 (IM.unionWith (+)) (EMM.unionWith (+))
+
+    describe "unionWithKey" $ do
+        let f a b c = (a + b) * c
+        prop "Level 1" $
+             runPropDuoL (IM.unionWithKey f) (EMM.unionWithKey
+                                              (\(K k) -> f k))
+        prop "Level 2" $
+             runPropDuoL2 (IM.unionWithKey f) (EMM.unionWithKey
+                                              (\(k :& K _) -> f k))
+        prop "Level 3" $
+             runPropDuoL3 (IM.unionWithKey f) (EMM.unionWithKey
+                                              (\(k :& _ :& K _) -> f k))
+        prop "Level 4" $
+             runPropDuoL4 (IM.unionWithKey f) (EMM.unionWithKey
+                                              (\(k :& _ :& _ :& K _) -> f k))
+
+    describe "intersectionWithKey" $ do
+        let f a b c = (a + b) * c
+        prop "Level 1" $
+             runPropDuoL (IM.intersectionWithKey f)
+                             (EMM.intersectionWithKey
+                                     (\(K k) a b ->  f k a b))
+        prop "Level 2" $
+             runPropDuoL2 (IM.intersectionWithKey f)
+                             (EMM.intersectionWithKey
+                                     (\(k :& K _) a b -> f k a b))
+        prop "Level 3" $
+             runPropDuoL3 (IM.intersectionWithKey f)
+                             (EMM.intersectionWithKey
+                                     (\(k :& _ :& K _) a b -> f k a b))
+        prop "Level 4" $
+             runPropDuoL4 (IM.intersectionWithKey f)
+                             (EMM.intersectionWithKey
+                                     (\(k :& _ :& _ :& K _) a b -> f k a b))
diff --git a/test/UnitEnumMapMap.hs b/test/UnitEnumMapMap.hs
new file mode 100644
--- /dev/null
+++ b/test/UnitEnumMapMap.hs
@@ -0,0 +1,249 @@
+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+import           Control.Monad (liftM, liftM2)
+import           Test.Hspec.HUnit ()
+import           Test.Hspec.Monadic
+import           Test.Hspec.QuickCheck (prop)
+import           Test.HUnit
+import           Test.QuickCheck (Arbitrary, arbitrary, shrink)
+
+#ifdef LAZY
+import           Data.EnumMapMap.Lazy(EnumMapMap, (:&)(..), K(..))
+import qualified Data.EnumMapMap.Lazy as EMM
+#else
+import           Data.EnumMapMap.Strict(EnumMapMap, (:&)(..), K(..))
+import qualified Data.EnumMapMap.Strict as EMM
+#endif
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (a :& b) where
+    arbitrary = liftM2 (:&) arbitrary arbitrary
+    shrink (x :& y) =    [ x' :& y | x' <- shrink x ]
+                      ++ [ x :& y' | y' <- shrink y ]
+
+instance (Arbitrary a) => Arbitrary (K a) where
+    arbitrary = liftM K arbitrary
+
+newtype ID1 = ID1 Int
+    deriving (Show, Enum, Arbitrary)
+newtype ID2 = ID2 Int
+    deriving (Show, Enum, Arbitrary)
+newtype ID3 = ID3 Int
+    deriving (Show, Enum, Arbitrary)
+
+type TestKey3 = ID3 :& ID2 :& K ID1
+type TestEmm3 = EnumMapMap TestKey3 Int
+
+tens :: [Int]
+tens = [1, 10, 100, 1000, 10000, 100000, 1000000]
+
+odds :: [Int]
+odds = [1, 3..1000]
+
+fewOdds :: [Int]
+fewOdds = [1, 3..6]
+
+evens :: [Int]
+evens = [2, 4..1000]
+
+alls :: [Int]
+alls = [1, 2..1000]
+
+l1tens :: EnumMapMap (K Int) Int
+l1tens = EMM.fromList $ map (\(k, v) -> (K k, v)) $ zip [1..7] tens
+l2tens :: EnumMapMap (Int :& K Int) Int
+l2tens = EMM.fromList $ zip (do
+                              k1 <- [1, 2]
+                              k2 <- [1..7]
+                              return $ k1 :& K k2) $ cycle tens
+
+l1odds :: EnumMapMap (K Int) Int
+l1odds = EMM.fromList $ map (\(k, v) -> (K k, v)) $ zip odds odds
+l2odds :: EnumMapMap (Int :& K Int) Int
+l2odds = EMM.fromList $ zip (do
+                              k1 <- fewOdds
+                              k2 <- fewOdds
+                              return $ k1 :& K k2) $ cycle odds
+l1evens :: EnumMapMap (K Int) Int
+l1evens = EMM.fromList $ map (\(k, v) -> (K k, v)) $ zip evens evens
+
+l1alls :: EnumMapMap (K Int) Int
+l1alls = EMM.fromList $ zip (map K alls) alls
+
+checkSubs :: (TestEmm3 -> TestEmm3 -> TestEmm3)
+          -> [(TestKey3, Int)]
+          -> [(TestKey3, Int)]
+          -> Bool
+checkSubs f l1 l2 =
+    False == (EMM.emptySubTrees $ f emm1 emm2)
+        where
+          emm1 = EMM.fromList l1
+          emm2 = EMM.fromList l2
+
+main :: IO ()
+main =
+  hspecX $ do
+    describe "empty" $ do
+      it "creates an empty EnumMapMap" $
+           (EMM.null $ (EMM.empty :: EnumMapMap (Int :& Int :& K Int) Bool))
+      it "has a size of 0" $
+           0 @=? (EMM.size $ (EMM.empty :: EnumMapMap (Int :& K Int) Bool))
+
+    describe "fromList" $ do
+      it "is the inverse of toList on 1 level" $
+           (EMM.fromList $ EMM.toList l1odds) @?= l1odds
+      it "is the inverse of toList on 2 levels" $
+           (EMM.fromList $ EMM.toList l2odds) @?= l2odds
+
+    describe "insert" $ do
+      describe "Level 1" $ do
+        it "creates a value in an empty EMM" $
+           EMM.insert (K 1) 1 EMM.empty @?=
+           (EMM.fromList [(K 1, 1)]
+                           :: EnumMapMap (K Int) Int)
+        it "adds another value to an EMM" $
+           let
+               emm :: EnumMapMap (K Int) Int
+               emm = EMM.fromList [(K 2, 2)] in
+           EMM.insert (K 1) 1 emm @?=
+              EMM.fromList [(K 1, 1), (K 2, 2)]
+        it "overwrites a value with the same key in an EMM" $
+           let emm :: EnumMapMap (K Int) Int
+               emm = EMM.fromList [(K 1, 1), (K 2, 2)] in
+           EMM.insert (K 1) 3 emm @?=
+              EMM.fromList [(K 1, 3), (K 2, 2)]
+
+        describe "Level 2" $ do
+          it "creates a value in an empty EMM" $
+             EMM.insert (1 :& K 1) 1 EMM.empty @?=
+                             (EMM.fromList [(1 :& K 1, 1)]
+                                  :: EnumMapMap (Int :& K Int) Int)
+          it "adds another value to an EMM on level 1" $
+             let
+                 emm :: EnumMapMap (Int :& K Int) Int
+                 emm = EMM.fromList [(1 :& K 2, 2)]
+             in
+               EMM.insert (1 :& K 1) 1 emm @?=
+               EMM.fromList [(1 :& K 1, 1), (1 :& K 2, 2)]
+          it "adds another value to an EMM on level 2" $
+             let
+                 emm :: EnumMapMap (Int :& K Int) Int
+                 emm = EMM.fromList [(1 :& K 1, 1)]
+             in
+               EMM.insert (2 :& K 2) 2 emm @?=
+               EMM.fromList [(1 :& K 1, 1), (2 :& K 2, 2)]
+
+    describe "insertWithKey" $ do
+      let undef = undefined -- fail if this is called
+      describe "Level 1" $ do
+        it "creates a value in an empty EMM" $
+           EMM.insertWithKey undef (K 1) 1 EMM.empty @?=
+                  (EMM.fromList [(K 1, 1)]
+                       :: EnumMapMap (K Int) Int)
+        it "adds another value to an EMM" $
+           let
+               emm :: EnumMapMap (K Int) Int
+               emm = EMM.fromList [(K 2, 2)] in
+           EMM.insertWithKey undef (K 1) 1 emm @?=
+              EMM.fromList [(K 1, 1), (K 2, 2)]
+        it "applies the function when overwriting" $
+           let emm :: EnumMapMap (K Int) Int
+               emm = EMM.fromList [(K 1, 1), (K 2, 4)]
+               f (K key1) o n = key1 * (o + n)
+           in
+             EMM.insertWithKey f (K 2) 3 emm @?=
+                EMM.fromList [(K 1, 1), (K 2, 14)]
+
+      describe "Level 2" $ do
+        it "creates a value in an empty EMM" $
+           EMM.insertWithKey undef (1 :& K 1) 1 EMM.empty @?=
+                  (EMM.fromList [(1 :& K 1, 1)]
+                           :: EnumMapMap (Int :& K Int) Int)
+        it "adds another value to an EMM on level 1" $
+           let
+               emm :: EnumMapMap (Int :& K Int) Int
+               emm = EMM.fromList [(1 :& K 2, 2)]
+           in
+             EMM.insertWithKey undef (1 :& K 1) 1 emm @?=
+                EMM.fromList [(1 :& K 1, 1), (1 :& K 2, 2)]
+        it "adds another value to an EMM on level 2" $
+           let
+               emm :: EnumMapMap (Int :& K Int) Int
+               emm = EMM.fromList [(1 :& K 1, 1)]
+           in
+             EMM.insertWithKey undef (2 :& K 2) 2 emm @?=
+                EMM.fromList [(1 :& K 1, 1), (2 :& K 2, 2)]
+        it "applies the function when overwriting" $
+           let emm :: EnumMapMap (Int :& K Int) Int
+               emm = EMM.fromList [(2 :& K 3, 1), (2 :& K 4, 5)]
+               f (k1 :& K k2) o n = (k1 + k2) * (o + n)
+           in
+             EMM.insertWithKey f (2 :& K 4) 3 emm @?=
+                EMM.fromList [(2 :& K 3, 1), (2 :& K 4, 48)]
+
+    describe "delete" $ do
+      prop "leaves no empty subtrees" $ \k l ->
+          not $ EMM.emptySubTrees $ EMM.delete k $ (EMM.fromList l :: TestEmm3)
+
+    describe "alter" $ do
+      let f b1 b2 n v = case v of
+                          Nothing -> if b1 then Just n else Nothing
+                          Just v' -> case b1 of
+                                       True  -> Just $ if b2 then v' else n
+                                       False -> Nothing
+      prop "leaves no empty subtrees" $ \k l b1 b2 n ->
+          not $ EMM.emptySubTrees $ EMM.alter (f b1 b2 n) k $
+                  (EMM.fromList l :: TestEmm3)
+
+    describe "foldrWithKey" $ do
+      describe "Level 1" $ do
+        it "folds across all values in an EnumMapMap" $
+           EMM.foldrWithKey (\_ -> (+)) 0 l1tens @?= 1111111
+        it "folds across all keys in an EnumMapMap" $
+           EMM.foldrWithKey (\(K k1) _ -> (+) k1) 0 l1tens @?= 28
+      describe "Level 2" $ do
+        it "folds across all values in an EnumMapMap" $
+           EMM.foldrWithKey (\_ -> (+)) 0 l2tens @?= 2222222
+        it "folds across all keys in an EnumMapMap" $
+           EMM.foldrWithKey
+                      (\(k1 :& K k2) _ -> (+) (k1 * k2)) 0 l2tens @?= 84
+
+      describe "union" $ do
+        describe "Level 1" $ do
+          it "includes every key from each EnumMapMap" $
+               (EMM.union l1odds l1evens) @?= l1alls
+        -- Just in case...
+        prop "Leaves no empty subtrees" $ checkSubs EMM.union
+
+      describe "difference" $ do
+        prop "Leaves no empty subtrees" $ checkSubs EMM.difference
+
+      describe "differenceWithKey" $ do
+        let f (k1 :& k2 :& K k3) v1 v2 =
+                Just $ v1 + v2 + (fromEnum k1) + (fromEnum k2) + (fromEnum k3)
+        prop "Leaves no empty subtrees" $ checkSubs (EMM.differenceWithKey f)
+
+      describe "intersection" $ do
+        prop "Leaves no empty subtrees" $ checkSubs EMM.intersection
+
+      describe "intersectionWithKey" $ do
+        let f (k1 :& k2 :& K k3) v1 v2 =
+                v1 + v2 + (fromEnum k1) + (fromEnum k2) + (fromEnum k3)
+        prop "Leaves no empty subtrees" $ checkSubs (EMM.intersectionWithKey f)
+
+      describe "joinKey $ splitKey z t == t" $ do
+        let go21 :: [(Int :& K Int, Int)] -> Bool
+            go21 l = emm == (EMM.joinKey $ EMM.splitKey EMM.d1 emm)
+                where emm = EMM.fromList l
+        prop "Level 2, depth = 1" go21
+
+        let go31 :: [(Int :& Int :& K Int, Int)] -> Bool
+            go31 l = emm == (EMM.joinKey $ EMM.splitKey EMM.d1 emm)
+                where emm = EMM.fromList l
+        prop "Level 3, depth = 1" go31
+
+        let go32 :: [(Int :& Int :& K Int, Int)] -> Bool
+            go32 l = emm == (EMM.joinKey $ EMM.splitKey EMM.d2 emm)
+                where emm = EMM.fromList l
+        prop "Level 3, depth = 2" go32
+