diff --git a/Data/EnumMapMap/Base.hs b/Data/EnumMapMap/Base.hs
--- a/Data/EnumMapMap/Base.hs
+++ b/Data/EnumMapMap/Base.hs
@@ -34,6 +34,7 @@
             EnumMapMap(..),
             -- ** SKey
             HasSKey(..),
+            SubKeyS(..),
             -- ** EMM internals
             mergeWithKey',
             mapWithKey_,
@@ -45,6 +46,7 @@
             Nat,
             Key,
             intFromNat,
+            natFromInt,
             shiftRL,
             shiftLL,
             branchMask,
@@ -153,13 +155,24 @@
 type instance Plus (k1 :& t) k2 = k1 :& Plus t k2
 
 class SubKey k1 k2 v where
-    -- k1 should be a prefix of k2.  If @k1 ~ k2@ then the 'Result' will be @v@.
+    -- | k1 should be a prefix of k2.  If @k1 ~ k2@ then the 'Result' will be
+    -- @v@.
+    --
+    -- > Result (K ID1) (ID1 :& K ID2) v        ~ EnumMapMap (K ID2) v
+    -- > Result (ID1 :& K ID2) (ID1 :& K ID2) v ~ v
+    -- > Result (ID1 :& K ID2) (K ID1) v        -- ERROR
+    -- > Result (ID2 :& K ID1) (ID1 :& K ID2)   -- ERROR
     type Result k1 k2 v :: *
+
+    -- | Is the key present in the 'EnumMapMap'?
+    member :: k1 -> EnumMapMap k2 v -> Bool
+
     -- | An 'EnumMapMap' with one element
     --
     -- > singleton (5 :& K 3) "a" == fromList [(5 :& K 3, "a")]
     -- > singleton (K 5) $ singleton (K 2) "a" == fromList [(5 :& K 3, "a")]
     singleton :: k1 -> Result k1 k2 v -> EnumMapMap k2 v
+
     -- | Lookup up the value at a key in the 'EnumMapMap'.
     --
     -- > emm = fromList [(3 :& K 1, "a")]
@@ -174,51 +187,38 @@
     --
     lookup :: (IsKey k1, IsKey k2) =>
               k1 -> EnumMapMap k2 v -> Maybe (Result k1 k2 v)
+
     -- | Insert a new key\/value pair into the 'EnumMapMap'.  Can also insert submaps.
     insert :: (IsKey k1, IsKey k2) =>
                k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
+
     -- | Insert with a combining function.  Can also insert submaps.
     insertWith :: (IsKey k1, IsKey k2) =>
                   (Result k1 k2 v -> Result k1 k2 v -> Result k1 k2 v)
                -> k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
     insertWith f = insertWithKey (\_ -> f)
+
     -- | Insert with a combining function.  Can also insert submaps.
     insertWithKey :: (IsKey k1, IsKey k2) =>
                      (k1 -> Result k1 k2 v -> Result k1 k2 v -> Result k1 k2 v)
                   -> k1 -> Result k1 k2 v -> EnumMapMap k2 v -> EnumMapMap k2 v
+
     -- | Remove a key and it's value from the 'EnumMapMap'.  If the key is not
     -- present the original 'EnumMapMap' is returned.
     delete :: (IsKey k1, IsKey k2) =>
               k1 -> EnumMapMap k2 v -> EnumMapMap k2 v
 
-instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
-    SubKey (k :& t1) (k :& t2) v where
-    type Result (k :& t1) (k :& t2) v = Result t1 t2 v
-
-    singleton (key :& nxt) = KCC . Tip (fromEnum key) . singleton nxt
-
-    lookup !(key' :& nxt) (KCC emm) = key `seq` 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 -> lookup nxt x
-                 False -> Nothing
-          go Nil = Nothing
-          key = fromEnum key'
-
-    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
+class SubKeyS k s where
+    -- | The intersection of an 'EnumMapMap' and an 'EnumMapSet'.  If a key is
+    -- present in the EnumMapSet then it will be present in the resulting
+    -- 'EnumMapMap'.  Works with 'EnumMapSet's that are submaps of the
+    -- 'EnumMapMap'.
+    intersectSet :: (IsKey k, IsKey s) =>
+                   EnumMapMap k v -> EnumMapMap s () -> EnumMapMap k v
+    -- | The difference between an 'EnumMapMap' and an 'EnumMapSet'.  If a key
+    -- is present in the 'EnumMapSet' it will not be present in the result.
+    differenceSet :: (IsKey k, IsKey s) =>
+                   EnumMapMap k v -> EnumMapMap s () -> EnumMapMap k v
 
 class HasSKey k where
     type Skey k :: *
@@ -293,8 +293,6 @@
     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
     -- | 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
@@ -322,9 +320,12 @@
     -- | List of keys
     keys :: EnumMapMap k v -> [k]
     keys = foldrWithKey (\k _ ks -> k:ks) []
-    -- | The 'Data.EnumMapSet' of the keys.  'EnumMapMap' keys can be converted into
+    -- | The 'Data.EnumMapSet' of the keys. 'EnumMapMap' keys can be converted into
     -- 'Data.EnumMapSet' keys using 'toS', and back again using 'toK'.
     keysSet :: (HasSKey k) => EnumMapMap k v -> EnumMapMap (Skey k) ()
+    -- | Build an 'EnumMapMap' from an 'EnumMapSet' and a function which for each
+    -- key computes it's value
+    fromSet :: HasSKey k => (k -> v) -> EnumMapMap (Skey k) () -> EnumMapMap k v
     -- | 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
@@ -370,6 +371,60 @@
     equal ::  Eq v => EnumMapMap k v -> EnumMapMap k v -> Bool
     nequal :: Eq v => EnumMapMap k v -> EnumMapMap k v -> Bool
 
+instance (Enum k, IsKey t1, IsKey t2, SubKey t1 t2 v) =>
+    SubKey (k :& t1) (k :& t2) v where
+    type Result (k :& t1) (k :& t2) v = Result t1 t2 v
+
+    member !(key' :& nxt) (KCC emm) = key `seq` 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) = key `seq` 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 -> lookup nxt x
+                 False -> Nothing
+          go Nil = Nothing
+          key = fromEnum key'
+
+    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
+
+instance (Enum k, IsKey t1, IsKey t2, SubKeyS t1 t2) =>
+    SubKeyS (k :& t1) (k :& t2) where
+        intersectSet (KCC emm) (KCC ems) =
+            KCC $ mergeWithKey' binD go (const Nil) (const Nil) emm ems
+                where
+                  go = \(Tip k1 x1) (Tip _ x2) ->
+                       tip k1 $ intersectSet x1 x2
+        differenceSet (KCC emm) (KCC ems) =
+            KCC $  mergeWithKey' binD go id (const Nil) emm ems
+                where
+                  go = \(Tip k1 x1) (Tip _ x2) ->
+                       tip k1 $ differenceSet x1 x2
+
 instance (Eq k, Enum k, IsKey t, HasSKey t) => IsKey (k :& t) where
     data EnumMapMap (k :& t) v = KCC (EMM k (EnumMapMap t v))
 
@@ -406,33 +461,25 @@
           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'
-
     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)
+          go k = mapWithKey (\nxt -> f $! k :& nxt)
 
     foldr f init (KCC emm) = foldrWithKey_ (\_ val z -> foldr f z val) init emm
 
     foldrWithKey f init (KCC emm) = foldrWithKey_ go init emm
         where
-          go k val z = foldrWithKey (\nxt -> f $ k :& nxt) z val
+          go k val z = foldrWithKey (\nxt -> f $! k :& nxt) z val
 
     keysSet (KCC emm) = KCC $ mapWithKey_ (\_ -> keysSet) emm
 
+    fromSet f (KCC ems) = KCC $ mapWithKey_ go ems
+        where
+          go k = fromSet (\nxt -> f $! k :& nxt)
+
     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
@@ -441,7 +488,7 @@
             where
               go = \(Tip k1 x1) (Tip _ x2) ->
                    Tip k1 $ unionWithKey (g k1) x1 x2
-              g k1 nxt = f $ toEnum k1 :& nxt
+              g k1 nxt = f $! toEnum k1 :& nxt
 
     difference (KCC emm1) (KCC emm2) =
         KCC $ mergeWithKey' binD go id (const Nil) emm1 emm2
@@ -453,7 +500,7 @@
             where
               go = \(Tip k1 x1) (Tip _ x2) ->
                    tip k1 $ differenceWithKey (\nxt ->
-                                              f $ toEnum k1 :& nxt) x1 x2
+                                              f $! toEnum k1 :& nxt) x1 x2
 
     intersection (KCC emm1) (KCC emm2) =
         KCC $ mergeWithKey' binD go (const Nil) (const Nil) emm1 emm2
@@ -465,7 +512,7 @@
             where
               go = \(Tip k1 x1) (Tip _ x2) ->
                    tip k1 $ intersectionWithKey (\nxt ->
-                                                f $ toEnum k1 :& nxt) x1 x2
+                                                f $! toEnum k1 :& nxt) x1 x2
 
     equal (KCC emm1) (KCC emm2) = emm1 == emm2
     nequal (KCC emm1) (KCC emm2) = emm1 /= emm2
@@ -530,8 +577,7 @@
 {-# INLINE foldrWithKey_ #-}
 
 -- | See 'IntMap' documentation for an explanation of 'mergeWithKey''.
-mergeWithKey' :: (Enum a) =>
-                 (Prefix -> Mask -> EMM a v3 -> EMM a v3 -> EMM a v3)
+mergeWithKey' :: (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)
@@ -557,7 +603,7 @@
                 | 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
+                | k1 == k2  = f t1 t2
                 | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
             merge t2 _  Nil = g2 t2
 
@@ -631,6 +677,10 @@
             go Nil           = ()
             go (Tip _ v)     = rnf v
             go (Bin _ _ l r) = go l `seq` go r
+
+instance (NFData k, NFData t) => NFData (k :& t)
+    where
+      rnf (k :& t) = rnf k `seq` rnf t
 
 {--------------------------------------------------------------------
   Nat conversion
diff --git a/Data/EnumMapMap/Lazy.hs b/Data/EnumMapMap/Lazy.hs
--- a/Data/EnumMapMap/Lazy.hs
+++ b/Data/EnumMapMap/Lazy.hs
@@ -63,22 +63,25 @@
             difference,
             differenceWith,
             differenceWithKey,
+            differenceSet,
             -- ** Intersection
             intersection,
             intersectionWith,
             intersectionWithKey,
+            intersectSet,
             -- * Map
             map,
             mapWithKey,
             -- * Folds
             foldr,
             foldrWithKey,
-            -- * Lists
+            -- * Lists and sets
             toList,
             fromList,
             keys,
             elems,
             keysSet,
+            fromSet,
             -- * Split/Join Keys
             toK,
             toS,
@@ -133,16 +136,6 @@
           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'
-
     alter f !(K key') (KEC emm) = KEC $ go emm
         where
           go t = case t of
@@ -175,6 +168,7 @@
           go z' (Tip _ x)     = f x z'
           go z' (Bin _ _ l r) = go (go z' r) l
     foldrWithKey f init (KEC emm) = foldrWithKey_ (\k -> f $ K k) init emm
+
     keysSet (KEC emm) = EMS.KSC $ go emm
         where
           go Nil        = EMS.Nil
@@ -188,6 +182,7 @@
                 computeBm !acc (Tip kx _)      = acc .|. EMS.bitmapOf kx
                 computeBm !acc Nil             = acc
 
+    fromSet f (EMS.KSC emm) = KEC $ fromSet_ (f . K . toEnum) 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
@@ -230,6 +225,10 @@
           go (Tip _ v)     = rnf v
           go (Bin _ _ l r) = go l `seq` go r
 
+instance (NFData k) => NFData (K k)
+    where
+      rnf (K k) = rnf k
+
 instance HasSKey (K k) where
     type Skey (K k) = EMS.S k
     toS (K !k) = EMS.S k
@@ -248,6 +247,7 @@
 
 instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
     type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v
+    member (K key) (KCC emm) = member_ (fromEnum key) emm
     singleton !(K key) = KCC . Tip (fromEnum key)
     lookup !(K key') (KCC emm) = lookup_ (fromEnum key') emm
     insert !(K key') val (KCC emm) = KCC $ insert_ (fromEnum key') val emm
@@ -257,6 +257,7 @@
 
 instance (Enum k) => SubKey (K k) (K k) v where
     type Result (K k) (K k) v = v
+    member (K key) (KEC emm) = member_ (fromEnum key) emm
     singleton !(K key) = KEC . Tip (fromEnum key)
     lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm
     insert !(K key') val (KEC emm) = KEC $ insert_ (fromEnum key') val emm
@@ -264,6 +265,24 @@
         KEC $ insertWK (f k) (fromEnum key') val emm
     delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm
 
+instance (Enum k1, k1 ~ k2) => SubKeyS (k1 :& t) (EMS.S k2) where
+    intersectSet (KCC emm) (EMS.KSC ems) = KCC $ intersectSet_ emm ems
+    differenceSet (KCC emm) (EMS.KSC ems) = KCC $ differenceSet_ emm ems
+
+instance (Enum k) => SubKeyS (K k) (EMS.S k) where
+    intersectSet (KEC emm) (EMS.KSC ems) = KEC $ intersectSet_ emm ems
+    differenceSet (KEC emm) (EMS.KSC ems) = KEC $ differenceSet_ emm ems
+
+member_ :: Key -> EMM k v -> Bool
+member_ key 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
+
 lookup_ :: Key -> EMM k v -> Maybe v
 lookup_ !key emm =
     case emm of
@@ -310,3 +329,36 @@
       Tip ky _    | key == ky       -> Nil
                   | otherwise       -> emm
       Nil                           -> Nil
+
+fromSet_ :: (Key -> v) -> EMS.EMS k -> EMM k v
+fromSet_ f = go
+    where
+      go EMS.Nil           = Nil
+      go (EMS.Bin p m l r) = Bin p m (go l) (go r)
+      go (EMS.Tip key bm)  = buildTree f key bm (EMS.suffixBitMask + 1)
+      buildTree g !prefix !bmask bits =
+          case bits of
+            0 -> Tip prefix (f prefix)
+            _ -> case intFromNat ((natFromInt bits) `shiftRL` 1) of
+                   bits2 | bmask .&. ((1 `shiftLL` bits2) -1) == 0 ->
+                             buildTree g (prefix + bits2)
+                                           (bmask `shiftRL` bits2) bits2
+                         | (bmask `shiftRL` bits2) .&.
+                           ((1 `shiftLL` bits2) - 1) == 0 ->
+                               buildTree g prefix bmask bits2
+                         | otherwise ->
+                             Bin prefix bits2
+                                     (buildTree g prefix bmask bits2)
+                                     (buildTree g (prefix + bits2)
+                                      (bmask `shiftRL` bits2)
+                                      bits2)
+
+intersectSet_ :: EMM k v -> EMS.EMS k -> EMM k v
+intersectSet_ emm ems =
+    mergeWithKey' bin const (const Nil) (const Nil) emm ems'
+        where ems' = fromSet_ (\_ -> ()) ems
+
+differenceSet_ :: EMM k v -> EMS.EMS k -> EMM k v
+differenceSet_ emm ems =
+    mergeWithKey' bin (\_ _ -> Nil) id (const Nil) emm ems'
+        where ems' = fromSet_ (\_ -> ()) ems
diff --git a/Data/EnumMapMap/Strict.hs b/Data/EnumMapMap/Strict.hs
--- a/Data/EnumMapMap/Strict.hs
+++ b/Data/EnumMapMap/Strict.hs
@@ -63,10 +63,12 @@
             difference,
             differenceWith,
             differenceWithKey,
+            differenceSet,
             -- ** Intersection
             intersection,
             intersectionWith,
             intersectionWithKey,
+            intersectSet,
             -- * Traversal
             -- ** Map
             map,
@@ -74,12 +76,13 @@
             -- * Folds
             foldr,
             foldrWithKey,
-            -- * Lists
+            -- * Lists and Sets
             toList,
             fromList,
             keys,
             elems,
             keysSet,
+            fromSet,
             -- * Split/Join Keys
             toK,
             toS,
@@ -134,16 +137,6 @@
           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'
-
     alter f !(K key') (KEC emm) = KEC $ go emm
         where
           go t = case t of
@@ -188,7 +181,7 @@
                 computeBm !acc (Bin _ _ l' r') = computeBm (computeBm acc l') r'
                 computeBm !acc (Tip kx _)      = acc .|. EMS.bitmapOf kx
                 computeBm !acc Nil             = acc
-
+    fromSet f (EMS.KSC emm) = KEC $ fromSet_ (f . K . toEnum) 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
@@ -197,7 +190,9 @@
                    Tip k1 $! f (K $ toEnum k1) x1 x2
 
     difference (KEC emm1) (KEC emm2) =
-        KEC $ mergeWithKey' bin (\_ _ -> Nil) id (const Nil) emm1 emm2
+        KEC $ go emm1 emm2
+            where go = mergeWithKey' bin (\_ _ -> Nil) id (const Nil)
+    {-# INLINE difference #-}
     differenceWithKey f (KEC emm1) (KEC emm2) =
         KEC $ mergeWithKey' bin combine id (const Nil) emm1 emm2
             where
@@ -231,6 +226,10 @@
           go (Tip _ v)     = rnf v
           go (Bin _ _ l r) = go l `seq` go r
 
+instance (NFData k) => NFData (K k)
+    where
+      rnf (K k) = rnf k
+
 instance HasSKey (K k) where
     type Skey (K k) = EMS.S k
     toS (K !k) = EMS.S k
@@ -249,15 +248,16 @@
 
 instance (Enum k1, k1 ~ k2) => SubKey (K k1) (k2 :& t2) v where
     type Result (K k1) (k2 :& t2) v = EnumMapMap t2 v
-    singleton !(K key) = KCC . Tip (fromEnum key)
+    member (K key) (KCC emm) = member_ (fromEnum key) emm
+    singleton (K key) = KCC . Tip (fromEnum key)
     lookup (K key') (KCC emm) = lookup_ (fromEnum key') emm
-    insert !(K key') val (KCC emm) = KCC $ insert_ (fromEnum key') val emm
+    insert (K key') val (KCC emm) = KCC $ insert_ (fromEnum key') val emm
     insertWithKey f !k@(K key') val (KCC emm) =
         KCC $ insertWK (f k) (fromEnum key') val emm
     delete !(K key') (KCC emm) = KCC $ delete_ (fromEnum key') emm
-
 instance (Enum k) => SubKey (K k) (K k) v where
     type Result (K k) (K k) v = v
+    member (K key) (KEC emm) = member_ (fromEnum key) emm
     singleton !(K key) !val = KEC $! Tip (fromEnum key) val
     lookup (K key') (KEC emm) = lookup_ (fromEnum key') emm
     insert !(K key') !val (KEC emm) = KEC $ insert_ (fromEnum key') val emm
@@ -265,28 +265,45 @@
         KEC $ insertWK (f k) (fromEnum key') val emm
     delete !(K key') (KEC emm) = KEC $ delete_ (fromEnum key') emm
 
+instance (Enum k1, k1 ~ k2) => SubKeyS (k1 :& t) (EMS.S k2) where
+    intersectSet (KCC emm) (EMS.KSC ems) = KCC $ intersectSet_ emm ems
+    differenceSet (KCC emm) (EMS.KSC ems) = KCC $ differenceSet_ emm ems
+
+instance (Enum k) => SubKeyS (K k) (EMS.S k) where
+    intersectSet (KEC emm) (EMS.KSC ems) = KEC $ intersectSet_ emm ems
+    differenceSet (KEC emm) (EMS.KSC ems) = KEC $ differenceSet_ emm ems
+
+member_ :: Key -> EMM k v -> Bool
+member_ key 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
+
 lookup_ :: Key -> EMM k v -> Maybe v
-lookup_ !key emm =
-    case emm of
-      Bin _ m l r
-          | zero key m -> lookup_ key l
-          | otherwise  -> lookup_ key r
-      Tip kx x         -> if kx == key then Just x else Nothing
-      Nil              -> Nothing
+lookup_ !key emm = go emm
+    where
+      go t = case t of
+               Bin _ m l r
+                   | zero key m -> go l
+                   | otherwise  -> go r
+               Tip kx x         -> if kx == key then Just x else Nothing
+               Nil              -> Nothing
 
 insert_ :: Key -> v -> EMM k v -> EMM k v
-insert_ !key val = go
-    where
-      go emm =
-          case emm of
-            Bin p m l r
-                | nomatch key p m -> join key (Tip key val) p emm
-                | 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 emm
-            Nil                   -> Tip key val
+insert_ !key !val emm =
+    case emm of
+      Bin p m l r
+          | nomatch key p m -> join key (Tip key val) p emm
+          | zero key m      -> Bin p m (insert_ key val l) r
+          | otherwise       -> Bin p m l (insert_ key val r)
+      Tip ky _
+          | key == ky       -> Tip key val
+          | otherwise       -> join key (Tip key val) ky emm
+      Nil                   -> Tip key val
 
 insertWK :: (v -> v -> v) -> Key -> v -> EMM k v -> EMM k v
 insertWK f !key val = go
@@ -303,11 +320,46 @@
             Nil                   -> Tip key val
 
 delete_ :: Key -> EMM k v -> EMM k v
-delete_ !key emm =
-    case emm of
-      Bin p m l r | nomatch key p m -> emm
-                  | zero key m      -> bin p m (delete_ key l) r
-                  | otherwise       -> bin p m l (delete_ key r)
-      Tip ky _    | key == ky       -> Nil
-                  | otherwise       -> emm
-      Nil                           -> Nil
+delete_ !key emm = 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
+
+fromSet_ :: (Key -> v) -> EMS.EMS k -> EMM k v
+fromSet_ f = go
+    where
+      go EMS.Nil           = Nil
+      go (EMS.Bin p m l r) = Bin p m (go l) (go r)
+      go (EMS.Tip key bm)  = buildTree f key bm (EMS.suffixBitMask + 1)
+      buildTree g !prefix !bmask bits =
+          case bits of
+            0 -> Tip prefix $! (f prefix)
+            _ -> case intFromNat ((natFromInt bits) `shiftRL` 1) of
+                   bits2 | bmask .&. ((1 `shiftLL` bits2) -1) == 0 ->
+                             buildTree g (prefix + bits2)
+                                           (bmask `shiftRL` bits2) bits2
+                         | (bmask `shiftRL` bits2) .&.
+                           ((1 `shiftLL` bits2) - 1) == 0 ->
+                               buildTree g prefix bmask bits2
+                         | otherwise ->
+                             Bin prefix bits2
+                                     (buildTree g prefix bmask bits2)
+                                     (buildTree g (prefix + bits2)
+                                      (bmask `shiftRL` bits2)
+                                      bits2)
+
+{-# INLINE fromSet_ #-}
+
+intersectSet_ :: EMM k v -> EMS.EMS k -> EMM k v
+intersectSet_ emm ems =
+    mergeWithKey' bin const (const Nil) (const Nil) emm ems'
+        where ems' = fromSet_ (\_ -> ()) ems
+
+differenceSet_ :: EMM k v -> EMS.EMS k -> EMM k v
+differenceSet_ emm ems =
+    mergeWithKey' bin (\_ _ -> Nil) id (const Nil) emm ems'
+        where ems' = fromSet_ (\_ -> ()) ems
diff --git a/Data/EnumMapSet/Base.hs b/Data/EnumMapSet/Base.hs
--- a/Data/EnumMapSet/Base.hs
+++ b/Data/EnumMapSet/Base.hs
@@ -127,16 +127,6 @@
           go (Tip _ bm)    = bitcount 0 bm
           go Nil           = 0
 
-    member !(S key') (KSC ems) = key `seq` go ems
-        where
-          go (Bin p m l r)
-              | nomatch key p m = False
-              | zero key m      = go l
-              | otherwise       = go r
-          go (Tip y bm) = prefixOf key == y && bitmapOf key .&. bm /= 0
-          go Nil = False
-          key = fromEnum key'
-
     foldrWithKey f init (KSC ems)
         = case ems of Bin _ m l r | m < 0 -> go (go init l) r
                                   | otherwise -> go (go init r) l
@@ -271,6 +261,7 @@
     toList = undefined
     elems = undefined
     keysSet = undefined
+    fromSet = undefined
 
 {---------------------------------------------------------------------
   Exported API
@@ -286,7 +277,8 @@
 size :: (IsKey k) => EnumMapSet k -> Int
 size = EMM.size
 
-member ::(IsKey k) => k -> EnumMapSet k -> Bool
+member ::(EMM.SubKey k1 k2 (), IsKey k1, IsKey k2) =>
+         k1 -> EnumMapSet k2 -> Bool
 member = EMM.member
 
 -- | Lookup a subtree in an 'EnumMapSet'.
@@ -368,6 +360,16 @@
 instance (Enum k1, k1 ~ k2) => EMM.SubKey (S k1) (k2 :& t2) () where
     type Result (S k1) (k2 :& t2) () = EnumMapSet t2
 
+    member !(S key') (EMM.KCC emm) = key `seq` go emm
+        where
+          go t = case t of
+               EMM.Bin _ m l r -> case zero key m of
+                                    True  -> go l
+                                    False -> go r
+               EMM.Tip kx _    -> key == kx
+               EMM.Nil         -> False
+          key = fromEnum key'
+
     singleton !(S key) = EMM.KCC . EMM.Tip (fromEnum key)
 
     lookup (S key') (EMM.KCC emm) = key `seq` go emm
@@ -412,6 +414,15 @@
 
 instance (Enum k) => EMM.SubKey (S k) (S k) () where
     type Result (S k) (S k) () = ()
+    member !(S key') (KSC ems) = key `seq` go ems
+        where
+          go (Bin p m l r)
+              | nomatch key p m = False
+              | zero key m      = go l
+              | otherwise       = go r
+          go (Tip y bm) = prefixOf key == y && bitmapOf key .&. bm /= 0
+          go Nil = False
+          key = fromEnum key'
     singleton !(S key') _ = KSC $! Tip (prefixOf key) (bitmapOf key)
           where key = fromEnum key'
     lookup = undefined
diff --git a/bench/IntMapVsEnumMapMap.hs b/bench/IntMapVsEnumMapMap.hs
new file mode 100644
--- /dev/null
+++ b/bench/IntMapVsEnumMapMap.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, TypeOperators #-}
+
+--  | This compares the speed of 'Data.IntMap' functions with the speed of
+--  'Data.EnumMapMap.Strict' functions.
+
+import           Control.DeepSeq
+import           Control.Exception (evaluate)
+import           Control.Monad.Trans (liftIO)
+import           Criterion.Config
+import           Criterion.Main
+import           Data.List (foldl')
+import           Data.Maybe (fromMaybe)
+
+import           Data.IntMap (IntMap)
+import qualified Data.IntMap as IM
+import           Data.EnumMapMap.Strict(EnumMapMap, (:&)(..), K(..))
+import qualified Data.EnumMapMap.Strict as EMM
+
+newtype ID = ID Int
+    deriving (Eq, Enum, Show, Num)
+
+main :: IO()
+main = do
+    let im :: IntMap Int
+        im = IM.fromAscList elemsIm
+        imAr :: [IntMap Int]
+        imAr = map IM.fromAscList elemsArIm
+        emm :: EnumMapMap (K ID) Int
+        emm = EMM.fromList elemsEmm
+        emmAr :: [EnumMapMap (K ID) Int]
+        emmAr = map EMM.fromList elemsArEmm
+    defaultMainWith
+        defaultConfig
+        (liftIO . evaluate $ rnf $ im :& emm :& imAr :& emmAr)
+        [ bench "lookup IM" $ whnf (lookupIm keysIm) im
+        , bench "lookup EMM" $ whnf (lookupEmm keysEmm) emm
+        , bench "insert IM" $ whnf (insIm elemsIm) IM.empty
+        , bench "insert EMM" $ whnf (insEmm elemsEmm) EMM.empty
+        , bench "delete IM" $ whnf (delIm keysIm) im
+        , bench "delete EMM" $ whnf (delEmm keysEmm) emm
+        , bench "union IM" $ nf (dual IM.union im) imAr
+        , bench "union EMM" $ nf (dual EMM.union emm) emmAr
+        , bench "difference IM" $ nf (dual IM.difference im) imAr
+        , bench "difference EMM" $ nf (dual EMM.difference emm) emmAr
+        , bench "intersection IM" $ nf (dual IM.intersection im) imAr
+        , bench "intersection EMM" $ nf (dual EMM.intersection emm) emmAr
+        ]
+    where
+      elemsIm = zip keysIm values
+      elemsEmm = zip keysEmm values
+      elemsArIm = map (\ks -> zip ks values) keysArIm
+      elemsArEmm = map (\ks -> zip ks values) keysArEmm
+      keysIm :: [Int]
+      keysIm = [1..2^12]
+      keysArIm :: [[Int]]
+      keysArIm = do
+         i <- [1..2^5]
+         return $ do
+                   j <- [1..(2^8)]
+                   return $ j * i
+      keysEmm :: [K ID]
+      keysEmm = map (K . ID) keysIm
+      keysArEmm :: [[K ID]]
+      keysArEmm = map (map (K . ID)) keysArIm
+      values :: [Int]
+      values = [1..2^12]
+
+lookupIm :: [Int] -> IntMap Int -> Int
+lookupIm xs im = foldl' (\n k -> fromMaybe n (IM.lookup k im)) 0 xs
+
+lookupEmm :: [K ID] -> EnumMapMap (K ID) Int -> Int
+lookupEmm xs emm = foldl' (\n k -> fromMaybe n (EMM.lookup k emm)) 0 xs
+
+insIm :: [(Int, Int)] -> IntMap Int -> IntMap Int
+insIm xs m = foldl' (\m (k, v) -> v `seq` IM.insert k v m) m xs
+
+insEmm :: [(K ID, Int)] -> EnumMapMap (K ID) Int -> EnumMapMap (K ID) Int
+insEmm xs m = foldl' (\m (k, v) -> EMM.insert k v m) m xs
+
+delIm :: [Int] -> IntMap Int -> IntMap Int
+delIm xs m = foldl' (\m k -> IM.delete k m) m xs
+
+delEmm :: [K ID] -> EnumMapMap (K ID) Int -> EnumMapMap (K ID) Int
+delEmm xs m = foldl' (\m k -> EMM.delete k m) m xs
+
+dual :: (a -> a -> a) -> a -> [a] -> [a]
+dual f i = map $! f i
diff --git a/enummapmap.cabal b/enummapmap.cabal
--- a/enummapmap.cabal
+++ b/enummapmap.cabal
@@ -1,5 +1,5 @@
 name:               enummapmap
-version:            0.2.0
+version:            0.4.0
 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
@@ -99,3 +99,16 @@
                       containers >= 0.4.2,
                       enummapmap
     cpp-options:      -DTESTING
+
+benchmark enummapmap-vs-intmap-bench
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   bench
+    main-is:          IntMapVsEnumMapMap.hs
+    build-depends:    base >= 4.0 && < 5,
+                      criterion,
+                      deepseq >= 1.2 && < 1.4,
+                      containers >= 0.4.2,
+                      mtl,
+                      enummapmap
+    default-language: Haskell2010
+    ghc-options:      -O2
diff --git a/test/EnumMapMapVsIntMap.hs b/test/EnumMapMapVsIntMap.hs
--- a/test/EnumMapMapVsIntMap.hs
+++ b/test/EnumMapMapVsIntMap.hs
@@ -10,6 +10,9 @@
 import           Test.Hspec.QuickCheck (prop)
 import           Test.QuickCheck ()
 
+import qualified Data.IntSet as IS
+import           Data.EnumMapSet (S(..))
+import qualified Data.EnumMapSet as EMS
 #ifdef LAZY
 import qualified Data.IntMap as IM
 
@@ -26,6 +29,10 @@
 type TestMap2 = EnumMapMap (Int :& K Int)               Int
 type TestMap3 = EnumMapMap (Int :& Int :& K Int)        Int
 type TestMap4 = EnumMapMap (Int :& Int :& Int :& K Int) Int
+-- type TestSet  = EnumMapSet (S Int)
+-- type TestSet2 = EnumMapSet (Int :& S Int)
+-- type TestSet3 = EnumMapSet (Int :& Int :& S Int)
+-- type TestSet4 = EnumMapSet (Int :& Int :& Int :& S Int)
 
 list2l1 :: [(Int, Int)] -> [(K Int, Int)]
 list2l1 = map (\(a, b) -> (K a, b))
@@ -39,6 +46,18 @@
 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))
 
+set2l1 :: [Int] -> [S Int]
+set2l1 = map S
+
+set2l2 :: Int -> [Int] -> [Int :& S Int]
+set2l2 s1 = map (\s -> s :& S s1)
+
+set2l3 :: Int -> Int -> [Int] -> [Int :& Int :& S Int]
+set2l3 s1 s2 = map (\s -> s :& s1 :& S s2)
+
+set2l4 :: Int -> Int -> Int -> [Int] -> [Int :& Int :& Int :& S Int]
+set2l4 s1 s2 s3 = map (\s -> s :& s1 :& s2 :& S s3)
+
 -- | Run functions on an 'IntMap' and an 'EnumMapMap' created from list and check
 -- that the results are equal
 runProp :: Eq t =>
@@ -206,6 +225,16 @@
     runPropDuo4 (\a b -> list2l4 k1 k2 k3 $ IM.toList $ f a b)
                     (\a b -> EMM.toList $ g a b) k1 k2 k3
 
+-- 'fromSet' is not in containers 4.*
+-- runSetProp :: Eq t =>
+--               (IS.IntSet -> IM.IntMap Int)
+--            -> (TestSet -> TestMap)
+--            -> [Int]
+--            -> Bool
+-- runSetProp f g list =
+--     (set2l1 $ IM.toList $ f $ IS.fromList list)
+--     == (EMM.toList $ g $ EMS.fromList $ set2l1 list)
+
 main :: IO ()
 main = hspec $ do
     describe "toList fromList" $ do
@@ -437,3 +466,17 @@
              runProp3 (IM.elems) (EMM.elems)
         prop "Level 4" $
              runProp4 (IM.elems) (EMM.elems)
+
+    describe "keysSet" $ do
+        prop "Level 1" $
+             runProp (set2l1 . IS.toList . IM.keysSet)
+                         (EMS.toList . EMM.keysSet)
+        prop "Level 2" $ \ s1 ->
+             runProp2 (set2l2 s1 . IS.toList . IM.keysSet)
+                         (EMS.toList . EMM.keysSet) s1
+        prop "Level 3" $ \ s1 s2 ->
+             runProp3 (set2l3 s1 s2 . IS.toList . IM.keysSet)
+                         (EMS.toList . EMM.keysSet) s1 s2
+        prop "Level 4" $ \ s1 s2 s3 ->
+             runProp4 (set2l4 s1 s2 s3 . IS.toList . IM.keysSet)
+                         (EMS.toList . EMM.keysSet) s1 s2 s3
diff --git a/test/UnitEnumMapMap.hs b/test/UnitEnumMapMap.hs
--- a/test/UnitEnumMapMap.hs
+++ b/test/UnitEnumMapMap.hs
@@ -46,6 +46,9 @@
 k :: Int -> K Int
 k = K
 
+s :: Int -> EMS.S Int
+s = EMS.S
+
 tens :: [Int]
 tens = [1, 10, 100, 1000, 10000, 100000, 1000000]
 
@@ -71,6 +74,8 @@
 
 l1odds :: EnumMapMap (K Int) Int
 l1odds = EMM.fromList $ map (\(key, v) -> (K key, v)) $ zip odds odds
+l1fewOdds :: EnumMapMap (K Int) Int
+l1fewOdds = EMM.fromList $ map (\(key, v) -> (K key, v)) $ zip fewOdds fewOdds
 l2odds :: EnumMapMap (Int :& K Int) Int
 l2odds = EMM.fromList $ zip (do
                               k1 <- fewOdds
@@ -313,4 +318,19 @@
                     emm = EMM.fromList list
           prop "Level 1" gol1
 
+      describe "intersectSet" $ do
+        it "leaves correct values" $
+           (EMM.intersectSet l1odds $ EMS.fromList [s 1, s 2, s 3])
+           @?= EMM.fromList [(k 1, 1), (k 3, 3)]
+        it "leaves correct subtree" $
+           (EMM.intersectSet l2odds $ EMS.fromList [s 1])
+           @?= EMM.fromList [(1 :& k 1, 1), (1 :& k 3, 3), (1 :& k 5, 5)]
+        -- TODO: check for empty subtrees
 
+      describe "differenceSet" $ do
+        it "works correctly" $
+           (EMM.differenceSet l1fewOdds $ EMS.fromList [s 3, s 4, s 5])
+           @?= EMM.fromList [(k 1, 1)]
+        it "leaves correct subtree" $
+           (EMM.differenceSet l2odds $ EMS.fromList [s 3, s 4, s 5])
+           @?= EMM.fromList [(1 :& k 1, 1), (1 :& k 3, 3), (1 :& k 5, 5)]