diff --git a/Data/IntMap.hs b/Data/IntMap.hs
--- a/Data/IntMap.hs
+++ b/Data/IntMap.hs
@@ -59,44 +59,26 @@
     ) where
 
 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
-import Data.IntMap.Base (IntMap(..), join, nomatch, zero)
+import qualified Data.IntMap.Strict as Strict
 import Data.IntMap.Lazy
 
 -- | /Deprecated./ As of version 0.5, replaced by
 -- 'Data.IntMap.Strict.insertWith'.
 --
 -- /O(log n)/. Same as 'insertWith', but the result of the combining function
--- is evaluated to WHNF before inserted to the map. In contrast to
--- 'Data.IntMap.Strict.insertWith', the value argument is not evaluted when not
--- needed by the combining function.
+-- is evaluated to WHNF before inserted to the map.
 
 insertWith' :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
--- We do not reuse Data.IntMap.Strict.insertWith, because it is stricter -- it
--- forces evaluation of the given value.
-insertWith' f k x t
-  = insertWithKey' (\_ x' y' -> f x' y') k x t
+insertWith' = Strict.insertWith
 
 -- | /Deprecated./ As of version 0.5, replaced by
 -- 'Data.IntMap.Strict.insertWithKey'.
 --
 -- /O(log n)/. Same as 'insertWithKey', but the result of the combining
--- function is evaluated to WHNF before inserted to the map. In contrast to
--- 'Data.IntMap.Strict.insertWithKey', the value argument is not evaluted when
--- not needed by the combining function.
+-- function is evaluated to WHNF before inserted to the map.
 
 insertWithKey' :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
--- We do not reuse Data.IntMap.Strict.insertWithKey, because it is stricter -- it
--- forces evaluation of the given value.
-insertWithKey' f k x t = k `seq`
-  case t of
-    Bin p m l r
-      | nomatch k p m -> join k (Tip k x) p t
-      | zero k m      -> Bin p m (insertWithKey' f k x l) r
-      | otherwise     -> Bin p m l (insertWithKey' f k x r)
-    Tip ky y
-      | k==ky         -> Tip k $! f k x y
-      | otherwise     -> join k (Tip k x) ky t
-    Nil -> Tip k x
+insertWithKey' = Strict.insertWithKey
 
 -- | /Deprecated./ As of version 0.5, replaced by 'foldr'.
 --
diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -123,6 +123,8 @@
     , foldl
     , foldrWithKey
     , foldlWithKey
+    , foldMapWithKey
+
     -- ** Strict folds
     , foldr'
     , foldl'
@@ -295,17 +297,24 @@
     mconcat = unions
 
 instance Foldable.Foldable IntMap where
-  fold Nil = mempty
-  fold (Tip _ v) = v
-  fold (Bin _ _ l r) = Foldable.fold l `mappend` Foldable.fold r
+  fold t = go t
+    where go Nil = mempty
+          go (Tip _ v) = v
+          go (Bin _ _ l r) = go l `mappend` go r
+  {-# INLINABLE fold #-}
   foldr = foldr
+  {-# INLINE foldr #-}
   foldl = foldl
-  foldMap _ Nil = mempty
-  foldMap f (Tip _k v) = f v
-  foldMap f (Bin _ _ l r) = Foldable.foldMap f l `mappend` Foldable.foldMap f r
+  {-# INLINE foldl #-}
+  foldMap f t = go t
+    where go Nil = mempty
+          go (Tip _ v) = f v
+          go (Bin _ _ l r) = go l `mappend` go r
+  {-# INLINE foldMap #-}
 
 instance Traversable IntMap where
     traverse f = traverseWithKey (\_ -> f)
+    {-# INLINE traverse #-}
 
 instance NFData a => NFData (IntMap a) where
     rnf Nil = ()
@@ -1250,13 +1259,13 @@
 --
 -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')])
 -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')])           == Nothing
-{-# INLINE traverseWithKey #-}
 traverseWithKey :: Applicative t => (Key -> a -> t b) -> IntMap a -> t (IntMap b)
 traverseWithKey f = go
   where
     go Nil = pure Nil
     go (Tip k v) = Tip k <$> f k v
     go (Bin p m l r) = Bin p m <$> go l <*> go r
+{-# INLINE traverseWithKey #-}
 
 -- | /O(n)/. The function @'mapAccum'@ threads an accumulating
 -- argument through the map in ascending order of keys.
@@ -1669,6 +1678,19 @@
     go z' (Tip kx x)    = f z' kx x
     go z' (Bin _ _ l r) = go (go z' l) r
 {-# INLINE foldlWithKey' #-}
+
+-- | /O(n)/. Fold the keys and values in the map using the given monoid, such that
+--
+-- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@
+--
+-- This can be an asymptotically faster than 'foldrWithKey' or 'foldlWithKey' for some monoids.
+foldMapWithKey :: Monoid m => (Key -> a -> m) -> IntMap a -> m
+foldMapWithKey f = go
+  where
+    go Nil           = mempty
+    go (Tip kx x)    = f kx x
+    go (Bin _ _ l r) = go l `mappend` go r
+{-# INLINE foldMapWithKey #-}
 
 {--------------------------------------------------------------------
   List variations
diff --git a/Data/IntMap/Lazy.hs b/Data/IntMap/Lazy.hs
--- a/Data/IntMap/Lazy.hs
+++ b/Data/IntMap/Lazy.hs
@@ -133,6 +133,8 @@
     , IM.foldl
     , foldrWithKey
     , foldlWithKey
+    , foldMapWithKey
+
     -- ** Strict folds
     , foldr'
     , foldl'
diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs
--- a/Data/IntMap/Strict.hs
+++ b/Data/IntMap/Strict.hs
@@ -139,6 +139,8 @@
     , foldl
     , foldrWithKey
     , foldlWithKey
+    , foldMapWithKey
+
     -- ** Strict folds
     , foldr'
     , foldl'
@@ -261,14 +263,13 @@
 --
 -- This module satisfies the following strictness properties:
 --
--- 1. Key and value arguments are evaluated to WHNF;
+-- 1. Key arguments are evaluated to WHNF;
 --
 -- 2. Keys and values are evaluated to WHNF before they are stored in
 --    the map.
 --
--- Here are some examples that illustrate the first property:
+-- Here's an example illustrating the first property:
 --
--- > insertWith (\ new old -> old) k undefined m  ==  undefined
 -- > delete undefined m  ==  undefined
 --
 -- Here are some examples that illustrate the second property:
@@ -289,7 +290,7 @@
 
 -- See IntMap.Base.Note: Local 'go' functions and capturing]
 findWithDefault :: a -> Key -> IntMap a -> a
-findWithDefault def k = def `seq` k `seq` go
+findWithDefault def k = k `seq` go
   where
     go (Bin p m l r) | nomatch k p m = def
                      | zero k m  = go l
@@ -365,16 +366,16 @@
 -- in the result of @f@.
 
 insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
-insertWithKey f k x t = k `seq` x `seq`
+insertWithKey f k x t = k `seq`
   case t of
     Bin p m l r
-      | nomatch k p m -> join k (Tip k x) p t
+      | nomatch k p m -> join k (singleton k x) p t
       | zero k m      -> Bin p m (insertWithKey f k x l) r
       | otherwise     -> Bin p m l (insertWithKey f k x r)
     Tip ky y
       | k==ky         -> Tip k $! f k x y
-      | otherwise     -> join k (Tip k x) ky t
-    Nil -> Tip k x
+      | otherwise     -> join k (singleton k x) ky t
+    Nil -> singleton k x
 
 -- | /O(min(n,W))/. The expression (@'insertLookupWithKey' f k x map@)
 -- is a pair where the first element is equal to (@'lookup' k map@)
@@ -392,18 +393,18 @@
 -- > insertLookup 7 "x" (fromList [(5,"a"), (3,"b")]) == (Nothing,  fromList [(3, "b"), (5, "a"), (7, "x")])
 
 insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
-insertLookupWithKey f0 k0 x0 t0 = k0 `seq` x0 `seq` toPair $ go f0 k0 x0 t0
+insertLookupWithKey f0 k0 x0 t0 = k0 `seq` toPair $ go f0 k0 x0 t0
   where
     go f k x t =
       case t of
         Bin p m l r
-          | nomatch k p m -> Nothing :*: join k (Tip k x) p t
+          | nomatch k p m -> Nothing :*: join k (singleton k x) p t
           | zero k m      -> let (found :*: l') = go f k x l in (found :*: Bin p m l' r)
           | otherwise     -> let (found :*: r') = go f k x r in (found :*: Bin p m l r')
         Tip ky y
           | k==ky         -> (Just y :*: (Tip k $! f k x y))
-          | otherwise     -> (Nothing :*: join k (Tip k x) ky t)
-        Nil -> Nothing :*: Tip k x
+          | otherwise     -> (Nothing :*: join k (singleton k x) ky t)
+        Nil -> Nothing :*: (singleton k x)
 
 
 {--------------------------------------------------------------------
diff --git a/Data/Map.hs b/Data/Map.hs
--- a/Data/Map.hs
+++ b/Data/Map.hs
@@ -12,17 +12,16 @@
 -- Stability   :  provisional
 -- Portability :  portable
 --
+-- /Note:/ You should use "Data.Map.Strict" instead of this module if:
+--
+-- * You will eventually need all the values stored.
+--
+-- * The stored values don't represent large virtual data structures
+-- to be lazily computed.
+--
 -- An efficient implementation of ordered maps from keys to values
 -- (dictionaries).
 --
--- This module re-exports the value lazy "Data.Map.Lazy" API, plus
--- several deprecated value strict functions. Please note that these functions
--- have different strictness properties than those in "Data.Map.Strict":
--- they only evaluate the values inserted into the map. For example, the
--- default value to 'insertWith'' is only evaluated if it's used, i.e. because
--- there's no value for the key already or because the higher-order argument
--- that combines the old and new value uses it.
---
 -- These modules are intended to be imported qualified, to avoid name
 -- clashes with Prelude functions, e.g.
 --
@@ -57,15 +56,13 @@
     ) where
 
 import Prelude hiding (foldr)
-import Data.Map.Base (Map(..), balanceL, balanceR)
 import Data.Map.Lazy
-import Data.StrictPair
+import qualified Data.Map.Strict as Strict
 
 -- | /Deprecated./ As of version 0.5, replaced by 'Data.Map.Strict.insertWith'.
 --
 -- /O(log n)/. Same as 'insertWith', but the value being inserted to the map is
--- evaluated to WHNF beforehand. In contrast to 'Data.Map.Strict.insertWith',
--- the value argument is not evaluted when not needed.
+-- evaluated to WHNF beforehand.
 --
 -- For example, to update a counter:
 --
@@ -73,12 +70,7 @@
 --
 
 insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
--- We do not reuse Data.Map.Strict.insertWith, because it is stricter -- it
--- forces evaluation of the given value. Some people depend on the original
--- behaviour, which forces only the key and the result of combining function.
--- Particularly, people use insertWith' as a strict version of adjust, which
--- requires to use undefined in the place of the value.
-insertWith' f = insertWithKey' (\_ x' y' -> f x' y')
+insertWith' = Strict.insertWith
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE insertWith' #-}
 #else
@@ -89,23 +81,12 @@
 -- 'Data.Map.Strict.insertWithKey'.
 --
 -- /O(log n)/. Same as 'insertWithKey', but the value being inserted to the map is
--- evaluated to WHNF beforehand. In contrast to 'Data.Map.Strict.insertWithKey',
--- the value argument is not evaluted when not needed.
+-- evaluated to WHNF beforehand.
 
 insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
 -- We do not reuse Data.Map.Strict.insertWithKey, because it is stricter -- it
 -- forces evaluation of the given value.
-insertWithKey' = go
-  where
-    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
-    go _ kx _ _ | kx `seq` False = undefined
-    go _ kx x Tip = x `seq` singleton kx x
-    go f kx x (Bin sy ky y l r) =
-        case compare kx ky of
-            LT -> balanceL ky y (go f kx x l) r
-            GT -> balanceR ky y l (go f kx x r)
-            EQ -> let x' = f kx x y
-                  in x' `seq` Bin sy kx x' l r
+insertWithKey' = Strict.insertWithKey
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE insertWithKey' #-}
 #else
@@ -116,27 +97,13 @@
 -- 'Data.Map.Strict.insertLookupWithKey'.
 --
 -- /O(log n)/. Same as 'insertLookupWithKey', but the value being inserted to
--- the map is evaluated to WHNF beforehand. In contrast to
--- 'Data.Map.Strict.insertLookupWithKey', the value argument is not evaluted
--- when not needed.
+-- the map is evaluated to WHNF beforehand.
 
 insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a
                      -> (Maybe a, Map k a)
 -- We do not reuse Data.Map.Strict.insertLookupWithKey, because it is stricter -- it
 -- forces evaluation of the given value.
-insertLookupWithKey' f0 kx0 x0 t0 = toPair $ go f0 kx0 x0 t0
-  where
-    go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
-    go _ kx _ _ | kx `seq` False = undefined
-    go _ kx x Tip = x `seq` Nothing :*: singleton kx x
-    go f kx x (Bin sy ky y l r) =
-        case compare kx ky of
-            LT -> let (found :*: l') = go f kx x l
-                  in found :*: balanceL ky y l' r
-            GT -> let (found :*: r') = go f kx x r
-                  in found :*: balanceR ky y l r'
-            EQ -> let x' = f kx x y
-                  in x' `seq` (Just y :*: Bin sy kx x' l r)
+insertLookupWithKey' = Strict.insertLookupWithKey
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE insertLookupWithKey' #-}
 #else
diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs
--- a/Data/Map/Base.hs
+++ b/Data/Map/Base.hs
@@ -169,6 +169,8 @@
     , foldl
     , foldrWithKey
     , foldlWithKey
+    , foldMapWithKey
+
     -- ** Strict folds
     , foldr'
     , foldl'
@@ -1654,13 +1656,13 @@
 --
 -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(1, 'a'), (5, 'e')]) == Just (fromList [(1, 'b'), (5, 'f')])
 -- > traverseWithKey (\k v -> if odd k then Just (succ v) else Nothing) (fromList [(2, 'c')])           == Nothing
-{-# INLINE traverseWithKey #-}
 traverseWithKey :: Applicative t => (k -> a -> t b) -> Map k a -> t (Map k b)
 traverseWithKey f = go
   where
     go Tip = pure Tip
-    go (Bin s k v l r)
-      = flip (Bin s k) <$> go l <*> f k v <*> go r
+    go (Bin 1 k v _ _) = (\v' -> Bin 1 k v' Tip Tip) <$> f k v
+    go (Bin s k v l r) = flip (Bin s k) <$> go l <*> f k v <*> go r
+{-# INLINE traverseWithKey #-}
 
 -- | /O(n)/. The function 'mapAccum' threads an accumulating
 -- argument through the map in ascending order of keys.
@@ -1873,6 +1875,19 @@
     go z' (Bin _ kx x l r) = go (f (go z' l) kx x) r
 {-# INLINE foldlWithKey' #-}
 
+-- | /O(n)/. Fold the keys and values in the map using the given monoid, such that
+--
+-- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@
+--
+-- This can be an asymptotically faster than 'foldrWithKey' or 'foldlWithKey' for some monoids.
+foldMapWithKey :: Monoid m => (k -> a -> m) -> Map k a -> m
+foldMapWithKey f = go
+  where
+    go Tip             = mempty
+    go (Bin 1 k v _ _) = f k v
+    go (Bin _ k v l r) = go l `mappend` (f k v `mappend` go r)
+{-# INLINE foldMapWithKey #-}
+
 {--------------------------------------------------------------------
   List variations
 --------------------------------------------------------------------}
@@ -2601,14 +2616,23 @@
 
 instance Traversable (Map k) where
   traverse f = traverseWithKey (\_ -> f)
+  {-# INLINE traverse #-}
 
 instance Foldable.Foldable (Map k) where
-  fold Tip = mempty
-  fold (Bin _ _ v l r) = Foldable.fold l `mappend` v `mappend` Foldable.fold r
+  fold t = go t
+    where go Tip = mempty
+          go (Bin 1 _ v _ _) = v
+          go (Bin _ _ v l r) = go l `mappend` (v `mappend` go r)
+  {-# INLINABLE fold #-}
   foldr = foldr
+  {-# INLINE foldr #-}
   foldl = foldl
-  foldMap _ Tip = mempty
-  foldMap f (Bin _ _ v l r) = Foldable.foldMap f l `mappend` f v `mappend` Foldable.foldMap f r
+  {-# INLINE foldl #-}
+  foldMap f t = go t
+    where go Tip = mempty
+          go (Bin 1 _ v _ _) = f v
+          go (Bin _ _ v l r) = go l `mappend` (f v `mappend` go r)
+  {-# INLINE foldMap #-}
 
 instance (NFData k, NFData a) => NFData (Map k a) where
     rnf Tip = ()
diff --git a/Data/Map/Lazy.hs b/Data/Map/Lazy.hs
--- a/Data/Map/Lazy.hs
+++ b/Data/Map/Lazy.hs
@@ -129,6 +129,8 @@
     , M.foldl
     , foldrWithKey
     , foldlWithKey
+    , foldMapWithKey
+
     -- ** Strict folds
     , foldr'
     , foldl'
diff --git a/Data/Map/Strict.hs b/Data/Map/Strict.hs
--- a/Data/Map/Strict.hs
+++ b/Data/Map/Strict.hs
@@ -136,6 +136,8 @@
     , foldl
     , foldrWithKey
     , foldlWithKey
+    , foldMapWithKey
+
     -- ** Strict folds
     , foldr'
     , foldl'
@@ -279,20 +281,19 @@
 #define STRICT_1_OF_3(fn) fn arg _ _ | arg `seq` False = undefined
 #define STRICT_2_OF_3(fn) fn _ arg _ | arg `seq` False = undefined
 #define STRICT_1_2_OF_3(fn) fn arg1 arg2 _ | arg1 `seq` arg2 `seq` False = undefined
-#define STRICT_2_3_OF_4(fn) fn _ arg1 arg2 _ | arg1 `seq` arg2 `seq` False = undefined
+#define STRICT_2_OF_4(fn) fn _ arg _ _ | arg `seq` False = undefined
 
 -- $strictness
 --
 -- This module satisfies the following strictness properties:
 --
--- 1. Key and value arguments are evaluated to WHNF;
+-- 1. Key arguments are evaluated to WHNF;
 --
 -- 2. Keys and values are evaluated to WHNF before they are stored in
 --    the map.
 --
--- Here are some examples that illustrate the first property:
+-- Here's an example illustrating the first property:
 --
--- > insertWith (\ new old -> old) k undefined m  ==  undefined
 -- > delete undefined m  ==  undefined
 --
 -- Here are some examples that illustrate the second property:
@@ -313,7 +314,7 @@
 
 -- See Map.Base.Note: Local 'go' functions and capturing
 findWithDefault :: Ord k => a -> k -> Map k a -> a
-findWithDefault def k = def `seq` k `seq` go
+findWithDefault def k = k `seq` go
   where
     go Tip = def
     go (Bin _ kx x l r) = case compare k kx of
@@ -404,7 +405,7 @@
 insertWithKey = go
   where
     go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
-    STRICT_2_3_OF_4(go)
+    STRICT_2_OF_4(go)
     go _ kx x Tip = singleton kx x
     go f kx x (Bin sy ky y l r) =
         case compare kx ky of
@@ -440,7 +441,7 @@
 insertLookupWithKey f0 kx0 x0 t0 = toPair $ go f0 kx0 x0 t0
   where
     go :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> StrictPair (Maybe a) (Map k a)
-    STRICT_2_3_OF_4(go)
+    STRICT_2_OF_4(go)
     go _ kx x Tip = Nothing :*: singleton kx x
     go f kx x (Bin sy ky y l r) =
         case compare kx ky of
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -234,12 +234,20 @@
     mconcat = unions
 
 instance Foldable.Foldable Set where
-    fold Tip = mempty
-    fold (Bin _ k l r) = Foldable.fold l `mappend` k `mappend` Foldable.fold r
+    fold t = go t
+      where go Tip = mempty
+            go (Bin 1 k _ _) = k
+            go (Bin _ k l r) = go l `mappend` (k `mappend` go r)
+    {-# INLINABLE fold #-}
     foldr = foldr
+    {-# INLINE foldr #-}
     foldl = foldl
-    foldMap _ Tip = mempty
-    foldMap f (Bin _ k l r) = Foldable.foldMap f l `mappend` f k `mappend` Foldable.foldMap f r
+    {-# INLINE foldl #-}
+    foldMap f t = go t
+      where go Tip = mempty
+            go (Bin 1 k _ _) = f k
+            go (Bin _ k l r) = go l `mappend` (f k `mappend` go r)
+    {-# INLINE foldMap #-}
 
 #if __GLASGOW_HASKELL__
 
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,22 +1,3 @@
-This library (libraries/containers) is derived from code from several
-sources:
-
-  * Code from the GHC project which is largely (c) The University of
-    Glasgow, and distributable under a BSD-style license (see below),
-
-  * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
-    and freely redistributable (but see the full license for
-    restrictions).
-
-  * Code from the Haskell Foreign Function Interface specification,
-    which is (c) Manuel M. T. Chakravarty and freely redistributable
-    (but see the full license for restrictions).
-
-The full text of these licenses is reproduced below.  All of the
-licenses are BSD-style or compatible.
-
------------------------------------------------------------------------------
-
 The Glasgow Haskell Compiler License
 
 Copyright 2004, The University Court of the University of Glasgow.
@@ -48,36 +29,3 @@
 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.
-
------------------------------------------------------------------------------
-
-Code derived from the document "Report on the Programming Language
-Haskell 98", is distributed under the following license:
-
-  Copyright (c) 2002 Simon Peyton Jones
-
-  The authors intend this Report to belong to the entire Haskell
-  community, and so we grant permission to copy and distribute it for
-  any purpose, provided that it is reproduced in its entirety,
-  including this Notice.  Modified versions of this Report may also be
-  copied and distributed for any purpose, provided that the modified
-  version is clearly presented as such, and that it does not claim to
-  be a definition of the Haskell 98 Language.
-
------------------------------------------------------------------------------
-
-Code derived from the document "The Haskell 98 Foreign Function
-Interface, An Addendum to the Haskell 98 Report" is distributed under
-the following license:
-
-  Copyright (c) 2002 Manuel M. T. Chakravarty
-
-  The authors intend this Report to belong to the entire Haskell
-  community, and so we grant permission to copy and distribute it for
-  any purpose, provided that it is reproduced in its entirety,
-  including this Notice.  Modified versions of this Report may also be
-  copied and distributed for any purpose, provided that the modified
-  version is clearly presented as such, and that it does not claim to
-  be a definition of the Haskell 98 Foreign Function Interface.
-
------------------------------------------------------------------------------
diff --git a/containers.cabal b/containers.cabal
--- a/containers.cabal
+++ b/containers.cabal
@@ -1,5 +1,5 @@
 name: containers
-version: 0.5.2.1
+version: 0.5.3.0
 license: BSD3
 license-file: LICENSE
 maintainer: fox@ucw.cz
@@ -207,3 +207,33 @@
         QuickCheck,
         test-framework,
         test-framework-quickcheck2
+
+test-suite map-strictness-properties
+  hs-source-dirs: tests
+  main-is: MapStrictness.hs
+  type: exitcode-stdio-1.0
+
+  build-depends:
+    base,
+    ChasingBottoms,
+    containers,
+    QuickCheck >= 2.4.0.1,
+    test-framework >= 0.3.3,
+    test-framework-quickcheck2 >= 0.2.9
+
+  ghc-options: -Wall
+
+test-suite intmap-strictness-properties
+  hs-source-dirs: tests
+  main-is: IntMapStrictness.hs
+  type: exitcode-stdio-1.0
+
+  build-depends:
+    base,
+    ChasingBottoms,
+    containers,
+    QuickCheck >= 2.4.0.1,
+    test-framework >= 0.3.3,
+    test-framework-quickcheck2 >= 0.2.9
+
+  ghc-options: -Wall
diff --git a/include/Typeable.h b/include/Typeable.h
--- a/include/Typeable.h
+++ b/include/Typeable.h
@@ -20,9 +20,15 @@
 --  // generate the instances.
 
 #define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon
+#if __GLASGOW_HASKELL__ >= 707
+#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable tycon
+#else
 #define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable1 tycon
 #define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable2 tycon
 #define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable3 tycon
+#endif
 
 #else /* !__GLASGOW_HASKELL__ */
 
diff --git a/tests/IntMapStrictness.hs b/tests/IntMapStrictness.hs
new file mode 100644
--- /dev/null
+++ b/tests/IntMapStrictness.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Main (main) where
+
+import Test.ChasingBottoms.IsBottom
+import Test.Framework (Test, defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck (Arbitrary(arbitrary))
+
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as M
+
+instance Arbitrary v => Arbitrary (IntMap v) where
+    arbitrary = M.fromList `fmap` arbitrary
+
+instance Show (Int -> Int) where
+    show _ = "<function>"
+
+instance Show (Int -> Int -> Int) where
+    show _ = "<function>"
+
+instance Show (Int -> Int -> Int -> Int) where
+    show _ = "<function>"
+
+------------------------------------------------------------------------
+-- * Properties
+
+------------------------------------------------------------------------
+-- ** Strict module
+
+pSingletonKeyStrict :: Int -> Bool
+pSingletonKeyStrict v = isBottom $ M.singleton (bottom :: Int) v
+
+pSingletonValueStrict :: Int -> Bool
+pSingletonValueStrict k = isBottom $ (M.singleton k (bottom :: Int))
+
+pFindWithDefaultKeyStrict :: Int -> IntMap Int -> Bool
+pFindWithDefaultKeyStrict def m = isBottom $ M.findWithDefault def bottom m
+
+pFindWithDefaultValueStrict :: Int -> IntMap Int -> Bool
+pFindWithDefaultValueStrict k m =
+    M.member k m || (isBottom $ M.findWithDefault bottom k m)
+
+pAdjustKeyStrict :: (Int -> Int) -> IntMap Int -> Bool
+pAdjustKeyStrict f m = isBottom $ M.adjust f bottom m
+
+pAdjustValueStrict :: Int -> IntMap Int -> Bool
+pAdjustValueStrict k m
+    | k `M.member` m = isBottom $ M.adjust (const bottom) k m
+    | otherwise       = case M.keys m of
+        []     -> True
+        (k':_) -> isBottom $ M.adjust (const bottom) k' m
+
+pInsertKeyStrict :: Int -> IntMap Int -> Bool
+pInsertKeyStrict v m = isBottom $ M.insert bottom v m
+
+pInsertValueStrict :: Int -> IntMap Int -> Bool
+pInsertValueStrict k m = isBottom $ M.insert k bottom m
+
+pInsertWithKeyStrict :: (Int -> Int -> Int) -> Int -> IntMap Int -> Bool
+pInsertWithKeyStrict f v m = isBottom $ M.insertWith f bottom v m
+
+pInsertWithValueStrict :: (Int -> Int -> Int) -> Int -> Int -> IntMap Int
+                       -> Bool
+pInsertWithValueStrict f k v m
+    | M.member k m = (isBottom $ M.insertWith (const2 bottom) k v m) &&
+                     not (isBottom $ M.insertWith (const2 1) k bottom m)
+    | otherwise    = isBottom $ M.insertWith f k bottom m
+
+pInsertLookupWithKeyKeyStrict :: (Int -> Int -> Int -> Int) -> Int -> IntMap Int
+                              -> Bool
+pInsertLookupWithKeyKeyStrict f v m = isBottom $ M.insertLookupWithKey f bottom v m
+
+pInsertLookupWithKeyValueStrict :: (Int -> Int -> Int -> Int) -> Int -> Int
+                                -> IntMap Int -> Bool
+pInsertLookupWithKeyValueStrict f k v m
+    | M.member k m = (isBottom $ M.insertLookupWithKey (const3 bottom) k v m) &&
+                     not (isBottom $ M.insertLookupWithKey (const3 1) k bottom m)
+    | otherwise    = isBottom $ M.insertLookupWithKey f k bottom m
+
+------------------------------------------------------------------------
+-- * Test list
+
+tests :: [Test]
+tests =
+    [
+    -- Basic interface
+      testGroup "IntMap.Strict"
+      [ testProperty "singleton is key-strict" pSingletonKeyStrict
+      , testProperty "singleton is value-strict" pSingletonValueStrict
+      , testProperty "member is key-strict" $ keyStrict M.member
+      , testProperty "lookup is key-strict" $ keyStrict M.lookup
+      , testProperty "findWithDefault is key-strict" pFindWithDefaultKeyStrict
+      , testProperty "findWithDefault is value-strict" pFindWithDefaultValueStrict
+      , testProperty "! is key-strict" $ keyStrict (flip (M.!))
+      , testProperty "delete is key-strict" $ keyStrict M.delete
+      , testProperty "adjust is key-strict" pAdjustKeyStrict
+      , testProperty "adjust is value-strict" pAdjustValueStrict
+      , testProperty "insert is key-strict" pInsertKeyStrict
+      , testProperty "insert is value-strict" pInsertValueStrict
+      , testProperty "insertWith is key-strict" pInsertWithKeyStrict
+      , testProperty "insertWith is value-strict" pInsertWithValueStrict
+      , testProperty "insertLookupWithKey is key-strict"
+        pInsertLookupWithKeyKeyStrict
+      , testProperty "insertLookupWithKey is value-strict"
+        pInsertLookupWithKeyValueStrict
+      ]
+    ]
+
+------------------------------------------------------------------------
+-- * Test harness
+
+main :: IO ()
+main = defaultMain tests
+
+------------------------------------------------------------------------
+-- * Utilities
+
+keyStrict :: (Int -> IntMap Int -> a) -> IntMap Int -> Bool
+keyStrict f m = isBottom $ f bottom m
+
+const2 :: a -> b -> c -> a
+const2 x _ _ = x
+
+const3 :: a -> b -> c -> d -> a
+const3 x _ _ _ = x
diff --git a/tests/MapStrictness.hs b/tests/MapStrictness.hs
new file mode 100644
--- /dev/null
+++ b/tests/MapStrictness.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Main (main) where
+
+import Test.ChasingBottoms.IsBottom
+import Test.Framework (Test, defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck (Arbitrary(arbitrary))
+
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+
+instance (Arbitrary k, Arbitrary v, Eq k, Ord k) =>
+         Arbitrary (Map k v) where
+    arbitrary = M.fromList `fmap` arbitrary
+
+instance Show (Int -> Int) where
+    show _ = "<function>"
+
+instance Show (Int -> Int -> Int) where
+    show _ = "<function>"
+
+instance Show (Int -> Int -> Int -> Int) where
+    show _ = "<function>"
+
+------------------------------------------------------------------------
+-- * Properties
+
+------------------------------------------------------------------------
+-- ** Strict module
+
+pSingletonKeyStrict :: Int -> Bool
+pSingletonKeyStrict v = isBottom $ M.singleton (bottom :: Int) v
+
+pSingletonValueStrict :: Int -> Bool
+pSingletonValueStrict k = isBottom $ (M.singleton k (bottom :: Int))
+
+pFindWithDefaultKeyStrict :: Int -> Map Int Int -> Bool
+pFindWithDefaultKeyStrict def m = isBottom $ M.findWithDefault def bottom m
+
+pFindWithDefaultValueStrict :: Int -> Map Int Int -> Bool
+pFindWithDefaultValueStrict k m =
+    M.member k m || (isBottom $ M.findWithDefault bottom k m)
+
+pAdjustKeyStrict :: (Int -> Int) -> Map Int Int -> Bool
+pAdjustKeyStrict f m = isBottom $ M.adjust f bottom m
+
+pAdjustValueStrict :: Int -> Map Int Int -> Bool
+pAdjustValueStrict k m
+    | k `M.member` m = isBottom $ M.adjust (const bottom) k m
+    | otherwise       = case M.keys m of
+        []     -> True
+        (k':_) -> isBottom $ M.adjust (const bottom) k' m
+
+pInsertKeyStrict :: Int -> Map Int Int -> Bool
+pInsertKeyStrict v m = isBottom $ M.insert bottom v m
+
+pInsertValueStrict :: Int -> Map Int Int -> Bool
+pInsertValueStrict k m = isBottom $ M.insert k bottom m
+
+pInsertWithKeyStrict :: (Int -> Int -> Int) -> Int -> Map Int Int -> Bool
+pInsertWithKeyStrict f v m = isBottom $ M.insertWith f bottom v m
+
+pInsertWithValueStrict :: (Int -> Int -> Int) -> Int -> Int -> Map Int Int
+                       -> Bool
+pInsertWithValueStrict f k v m
+    | M.member k m = (isBottom $ M.insertWith (const2 bottom) k v m) &&
+                     not (isBottom $ M.insertWith (const2 1) k bottom m)
+    | otherwise    = isBottom $ M.insertWith f k bottom m
+
+pInsertLookupWithKeyKeyStrict :: (Int -> Int -> Int -> Int) -> Int
+                              -> Map Int Int -> Bool
+pInsertLookupWithKeyKeyStrict f v m = isBottom $ M.insertLookupWithKey f bottom v m
+
+pInsertLookupWithKeyValueStrict :: (Int -> Int -> Int -> Int) -> Int -> Int
+                                -> Map Int Int -> Bool
+pInsertLookupWithKeyValueStrict f k v m
+    | M.member k m = (isBottom $ M.insertLookupWithKey (const3 bottom) k v m) &&
+                     not (isBottom $ M.insertLookupWithKey (const3 1) k bottom m)
+    | otherwise    = isBottom $ M.insertLookupWithKey f k bottom m
+
+------------------------------------------------------------------------
+-- * Test list
+
+tests :: [Test]
+tests =
+    [
+    -- Basic interface
+      testGroup "Map.Strict"
+      [ testProperty "singleton is key-strict" pSingletonKeyStrict
+      , testProperty "singleton is value-strict" pSingletonValueStrict
+      , testProperty "member is key-strict" $ keyStrict M.member
+      , testProperty "lookup is key-strict" $ keyStrict M.lookup
+      , testProperty "findWithDefault is key-strict" pFindWithDefaultKeyStrict
+      , testProperty "findWithDefault is value-strict" pFindWithDefaultValueStrict
+      , testProperty "! is key-strict" $ keyStrict (flip (M.!))
+      , testProperty "delete is key-strict" $ keyStrict M.delete
+      , testProperty "adjust is key-strict" pAdjustKeyStrict
+      , testProperty "adjust is value-strict" pAdjustValueStrict
+      , testProperty "insert is key-strict" pInsertKeyStrict
+      , testProperty "insert is value-strict" pInsertValueStrict
+      , testProperty "insertWith is key-strict" pInsertWithKeyStrict
+      , testProperty "insertWith is value-strict" pInsertWithValueStrict
+      , testProperty "insertLookupWithKey is key-strict"
+        pInsertLookupWithKeyKeyStrict
+      , testProperty "insertLookupWithKey is value-strict"
+        pInsertLookupWithKeyValueStrict
+      ]
+    ]
+
+------------------------------------------------------------------------
+-- * Test harness
+
+main :: IO ()
+main = defaultMain tests
+
+------------------------------------------------------------------------
+-- * Utilities
+
+keyStrict :: (Int -> Map Int Int -> a) -> Map Int Int -> Bool
+keyStrict f m = isBottom $ f bottom m
+
+const2 :: a -> b -> c -> a
+const2 x _ _ = x
+
+const3 :: a -> b -> c -> d -> a
+const3 x _ _ _ = x