remove foldlStrict, generalize type of unions, see #520 (#524)
[packages/containers.git] / Data / Map / Internal.hs
index 88b12f4..d0c1b97 100644 (file)
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE PatternGuards #-}
 #if __GLASGOW_HASKELL__
 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
 #endif
 #define USE_MAGIC_PROXY 1
 #endif
 
-#if USE_MAGIC_PROXY
+#ifdef USE_MAGIC_PROXY
 {-# LANGUAGE MagicHash #-}
 #endif
 
+{-# OPTIONS_HADDOCK not-home #-}
+
 #include "containers.h"
 
 #if !(WORD_SIZE_IN_BITS >= 61)
@@ -29,7 +32,6 @@
 --                (c) Andriy Palamarchuk 2008
 -- License     :  BSD-style
 -- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
 -- Portability :  portable
 --
 -- = WARNING
@@ -77,6 +79,8 @@
 --
 -- Operation comments contain the operation time complexity in
 -- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.
+--
+-- @since 0.5.9
 -----------------------------------------------------------------------------
 
 -- [Note: Using INLINABLE]
 module Data.Map.Internal (
     -- * Map type
       Map(..)          -- instance Eq,Show,Read
+    , Size
 
     -- * Operators
-    , (!), (\\)
+    , (!), (!?), (\\)
 
     -- * Query
     , null
@@ -312,6 +317,8 @@ module Data.Map.Internal (
     , splitAt
 
     -- * Min\/Max
+    , lookupMin
+    , lookupMax
     , findMin
     , findMax
     , deleteMin
@@ -327,11 +334,6 @@ module Data.Map.Internal (
     , minViewWithKey
     , maxViewWithKey
 
-    -- * Debugging
-    , showTree
-    , showTreeWith
-    , valid
-
     -- Used by the strict version
     , AreWeStrict (..)
     , atKeyImpl
@@ -340,7 +342,6 @@ module Data.Map.Internal (
 #endif
     , bin
     , balance
-    , balanced
     , balanceL
     , balanceR
     , delta
@@ -351,7 +352,7 @@ module Data.Map.Internal (
     , MaybeS(..)
     , Identity(..)
 
-    -- Used by Map.Lazy.Merge
+    -- Used by Map.Merge.Lazy
     , mapWhenMissing
     , mapWhenMatched
     , lmapWhenMissing
@@ -363,38 +364,40 @@ module Data.Map.Internal (
 
 #if MIN_VERSION_base(4,8,0)
 import Data.Functor.Identity (Identity (..))
+import Control.Applicative (liftA3)
 #else
-import Control.Applicative (Applicative(..), (<$>))
+import Control.Applicative (Applicative(..), (<$>), liftA3)
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 #endif
 #if MIN_VERSION_base(4,9,0)
+import Data.Functor.Classes
 import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
 #endif
 import Control.Applicative (Const (..))
 import Control.DeepSeq (NFData(rnf))
 import Data.Bits (shiftL, shiftR)
 import qualified Data.Foldable as Foldable
+import Data.Foldable (Foldable())
 import Data.Typeable
 import Prelude hiding (lookup, map, filter, foldr, foldl, null, splitAt, take, drop)
 
 import qualified Data.Set.Internal as Set
 import Data.Set.Internal (Set)
-import Data.Utils.PtrEquality (ptrEq)
-import Data.Utils.StrictFold
-import Data.Utils.StrictPair
-import Data.Utils.StrictMaybe
-import Data.Utils.BitQueue
-#if DEFINE_ALTERF_FALLBACK
-import Data.Utils.BitUtil (wordSize)
+import Utils.Containers.Internal.PtrEquality (ptrEq)
+import Utils.Containers.Internal.StrictPair
+import Utils.Containers.Internal.StrictMaybe
+import Utils.Containers.Internal.BitQueue
+#ifdef DEFINE_ALTERF_FALLBACK
+import Utils.Containers.Internal.BitUtil (wordSize)
 #endif
 
 #if __GLASGOW_HASKELL__
-import GHC.Exts (build)
+import GHC.Exts (build, lazy)
 #if !MIN_VERSION_base(4,8,0)
 import Data.Functor ((<$))
 #endif
-#if USE_MAGIC_PROXY
+#ifdef USE_MAGIC_PROXY
 import GHC.Exts (Proxy#, proxy# )
 #endif
 #if __GLASGOW_HASKELL__ >= 708
@@ -412,7 +415,7 @@ import Data.Coerce
 {--------------------------------------------------------------------
   Operators
 --------------------------------------------------------------------}
-infixl 9 !,\\ --
+infixl 9 !,!?,\\ --
 
 -- | /O(log n)/. Find the value at a key.
 -- Calls 'error' when the element can not be found.
@@ -423,14 +426,28 @@ infixl 9 !,\\ --
 (!) :: Ord k => Map k a -> k -> a
 (!) m k = find k m
 #if __GLASGOW_HASKELL__
-{-# INLINABLE (!) #-}
+{-# INLINE (!) #-}
+#endif
+
+-- | /O(log n)/. Find the value at a key.
+-- Returns 'Nothing' when the element can not be found.
+--
+-- prop> fromList [(5, 'a'), (3, 'b')] !? 1 == Nothing
+-- prop> fromList [(5, 'a'), (3, 'b')] !? 5 == Just 'a'
+--
+-- @since 0.5.9
+
+(!?) :: Ord k => Map k a -> k -> Maybe a
+(!?) m k = lookup k m
+#if __GLASGOW_HASKELL__
+{-# INLINE (!?) #-}
 #endif
 
 -- | Same as 'difference'.
 (\\) :: Ord k => Map k a -> Map k b -> Map k a
 m1 \\ m2 = difference m1 m2
 #if __GLASGOW_HASKELL__
-{-# INLINABLE (\\) #-}
+{-# INLINE (\\) #-}
 #endif
 
 {--------------------------------------------------------------------
@@ -745,49 +762,69 @@ singleton k x = Bin 1 k x Tip Tip
 -- > insert 5 'x' empty                         == singleton 5 'x'
 
 -- See Note: Type of local 'go' function
+-- See Note: Avoiding worker/wrapper
 insert :: Ord k => k -> a -> Map k a -> Map k a
-insert = go
+insert kx0 = go kx0 kx0
   where
     -- Unlike insertR, we only get sharing here
     -- when the inserted value is at the same address
-    -- as the present value. We try anyway. If we decide
-    -- not to, then Data.Map.Strict should probably
-    -- get its own union implementation.
-    go :: Ord k => k -> a -> Map k a -> Map k a
-    go !kx x Tip = singleton kx x
-    go !kx x t@(Bin sz ky y l r) =
+    -- as the present value. We try anyway; this condition
+    -- seems particularly likely to occur in 'union'.
+    go :: Ord k => k -> k -> a -> Map k a -> Map k a
+    go orig !_  x Tip = singleton (lazy orig) x
+    go orig !kx x t@(Bin sz ky y l r) =
         case compare kx ky of
             LT | l' `ptrEq` l -> t
                | otherwise -> balanceL ky y l' r
-               where !l' = go kx x l
+               where !l' = go orig kx x l
             GT | r' `ptrEq` r -> t
                | otherwise -> balanceR ky y l r'
-               where !r' = go kx x r
-            EQ | kx `ptrEq` ky && x `ptrEq` y -> t
-               | otherwise -> Bin sz kx x l r
+               where !r' = go orig kx x r
+            EQ | x `ptrEq` y && (lazy orig `seq` (orig `ptrEq` ky)) -> t
+               | otherwise -> Bin sz (lazy orig) x l r
 #if __GLASGOW_HASKELL__
 {-# INLINABLE insert #-}
 #else
 {-# INLINE insert #-}
 #endif
 
+#ifndef __GLASGOW_HASKELL__
+lazy :: a -> a
+lazy a = a
+#endif
+
+-- [Note: Avoiding worker/wrapper]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- 'insert' has to go to great lengths to get pointer equality right and
+-- to prevent unnecessary allocation. The trouble is that GHC *really* wants
+-- to unbox the key and throw away the boxed one. This is bad for us, because
+-- we want to compare the pointer of the box we are given to the one already
+-- present if they compare EQ. It's also bad for us because it leads to the
+-- key being *reboxed* if it's actually stored in the map. Ugh! So we pass the
+-- 'go' function *two copies* of the key we're given. One of them we use for
+-- comparisons; the other we keep in our pocket. To prevent worker/wrapper from
+-- messing with the copy in our pocket, we sprinkle about calls to the magical
+-- function 'lazy'. This is all horrible, but it seems to work okay.
+
+
 -- Insert a new key and value in the map if it is not already present.
 -- Used by `union`.
 
 -- See Note: Type of local 'go' function
+-- See Note: Avoiding worker/wrapper
 insertR :: Ord k => k -> a -> Map k a -> Map k a
-insertR = go
+insertR kx0 = go kx0 kx0
   where
-    go :: Ord k => k -> a -> Map k a -> Map k a
-    go !kx x Tip = singleton kx x
-    go kx x t@(Bin _ ky y l r) =
+    go :: Ord k => k -> k -> a -> Map k a -> Map k a
+    go orig !_  x Tip = singleton (lazy orig) x
+    go orig !kx x t@(Bin _ ky y l r) =
         case compare kx ky of
             LT | l' `ptrEq` l -> t
                | otherwise -> balanceL ky y l' r
-               where !l' = go kx x l
+               where !l' = go orig kx x l
             GT | r' `ptrEq` r -> t
                | otherwise -> balanceR ky y l r'
-               where !r' = go kx x r
+               where !r' = go orig kx x r
             EQ -> t
 #if __GLASGOW_HASKELL__
 {-# INLINABLE insertR #-}
@@ -1187,7 +1224,7 @@ alterF f k m = atKeyImpl Lazy k f m
 
 atKeyImpl :: (Functor f, Ord k) =>
       AreWeStrict -> k -> (Maybe a -> f (Maybe a)) -> Map k a -> f (Map k a)
-#if DEFINE_ALTERF_FALLBACK
+#ifdef DEFINE_ALTERF_FALLBACK
 atKeyImpl strict !k f m
 -- It doesn't seem sensible to worry about overflowing the queue
 -- if the word size is 61 or more. If I calculate it correctly,
@@ -1210,7 +1247,7 @@ atKeyImpl strict !k f m = case lookupTrace k m of
 
 {-# INLINE atKeyImpl #-}
 
-#if DEFINE_ALTERF_FALLBACK
+#ifdef DEFINE_ALTERF_FALLBACK
 alterFCutoff :: Int
 #if WORD_SIZE_IN_BITS == 32
 alterFCutoff = 55744454
@@ -1277,7 +1314,7 @@ insertAlong q kx x (Bin sz ky y l r) =
 -- proxy that's ultimately erased.
 deleteAlong :: any -> BitQueue -> Map k a -> Map k a
 deleteAlong old !q0 !m = go (bogus old) q0 m where
-#if USE_MAGIC_PROXY
+#ifdef USE_MAGIC_PROXY
   go :: Proxy# () -> BitQueue -> Map k a -> Map k a
 #else
   go :: any -> BitQueue -> Map k a -> Map k a
@@ -1289,7 +1326,7 @@ deleteAlong old !q0 !m = go (bogus old) q0 m where
         Just (True, tl) -> balanceL ky y l (go foom tl r)
         Nothing -> glue l r
 
-#if USE_MAGIC_PROXY
+#ifdef USE_MAGIC_PROXY
 {-# NOINLINE bogus #-}
 bogus :: a -> Proxy# ()
 bogus _ = proxy#
@@ -1350,7 +1387,7 @@ atKeyPlain strict k0 f0 t = case go k0 f0 t of
 data Altered k a = AltSmaller !(Map k a) | AltBigger !(Map k a) | AltAdj !(Map k a) | AltSame
 #endif
 
-#if DEFINE_ALTERF_FALLBACK
+#ifdef DEFINE_ALTERF_FALLBACK
 -- When the map is too large to use a bit queue, we fall back to
 -- this much slower version which uses a more "natural" implementation
 -- improved with Yoneda to avoid repeated fmaps. This works okayish for
@@ -1456,6 +1493,8 @@ elemAt i (Bin _ kx x l r)
 -- @
 -- take n = 'fromDistinctAscList' . 'Prelude.take' n . 'toAscList'
 -- @
+--
+-- @since 0.5.8
 
 take :: Int -> Map k a -> Map k a
 take i m | i >= size m = m
@@ -1476,6 +1515,8 @@ take i0 m0 = go i0 m0
 -- @
 -- drop n = 'fromDistinctAscList' . 'Prelude.drop' n . 'toAscList'
 -- @
+--
+-- @since 0.5.8
 drop :: Int -> Map k a -> Map k a
 drop i m | i >= size m = Tip
 drop i0 m0 = go i0 m0
@@ -1494,6 +1535,8 @@ drop i0 m0 = go i0 m0
 -- @
 -- splitAt !n !xs = ('take' n xs, 'drop' n xs)
 -- @
+--
+-- @since 0.5.8
 splitAt :: Int -> Map k a -> (Map k a, Map k a)
 splitAt i0 m0
   | i0 >= size m0 = (m0, Tip)
@@ -1560,25 +1603,56 @@ deleteAt !i t =
 {--------------------------------------------------------------------
   Minimal, Maximal
 --------------------------------------------------------------------}
+
+lookupMinSure :: k -> a -> Map k a -> (k, a)
+lookupMinSure k a Tip = (k, a)
+lookupMinSure _ _ (Bin _ k a l _) = lookupMinSure k a l
+
+-- | /O(log n)/. The minimal key of the map. Returns 'Nothing' if the map is empty.
+--
+-- > lookupMin (fromList [(5,"a"), (3,"b")]) == Just (3,"b")
+-- > findMin empty = Nothing
+--
+-- @since 0.5.9
+
+lookupMin :: Map k a -> Maybe (k,a)
+lookupMin Tip = Nothing
+lookupMin (Bin _ k x l _) = Just $! lookupMinSure k x l
+
 -- | /O(log n)/. The minimal key of the map. Calls 'error' if the map is empty.
 --
 -- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b")
 -- > findMin empty                            Error: empty map has no minimal element
 
 findMin :: Map k a -> (k,a)
-findMin (Bin _ kx x Tip _)  = (kx,x)
-findMin (Bin _ _  _ l _)    = findMin l
-findMin Tip                 = error "Map.findMin: empty map has no minimal element"
+findMin t
+  | Just r <- lookupMin t = r
+  | otherwise = error "Map.findMin: empty map has no minimal element"
 
 -- | /O(log n)/. The maximal key of the map. Calls 'error' if the map is empty.
 --
 -- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")
 -- > findMax empty                            Error: empty map has no maximal element
 
+lookupMaxSure :: k -> a -> Map k a -> (k, a)
+lookupMaxSure k a Tip = (k, a)
+lookupMaxSure _ _ (Bin _ k a _ r) = lookupMaxSure k a r
+
+-- | /O(log n)/. The maximal key of the map. Returns 'Nothing' if the map is empty.
+--
+-- > lookupMax (fromList [(5,"a"), (3,"b")]) == Just (5,"a")
+-- > lookupMax empty = Nothing
+--
+-- @since 0.5.9
+
+lookupMax :: Map k a -> Maybe (k, a)
+lookupMax Tip = Nothing
+lookupMax (Bin _ k x _ r) = Just $! lookupMaxSure k x r
+
 findMax :: Map k a -> (k,a)
-findMax (Bin _ kx x _ Tip)  = (kx,x)
-findMax (Bin _ _  _ _ r)    = findMax r
-findMax Tip                 = error "Map.findMax: empty map has no maximal element"
+findMax t
+  | Just r <- lookupMax t = r
+  | otherwise = error "Map.findMax: empty map has no maximal element"
 
 -- | /O(log n)/. Delete the minimal key. Returns an empty map if the map is empty.
 --
@@ -1651,7 +1725,13 @@ updateMaxWithKey f (Bin _ kx x l r)    = balanceL kx x l (updateMaxWithKey f r)
 
 minViewWithKey :: Map k a -> Maybe ((k,a), Map k a)
 minViewWithKey Tip = Nothing
-minViewWithKey x   = Just $! deleteFindMin x
+minViewWithKey (Bin _ k x l r) = Just $
+  case minViewSure k x l r of
+    MinView km xm t -> ((km, xm), t)
+-- We inline this to give GHC the best possible chance of getting
+-- rid of the Maybe and pair constructors, as well as the thunk under
+-- the Just.
+{-# INLINE minViewWithKey #-}
 
 -- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and
 -- the map stripped of that element, or 'Nothing' if passed an empty map.
@@ -1661,7 +1741,11 @@ minViewWithKey x   = Just $! deleteFindMin x
 
 maxViewWithKey :: Map k a -> Maybe ((k,a), Map k a)
 maxViewWithKey Tip = Nothing
-maxViewWithKey x   = Just $! deleteFindMax x
+maxViewWithKey (Bin _ k x l r) = Just $
+  case maxViewSure k x l r of
+    MaxView km xm t -> ((km, xm), t)
+-- See note on inlining at minViewWithKey
+{-# INLINE maxViewWithKey #-}
 
 -- | /O(log n)/. Retrieves the value associated with minimal key of the
 -- map, and the map stripped of that element, or 'Nothing' if passed an
@@ -1671,8 +1755,9 @@ maxViewWithKey x   = Just $! deleteFindMax x
 -- > minView empty == Nothing
 
 minView :: Map k a -> Maybe (a, Map k a)
-minView Tip = Nothing
-minView x   = Just $! (first snd $ deleteFindMin x)
+minView t = case minViewWithKey t of
+              Nothing -> Nothing
+              Just ~((_, x), t') -> Just (x, t')
 
 -- | /O(log n)/. Retrieves the value associated with maximal key of the
 -- map, and the map stripped of that element, or 'Nothing' if passed an
@@ -1682,13 +1767,9 @@ minView x   = Just $! (first snd $ deleteFindMin x)
 -- > maxView empty == Nothing
 
 maxView :: Map k a -> Maybe (a, Map k a)
-maxView Tip = Nothing
-maxView x   = Just $! (first snd $ deleteFindMax x)
-
--- Update the 1st component of a tuple (stricter version of
--- Control.Arrow.first)
-first :: (a -> b) -> (a,c) -> (b,c)
-first f (x,y) = (f x, y)
+maxView t = case maxViewWithKey t of
+              Nothing -> Nothing
+              Just ~((_, x), t') -> Just (x, t')
 
 {--------------------------------------------------------------------
   Union.
@@ -1701,9 +1782,9 @@ first f (x,y) = (f x, y)
 -- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])]
 -- >     == fromList [(3, "B3"), (5, "A3"), (7, "C")]
 
-unions :: Ord k => [Map k a] -> Map k a
+unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a
 unions ts
-  = foldlStrict union empty ts
+  = Foldable.foldl' union empty ts
 #if __GLASGOW_HASKELL__
 {-# INLINABLE unions #-}
 #endif
@@ -1714,9 +1795,9 @@ unions ts
 -- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])]
 -- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
 
-unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a
+unionsWith :: (Foldable f, Ord k) => (a->a->a) -> f (Map k a) -> Map k a
 unionsWith f ts
-  = foldlStrict (unionWith f) empty ts
+  = Foldable.foldl' (unionWith f) empty ts
 #if __GLASGOW_HASKELL__
 {-# INLINABLE unionsWith #-}
 #endif
@@ -1790,6 +1871,12 @@ unionWithKey f (Bin _ k1 x1 l1 r1) t2 = case splitLookup k1 t2 of
   Difference
 --------------------------------------------------------------------}
 
+-- We don't currently attempt to use any pointer equality tricks for
+-- 'difference'. To do so, we'd have to match on the first argument
+-- and split the second. Unfortunately, the proof of the time bound
+-- relies on doing it the way we do, and it's not clear whether that
+-- bound holds the other way.
+
 -- | /O(m*log(n\/m + 1)), m <= n/. Difference of two maps.
 -- Return elements of the first map not existing in the second map.
 --
@@ -1809,10 +1896,11 @@ difference t1 (Bin _ k _ l2 r2) = case split k t1 of
 {-# INLINABLE difference #-}
 #endif
 
--- | /O(m*log(n/m + 1)), m <= n/. Remove all keys in a 'Set' from a 'Map'.
+-- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Set' from a 'Map'.
 --
 -- @
--- m `withoutKeys` s = 'filterWithKey' (\k _ -> k `'Set.notMember'` s) m
+-- m `'withoutKeys'` s = 'filterWithKey' (\k _ -> k `'Set.notMember'` s) m
+-- m `'withoutKeys'` s = m `'difference'` 'fromSet' (const ()) s
 -- @
 --
 -- @since 0.5.8
@@ -1889,11 +1977,12 @@ intersection t1@(Bin _ k x l1 r1) t2
 {-# INLINABLE intersection #-}
 #endif
 
--- | /O(m*log(n/m + 1)), m <= n/. Restrict a 'Map' to only those keys
+-- | /O(m*log(n\/m + 1)), m <= n/. Restrict a 'Map' to only those keys
 -- found in a 'Set'.
 --
 -- @
--- m `restrictKeys` s = 'filterWithKey' (\k _ -> k `'Set.member'` s) m
+-- m `'restrictKeys'` s = 'filterWithKey' (\k _ -> k `'Set.member'` s) m
+-- m `'restrictKeys'` s = m `'intersect' 'fromSet' (const ()) s
 -- @
 --
 -- @since 0.5.8
@@ -1975,15 +2064,19 @@ instance Applicative Identity where
 --
 -- A tactic of type @ WhenMissing f k x z @ is an abstract representation
 -- of a function of type @ k -> x -> f (Maybe z) @.
+--
+-- @since 0.5.9
 
 data WhenMissing f k x y = WhenMissing
   { missingSubtree :: Map k x -> f (Map k y)
   , missingKey :: k -> x -> f (Maybe y)}
 
+-- | @since 0.5.9
 instance (Applicative f, Monad f) => Functor (WhenMissing f k x) where
   fmap = mapWhenMissing
   {-# INLINE fmap #-}
 
+-- | @since 0.5.9
 instance (Applicative f, Monad f)
          => Category.Category (WhenMissing f k) where
   id = preserveMissing
@@ -1996,6 +2089,8 @@ instance (Applicative f, Monad f)
   {-# INLINE (.) #-}
 
 -- | Equivalent to @ ReaderT k (ReaderT x (MaybeT f)) @.
+--
+-- @since 0.5.9
 instance (Applicative f, Monad f) => Applicative (WhenMissing f k x) where
   pure x = mapMissing (\ _ _ -> x)
   f <*> g = traverseMaybeMissing $ \k x -> do
@@ -2007,6 +2102,8 @@ instance (Applicative f, Monad f) => Applicative (WhenMissing f k x) where
   {-# INLINE (<*>) #-}
 
 -- | Equivalent to @ ReaderT k (ReaderT x (MaybeT f)) @.
+--
+-- @since 0.5.9
 instance (Applicative f, Monad f) => Monad (WhenMissing f k x) where
 #if !MIN_VERSION_base(4,8,0)
   return = pure
@@ -2019,6 +2116,8 @@ instance (Applicative f, Monad f) => Monad (WhenMissing f k x) where
   {-# INLINE (>>=) #-}
 
 -- | Map covariantly over a @'WhenMissing' f k x@.
+--
+-- @since 0.5.9
 mapWhenMissing :: (Applicative f, Monad f)
                => (a -> b)
                -> WhenMissing f k x a -> WhenMissing f k x b
@@ -2047,6 +2146,8 @@ mapGentlyWhenMatched f t = zipWithMaybeAMatched $
 {-# INLINE mapGentlyWhenMatched #-}
 
 -- | Map contravariantly over a @'WhenMissing' f k _ x@.
+--
+-- @since 0.5.9
 lmapWhenMissing :: (b -> a) -> WhenMissing f k a x -> WhenMissing f k b x
 lmapWhenMissing f t = WhenMissing
   { missingSubtree = \m -> missingSubtree t (fmap f m)
@@ -2054,6 +2155,8 @@ lmapWhenMissing f t = WhenMissing
 {-# INLINE lmapWhenMissing #-}
 
 -- | Map contravariantly over a @'WhenMatched' f k _ y z@.
+--
+-- @since 0.5.9
 contramapFirstWhenMatched :: (b -> a)
                           -> WhenMatched f k a y z
                           -> WhenMatched f k b y z
@@ -2062,6 +2165,8 @@ contramapFirstWhenMatched f t = WhenMatched $
 {-# INLINE contramapFirstWhenMatched #-}
 
 -- | Map contravariantly over a @'WhenMatched' f k x _ z@.
+--
+-- @since 0.5.9
 contramapSecondWhenMatched :: (b -> a)
                            -> WhenMatched f k x a z
                            -> WhenMatched f k x b z
@@ -2074,6 +2179,8 @@ contramapSecondWhenMatched f t = WhenMatched $
 --
 -- A tactic of type @ SimpleWhenMissing k x z @ is an abstract representation
 -- of a function of type @ k -> x -> Maybe z @.
+--
+-- @since 0.5.9
 type SimpleWhenMissing = WhenMissing Identity
 
 -- | A tactic for dealing with keys present in both
@@ -2081,25 +2188,33 @@ type SimpleWhenMissing = WhenMissing Identity
 --
 -- A tactic of type @ WhenMatched f k x y z @ is an abstract representation
 -- of a function of type @ k -> x -> y -> f (Maybe z) @.
+--
+-- @since 0.5.9
 newtype WhenMatched f k x y z = WhenMatched
   { matchedKey :: k -> x -> y -> f (Maybe z) }
 
 -- | Along with zipWithMaybeAMatched, witnesses the isomorphism between
 -- @WhenMatched f k x y z@ and @k -> x -> y -> f (Maybe z)@.
+--
+-- @since 0.5.9
 runWhenMatched :: WhenMatched f k x y z -> k -> x -> y -> f (Maybe z)
 runWhenMatched = matchedKey
 {-# INLINE runWhenMatched #-}
 
 -- | Along with traverseMaybeMissing, witnesses the isomorphism between
 -- @WhenMissing f k x y@ and @k -> x -> f (Maybe y)@.
+--
+-- @since 0.5.9
 runWhenMissing :: WhenMissing f k x y -> k -> x -> f (Maybe y)
 runWhenMissing = missingKey
 {-# INLINE runWhenMissing #-}
 
+-- | @since 0.5.9
 instance Functor f => Functor (WhenMatched f k x y) where
   fmap = mapWhenMatched
   {-# INLINE fmap #-}
 
+-- | @since 0.5.9
 instance (Monad f, Applicative f) => Category.Category (WhenMatched f k x) where
   id = zipWithMatched (\_ _ y -> y)
   f . g = zipWithMaybeAMatched $
@@ -2112,6 +2227,8 @@ instance (Monad f, Applicative f) => Category.Category (WhenMatched f k x) where
   {-# INLINE (.) #-}
 
 -- | Equivalent to @ ReaderT k (ReaderT x (ReaderT y (MaybeT f))) @
+--
+-- @since 0.5.9
 instance (Monad f, Applicative f) => Applicative (WhenMatched f k x y) where
   pure x = zipWithMatched (\_ _ _ -> x)
   fs <*> xs = zipWithMaybeAMatched $ \k x y -> do
@@ -2123,6 +2240,8 @@ instance (Monad f, Applicative f) => Applicative (WhenMatched f k x y) where
   {-# INLINE (<*>) #-}
 
 -- | Equivalent to @ ReaderT k (ReaderT x (ReaderT y (MaybeT f))) @
+--
+-- @since 0.5.9
 instance (Monad f, Applicative f) => Monad (WhenMatched f k x y) where
 #if !MIN_VERSION_base(4,8,0)
   return = pure
@@ -2135,6 +2254,8 @@ instance (Monad f, Applicative f) => Monad (WhenMatched f k x y) where
   {-# INLINE (>>=) #-}
 
 -- | Map covariantly over a @'WhenMatched' f k x y@.
+--
+-- @since 0.5.9
 mapWhenMatched :: Functor f
                => (a -> b)
                -> WhenMatched f k x y a
@@ -2146,6 +2267,8 @@ mapWhenMatched f (WhenMatched g) = WhenMatched $ \k x y -> fmap (fmap f) (g k x
 --
 -- A tactic of type @ SimpleWhenMatched k x y z @ is an abstract representation
 -- of a function of type @ k -> x -> y -> Maybe z @.
+--
+-- @since 0.5.9
 type SimpleWhenMatched = WhenMatched Identity
 
 -- | When a key is found in both maps, apply a function to the
@@ -2155,6 +2278,8 @@ type SimpleWhenMatched = WhenMatched Identity
 -- zipWithMatched :: (k -> x -> y -> z)
 --                -> SimpleWhenMatched k x y z
 -- @
+--
+-- @since 0.5.9
 zipWithMatched :: Applicative f
                => (k -> x -> y -> z)
                -> WhenMatched f k x y z
@@ -2163,6 +2288,8 @@ zipWithMatched f = WhenMatched $ \ k x y -> pure . Just $ f k x y
 
 -- | When a key is found in both maps, apply a function to the
 -- key and values to produce an action and use its result in the merged map.
+--
+-- @since 0.5.9
 zipWithAMatched :: Applicative f
                 => (k -> x -> y -> f z)
                 -> WhenMatched f k x y z
@@ -2176,6 +2303,8 @@ zipWithAMatched f = WhenMatched $ \ k x y -> Just <$> f k x y
 -- zipWithMaybeMatched :: (k -> x -> y -> Maybe z)
 --                     -> SimpleWhenMatched k x y z
 -- @
+--
+-- @since 0.5.9
 zipWithMaybeMatched :: Applicative f
                     => (k -> x -> y -> Maybe z)
                     -> WhenMatched f k x y z
@@ -2185,8 +2314,10 @@ zipWithMaybeMatched f = WhenMatched $ \ k x y -> pure $ f k x y
 -- | When a key is found in both maps, apply a function to the
 -- key and values, perform the resulting action, and maybe use
 -- the result in the merged map.
--- 
+--
 -- This is the fundamental 'WhenMatched' tactic.
+--
+-- @since 0.5.9
 zipWithMaybeAMatched :: (k -> x -> y -> f (Maybe z))
                      -> WhenMatched f k x y z
 zipWithMaybeAMatched f = WhenMatched $ \ k x y -> f k x y
@@ -2202,6 +2333,8 @@ zipWithMaybeAMatched f = WhenMatched $ \ k x y -> f k x y
 -- prop> dropMissing = mapMaybeMissing (\_ _ -> Nothing)
 --
 -- but @dropMissing@ is much faster.
+--
+-- @since 0.5.9
 dropMissing :: Applicative f => WhenMissing f k x y
 dropMissing = WhenMissing
   { missingSubtree = const (pure Tip)
@@ -2215,9 +2348,11 @@ dropMissing = WhenMissing
 -- preserveMissing :: SimpleWhenMissing k x x
 -- @
 --
--- prop> preserveMissing = Lazy.Merge.mapMaybeMissing (\_ x -> Just x)
+-- prop> preserveMissing = Merge.Lazy.mapMaybeMissing (\_ x -> Just x)
 --
 -- but @preserveMissing@ is much faster.
+--
+-- @since 0.5.9
 preserveMissing :: Applicative f => WhenMissing f k x x
 preserveMissing = WhenMissing
   { missingSubtree = pure
@@ -2233,6 +2368,8 @@ preserveMissing = WhenMissing
 -- prop> mapMissing f = mapMaybeMissing (\k x -> Just $ f k x)
 --
 -- but @mapMissing@ is somewhat faster.
+--
+-- @since 0.5.9
 mapMissing :: Applicative f => (k -> x -> y) -> WhenMissing f k x y
 mapMissing f = WhenMissing
   { missingSubtree = \m -> pure $! mapWithKey f m
@@ -2250,6 +2387,8 @@ mapMissing f = WhenMissing
 -- prop> mapMaybeMissing f = traverseMaybeMissing (\k x -> pure (f k x))
 --
 -- but @mapMaybeMissing@ uses fewer unnecessary 'Applicative' operations.
+--
+-- @since 0.5.9
 mapMaybeMissing :: Applicative f => (k -> x -> Maybe y) -> WhenMissing f k x y
 mapMaybeMissing f = WhenMissing
   { missingSubtree = \m -> pure $! mapMaybeWithKey f m
@@ -2262,9 +2401,11 @@ mapMaybeMissing f = WhenMissing
 -- filterMissing :: (k -> x -> Bool) -> SimpleWhenMissing k x x
 -- @
 --
--- prop> filterMissing f = Lazy.Merge.mapMaybeMissing $ \k x -> guard (f k x) *> Just x
+-- prop> filterMissing f = Merge.Lazy.mapMaybeMissing $ \k x -> guard (f k x) *> Just x
 --
 -- but this should be a little faster.
+--
+-- @since 0.5.9
 filterMissing :: Applicative f
               => (k -> x -> Bool) -> WhenMissing f k x x
 filterMissing f = WhenMissing
@@ -2276,11 +2417,13 @@ filterMissing f = WhenMissing
 -- using some 'Applicative' action.
 --
 -- @
--- filterAMissing f = Lazy.Merge.traverseMaybeMissing $
+-- filterAMissing f = Merge.Lazy.traverseMaybeMissing $
 --   \k x -> (\b -> guard b *> Just x) <$> f k x
 -- @
 --
 -- but this should be a little faster.
+--
+-- @since 0.5.9
 filterAMissing :: Applicative f
               => (k -> x -> f Bool) -> WhenMissing f k x x
 filterAMissing f = WhenMissing
@@ -2294,6 +2437,8 @@ bool f _ False = f
 bool _ t True  = t
 
 -- | Traverse over the entries whose keys are missing from the other map.
+--
+-- @since 0.5.9
 traverseMissing :: Applicative f
                     => (k -> x -> f y) -> WhenMissing f k x y
 traverseMissing f = WhenMissing
@@ -2305,6 +2450,8 @@ traverseMissing f = WhenMissing
 -- optionally producing values to put in the result.
 -- This is the most powerful 'WhenMissing' tactic, but others are usually
 -- more efficient.
+--
+-- @since 0.5.9
 traverseMaybeMissing :: Applicative f
                       => (k -> x -> f (Maybe y)) -> WhenMissing f k x y
 traverseMaybeMissing f = WhenMissing
@@ -2381,7 +2528,7 @@ traverseMaybeMissing f = WhenMissing
 -- prop> symmetricDifference = merge diffPreserve diffPreserve (\ _ _ _ -> Nothing)
 -- prop> mapEachPiece f g h = merge (diffMapWithKey f) (diffMapWithKey g)
 --
--- @since 0.5.8
+-- @since 0.5.9
 merge :: Ord k
              => SimpleWhenMissing k a c -- ^ What to do with keys in @m1@ but not @m2@
              -> SimpleWhenMissing k b c -- ^ What to do with keys in @m2@ but not @m1@
@@ -2455,24 +2602,28 @@ merge g1 g2 f m1 m2 = runIdentity $
 -- site. To prevent excessive inlining, you should generally only use
 -- 'mergeA' to define custom combining functions.
 --
--- @since 0.5.8
-mergeA :: (Applicative f, Ord k)
-              => WhenMissing f k a c -- ^ What to do with keys in @m1@ but not @m2@
-              -> WhenMissing f k b c -- ^ What to do with keys in @m2@ but not @m1@
-              -> WhenMatched f k a b c -- ^ What to do with keys in both @m1@ and @m2@
-              -> Map k a -- ^ Map @m1@
-              -> Map k b -- ^ Map @m2@
-              -> f (Map k c)
-mergeA g1 WhenMissing{missingSubtree = g2} (WhenMatched f) = go
+-- @since 0.5.9
+mergeA
+  :: (Applicative f, Ord k)
+  => WhenMissing f k a c -- ^ What to do with keys in @m1@ but not @m2@
+  -> WhenMissing f k b c -- ^ What to do with keys in @m2@ but not @m1@
+  -> WhenMatched f k a b c -- ^ What to do with keys in both @m1@ and @m2@
+  -> Map k a -- ^ Map @m1@
+  -> Map k b -- ^ Map @m2@
+  -> f (Map k c)
+mergeA
+    WhenMissing{missingSubtree = g1t, missingKey = g1k}
+    WhenMissing{missingSubtree = g2t}
+    (WhenMatched f) = go
   where
-    go t1 Tip = missingSubtree g1 t1
-    go Tip t2 = g2 t2
+    go t1 Tip = g1t t1
+    go Tip t2 = g2t t2
     go (Bin _ kx x1 l1 r1) t2 = case splitLookup kx t2 of
       (l2, mx2, r2) -> case mx2 of
-          Nothing -> (\l' mx' r' -> maybe link2 (link kx) mx' l' r')
-                        <$> l1l2 <*> missingKey g1 kx x1 <*> r1r2
-          Just x2 -> (\l' mx' r' -> maybe link2 (link kx) mx' l' r')
-                        <$> l1l2 <*> f kx x1 x2 <*> r1r2
+          Nothing -> liftA3 (\l' mx' r' -> maybe link2 (link kx) mx' l' r')
+                        l1l2 (g1k kx x1) r1r2
+          Just x2 -> liftA3 (\l' mx' r' -> maybe link2 (link kx) mx' l' r')
+                        l1l2 (f kx x1 x2) r1r2
         where
           !l1l2 = go l1 l2
           !r1r2 = go r1 r2
@@ -2543,7 +2694,7 @@ mergeWithKey f g1 g2 = go
 {--------------------------------------------------------------------
   Submap
 --------------------------------------------------------------------}
--- | /O(m*log(n/m + 1)), m <= n/.
+-- | /O(m*log(n\/m + 1)), m <= n/.
 -- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
 --
 isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
@@ -2552,7 +2703,7 @@ isSubmapOf m1 m2 = isSubmapOfBy (==) m1 m2
 {-# INLINABLE isSubmapOf #-}
 #endif
 
-{- | /O(m*log(n/m + 1)), m <= n/.
+{- | /O(m*log(n\/m + 1)), m <= n/.
  The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
  all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when
  applied to their respective values. For example, the following
@@ -2590,7 +2741,7 @@ submap' f (Bin _ kx x l r) t
 {-# INLINABLE submap' #-}
 #endif
 
--- | /O(m*log(n/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).
+-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).
 -- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
 isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
 isProperSubmapOf m1 m2
@@ -2599,7 +2750,7 @@ isProperSubmapOf m1 m2
 {-# INLINABLE isProperSubmapOf #-}
 #endif
 
-{- | /O(m*log(n/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).
+{- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap but not equal).
  The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
  @m1@ and @m2@ are not equal,
  all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
@@ -2656,7 +2807,7 @@ filterWithKey p t@(Bin _ kx x l r)
 filterWithKeyA :: Applicative f => (k -> a -> f Bool) -> Map k a -> f (Map k a)
 filterWithKeyA _ Tip = pure Tip
 filterWithKeyA p t@(Bin _ kx x l r) =
-  combine <$> p kx x <*> filterWithKeyA p l <*> filterWithKeyA p r
+  liftA3 combine (p kx x) (filterWithKeyA p l) (filterWithKeyA p r)
   where
     combine True pl pr
       | pl `ptrEq` l && pr `ptrEq` r = t
@@ -2671,6 +2822,8 @@ filterWithKeyA p t@(Bin _ kx x l r) =
 -- takeWhileAntitone p = 'fromDistinctAscList' . 'Data.List.takeWhile' (p . fst) . 'toList'
 -- takeWhileAntitone p = 'filterWithKey' (\k _ -> p k)
 -- @
+--
+-- @since 0.5.8
 
 takeWhileAntitone :: (k -> Bool) -> Map k a -> Map k a
 takeWhileAntitone _ Tip = Tip
@@ -2686,6 +2839,8 @@ takeWhileAntitone p (Bin _ kx x l r)
 -- dropWhileAntitone p = 'fromDistinctAscList' . 'Data.List.dropWhile' (p . fst) . 'toList'
 -- dropWhileAntitone p = 'filterWithKey' (\k -> not (p k))
 -- @
+--
+-- @since 0.5.8
 
 dropWhileAntitone :: (k -> Bool) -> Map k a -> Map k a
 dropWhileAntitone _ Tip = Tip
@@ -2706,6 +2861,8 @@ dropWhileAntitone p (Bin _ kx x l r)
 -- at some /unspecified/ point where the predicate switches from holding to not
 -- holding (where the predicate is seen to hold before the first key and to fail
 -- after the last key).
+--
+-- @since 0.5.8
 
 spanAntitone :: (k -> Bool) -> Map k a -> (Map k a, Map k a)
 spanAntitone p0 m = toPair (go p0 m)
@@ -2771,14 +2928,15 @@ mapMaybeWithKey f (Bin _ kx x l r) = case f kx x of
   Nothing -> link2 (mapMaybeWithKey f l) (mapMaybeWithKey f r)
 
 -- | /O(n)/. Traverse keys\/values and collect the 'Just' results.
-
+--
+-- @since 0.5.8
 traverseMaybeWithKey :: Applicative f
                      => (k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
 traverseMaybeWithKey = go
   where
     go _ Tip = pure Tip
     go f (Bin _ kx x Tip Tip) = maybe Tip (\x' -> Bin 1 kx x' Tip Tip) <$> f kx x
-    go f (Bin _ kx x l r) = combine <$> go f l <*> f kx x <*> go f r
+    go f (Bin _ kx x l r) = liftA3 combine (go f l) (f kx x) (go f r)
       where
         combine !l' mx !r' = case mx of
           Nothing -> link2 l' r'
@@ -2878,7 +3036,7 @@ traverseWithKey f = go
   where
     go Tip = pure Tip
     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
+    go (Bin s k v l r) = liftA3 (flip (Bin s k)) (go l) (f k v) (go r)
 {-# INLINE traverseWithKey #-}
 
 -- | /O(n)/. The function 'mapAccum' threads an accumulating
@@ -2943,7 +3101,8 @@ mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []
 --
 -- The size of the result may be smaller if @f@ maps two or more distinct
 -- keys to the same new key.  In this case the associated values will be
--- combined using @c@.
+-- combined using @c@. The value at the greater of the two original keys
+-- is used as the first argument to @c@.
 --
 -- > mapKeysWith (++) (\ _ -> 1) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 1 "cdab"
 -- > mapKeysWith (++) (\ _ -> 3) (fromList [(1,"b"), (2,"a"), (3,"d"), (4,"c")]) == singleton 3 "cdab"
@@ -3093,6 +3252,8 @@ foldlWithKey' f z = go z
 -- @'foldMapWithKey' f = 'Prelude.fold' . 'mapWithKey' f@
 --
 -- This can be an asymptotically faster than 'foldrWithKey' or 'foldlWithKey' for some monoids.
+--
+-- @since 0.5.4
 foldMapWithKey :: Monoid m => (k -> a -> m) -> Map k a -> m
 foldMapWithKey f = go
   where
@@ -3157,6 +3318,7 @@ fromSet f (Set.Bin sz x l r) = Bin sz x (f x) (fromSet f l) (fromSet f r)
   use [foldlStrict] to reduce demand on the control-stack
 --------------------------------------------------------------------}
 #if __GLASGOW_HASKELL__ >= 708
+-- | @since 0.5.6.2
 instance (Ord k) => GHCExts.IsList (Map k v) where
   type Item (Map k v) = (k,v)
   fromList = fromList
@@ -3186,7 +3348,7 @@ fromList ((kx0, x0) : xs0) | not_ordered kx0 xs0 = fromList' (Bin 1 kx0 x0 Tip T
     not_ordered kx ((ky,_) : _) = kx >= ky
     {-# INLINE not_ordered #-}
 
-    fromList' t0 xs = foldlStrict ins t0 xs
+    fromList' t0 xs = Foldable.foldl' ins t0 xs
       where ins t (k,x) = insert k x t
 
     go !_ t [] = t
@@ -3235,7 +3397,7 @@ fromListWith f xs
 
 fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
 fromListWithKey f xs
-  = foldlStrict ins empty xs
+  = Foldable.foldl' ins empty xs
   where
     ins t (k,x) = insertWithKey f k x t
 #if __GLASGOW_HASKELL__
@@ -3318,7 +3480,19 @@ foldlFB = foldlWithKey
 
 fromAscList :: Eq k => [(k,a)] -> Map k a
 fromAscList xs
-  = fromAscListWithKey (\_ x _ -> x) xs
+  = fromDistinctAscList (combineEq xs)
+  where
+  -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
+  combineEq xs'
+    = case xs' of
+        []     -> []
+        [x]    -> [x]
+        (x:xx) -> combineEq' x xx
+
+  combineEq' z [] = [z]
+  combineEq' z@(kz,_) (x@(kx,xx):xs')
+    | kx==kz    = combineEq' (kx,xx) xs'
+    | otherwise = z:combineEq' x xs'
 #if __GLASGOW_HASKELL__
 {-# INLINABLE fromAscList #-}
 #endif
@@ -3330,10 +3504,23 @@ fromAscList xs
 -- > fromDescList [(5,"a"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "b")]
 -- > valid (fromDescList [(5,"a"), (5,"b"), (3,"b")]) == True
 -- > valid (fromDescList [(5,"a"), (3,"b"), (5,"b")]) == False
+--
+-- @since 0.5.8
 
 fromDescList :: Eq k => [(k,a)] -> Map k a
-fromDescList xs
-  = fromDescListWithKey (\_ x _ -> x) xs
+fromDescList xs = fromDistinctDescList (combineEq xs)
+  where
+  -- [combineEq f xs] combines equal elements with function [f] in an ordered list [xs]
+  combineEq xs'
+    = case xs' of
+        []     -> []
+        [x]    -> [x]
+        (x:xx) -> combineEq' x xx
+
+  combineEq' z [] = [z]
+  combineEq' z@(kz,_) (x@(kx,xx):xs')
+    | kx==kz    = combineEq' (kx,xx) xs'
+    | otherwise = z:combineEq' x xs'
 #if __GLASGOW_HASKELL__
 {-# INLINABLE fromDescList #-}
 #endif
@@ -3358,6 +3545,8 @@ fromAscListWith f xs
 -- > fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")] == fromList [(3, "b"), (5, "ba")]
 -- > valid (fromDescListWith (++) [(5,"a"), (5,"b"), (3,"b")]) == True
 -- > valid (fromDescListWith (++) [(5,"a"), (3,"b"), (5,"b")]) == False
+--
+-- @since 0.5.8
 
 fromDescListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
 fromDescListWith f xs
@@ -3437,15 +3626,16 @@ fromDistinctAscList ((kx0, x0) : xs0) = go (1::Int) (Bin 1 kx0 x0 Tip Tip) xs0
   where
     go !_ t [] = t
     go s l ((kx, x) : xs) = case create s xs of
-                              (r, ys) -> go (s `shiftL` 1) (link kx x l r) ys
+                                (r :*: ys) -> let !t' = link kx x l r
+                                              in go (s `shiftL` 1) t' ys
 
-    create !_ [] = (Tip, [])
+    create !_ [] = (Tip :*: [])
     create s xs@(x' : xs')
-      | s == 1 = case x' of (kx, x) -> (Bin 1 kx x Tip Tip, xs')
+      | s == 1 = case x' of (kx, x) -> (Bin 1 kx x Tip Tip :*: xs')
       | otherwise = case create (s `shiftR` 1) xs of
-                      res@(_, []) -> res
-                      (l, (ky, y):ys) -> case create (s `shiftR` 1) ys of
-                        (r, zs) -> (link ky y l r, zs)
+                      res@(_ :*: []) -> res
+                      (l :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of
+                        (r :*: zs) -> (link ky y l r :*: zs)
 
 -- | /O(n)/. Build a map from a descending list of distinct elements in linear time.
 -- /The precondition is not checked./
@@ -3453,6 +3643,8 @@ fromDistinctAscList ((kx0, x0) : xs0) = go (1::Int) (Bin 1 kx0 x0 Tip Tip) xs0
 -- > fromDistinctDescList [(5,"a"), (3,"b")] == fromList [(3, "b"), (5, "a")]
 -- > valid (fromDistinctDescList [(5,"a"), (3,"b")])          == True
 -- > valid (fromDistinctDescList [(5,"a"), (5,"b"), (3,"b")]) == False
+--
+-- @since 0.5.8
 
 -- For some reason, when 'singleton' is used in fromDistinctDescList or in
 -- create, it is not inlined, so we inline it manually.
@@ -3462,15 +3654,16 @@ fromDistinctDescList ((kx0, x0) : xs0) = go (1 :: Int) (Bin 1 kx0 x0 Tip Tip) xs
   where
      go !_ t [] = t
      go s r ((kx, x) : xs) = case create s xs of
-                               (l, ys) -> go (s `shiftL` 1) (link kx x l r) ys
+                               (l :*: ys) -> let !t' = link kx x l r
+                                             in go (s `shiftL` 1) t' ys
 
-     create !_ [] = (Tip, [])
+     create !_ [] = (Tip :*: [])
      create s xs@(x' : xs')
-       | s == 1 = case x' of (kx, x) -> (Bin 1 kx x Tip Tip, xs')
+       | s == 1 = case x' of (kx, x) -> (Bin 1 kx x Tip Tip :*: xs')
        | otherwise = case create (s `shiftR` 1) xs of
-                       res@(_, []) -> res
-                       (r, (ky, y):ys) -> case create (s `shiftR` 1) ys of
-                         (l, zs) -> (link ky y l r, zs)
+                       res@(_ :*: []) -> res
+                       (r :*: (ky, y):ys) -> case create (s `shiftR` 1) ys of
+                         (l :*: zs) -> (link ky y l r :*: zs)
 
 {-
 -- Functions very similar to these were used to implement
@@ -3651,10 +3844,30 @@ link2 l@(Bin sizeL kx x lx rx) r@(Bin sizeR ky y ly ry)
 glue :: Map k a -> Map k a -> Map k a
 glue Tip r = r
 glue l Tip = l
-glue l r
-  | size l > size r = let ((km,m),l') = deleteFindMax l in balanceR km m l' r
-  | otherwise       = let ((km,m),r') = deleteFindMin r in balanceL km m l r'
+glue l@(Bin sl kl xl ll lr) r@(Bin sr kr xr rl rr)
+  | sl > sr = let !(MaxView km m l') = maxViewSure kl xl ll lr in balanceR km m l' r
+  | otherwise = let !(MinView km m r') = minViewSure kr xr rl rr in balanceL km m l r'
+
+data MinView k a = MinView !k a !(Map k a)
+data MaxView k a = MaxView !k a !(Map k a)
 
+minViewSure :: k -> a -> Map k a -> Map k a -> MinView k a
+minViewSure = go
+  where
+    go k x Tip r = MinView k x r
+    go k x (Bin _ kl xl ll lr) r =
+      case go kl xl ll lr of
+        MinView km xm l' -> MinView km xm (balanceR k x l' r)
+{-# NOINLINE minViewSure #-}
+
+maxViewSure :: k -> a -> Map k a -> Map k a -> MaxView k a
+maxViewSure = go
+  where
+    go k x l Tip = MaxView k x l
+    go k x l (Bin _ kr xr rl rr) =
+      case go kr xr rl rr of
+        MaxView km xm r' -> MaxView km xm (balanceL k x l r')
+{-# NOINLINE maxViewSure #-}
 
 -- | /O(log n)/. Delete and find the minimal element.
 --
@@ -3662,13 +3875,9 @@ glue l r
 -- > deleteFindMin                                            Error: can not return the minimal element of an empty map
 
 deleteFindMin :: Map k a -> ((k,a),Map k a)
-deleteFindMin t
-  = case t of
-      Bin _ k x Tip r -> ((k,x),r)
-      Bin _ k x l r   -> let !(km,l') = deleteFindMin l
-                             !t' = balanceR k x l' r
-                         in (km, t')
-      Tip             -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
+deleteFindMin t = case minViewWithKey t of
+  Nothing -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
+  Just res -> res
 
 -- | /O(log n)/. Delete and find the maximal element.
 --
@@ -3676,14 +3885,9 @@ deleteFindMin t
 -- > deleteFindMax empty                                      Error: can not return the maximal element of an empty map
 
 deleteFindMax :: Map k a -> ((k,a),Map k a)
-deleteFindMax t
-  = case t of
-      Bin _ k x l Tip -> ((k,x),l)
-      Bin _ k x l r   -> let !(km,r') = deleteFindMax r
-                             !t' = balanceL k x l r'
-                         in (km, t')
-      Tip             -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
-
+deleteFindMax t = case maxViewWithKey t of
+  Nothing -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
+  Just res -> res
 
 {--------------------------------------------------------------------
   [balance l x r] balances two trees with value x.
@@ -3865,6 +4069,50 @@ instance (Eq k,Eq a) => Eq (Map k a) where
 instance (Ord k, Ord v) => Ord (Map k v) where
     compare m1 m2 = compare (toAscList m1) (toAscList m2)
 
+#if MIN_VERSION_base(4,9,0)
+{--------------------------------------------------------------------
+  Lifted instances
+--------------------------------------------------------------------}
+
+-- | @since 0.5.9
+instance Eq2 Map where
+    liftEq2 eqk eqv m n =
+        size m == size n && liftEq (liftEq2 eqk eqv) (toList m) (toList n)
+
+-- | @since 0.5.9
+instance Eq k => Eq1 (Map k) where
+    liftEq = liftEq2 (==)
+
+-- | @since 0.5.9
+instance Ord2 Map where
+    liftCompare2 cmpk cmpv m n =
+        liftCompare (liftCompare2 cmpk cmpv) (toList m) (toList n)
+
+-- | @since 0.5.9
+instance Ord k => Ord1 (Map k) where
+    liftCompare = liftCompare2 compare
+
+-- | @since 0.5.9
+instance Show2 Map where
+    liftShowsPrec2 spk slk spv slv d m =
+        showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m)
+      where
+        sp = liftShowsPrec2 spk slk spv slv
+        sl = liftShowList2 spk slk spv slv
+
+-- | @since 0.5.9
+instance Show k => Show1 (Map k) where
+    liftShowsPrec = liftShowsPrec2 showsPrec showList
+
+-- | @since 0.5.9
+instance (Ord k, Read k) => Read1 (Map k) where
+    liftReadsPrec rp rl = readsData $
+        readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList
+      where
+        rp' = liftReadsPrec rp rl
+        rl' = liftReadList rp rl
+#endif
+
 {--------------------------------------------------------------------
   Functor
 --------------------------------------------------------------------}
@@ -3913,14 +4161,14 @@ instance Foldable.Foldable (Map k) where
           go x (Bin _ _ v l r) = x == v || go x l || go x r
   {-# INLINABLE elem #-}
   maximum = start
-    where start Tip = error "Map.Foldable.maximum: called with empty map"
+    where start Tip = error "Data.Foldable.maximum (for Data.Map): empty map"
           start (Bin _ _ v l r) = go (go v l) r
 
           go !m Tip = m
           go m (Bin _ _ v l r) = go (go (max m v) l) r
   {-# INLINABLE maximum #-}
   minimum = start
-    where start Tip = error "Map.Foldable.minumum: called with empty map"
+    where start Tip = error "Data.Foldable.minimum (for Data.Map): empty map"
           start (Bin _ _ v l r) = go (go v l) r
 
           go !m Tip = m
@@ -3961,102 +4209,6 @@ instance (Show k, Show a) => Show (Map k a) where
   showsPrec d m  = showParen (d > 10) $
     showString "fromList " . shows (toList m)
 
--- | /O(n)/. Show the tree that implements the map. The tree is shown
--- in a compressed, hanging format. See 'showTreeWith'.
-{-# DEPRECATED showTree "This function is being removed from the public API." #-}
-showTree :: (Show k,Show a) => Map k a -> String
-showTree m
-  = showTreeWith showElem True False m
-  where
-    showElem k x  = show k ++ ":=" ++ show x
-
-
-{- | /O(n)/. The expression (@'showTreeWith' showelem hang wide map@) shows
- the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is
- 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If
- @wide@ is 'True', an extra wide version is shown.
-
->  Map> let t = fromDistinctAscList [(x,()) | x <- [1..5]]
->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True False t
->  (4,())
->  +--(2,())
->  |  +--(1,())
->  |  +--(3,())
->  +--(5,())
->
->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True True t
->  (4,())
->  |
->  +--(2,())
->  |  |
->  |  +--(1,())
->  |  |
->  |  +--(3,())
->  |
->  +--(5,())
->
->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) False True t
->  +--(5,())
->  |
->  (4,())
->  |
->  |  +--(3,())
->  |  |
->  +--(2,())
->     |
->     +--(1,())
-
--}
-{-# DEPRECATED showTreeWith "This function is being removed from the public API." #-}
-showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String
-showTreeWith showelem hang wide t
-  | hang      = (showsTreeHang showelem wide [] t) ""
-  | otherwise = (showsTree showelem wide [] [] t) ""
-
-showsTree :: (k -> a -> String) -> Bool -> [String] -> [String] -> Map k a -> ShowS
-showsTree showelem wide lbars rbars t
-  = case t of
-      Tip -> showsBars lbars . showString "|\n"
-      Bin _ kx x Tip Tip
-          -> showsBars lbars . showString (showelem kx x) . showString "\n"
-      Bin _ kx x l r
-          -> showsTree showelem wide (withBar rbars) (withEmpty rbars) r .
-             showWide wide rbars .
-             showsBars lbars . showString (showelem kx x) . showString "\n" .
-             showWide wide lbars .
-             showsTree showelem wide (withEmpty lbars) (withBar lbars) l
-
-showsTreeHang :: (k -> a -> String) -> Bool -> [String] -> Map k a -> ShowS
-showsTreeHang showelem wide bars t
-  = case t of
-      Tip -> showsBars bars . showString "|\n"
-      Bin _ kx x Tip Tip
-          -> showsBars bars . showString (showelem kx x) . showString "\n"
-      Bin _ kx x l r
-          -> showsBars bars . showString (showelem kx x) . showString "\n" .
-             showWide wide bars .
-             showsTreeHang showelem wide (withBar bars) l .
-             showWide wide bars .
-             showsTreeHang showelem wide (withEmpty bars) r
-
-showWide :: Bool -> [String] -> String -> String
-showWide wide bars
-  | wide      = showString (concat (reverse bars)) . showString "|\n"
-  | otherwise = id
-
-showsBars :: [String] -> ShowS
-showsBars bars
-  = case bars of
-      [] -> id
-      _  -> showString (concat (reverse (tail bars))) . showString node
-
-node :: String
-node           = "+--"
-
-withBar, withEmpty :: [String] -> [String]
-withBar bars   = "|  ":bars
-withEmpty bars = "   ":bars
-
 {--------------------------------------------------------------------
   Typeable
 --------------------------------------------------------------------}
@@ -4064,46 +4216,6 @@ withEmpty bars = "   ":bars
 INSTANCE_TYPEABLE2(Map)
 
 {--------------------------------------------------------------------
-  Assertions
---------------------------------------------------------------------}
--- | /O(n)/. Test if the internal map structure is valid.
---
--- > valid (fromAscList [(3,"b"), (5,"a")]) == True
--- > valid (fromAscList [(5,"a"), (3,"b")]) == False
-
-valid :: Ord k => Map k a -> Bool
-valid t
-  = balanced t && ordered t && validsize t
-
-ordered :: Ord a => Map a b -> Bool
-ordered t
-  = bounded (const True) (const True) t
-  where
-    bounded lo hi t'
-      = case t' of
-          Tip              -> True
-          Bin _ kx _ l r  -> (lo kx) && (hi kx) && bounded lo (<kx) l && bounded (>kx) hi r
-
--- | Exported only for "Debug.QuickCheck"
-balanced :: Map k a -> Bool
-balanced t
-  = case t of
-      Tip            -> True
-      Bin _ _ _ l r  -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&
-                        balanced l && balanced r
-
-validsize :: Map a b -> Bool
-validsize t
-  = (realsize t == Just (size t))
-  where
-    realsize t'
-      = case t' of
-          Tip            -> Just 0
-          Bin sz _ _ l r -> case (realsize l,realsize r) of
-                            (Just n,Just m)  | n+m+1 == sz  -> Just sz
-                            _                               -> Nothing
-
-{--------------------------------------------------------------------
   Utilities
 --------------------------------------------------------------------}
 
@@ -4125,6 +4237,8 @@ validsize t
 --  Note that the current implementation does not return more than three submaps,
 --  but you should not depend on this behaviour because it can change in the
 --  future without notice.
+--
+-- @since 0.5.4
 splitRoot :: Map k b -> [Map k b]
 splitRoot orig =
   case orig of