diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,12 @@
+= Version 1.0.0.3, 2010-08-07 =
+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+* Improving the performance of HashSet and HashMap
+by using (Some a) datatype. This speeds up the
+case where only one value is stored for a given
+hash. The performance gain is ~10% for delete,
+~15% for insert, 20-50% for union.
+
+
 = Version 1.0.0.2, 2010-06-01 =
 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 * Improving performance of ByteString hash
diff --git a/Data/HashMap.hs b/Data/HashMap.hs
--- a/Data/HashMap.hs
+++ b/Data/HashMap.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, PatternGuards #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -119,7 +119,6 @@
 import Data.Hashable
 import Data.Foldable (Foldable(foldMap))
 import Data.List (foldl')
-import Data.Maybe (fromMaybe)
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 import Data.Typeable
@@ -154,9 +153,11 @@
   Types
 --------------------------------------------------------------------}
 
+data Some k v = Only !k v | More !(M.Map k v) deriving (Eq, Ord)
+
 -- | The abstract type of a @HashMap@. Its interface is a suitable
 -- subset of 'Data.IntMap.IntMap'.
-newtype HashMap k v = HashMap (I.IntMap (M.Map k v)) deriving (Eq, Ord)
+newtype HashMap k v = HashMap (I.IntMap (Some k v)) deriving (Eq, Ord)
 
 instance Functor (HashMap k) where
   fmap = map
@@ -167,10 +168,14 @@
   mconcat = unions
 
 instance Foldable (HashMap k) where
-  foldMap f (HashMap m) = foldMap (foldMap f) m
+  foldMap f (HashMap m) = foldMap some_fold m
+    where some_fold (Only _ x) = f x
+          some_fold (More s)   = foldMap f s
 
 instance Traversable (HashMap k) where
-  traverse f (HashMap m) = pure HashMap <*> traverse (traverse f) m
+  traverse f (HashMap m) = pure HashMap <*> traverse some_traverse m
+    where some_traverse (Only k x) = pure (Only k) <*> f x
+          some_traverse (More s) = pure More <*> traverse f s
 
 instance (Show k, Show a) => Show (HashMap k a) where
   showsPrec d m   = showParen (d > 10) $
@@ -212,7 +217,19 @@
   dataCast1 f  = gcast1 f
 #endif
 
+{--------------------------------------------------------------------
+  Comparing elements
+--------------------------------------------------------------------}
 
+-- For ByteStrings, doing compare is usually faster than doing (==),
+-- according to benchmarks. A Set is using compare naturally. We therefore
+-- define eq :: Ord a => a -> a -> Bool, which serves as (==).
+
+{-# INLINE eq #-}
+eq :: Ord a => a -> a -> Bool
+eq x y = x `compare` y == EQ
+
+
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}
@@ -222,7 +239,9 @@
 
 -- | Number of elements in the map.
 size :: HashMap k a -> Int
-size (HashMap m) = I.fold ((+) . M.size) 0 m
+size (HashMap m) = I.fold ((+) . some_size) 0 m
+  where some_size (Only _ _) = 1
+        some_size (More s) = M.size s
 
 -- | Is the key a member of the map?
 member :: (Hashable k, Ord k) => k -> HashMap k a -> Bool
@@ -234,9 +253,14 @@
 notMember :: (Hashable k, Ord k) => k -> HashMap k a -> Bool
 notMember k m = not $ member k m
 
+some_lookup :: Ord k => k -> Some k a -> Maybe a
+some_lookup k (Only k' x) | k `eq` k' = Just x
+                          | otherwise = Nothing
+some_lookup k (More s) = M.lookup k s
+
 -- | Lookup the value at a key in the map.
 lookup :: (Hashable k, Ord k) => k -> HashMap k a -> Maybe a
-lookup k (HashMap m) = I.lookup (hash k) m >>= M.lookup k
+lookup k (HashMap m) = I.lookup (hash k) m >>= some_lookup k
 
 -- | The expression @('findWithDefault' def k map)@ returns the value at key
 -- @k@ or returns @def@ when the key is not an element of the map.
@@ -256,7 +280,7 @@
 -- | A map of one element.
 singleton :: Hashable k => k -> a -> HashMap k a
 singleton k x = HashMap $
-  I.singleton (hash k) $ M.singleton k x
+  I.singleton (hash k) $ (Only k x)
 
 
 {--------------------------------------------------------------------
@@ -268,7 +292,10 @@
 insert :: (Hashable k, Ord k)
        => k -> a -> HashMap k a -> HashMap k a
 insert k x (HashMap m) = HashMap $
-  I.insertWith (\_ -> M.insert k x) (hash k) (M.singleton k x) m
+  I.insertWith some_insert (hash k) (Only k x) m
+  where some_insert _ (Only k' x') | k `eq` k' = Only k x
+                                   | otherwise = More $ M.insert k x (M.singleton k' x')
+        some_insert _ (More s) = More $ M.insert k x s
 
 -- | Insert with a combining function.  @'insertWith' f key value mp@ will
 -- insert the pair (key, value) into @mp@ if key does not exist in the map. If
@@ -276,7 +303,10 @@
 insertWith :: (Hashable k, Ord k)
            => (a -> a -> a) -> k -> a -> HashMap k a -> HashMap k a
 insertWith f k x (HashMap m) = HashMap $
-  I.insertWith (\_ -> M.insertWith f k x) (hash k) (M.singleton k x) m
+  I.insertWith some_insert_with (hash k) (Only k x) m
+  where some_insert_with _ (Only k' x') | k `eq` k' = Only k (f x x')
+                                        | otherwise = More $ M.insert k x (M.singleton k' x')
+        some_insert_with _ (More s) = More $ M.insertWith f k x s
 
 -- | Insert with a combining function.  @'insertWithKey' f key value mp@ will
 -- insert the pair (key, value) into @mp@ if key does not exist in the map. If
@@ -284,7 +314,10 @@
 insertWithKey :: (Hashable k, Ord k)
               => (k -> a -> a -> a) -> k -> a -> HashMap k a -> HashMap k a
 insertWithKey f k x (HashMap m) = HashMap $
-  I.insertWith (\_ -> M.insertWithKey f k x) (hash k) (M.singleton k x) m
+  I.insertWith some_insert_with_key (hash k) (Only k x) m
+  where some_insert_with_key _ (Only k' x') | k `eq` k' = Only k (f k x x')
+                                            | otherwise = More $ M.insert k x (M.singleton k' x')
+        some_insert_with_key _ (More s) = More $ M.insertWithKey f k x s
 
 -- | The expression (@'insertLookupWithKey' f k x map@) is a pair where the
 -- first element is equal to (@'lookup' k map@) and the second element equal to
@@ -292,38 +325,55 @@
 insertLookupWithKey :: (Hashable k, Ord k)
                     => (k -> a -> a -> a) -> k -> a -> HashMap k a -> (Maybe a, HashMap k a)
 insertLookupWithKey f k x (HashMap m) =
-  case I.insertLookupWithKey (\_ _ -> M.insertWithKey f k x) (hash k) (M.singleton k x) m of
-    (found, m') -> (found >>= M.lookup k, HashMap m')
+  case I.insertLookupWithKey some_insert_with_key (hash k) (Only k x) m of
+    (found, m') -> (found >>= some_lookup k, HashMap m')
+  where some_insert_with_key _ _ (Only k' x') | k `eq` k' = Only k (f k x x')
+                                              | otherwise = More $ M.insert k x (M.singleton k' x')
+        some_insert_with_key _ _ (More s) = More $ M.insertWithKey f k x s
 
 
 {--------------------------------------------------------------------
   Deletion
 --------------------------------------------------------------------}
 
-nonempty :: M.Map k a -> Maybe (M.Map k a)
-nonempty m | M.null m  = Nothing
-           | otherwise = Just m
+some_norm :: M.Map k v -> Maybe (Some k v)
+some_norm s = case M.size s of 0 -> Nothing
+                               1 -> case M.findMin s of (k, x) -> Just $ Only k x
+                               _ -> Just $ More $ s
 
+some_norm' :: M.Map k v -> Some k v
+some_norm' s = case M.size s of 1 -> case M.findMin s of (k, x) -> Only k x
+                                _ -> More $ s
+
 -- | Delete a key and its value from the map. When the key is not
 -- a member of the map, the original map is returned.
 delete :: (Hashable k, Ord k)
        => k -> HashMap k a -> HashMap k a
 delete k (HashMap m) = HashMap $
-  I.update (nonempty . M.delete k) (hash k) m
+  I.update some_delete (hash k) m
+  where some_delete v@(Only k' _) | k `eq` k'  = Nothing
+                                  | otherwise  = Just v
+        some_delete (More t) = some_norm $ M.delete k t
 
 -- | Adjust a value at a specific key. When the key is not a member of the map,
 -- the original map is returned.
 adjust :: (Hashable k, Ord k)
        => (a -> a) -> k -> HashMap k a -> HashMap k a
 adjust f k (HashMap m) = HashMap $
-  I.adjust (M.adjust f k) (hash k) m
+  I.adjust some_adjust (hash k) m
+  where some_adjust v@(Only k' x) | k `eq` k'  = Only k (f x)
+                                  | otherwise  = v
+        some_adjust (More t) = More $ M.adjust f k t
 
 -- | Adjust a value at a specific key. When the key is not a member of the map,
 -- the original map is returned.
 adjustWithKey :: (Hashable k, Ord k)
               => (k -> a -> a) -> k -> HashMap k a -> HashMap k a
 adjustWithKey f k (HashMap m) = HashMap $
-  I.adjust (M.adjustWithKey f k) (hash k) m
+  I.adjust some_adjust_with_key (hash k) m
+  where some_adjust_with_key v@(Only k' x) | k `eq` k'  = Only k (f k x)
+                                           | otherwise  = v
+        some_adjust_with_key (More t) = More $ M.adjustWithKey f k t
 
 -- | The expression (@'update' f k map@) updates the value @x@ at @k@ (if it is
 -- in the map). If (@f x@) is 'Nothing', the element is deleted. If it is
@@ -331,7 +381,10 @@
 update :: (Hashable k, Ord k)
        => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a
 update f k (HashMap m) = HashMap $
-  I.update (nonempty . M.update f k) (hash k) m
+  I.update some_update (hash k) m
+  where some_update v@(Only k' x) | k `eq` k' = f x >>= return . Only k'
+                                  | otherwise = Just v
+        some_update (More t) = some_norm $ M.update f k t
 
 -- | The expression (@'update' f k map@) updates the value @x@ at @k@ (if it is
 -- in the map). If (@f k x@) is 'Nothing', the element is deleted. If it is
@@ -339,7 +392,10 @@
 updateWithKey :: (Hashable k, Ord k)
               => (k -> a -> Maybe a) -> k -> HashMap k a -> HashMap k a
 updateWithKey f k (HashMap m) = HashMap $
-  I.update (nonempty . M.updateWithKey f k) (hash k) m
+  I.update some_update_with_key (hash k) m
+  where some_update_with_key v@(Only k' x) | k `eq` k' = f k x >>= return . Only k'
+                                           | otherwise = Just v
+        some_update_with_key (More t) = some_norm $ M.updateWithKey f k t
 
 -- | Lookup and update.  The function returns original value, if it is updated.
 -- This is different behavior than 'Data.Map.updateLookupWithKey'.  Returns the
@@ -347,8 +403,11 @@
 updateLookupWithKey :: (Hashable k, Ord k)
                     => (k -> a -> Maybe a) -> k -> HashMap k a -> (Maybe a, HashMap k a)
 updateLookupWithKey f k (HashMap m) =
-  case I.updateLookupWithKey (\_ -> nonempty . M.updateWithKey f k) (hash k) m of
-    (found, m') -> (found >>= M.lookup k, HashMap m')
+  case I.updateLookupWithKey some_update_with_key (hash k) m of
+    (found, m') -> (found >>= some_lookup k, HashMap m')
+  where some_update_with_key _ v@(Only k' x) | k `eq` k' = f k x >>= return . Only k'
+                                             | otherwise = Just v
+        some_update_with_key _ (More t) = some_norm $ M.updateWithKey f k t
 
 -- | The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence
 -- thereof.  'alter' can be used to insert, delete, or update a value in an
@@ -356,7 +415,11 @@
 alter :: (Hashable k, Ord k)
       => (Maybe a -> Maybe a) -> k -> HashMap k a -> HashMap k a
 alter f k (HashMap m) = HashMap $
-  I.alter (nonempty . M.alter f k . fromMaybe M.empty) (hash k) m
+  I.alter some_alter (hash k) m
+  where some_alter Nothing = f Nothing >>= return . Only k
+        some_alter (Just v@(Only k' x)) | k `eq` k' = f (Just x) >>= return . Only k'
+                                        | otherwise = Just v
+        some_alter (Just (More t)) = some_norm $ M.alter f k t
 
 
 {--------------------------------------------------------------------
@@ -375,18 +438,29 @@
 -- i.e. (@'union' == 'unionWith' 'const'@).
 union :: Ord k => HashMap k a -> HashMap k a -> HashMap k a
 union (HashMap m1) (HashMap m2) = HashMap $
-  I.unionWith M.union m1 m2
+  I.unionWith some_union m1 m2
+  where some_union v@(Only k x) (Only l y) | k `eq` l  = v
+                                           | otherwise = More (M.singleton k x `M.union` M.singleton l y)
+        some_union (Only k x) (More t) = More $ M.singleton k x `M.union` t
+        some_union (More t) (Only k x) = More $ t `M.union` M.singleton k x
+        some_union (More t) (More u) = More $ t `M.union` u
 
+some_union_with_key :: Ord k => (k -> a -> a -> a) -> Some k a -> Some k a -> Some k a
+some_union_with_key f (Only k x) (Only l y) | k `eq` l  = Only k (f k x y)
+                                            | otherwise = More (M.unionWithKey f (M.singleton k x) (M.singleton l y))
+some_union_with_key f (Only k x) (More t) = More $ M.unionWithKey f (M.singleton k x) t
+some_union_with_key f (More t) (Only k x) = More $ M.unionWithKey f t (M.singleton k x)
+some_union_with_key f (More t) (More u) = More $ M.unionWithKey f t u
+
 -- | The union with a combining function.
 unionWith :: Ord k => (a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a
 unionWith f (HashMap m1) (HashMap m2) = HashMap $
-  I.unionWith (M.unionWith f) m1 m2
+  I.unionWith (some_union_with_key $ const f) m1 m2
 
 -- | The union with a combining function.
 unionWithKey :: Ord k => (k -> a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a
 unionWithKey f (HashMap m1) (HashMap m2) = HashMap $
-  I.unionWith (M.unionWithKey f) m1 m2
-
+  I.unionWith (some_union_with_key f) m1 m2
 
 {--------------------------------------------------------------------
   Difference
@@ -394,42 +468,70 @@
 -- | Difference between two maps (based on keys).
 difference :: Ord k => HashMap k a -> HashMap k b -> HashMap k a
 difference (HashMap m1) (HashMap m2) = HashMap $
-  I.differenceWith (\n1 n2 -> nonempty $ M.difference n1 n2) m1 m2
+  I.differenceWith some_diff m1 m2
+  where some_diff v@(Only k _) (Only l _) | k `eq` l  = Nothing
+                                          | otherwise = Just v
+        some_diff v@(Only k _) (More t) | k `M.member` t = Nothing
+                                        | otherwise      = Just v
+        some_diff (More t) (Only k _) = some_norm $ M.delete k t
+        some_diff (More t) (More u) = some_norm $ t `M.difference` u
 
+some_diff_with_key :: Ord k => (k -> a -> b -> Maybe a) -> Some k a -> Some k b -> Maybe (Some k a)
+some_diff_with_key f v@(Only k x) (Only l y) | k `eq` l  = f k x y >>= return . Only k
+                                             | otherwise = Just v
+some_diff_with_key f (Only k x) (More t) = some_norm $ M.differenceWithKey f (M.singleton k x) t
+some_diff_with_key f (More t) (Only k x) = some_norm $ M.differenceWithKey f t (M.singleton k x)
+some_diff_with_key f (More t) (More u) = some_norm $ M.differenceWithKey f t u
+
 -- | Difference with a combining function.
 differenceWith :: Ord k => (a -> b -> Maybe a) -> HashMap k a -> HashMap k b -> HashMap k a
 differenceWith f (HashMap m1) (HashMap m2) = HashMap $
-  I.differenceWith (\n1 n2 -> nonempty $ M.differenceWith f n1 n2) m1 m2
+  I.differenceWith (some_diff_with_key $ const f) m1 m2
 
 -- | Difference with a combining function. When two equal keys are
 -- encountered, the combining function is applied to the key and both values.
 -- If it returns 'Nothing', the element is discarded (proper set difference).
--- If it returns (@'Just' y@), the element is updated with a new value @y@. 
+-- If it returns (@'Just' y@), the element is updated with a new value @y@.
 differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> HashMap k a -> HashMap k b -> HashMap k a
 differenceWithKey f (HashMap m1) (HashMap m2) = HashMap $
-  I.differenceWith (\n1 n2 -> nonempty $ M.differenceWithKey f n1 n2) m1 m2
+  I.differenceWith (some_diff_with_key f) m1 m2
 
 
 {--------------------------------------------------------------------
   Intersection
 --------------------------------------------------------------------}
-delete_empty :: I.IntMap (M.Map k a) -> I.IntMap (M.Map k a)
-delete_empty = I.filter (not . M.null)
+delete_empty :: I.IntMap (Some k a) -> I.IntMap (Some k a)
+delete_empty = I.filter some_empty
+  where some_empty (Only _ _) = True
+        some_empty (More t) = not $ M.null t
 
 -- | The (left-biased) intersection of two maps (based on keys).
 intersection :: Ord k => HashMap k a -> HashMap k b -> HashMap k a
 intersection (HashMap m1) (HashMap m2) = HashMap $ delete_empty $
-  I.intersectionWith M.intersection m1 m2
+  I.intersectionWith some_intersection m1 m2
+  where some_intersection v@(Only k _) (Only l _) | k `eq` l  = v
+                                                  | otherwise = More (M.empty)
+        some_intersection v@(Only k _) (More t) | k `M.member` t = v
+                                                | otherwise      = More (M.empty)
+        some_intersection (More t) (Only k x) = some_norm' $ M.intersection t (M.singleton k x)
+        some_intersection (More t) (More u) = some_norm' $ M.intersection t u
 
+some_intersection_with_key :: Ord k => (k -> a -> b -> c) -> Some k a -> Some k b -> Some k c
+some_intersection_with_key f (Only k x) (Only l y) | k `eq` l  = Only k (f k x y)
+                                                   | otherwise = More (M.empty)
+some_intersection_with_key f (Only k x) (More t) = some_norm' $ M.intersectionWithKey f (M.singleton k x) t
+some_intersection_with_key f (More t) (Only k x) = some_norm' $ M.intersectionWithKey f t (M.singleton k x)
+some_intersection_with_key f (More t) (More u) = some_norm' $ M.intersectionWithKey f t u
+
 -- | The intersection with a combining function.
 intersectionWith :: Ord k => (a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
 intersectionWith f (HashMap m1) (HashMap m2) = HashMap $ delete_empty $
-  I.intersectionWith (M.intersectionWith f) m1 m2
+  I.intersectionWith (some_intersection_with_key $ const f) m1 m2
 
 -- | The intersection with a combining function.
 intersectionWithKey :: Ord k => (k -> a -> b -> c) -> HashMap k a -> HashMap k b -> HashMap k c
 intersectionWithKey f (HashMap m1) (HashMap m2) = HashMap $ delete_empty $
-  I.intersectionWith (M.intersectionWithKey f) m1 m2
+  I.intersectionWith (some_intersection_with_key f) m1 m2
 
 
 {--------------------------------------------------------------------
@@ -449,14 +551,23 @@
 -- | Is this a submap?
 isSubmapOf :: (Ord k, Eq a) => HashMap k a -> HashMap k a -> Bool
 isSubmapOf (HashMap m1) (HashMap m2) =
-  I.isSubmapOfBy (M.isSubmapOf) m1 m2
+  I.isSubmapOfBy some_isSubmapOf m1 m2
+  where some_isSubmapOf (Only k _) (Only l _) = k `eq` l
+        some_isSubmapOf (Only k _) (More t)   = k `M.member` t
+        some_isSubmapOf (More _) (Only _ _)   = False
+        some_isSubmapOf (More t) (More u)     = t `M.isSubmapOf` u
 
 -- | The expression (@'isSubmapOfBy' f m1 m2@) returns 'True' if all keys in
 -- @m1@ are in @m2@, and when @f@ returns 'True' when applied to their
 -- respective values.
 isSubmapOfBy :: Ord k => (a -> b -> Bool) -> HashMap k a -> HashMap k b -> Bool
 isSubmapOfBy f (HashMap m1) (HashMap m2) =
-  I.isSubmapOfBy (M.isSubmapOfBy f) m1 m2
+  I.isSubmapOfBy some_isSubmapOfBy m1 m2
+  where some_isSubmapOfBy (Only k x) (Only l y) = k `eq` l && x `f` y
+        some_isSubmapOfBy (Only k x) (More t) | Just y <- M.lookup k t = f x y
+                                              | otherwise              = False
+        some_isSubmapOfBy (More _) (Only _ _) = False
+        some_isSubmapOfBy (More t) (More u)   = M.isSubmapOfBy f t u
 
 
 {--------------------------------------------------------------------
@@ -465,26 +576,34 @@
 -- | Map a function over all values in the map.
 map :: (a -> b) -> HashMap k a -> HashMap k b
 map f (HashMap m) = HashMap $
-  I.map (M.map f) m
+  I.map some_map m
+  where some_map (Only k x) = Only k $ f x
+        some_map (More t)   = More $ M.map f t
 
 -- | Map a function over all values in the map.
 mapWithKey :: (k -> a -> b) -> HashMap k a -> HashMap k b
 mapWithKey f (HashMap m) = HashMap $
-  I.map (M.mapWithKey f) m
+  I.map some_map_with_key m
+  where some_map_with_key (Only k x) = Only k $ f k x
+        some_map_with_key (More t)   = More $ M.mapWithKey f t
 
 -- | The function @'mapAccum'@ threads an accumulating argument through the map
 -- in unspecified order of keys.
 mapAccum :: (a -> b -> (a,c)) -> a -> HashMap k b -> (a,HashMap k c)
 mapAccum f a (HashMap m) =
-  case I.mapAccum (M.mapAccum f) a m of
+  case I.mapAccum some_map_accum a m of
     (acc, m') -> (acc, HashMap m')
+  where some_map_accum acc (Only k x) = case f acc x of (acc', x') -> (acc', Only k x')
+        some_map_accum acc (More t)   = case M.mapAccum f acc t of (acc', t') -> (acc', More t')
 
 -- | The function @'mapAccumWithKey'@ threads an accumulating argument through
 -- the map in unspecified order of keys.
 mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> HashMap k b -> (a,HashMap k c)
 mapAccumWithKey f a (HashMap m) =
-  case I.mapAccum (M.mapAccumWithKey f) a m of
+  case I.mapAccum some_map_accum_with_key a m of
     (acc, m') -> (acc, HashMap m')
+  where some_map_accum_with_key acc (Only k x) = case f acc k x of (acc', x') -> (acc', Only k x')
+        some_map_accum_with_key acc (More t)   = case M.mapAccumWithKey f acc t of (acc', t') -> (acc', More t')
 
 
 {--------------------------------------------------------------------
@@ -493,12 +612,18 @@
 -- | Filter all values that satisfy some predicate.
 filter :: Ord k => (a -> Bool) -> HashMap k a -> HashMap k a
 filter p (HashMap m) = HashMap $
-  I.mapMaybe (nonempty . M.filter p) m
+  I.mapMaybe some_filter m
+  where some_filter v@(Only _ x) | p x       = Just v
+                                 | otherwise = Nothing
+        some_filter (More t) = some_norm $ M.filter p t
 
 -- | Filter all keys\/values that satisfy some predicate.
 filterWithKey :: Ord k => (k -> a -> Bool) -> HashMap k a -> HashMap k a
 filterWithKey p (HashMap m) = HashMap $
-  I.mapMaybe (nonempty . M.filterWithKey p) m
+  I.mapMaybe some_filter_with_key m
+  where some_filter_with_key v@(Only k x) | p k x     = Just v
+                                          | otherwise = Nothing
+        some_filter_with_key (More t) = some_norm $ M.filterWithKey p t
 
 -- | Partition the map according to some predicate. The first map contains all
 -- elements that satisfy the predicate, the second all elements that fail the
@@ -515,12 +640,16 @@
 -- | Map values and collect the 'Just' results.
 mapMaybe :: Ord k => (a -> Maybe b) -> HashMap k a -> HashMap k b
 mapMaybe f (HashMap m) = HashMap $
-  I.mapMaybe (nonempty . M.mapMaybe f) m
+  I.mapMaybe some_map_maybe m
+  where some_map_maybe (Only k x) = f x >>= return . Only k
+        some_map_maybe (More t) = some_norm $ M.mapMaybe f t
 
 -- | Map keys\/values and collect the 'Just' results.
 mapMaybeWithKey :: Ord k => (k -> a -> Maybe b) -> HashMap k a -> HashMap k b
 mapMaybeWithKey f (HashMap m) = HashMap $
-  I.mapMaybe (nonempty . M.mapMaybeWithKey f) m
+  I.mapMaybe some_map_maybe_with_key m
+  where some_map_maybe_with_key (Only k x) = f k x >>= return . Only k
+        some_map_maybe_with_key (More t) = some_norm $ M.mapMaybeWithKey f t
 
 -- | Map values and separate the 'Left' and 'Right' results.
 mapEither :: Ord k => (a -> Either b c) -> HashMap k a -> (HashMap k b, HashMap k c)
@@ -547,12 +676,16 @@
 -- | Fold the values in the map, such that @'fold' f z == 'Prelude.foldr'
 -- f z . 'elems'@.
 fold :: (a -> b -> b) -> b -> HashMap k a -> b
-fold f z (HashMap m) = I.fold (flip $ M.fold f) z m
+fold f z (HashMap m) = I.fold some_fold z m
+  where some_fold (Only _ x) y = f x y
+        some_fold (More t) y   = M.fold f y t
 
 -- | Fold the keys and values in the map, such that @'foldWithKey' f z ==
 -- 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
 foldWithKey :: (k -> a -> b -> b) -> b -> HashMap k a -> b
-foldWithKey f z (HashMap m) = I.fold (flip $ M.foldWithKey f) z m
+foldWithKey f z (HashMap m) = I.fold some_fold_with_key z m
+  where some_fold_with_key (Only k x) y = f k x y
+        some_fold_with_key (More t) y   = M.foldWithKey f y t
 
 
 {--------------------------------------------------------------------
@@ -560,15 +693,21 @@
 --------------------------------------------------------------------}
 -- | Return all elements of the map in arbitrary order of their keys.
 elems :: HashMap k a -> [a]
-elems (HashMap m) = I.fold ((++) . M.elems) [] m
+elems (HashMap m) = I.fold some_append_elems [] m
+  where some_append_elems (Only _ x) acc = x : acc
+        some_append_elems (More t) acc   = M.elems t ++ acc
 
 -- | Return all keys of the map in arbitrary order.
 keys  :: HashMap k a -> [k]
-keys (HashMap m) = I.fold ((++) . M.keys) [] m
+keys (HashMap m) = I.fold some_append_keys [] m
+  where some_append_keys (Only k _) acc = k : acc
+        some_append_keys (More t) acc   = M.keys t ++ acc
 
 -- | The set of all keys of the map.
 keysSet :: Ord k => HashMap k a -> S.Set k
-keysSet (HashMap m) = I.fold (S.union . M.keysSet) S.empty m
+keysSet (HashMap m) = I.fold (S.union . some_keys_set) S.empty m
+  where some_keys_set (Only k _) = S.singleton k
+        some_keys_set (More t)   = M.keysSet t
 
 -- | Return all key\/value pairs in the map in arbitrary key order.
 assocs :: HashMap k a -> [(k,a)]
@@ -581,17 +720,19 @@
 -- | Convert the map to a list of key\/value pairs.
 toList :: HashMap k a -> [(k,a)]
 toList (HashMap m) =
-  I.fold ((++) . M.toList) [] m
+  I.fold some_append [] m
+  where some_append (Only k x) acc = (k, x) : acc
+        some_append (More t) acc   = M.toList t ++ acc
 
 -- | Create a map from a list of key\/value pairs.
 fromList :: (Hashable k, Ord k)
          => [(k,a)] -> HashMap k a
-fromList xs = foldl' (\m (k, v) -> insert k v m) empty xs
+fromList xs = foldl' (\m (k, x) -> insert k x m) empty xs
 
 -- | Create a map from a list of key\/value pairs with a combining function.
 fromListWith :: (Hashable k, Ord k) => (a -> a -> a) -> [(k,a)] -> HashMap k a
-fromListWith f xs = foldl' (\m (k, v) -> insertWith f k v m) empty xs
+fromListWith f xs = foldl' (\m (k, x) -> insertWith f k x m) empty xs
 
 -- | Build a map from a list of key\/value pairs with a combining function.
 fromListWithKey :: (Hashable k, Ord k) => (k -> a -> a -> a) -> [(k,a)] -> HashMap k a
-fromListWithKey f xs = foldl' (\m (k, v) -> insertWithKey f k v m) empty xs
+fromListWithKey f xs = foldl' (\m (k, x) -> insertWithKey f k x m) empty xs
diff --git a/Data/HashSet.hs b/Data/HashSet.hs
--- a/Data/HashSet.hs
+++ b/Data/HashSet.hs
@@ -96,9 +96,11 @@
   Types
 --------------------------------------------------------------------}
 
+data Some a = Only !a | More !(S.Set a) deriving (Eq, Ord)
+
 -- | The abstract type of a @HashSet@. Its interface is a suitable
 -- subset of 'Data.IntSet.IntSet'.
-newtype HashSet a = HashSet (I.IntMap (S.Set a)) deriving (Eq, Ord)
+newtype HashSet a = HashSet (I.IntMap (Some a)) deriving (Eq, Ord)
 
 instance Ord a => Monoid (HashSet a) where
   mempty  = empty
@@ -144,7 +146,18 @@
   dataCast1 f  = gcast1 f
 #endif
 
+{--------------------------------------------------------------------
+  Comparing elements
+--------------------------------------------------------------------}
 
+-- For ByteStrings, doing compare is usually faster than doing (==),
+-- according to benchmarks. A Set is using compare naturally. We therefore
+-- define eq :: Ord a => a -> a -> Bool, which serves as (==).
+
+{-# INLINE eq #-}
+eq :: Ord a => a -> a -> Bool
+eq x y = x `compare` y == EQ
+
 {--------------------------------------------------------------------
   Query
 --------------------------------------------------------------------}
@@ -154,14 +167,17 @@
 
 -- | Number of elements in the set.
 size :: HashSet a -> Int
-size (HashSet s) = I.fold ((+) . S.size) 0 s
+size (HashSet s) = I.fold ((+) . some_size) 0 s
+  where some_size (Only _) = 1
+        some_size (More t) = S.size t
 
 -- | Is the element a member of the set?
 member :: (Hashable a, Ord a) => a -> HashSet a -> Bool
 member a (HashSet s) =
   case I.lookup (hash a) s of
     Nothing -> False
-    Just s' -> S.member a s'
+    Just (Only a') -> a `eq` a'
+    Just (More s') -> S.member a s'
 
 -- | Is the element not a member of the set?
 notMember :: (Hashable a, Ord a) => a -> HashSet a -> Bool
@@ -170,7 +186,11 @@
 -- | Is this a subset?
 isSubsetOf :: Ord a => HashSet a -> HashSet a -> Bool
 isSubsetOf (HashSet s1) (HashSet s2) =
-  I.isSubmapOfBy (S.isSubsetOf) s1 s2
+  I.isSubmapOfBy (some_isSubsetOf) s1 s2
+  where some_isSubsetOf (Only a) (Only b) = a `eq` b
+        some_isSubsetOf (Only a) (More s) = a `S.member` s
+        some_isSubsetOf (More _) (Only _) = False
+        some_isSubsetOf (More s) (More t) = s `S.isSubsetOf` t
 
 -- | Is this a proper subset? (ie. a subset but not equal).
 isProperSubsetOf :: Ord a => HashSet a -> HashSet a -> Bool
@@ -187,24 +207,35 @@
 -- | A set of one element.
 singleton :: Hashable a => a -> HashSet a
 singleton a = HashSet $
-  I.singleton (hash a) $ S.singleton a
+  I.singleton (hash a) $ Only a
 
 -- | Add a value to the set. When the value is already an element of the set,
 -- it is replaced by the new one, ie. 'insert' is left-biased.
 insert :: (Hashable a, Ord a) => a -> HashSet a -> HashSet a
 insert a (HashSet s) = HashSet $
-  I.insertWith (\_ -> S.insert a) (hash a) (S.singleton a) s
+  I.insertWith some_insert (hash a) (Only a) s
+  where some_insert _ v@(Only b) | a `eq` b    = v
+                                 | otherwise = More $ S.insert a (S.singleton b)
+        some_insert _ (More t) = More $ S.insert a t
 
 
-nonempty :: S.Set a -> Maybe (S.Set a)
-nonempty m | S.null m  = Nothing
-           | otherwise = Just m
+some_norm :: S.Set a -> Maybe (Some a)
+some_norm s = case S.size s of 0 -> Nothing
+                               1 -> Just $ Only $ S.findMin s
+                               _ -> Just $ More $ s
 
+some_norm' :: S.Set a -> Some a
+some_norm' s = case S.size s of 1 -> Only $ S.findMin s
+                                _ -> More $ s
+
 -- | Delete a value in the set. Returns the original set when the value was not
 -- present.
 delete :: (Hashable a, Ord a) => a -> HashSet a -> HashSet a
 delete a (HashSet s) = HashSet $
-  I.update (nonempty . S.delete a) (hash a) s
+  I.update some_delete (hash a) s
+  where some_delete v@(Only b) | a `eq` b  = Nothing
+                               | otherwise = Just v
+        some_delete (More t) = some_norm $ S.delete a t
 
 
 {--------------------------------------------------------------------
@@ -213,7 +244,12 @@
 
 -- | The union of two sets.
 union :: Ord a => HashSet a -> HashSet a -> HashSet a
-union (HashSet s1) (HashSet s2) = HashSet $ I.unionWith S.union s1 s2
+union (HashSet s1) (HashSet s2) = HashSet $ I.unionWith some_union s1 s2
+  where some_union v@(Only a) (Only b) | a `eq` b  = v
+                                       | otherwise = More (S.singleton a `S.union` S.singleton b)
+        some_union (Only a) (More s) = More $ S.singleton a `S.union` s
+        some_union (More s) (Only a) = More $ s `S.union` S.singleton a
+        some_union (More s) (More t) = More $ s `S.union` t
 
 -- | The union of a list of sets.
 unions :: Ord a => [HashSet a] -> HashSet a
@@ -222,15 +258,35 @@
 -- | Difference between two sets.
 difference :: Ord a => HashSet a -> HashSet a -> HashSet a
 difference (HashSet s1) (HashSet s2) = HashSet $
-  I.differenceWith (\t1 t2 -> nonempty $ S.difference t1 t2) s1 s2
+  I.differenceWith some_diff s1 s2
+  where some_diff v@(Only a) (Only b) | a `eq` b  = Nothing
+                                      | otherwise = Just v
+        some_diff v@(Only a) (More s) | a `S.member` s = Nothing
+                                      | otherwise      = Just v
+        some_diff (More s) (Only a) = some_norm $ S.delete a s
+        some_diff (More s) (More t) = some_norm $ s `S.difference` t
 
-delete_empty :: I.IntMap (S.Set a) -> I.IntMap (S.Set a)
-delete_empty = I.filter (not . S.null)
+-- The I.intersectionWith does not have type general enough. We need the function
+-- given to I.intersectionWith to have type a -> b -> Maybe c, so the elements could
+-- be deleted from the IntMap. As it is only a -> b -> c, we allow empty sets to be
+-- in the resulting intersection and delete them with a filter afterwards. This is
+-- the function performing the deletions.
+delete_empty :: I.IntMap (Some a) -> I.IntMap (Some a)
+delete_empty = I.filter some_empty
+  where some_empty (Only _) = True
+        some_empty (More s) = not $ S.null s
 
 -- | The intersection of two sets.
 intersection :: Ord a => HashSet a -> HashSet a -> HashSet a
 intersection (HashSet s1) (HashSet s2) = HashSet $ delete_empty $
-  I.intersectionWith S.intersection s1 s2
+  I.intersectionWith some_intersection s1 s2
+  where some_intersection v@(Only a) (Only b) | a `eq` b  = v
+                                              | otherwise = More (S.empty)
+        some_intersection v@(Only a) (More s) | a `S.member` s = v
+                                              | otherwise      = More (S.empty)
+        some_intersection (More s) (Only a) | a `S.member` s = Only (S.findMin $ s `S.intersection` (S.singleton a))
+                                            | otherwise      = More (S.empty)
+        some_intersection (More s) (More t) = some_norm' $ s `S.intersection` t
 
 
 {--------------------------------------------------------------------
@@ -239,7 +295,10 @@
 -- | Filter all elements that satisfy some predicate.
 filter :: Ord a => (a -> Bool) -> HashSet a -> HashSet a
 filter p (HashSet s) = HashSet $
-  I.mapMaybe (nonempty . S.filter p) s
+  I.mapMaybe some_filter s
+  where some_filter v@(Only a) | p a       = Just v
+                               | otherwise = Nothing
+        some_filter (More t) = some_norm (S.filter p t)
 
 -- | Partition the set according to some predicate. The first set contains all
 -- elements that satisfy the predicate, the second all elements that fail the
@@ -264,7 +323,9 @@
 --------------------------------------------------------------------}
 -- | Fold over the elements of a set in an unspecified order.
 fold :: (a -> b -> b) -> b -> HashSet a -> b
-fold f z (HashSet s) = I.fold (flip $ S.fold f) z s
+fold f z (HashSet s) = I.fold some_fold z s
+  where some_fold (Only a) x = f a x
+        some_fold (More t) x = S.fold f x t
 
 
 {--------------------------------------------------------------------
@@ -276,7 +337,9 @@
 
 -- | Convert the set to a list of elements.
 toList :: HashSet a -> [a]
-toList (HashSet s) = I.fold ((++) . S.toList) [] s
+toList (HashSet s) = I.fold some_append [] s
+  where some_append (Only a) acc = a : acc
+        some_append (More t) acc = S.toList t ++ acc
 
 -- | Create a set from a list of elements.
 fromList :: (Hashable a, Ord a) => [a] -> HashSet a
diff --git a/hashmap.cabal b/hashmap.cabal
--- a/hashmap.cabal
+++ b/hashmap.cabal
@@ -1,5 +1,5 @@
 Name:                hashmap
-Version:             1.0.0.2
+Version:             1.0.0.3
 Synopsis:            Persistent containers HashMap and HashSet.
 Description:         An implementation of persistent 'HashMap' and 'HashSet' on
                      top of 'Data.IntMap.IntMap' and 'Data.IntSet.IntSet',