diff --git a/Data/Graph.hs b/Data/Graph.hs
--- a/Data/Graph.hs
+++ b/Data/Graph.hs
@@ -80,8 +80,8 @@
 import Data.Tree (Tree(Node), Forest)
 
 -- std interfaces
-#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
+#if !MIN_VERSION_base(4,8,0)
 import qualified Data.Foldable as F
 import Data.Traversable
 #else
@@ -157,7 +157,7 @@
   traverse f (AcyclicSCC vertex) = AcyclicSCC <$> f vertex
   traverse _f (CyclicSCC []) = pure (CyclicSCC [])
   traverse f (CyclicSCC (x : xs)) =
-    (\x' xs' -> CyclicSCC (x' : xs')) <$> f x <*> traverse f xs
+    liftA2 (\x' xs' -> CyclicSCC (x' : xs')) (f x) (traverse f xs)
 
 instance NFData a => NFData (SCC a) where
     rnf (AcyclicSCC v) = rnf v
diff --git a/Data/IntMap/Internal.hs b/Data/IntMap/Internal.hs
--- a/Data/IntMap/Internal.hs
+++ b/Data/IntMap/Internal.hs
@@ -281,8 +281,9 @@
 
 #if MIN_VERSION_base(4,8,0)
 import Data.Functor.Identity (Identity (..))
+import Control.Applicative (liftA2)
 #else
-import Control.Applicative (Applicative(pure, (<*>)), (<$>))
+import Control.Applicative (Applicative(pure, (<*>)), (<$>), liftA2)
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
 import Data.Word (Word)
@@ -353,6 +354,16 @@
 type Prefix = Int
 type Mask   = Int
 
+
+-- Some stuff from "Data.IntSet.Internal", for 'restrictKeys' and
+-- 'withoutKeys' to use.
+type IntSetPrefix = Int
+type IntSetBitMap = Word
+
+bitmapOf :: Int -> IntSetBitMap
+bitmapOf x = shiftLL 1 (x .&. IntSet.suffixBitMask)
+{-# INLINE bitmapOf #-}
+
 {--------------------------------------------------------------------
   Operators
 --------------------------------------------------------------------}
@@ -501,9 +512,11 @@
 -- > size (singleton 1 'a')                       == 1
 -- > size (fromList([(1,'a'), (2,'c'), (3,'b')])) == 3
 size :: IntMap a -> Int
-size (Bin _ _ l r) = size l + size r
-size (Tip _ _) = 1
-size Nil = 0
+size = go 0
+  where
+    go !acc (Bin _ _ l r) = go (go acc l) r
+    go acc (Tip _ _) = 1 + acc
+    go acc Nil = acc
 
 -- | /O(min(n,W))/. Is the key a member of the map?
 --
@@ -1035,7 +1048,9 @@
 differenceWithKey f m1 m2
   = mergeWithKey f id (const Nil) m1 m2
 
--- | Remove all the keys in a given set from a map.
+
+-- TODO(wrengr): re-verify that asymptotic bound
+-- | /O(n+m)/. Remove all the keys in a given set from a map.
 --
 -- @
 -- m `withoutKeys` s = 'filterWithKey' (\k _ -> k `'IntSet.notMember'` s) m
@@ -1043,32 +1058,63 @@
 --
 -- @since 0.5.8
 withoutKeys :: IntMap a -> IntSet.IntSet -> IntMap a
-withoutKeys = go
-  where
-    go t1@(Bin p1 m1 l1 r1) t2@(IntSet.Bin p2 m2 l2 r2)
-      | shorter m1 m2  = merge1
-      | shorter m2 m1  = merge2
-      | p1 == p2       = bin p1 m1 (go l1 l2) (go r1 r2)
-      | otherwise      = t1
-      where
-        merge1 | nomatch p2 p1 m1  = t1
-               | zero p2 m1        = binCheckLeft p1 m1 (go l1 t2) r1
-               | otherwise         = binCheckRight p1 m1 l1 (go r1 t2)
-        merge2 | nomatch p1 p2 m2  = t1
-               | zero p1 m2        = bin p2 m2 (go t1 l2) Nil
-               | otherwise         = bin p2 m2 Nil (go t1 r2)
+withoutKeys t1@(Bin p1 m1 l1 r1) t2@(IntSet.Bin p2 m2 l2 r2)
+    | shorter m1 m2  = difference1
+    | shorter m2 m1  = difference2
+    | p1 == p2       = bin p1 m1 (withoutKeys l1 l2) (withoutKeys r1 r2)
+    | otherwise      = t1
+    where
+    difference1
+        | nomatch p2 p1 m1  = t1
+        | zero p2 m1        = binCheckLeft p1 m1 (withoutKeys l1 t2) r1
+        | otherwise         = binCheckRight p1 m1 l1 (withoutKeys r1 t2)
+    difference2
+        | nomatch p1 p2 m2  = t1
+        | zero p1 m2        = withoutKeys t1 l2
+        | otherwise         = withoutKeys t1 r2
+withoutKeys t1@(Bin p1 m1 _ _) (IntSet.Tip p2 bm2) =
+    let minbit = bitmapOf p1
+        lt_minbit = minbit - 1
+        maxbit = bitmapOf (p1 .|. (m1 .|. (m1 - 1)))
+        gt_maxbit = maxbit `xor` complement (maxbit - 1)
+    -- TODO(wrengr): should we manually inline/unroll 'updatePrefix'
+    -- and 'withoutBM' here, in order to avoid redundant case analyses?
+    in updatePrefix p2 t1 $ withoutBM (bm2 .|. lt_minbit .|. gt_maxbit)
+withoutKeys t1@(Bin _ _ _ _) IntSet.Nil = t1
+withoutKeys t1@(Tip k1 _) t2
+    | k1 `IntSet.member` t2 = Nil
+    | otherwise = t1
+withoutKeys Nil _ = Nil
 
-    go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip _ _) =
-      filterWithKey (\k _ -> k `IntSet.notMember` t2') t1'
 
-    go t1@(Bin _ _ _ _) IntSet.Nil = t1
+updatePrefix
+    :: IntSetPrefix -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
+updatePrefix !kp t@(Bin p m l r) f
+    | m .&. IntSet.suffixBitMask /= 0 =
+        if p .&. IntSet.prefixBitMask == kp then f t else t
+    | nomatch kp p m = t
+    | zero kp m      = binCheckLeft p m (updatePrefix kp l f) r
+    | otherwise      = binCheckRight p m l (updatePrefix kp r f)
+updatePrefix kp t@(Tip kx _) f
+    | kx .&. IntSet.prefixBitMask == kp = f t
+    | otherwise = t
+updatePrefix _ Nil _ = Nil
 
-    go t1'@(Tip k1' _) t2'
-      | k1' `IntSet.member` t2' = Nil
-      | otherwise = t1'
-    go Nil _ = Nil
 
+withoutBM :: IntSetBitMap -> IntMap a -> IntMap a
+withoutBM 0 t = t
+withoutBM bm (Bin p m l r) =
+    let leftBits = bitmapOf (p .|. m) - 1
+        bmL = bm .&. leftBits
+        bmR = bm `xor` bmL -- = (bm .&. complement leftBits)
+    in  bin p m (withoutBM bmL l) (withoutBM bmR r)
+withoutBM bm t@(Tip k _)
+    -- TODO(wrengr): need we manually inline 'IntSet.Member' here?
+    | k `IntSet.member` IntSet.Tip (k .&. IntSet.prefixBitMask) bm = Nil
+    | otherwise = t
+withoutBM _ Nil = Nil
 
+
 {--------------------------------------------------------------------
   Intersection
 --------------------------------------------------------------------}
@@ -1080,6 +1126,8 @@
 intersection m1 m2
   = mergeWithKey' bin const (const Nil) (const Nil) m1 m2
 
+
+-- TODO(wrengr): re-verify that asymptotic bound
 -- | /O(n+m)/. The restriction of a map to the keys in a set.
 --
 -- @
@@ -1088,30 +1136,64 @@
 --
 -- @since 0.5.8
 restrictKeys :: IntMap a -> IntSet.IntSet -> IntMap a
-restrictKeys = go
-  where
-    go t1@(Bin p1 m1 l1 r1) t2@(IntSet.Bin p2 m2 l2 r2)
-      | shorter m1 m2  = merge1
-      | shorter m2 m1  = merge2
-      | p1 == p2       = bin p1 m1 (go l1 l2) (go r1 r2)
-      | otherwise      = Nil
-      where
-        merge1 | nomatch p2 p1 m1  = Nil
-               | zero p2 m1        = bin p1 m1 (go l1 t2) Nil
-               | otherwise         = bin p1 m1 Nil (go r1 t2)
-        merge2 | nomatch p1 p2 m2  = Nil
-               | zero p1 m2        = bin p2 m2 (go t1 l2) Nil
-               | otherwise         = bin p2 m2 Nil (go t1 r2)
+restrictKeys t1@(Bin p1 m1 l1 r1) t2@(IntSet.Bin p2 m2 l2 r2)
+    | shorter m1 m2  = intersection1
+    | shorter m2 m1  = intersection2
+    | p1 == p2       = bin p1 m1 (restrictKeys l1 l2) (restrictKeys r1 r2)
+    | otherwise      = Nil
+    where
+    intersection1
+        | nomatch p2 p1 m1  = Nil
+        | zero p2 m1        = restrictKeys l1 t2
+        | otherwise         = restrictKeys r1 t2
+    intersection2
+        | nomatch p1 p2 m2  = Nil
+        | zero p1 m2        = restrictKeys t1 l2
+        | otherwise         = restrictKeys t1 r2
+restrictKeys t1@(Bin p1 m1 _ _) (IntSet.Tip p2 bm2) =
+    let minbit = bitmapOf p1
+        ge_minbit = complement (minbit - 1)
+        maxbit = bitmapOf (p1 .|. (m1 .|. (m1 - 1)))
+        le_maxbit = maxbit .|. (maxbit - 1)
+    -- TODO(wrengr): should we manually inline/unroll 'lookupPrefix'
+    -- and 'restrictBM' here, in order to avoid redundant case analyses?
+    in restrictBM (bm2 .&. ge_minbit .&. le_maxbit) (lookupPrefix p2 t1)
+restrictKeys (Bin _ _ _ _) IntSet.Nil = Nil
+restrictKeys t1@(Tip k1 _) t2
+    | k1 `IntSet.member` t2 = t1
+    | otherwise = Nil
+restrictKeys Nil _ = Nil
 
-    go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip _ _) =
-      filterWithKey (\k _ -> k `IntSet.member` t2') t1'
-    go (Bin _ _ _ _) IntSet.Nil = Nil
 
-    go t1'@(Tip k1' _) t2'
-      | k1' `IntSet.member` t2' = t1'
-      | otherwise = Nil
-    go Nil _ = Nil
+-- | /O(min(n,W))/. Restrict to the sub-map with all keys matching
+-- a key prefix.
+lookupPrefix :: IntSetPrefix -> IntMap a -> IntMap a
+lookupPrefix !kp t@(Bin p m l r)
+    | m .&. IntSet.suffixBitMask /= 0 =
+        if p .&. IntSet.prefixBitMask == kp then t else Nil
+    | nomatch kp p m = Nil
+    | zero kp m      = lookupPrefix kp l
+    | otherwise      = lookupPrefix kp r
+lookupPrefix kp t@(Tip kx _)
+    | (kx .&. IntSet.prefixBitMask) == kp = t
+    | otherwise = Nil
+lookupPrefix _ Nil = Nil
 
+
+restrictBM :: IntSetBitMap -> IntMap a -> IntMap a
+restrictBM 0 _ = Nil
+restrictBM bm (Bin p m l r) =
+    let leftBits = bitmapOf (p .|. m) - 1
+        bmL = bm .&. leftBits
+        bmR = bm `xor` bmL -- = (bm .&. complement leftBits)
+    in  bin p m (restrictBM bmL l) (restrictBM bmR r)
+restrictBM bm t@(Tip k _)
+    -- TODO(wrengr): need we manually inline 'IntSet.Member' here?
+    | k `IntSet.member` IntSet.Tip (k .&. IntSet.prefixBitMask) bm = t
+    | otherwise = Nil
+restrictBM _ Nil = Nil
+
+
 -- | /O(n+m)/. The intersection with a combining function.
 --
 -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"
@@ -1618,7 +1700,7 @@
 filterWithKeyA _ Nil           = pure Nil
 filterWithKeyA f t@(Tip k x)   = (\b -> if b then t else Nil) <$> f k x
 filterWithKeyA f (Bin p m l r) =
-    bin p m <$> filterWithKeyA f l <*> filterWithKeyA f r
+    liftA2 (bin p m) (filterWithKeyA f l) (filterWithKeyA f r)
 
 -- | This wasn't in Data.Bool until 4.7.0, so we define it here
 bool :: a -> a -> Bool -> a
@@ -1655,7 +1737,7 @@
     where
     go Nil           = pure Nil
     go (Tip k x)     = maybe Nil (Tip k) <$> f k x
-    go (Bin p m l r) = bin p m <$> go l <*> go r
+    go (Bin p m l r) = liftA2 (bin p m) (go l) (go r)
 
 
 -- | Merge two maps.
@@ -1827,8 +1909,8 @@
       where
         merge2 t2@(Bin p2 m2 l2 r2)
           | nomatch k1 p2 m2 = linkA k1 (subsingletonBy g1k k1 x1) p2 (g2t t2)
-          | zero k1 m2       = bin p2 m2 <$> merge2 l2 <*> g2t r2
-          | otherwise        = bin p2 m2 <$> g2t l2 <*> merge2 r2
+          | zero k1 m2       = liftA2 (bin p2 m2) (merge2 l2) (g2t r2)
+          | otherwise        = liftA2 (bin p2 m2) (g2t l2) (merge2 r2)
         merge2 (Tip k2 x2)   = mergeTips k1 x1 k2 x2
         merge2 Nil           = subsingletonBy g1k k1 x1
 
@@ -1836,34 +1918,34 @@
       where
         merge1 t1@(Bin p1 m1 l1 r1)
           | nomatch k2 p1 m1 = linkA p1 (g1t t1) k2 (subsingletonBy g2k k2 x2)
-          | zero k2 m1       = bin p1 m1 <$> merge1 l1 <*> g1t r1
-          | otherwise        = bin p1 m1 <$> g1t l1 <*> merge1 r1
+          | zero k2 m1       = liftA2 (bin p1 m1) (merge1 l1) (g1t r1)
+          | otherwise        = liftA2 (bin p1 m1) (g1t l1) (merge1 r1)
         merge1 (Tip k1 x1)   = mergeTips k1 x1 k2 x2
         merge1 Nil           = subsingletonBy g2k k2 x2
 
     go t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
       | shorter m1 m2  = merge1
       | shorter m2 m1  = merge2
-      | p1 == p2       = bin p1 m1   <$> go  l1 l2 <*> go r1 r2
-      | otherwise      = link_ p1 p2 <$> g1t t1    <*> g2t   t2
+      | p1 == p2       = liftA2 (bin p1 m1)   (go  l1 l2) (go r1 r2)
+      | otherwise      = liftA2 (link_ p1 p2) (g1t t1)    (g2t   t2)
       where
-        merge1 | nomatch p2 p1 m1  = link_ p1 p2 <$> g1t t1    <*> g2t t2
-               | zero p2 m1        = bin p1 m1   <$> go  l1 t2 <*> g1t r1
-               | otherwise         = bin p1 m1   <$> g1t l1    <*> go  r1 t2
-        merge2 | nomatch p1 p2 m2  = link_ p1 p2 <$> g1t t1    <*> g2t    t2
-               | zero p1 m2        = bin p2 m2   <$> go  t1 l2 <*> g2t    r2
-               | otherwise         = bin p2 m2   <$> g2t    l2 <*> go  t1 r2
+        merge1 | nomatch p2 p1 m1  = liftA2 (link_ p1 p2) (g1t t1)    (g2t t2)
+               | zero p2 m1        = liftA2 (bin p1 m1)   (go  l1 t2) (g1t r1)
+               | otherwise         = liftA2 (bin p1 m1)   (g1t l1)    (go  r1 t2)
+        merge2 | nomatch p1 p2 m2  = liftA2 (link_ p1 p2) (g1t t1)    (g2t    t2)
+               | zero p1 m2        = liftA2 (bin p2 m2)   (go  t1 l2) (g2t    r2)
+               | otherwise         = liftA2 (bin p2 m2)   (g2t    l2) (go  t1 r2)
 
     subsingletonBy gk k x = maybe Nil (Tip k) <$> gk k x
     {-# INLINE subsingletonBy #-}
 
     mergeTips k1 x1 k2 x2
       | k1 == k2  = maybe Nil (Tip k1) <$> f k1 x1 x2
-      | k1 <  k2  = subdoubleton k1 k2 <$> g1k k1 x1 <*> g2k k2 x2
+      | k1 <  k2  = liftA2 (subdoubleton k1 k2) (g1k k1 x1) (g2k k2 x2)
         {-
         = link_ k1 k2 <$> subsingletonBy g1k k1 x1 <*> subsingletonBy g2k k2 x2
         -}
-      | otherwise = subdoubleton k2 k1 <$> g2k k2 x2 <*> g1k k1 x1
+      | otherwise = liftA2 (subdoubleton k2 k1) (g2k k2 x2) (g1k k1 x1)
     {-# INLINE mergeTips #-}
 
     subdoubleton _ _   Nothing Nothing     = Nil
@@ -1885,8 +1967,8 @@
         -> Prefix -> f (IntMap a)
         -> f (IntMap a)
     linkA p1 t1 p2 t2
-      | zero p1 m = bin p m <$> t1 <*> t2
-      | otherwise = bin p m <$> t2 <*> t1
+      | zero p1 m = liftA2 (bin p m) t1 t2
+      | otherwise = liftA2 (bin p m) t2 t1
       where
         m = branchMask p1 p2
         p = mask p1 m
@@ -2203,7 +2285,7 @@
   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
+    go (Bin p m l r) = liftA2 (Bin p m) (go l) (go r)
 {-# INLINE traverseWithKey #-}
 
 -- | /O(n)/. The function @'mapAccum'@ threads an accumulating
@@ -3066,20 +3148,31 @@
 {--------------------------------------------------------------------
   Endian independent bit twiddling
 --------------------------------------------------------------------}
+
+-- | Should this key follow the left subtree of a 'Bin' with switching
+-- bit @m@? N.B., the answer is only valid when @match i p m@ is true.
 zero :: Key -> Mask -> Bool
 zero i m
   = (natFromInt i) .&. (natFromInt m) == 0
 {-# INLINE zero #-}
 
 nomatch,match :: Key -> Prefix -> Mask -> Bool
+
+-- | Does the key @i@ differ from the prefix @p@ before getting to
+-- the switching bit @m@?
 nomatch i p m
   = (mask i m) /= p
 {-# INLINE nomatch #-}
 
+-- | Does the key @i@ match the prefix @p@ (up to but not including
+-- bit @m@)?
 match i p m
   = (mask i m) == p
 {-# INLINE match #-}
 
+
+-- | The prefix of key @i@ up to (but not including) the switching
+-- bit @m@.
 mask :: Key -> Mask -> Prefix
 mask i m
   = maskW (natFromInt i) (natFromInt m)
@@ -3089,16 +3182,21 @@
 {--------------------------------------------------------------------
   Big endian operations
 --------------------------------------------------------------------}
+
+-- | The prefix of key @i@ up to (but not including) the switching
+-- bit @m@.
 maskW :: Nat -> Nat -> Prefix
 maskW i m
   = intFromNat (i .&. (complement (m-1) `xor` m))
 {-# INLINE maskW #-}
 
+-- | Does the left switching bit specify a shorter prefix?
 shorter :: Mask -> Mask -> Bool
 shorter m1 m2
   = (natFromInt m1) > (natFromInt m2)
 {-# INLINE shorter #-}
 
+-- | The first switching bit where the two prefixes disagree.
 branchMask :: Prefix -> Prefix -> Mask
 branchMask p1 p2
   = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
@@ -3108,8 +3206,9 @@
   Utilities
 --------------------------------------------------------------------}
 
--- | /O(1)/.  Decompose a map into pieces based on the structure of the underlying
--- tree.  This function is useful for consuming a map in parallel.
+-- | /O(1)/.  Decompose a map into pieces based on the structure
+-- of the underlying tree. This function is useful for consuming a
+-- map in parallel.
 --
 -- No guarantee is made as to the sizes of the pieces; an internal, but
 -- deterministic process determines this.  However, it is guaranteed that the
@@ -3139,9 +3238,6 @@
 {--------------------------------------------------------------------
   Debugging
 --------------------------------------------------------------------}
-{-# DEPRECATED showTree, showTreeWith
-    "These debugging functions will be moved to a separate module in future versions"
-    #-}
 
 -- | /O(n)/. Show the tree that implements the map. The tree is shown
 -- in a compressed, hanging format.
diff --git a/Data/IntMap/Internal/Debug.hs b/Data/IntMap/Internal/Debug.hs
new file mode 100644
--- /dev/null
+++ b/Data/IntMap/Internal/Debug.hs
@@ -0,0 +1,6 @@
+module Data.IntMap.Internal.Debug
+  ( showTree
+  , showTreeWith
+  ) where
+
+import Data.IntMap.Internal
diff --git a/Data/IntMap/Internal/DeprecatedDebug.hs b/Data/IntMap/Internal/DeprecatedDebug.hs
new file mode 100644
--- /dev/null
+++ b/Data/IntMap/Internal/DeprecatedDebug.hs
@@ -0,0 +1,20 @@
+module Data.IntMap.Internal.DeprecatedDebug where
+import qualified Data.IntMap.Internal as IM
+import Data.IntMap.Internal (IntMap)
+
+{-# DEPRECATED showTree, showTreeWith
+    "These debugging functions will be removed from this module. They are available from Data.IntMap.Internal.Debug."
+    #-}
+
+-- | /O(n)/. Show the tree that implements the map. The tree is shown
+-- in a compressed, hanging format.
+showTree :: Show a => IntMap a -> String
+showTree = IM.showTree
+
+{- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows
+ the tree that implements the map. 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.
+-}
+showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
+showTreeWith = IM.showTreeWith
diff --git a/Data/IntMap/Lazy.hs b/Data/IntMap/Lazy.hs
--- a/Data/IntMap/Lazy.hs
+++ b/Data/IntMap/Lazy.hs
@@ -207,7 +207,8 @@
     , showTreeWith
     ) where
 
-import Data.IntMap.Internal as IM
+import Data.IntMap.Internal as IM hiding (showTree, showTreeWith)
+import Data.IntMap.Internal.DeprecatedDebug
 
 -- $strictness
 --
diff --git a/Data/IntMap/Strict.hs b/Data/IntMap/Strict.hs
--- a/Data/IntMap/Strict.hs
+++ b/Data/IntMap/Strict.hs
@@ -217,62 +217,93 @@
 import Prelude hiding (lookup,map,filter,foldr,foldl,null)
 
 import Data.Bits
-import Data.IntMap.Internal hiding
-    ( findWithDefault
-    , singleton
-    , insert
-    , insertWith
-    , insertWithKey
-    , insertLookupWithKey
-    , adjust
-    , adjustWithKey
-    , update
-    , updateWithKey
-    , updateLookupWithKey
-    , alter
-    , alterF
-    , unionsWith
-    , unionWith
-    , unionWithKey
-    , differenceWith
-    , differenceWithKey
-    , intersectionWith
-    , intersectionWithKey
-    , mergeWithKey
-    , updateMinWithKey
-    , updateMaxWithKey
-    , updateMax
-    , updateMin
-    , map
-    , mapWithKey
-    , mapAccum
-    , mapAccumWithKey
-    , mapAccumRWithKey
-    , mapKeysWith
-    , mapMaybe
-    , mapMaybeWithKey
-    , mapEither
-    , mapEitherWithKey
-    , fromSet
-    , fromList
-    , fromListWith
-    , fromListWithKey
-    , fromAscList
-    , fromAscListWith
-    , fromAscListWithKey
-    , fromDistinctAscList
-    )
+import qualified Data.IntMap.Internal as L
+import Data.IntMap.Internal
+  ( IntMap (..)
+  , Key
+  , Prefix
+  , Mask
+  , mask
+  , branchMask
+  , shorter
+  , nomatch
+  , zero
+  , natFromInt
+  , intFromNat
+  , bin
+  , binCheckLeft
+  , binCheckRight
+  , link
 
+  , (\\)
+  , (!)
+  , empty
+  , assocs
+  , filter
+  , filterWithKey
+  , findMin
+  , findMax
+  , foldMapWithKey
+  , foldr
+  , foldl
+  , foldr'
+  , foldl'
+  , foldlWithKey
+  , foldrWithKey
+  , foldlWithKey'
+  , foldrWithKey'
+  , keysSet
+  , mergeWithKey'
+  , delete
+  , deleteMin
+  , deleteMax
+  , deleteFindMax
+  , deleteFindMin
+  , difference
+  , elems
+  , intersection
+  , isProperSubmapOf
+  , isProperSubmapOfBy
+  , isSubmapOf
+  , isSubmapOfBy
+  , lookup
+  , lookupLE
+  , lookupGE
+  , lookupLT
+  , lookupGT
+  , minView
+  , maxView
+  , minViewWithKey
+  , maxViewWithKey
+  , keys
+  , mapKeys
+  , mapKeysMonotonic
+  , member
+  , notMember
+  , null
+  , partition
+  , partitionWithKey
+  , restrictKeys
+  , size
+  , split
+  , splitLookup
+  , splitRoot
+  , toAscList
+  , toDescList
+  , toList
+  , union
+  , unions
+  , withoutKeys
+  )
+import Data.IntMap.Internal.DeprecatedDebug (showTree, showTreeWith)
 import qualified Data.IntSet.Internal as IntSet
 import Utils.Containers.Internal.BitUtil
 import Utils.Containers.Internal.StrictFold
 import Utils.Containers.Internal.StrictPair
-#if __GLASGOW_HASKELL__ >= 709
-import Data.Coerce
-#endif
 #if !MIN_VERSION_base(4,8,0)
 import Data.Functor((<$>))
 #endif
+import Control.Applicative (Applicative (..), liftA2)
 
 -- $strictness
 --
@@ -777,12 +808,8 @@
 #ifdef __GLASGOW_HASKELL__
 {-# NOINLINE [1] map #-}
 {-# RULES
-"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
- #-}
-#endif
-#if __GLASGOW_HASKELL__ >= 709
-{-# RULES
-"map/coerce" map coerce = coerce
+"map/map" forall f g xs . map f (map g xs) = map (\x -> f $! g x) xs
+"map/mapL" forall f g xs . map f (L.map g xs) = map (\x -> f (g x)) xs
  #-}
 #endif
 
@@ -799,16 +826,49 @@
       Nil         -> Nil
 
 #ifdef __GLASGOW_HASKELL__
+-- Pay close attention to strictness here. We need to force the
+-- intermediate result for map f . map g, and we need to refrain
+-- from forcing it for map f . L.map g, etc.
+--
+-- TODO Consider moving map and mapWithKey to IntMap.Internal so we can write
+-- non-orphan RULES for things like L.map f (map g xs). We'd need a new function
+-- for this, and we'd have to pay attention to simplifier phases. Something like
+--
+-- lsmap :: (b -> c) -> (a -> b) -> IntMap a -> IntMap c
+-- lsmap _ _ Nil = Nil
+-- lsmap f g (Tip k x) = let !gx = g x in Tip k (f gx)
+-- lsmap f g (Bin p m l r) = Bin p m (lsmap f g l) (lsmap f g r)
 {-# NOINLINE [1] mapWithKey #-}
 {-# RULES
 "mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
+  mapWithKey (\k a -> f k $! g k a) xs
+"mapWithKey/mapWithKeyL" forall f g xs . mapWithKey f (L.mapWithKey g xs) =
   mapWithKey (\k a -> f k (g k a)) xs
 "mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
+  mapWithKey (\k a -> f k $! g a) xs
+"mapWithKey/mapL" forall f g xs . mapWithKey f (L.map g xs) =
   mapWithKey (\k a -> f k (g a)) xs
 "map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
+  mapWithKey (\k a -> f $! g k a) xs
+"map/mapWithKeyL" forall f g xs . map f (L.mapWithKey g xs) =
   mapWithKey (\k a -> f (g k a)) xs
  #-}
 #endif
+
+-- | /O(n)/.
+-- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@
+-- That is, behaves exactly like a regular 'traverse' except that the traversing
+-- function also has access to the key associated with a value.
+--
+-- > 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
+traverseWithKey :: Applicative t => (Key -> a -> t b) -> IntMap a -> t (IntMap b)
+traverseWithKey f = go
+  where
+    go Nil = pure Nil
+    go (Tip k v) = (\ !v' -> Tip k v') <$> f k v
+    go (Bin p m l r) = liftA2 (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.
diff --git a/Data/IntSet/Internal.hs b/Data/IntSet/Internal.hs
--- a/Data/IntSet/Internal.hs
+++ b/Data/IntSet/Internal.hs
@@ -311,9 +311,11 @@
 
 -- | /O(n)/. Cardinality of the set.
 size :: IntSet -> Int
-size (Bin _ _ l r) = size l + size r
-size (Tip _ bm) = bitcount 0 bm
-size Nil = 0
+size = go 0
+  where
+    go !acc (Bin _ _ l r) = go (go acc l) r
+    go acc (Tip _ bm) = acc + bitcount 0 bm
+    go acc Nil = acc
 
 -- | /O(min(n,W))/. Is the value a member of the set?
 
diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs
--- a/Data/Map/Internal.hs
+++ b/Data/Map/Internal.hs
@@ -359,8 +359,9 @@
 
 #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
@@ -387,7 +388,7 @@
 #endif
 
 #if __GLASGOW_HASKELL__
-import GHC.Exts (build)
+import GHC.Exts (build, lazy)
 #if !MIN_VERSION_base(4,8,0)
 import Data.Functor ((<$))
 #endif
@@ -754,49 +755,69 @@
 -- > 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 #-}
@@ -1831,6 +1852,12 @@
   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.
 --
@@ -1850,7 +1877,7 @@
 {-# 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
@@ -1930,7 +1957,7 @@
 {-# 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'.
 --
 -- @
@@ -2514,10 +2541,10 @@
     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 <*> g1k 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
@@ -2588,7 +2615,7 @@
 {--------------------------------------------------------------------
   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
@@ -2597,7 +2624,7 @@
 {-# 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
@@ -2635,7 +2662,7 @@
 {-# 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
@@ -2644,7 +2671,7 @@
 {-# 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
@@ -2701,7 +2728,7 @@
 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
@@ -2816,14 +2843,15 @@
   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'
@@ -2923,7 +2951,7 @@
   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
diff --git a/Data/Map/Strict/Internal.hs b/Data/Map/Strict/Internal.hs
--- a/Data/Map/Strict/Internal.hs
+++ b/Data/Map/Strict/Internal.hs
@@ -398,11 +398,12 @@
 import Data.Map.Internal.DeprecatedShowTree (showTree, showTreeWith)
 import Data.Map.Internal.Debug (valid)
 
-import Control.Applicative (Const (..))
+import Control.Applicative (Const (..), liftA3)
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative (Applicative (..), (<$>))
 #endif
 import qualified Data.Set.Internal as Set
+import qualified Data.Map.Internal as L
 import Utils.Containers.Internal.StrictFold
 import Utils.Containers.Internal.StrictPair
 
@@ -1270,6 +1271,8 @@
   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)
@@ -1277,7 +1280,7 @@
   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'
@@ -1334,13 +1337,8 @@
 #ifdef __GLASGOW_HASKELL__
 {-# NOINLINE [1] map #-}
 {-# RULES
-"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
- #-}
-#endif
-#if __GLASGOW_HASKELL__ >= 709
--- Safe coercions were introduced in 7.8, but did not work well with RULES yet.
-{-# RULES
-"mapSeq/coerce" map coerce = coerce
+"map/map" forall f g xs . map f (map g xs) = map (\x -> f $! g x) xs
+"map/mapL" forall f g xs . map f (L.map g xs) = map (\x -> f (g x)) xs
  #-}
 #endif
 
@@ -1359,10 +1357,16 @@
 {-# NOINLINE [1] mapWithKey #-}
 {-# RULES
 "mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
+  mapWithKey (\k a -> f k $! g k a) xs
+"mapWithKey/mapWithKeyL" forall f g xs . mapWithKey f (L.mapWithKey g xs) =
   mapWithKey (\k a -> f k (g k a)) xs
 "mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
+  mapWithKey (\k a -> f k $! g a) xs
+"mapWithKey/mapL" forall f g xs . mapWithKey f (L.map g xs) =
   mapWithKey (\k a -> f k (g a)) xs
 "map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
+  mapWithKey (\k a -> f $! g k a) xs
+"map/mapWithKeyL" forall f g xs . map f (L.mapWithKey g xs) =
   mapWithKey (\k a -> f (g k a)) xs
  #-}
 #endif
@@ -1380,7 +1384,7 @@
   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) = (\ l' !v' r' -> Bin s k v' l' r') <$> go l <*> f k v <*> go r
+    go (Bin s k v l r) = liftA3 (\ l' !v' r' -> Bin s k v' l' r') (go l) (f k v) (go r)
 {-# INLINE traverseWithKey #-}
 
 -- | /O(n)/. The function 'mapAccum' threads an accumulating
diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -174,6 +174,7 @@
     traverseWithIndex, -- :: Applicative f => (Int -> a -> f b) -> Seq a -> f (Seq b)
     reverse,        -- :: Seq a -> Seq a
     intersperse,    -- :: a -> Seq a -> Seq a
+    liftA2Seq,      -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
     -- ** Zips
     zip,            -- :: Seq a -> Seq b -> Seq (a, b)
     zipWith,        -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
@@ -285,9 +286,10 @@
 infixr 5 :<|
 infixl 5 :|>
 
--- TODO: Once GHC implements some way to prevent non-exhaustive
--- pattern match warnings for pattern synonyms, we should be
--- sure to take advantage of that.
+#if __GLASGOW_HASKELL__ >= 801
+{-# COMPLETE (:<|), Empty #-}
+{-# COMPLETE (:|>), Empty #-}
+#endif
 
 -- | A pattern synonym matching an empty sequence.
 pattern Empty :: Seq a
@@ -413,8 +415,8 @@
 traverseFTE _f EmptyT = pure empty
 traverseFTE f (Single x) = Seq . Single . Elem <$> f x
 traverseFTE f (Deep s pr m sf) =
-  (\pr' m' sf' -> coerce $ Deep s pr' m' sf') <$>
-     traverse f pr <*> traverse (traverse f) m <*> traverse f sf
+  liftA3 (\pr' m' sf' -> coerce $ Deep s pr' m' sf')
+     (traverse f pr) (traverse (traverse f) m) (traverse f sf)
 #else
 instance Traversable Seq where
     traverse f (Seq xs) = Seq <$> traverse (traverse f) xs
@@ -432,24 +434,43 @@
 instance Applicative Seq where
     pure = singleton
     xs *> ys = cycleNTimes (length xs) ys
+    (<*>) = apSeq
+#if MIN_VERSION_base(4,10,0)
+    liftA2 = liftA2Seq
+#endif
 
-    fs <*> xs@(Seq xsFT) = case viewl fs of
-      EmptyL -> empty
-      firstf :< fs' -> case viewr fs' of
-        EmptyR -> fmap firstf xs
-        Seq fs''FT :> lastf -> case rigidify xsFT of
-             RigidEmpty -> empty
-             RigidOne (Elem x) -> fmap ($x) fs
-             RigidTwo (Elem x1) (Elem x2) ->
-                Seq $ ap2FT firstf fs''FT lastf (x1, x2)
-             RigidThree (Elem x1) (Elem x2) (Elem x3) ->
-                Seq $ ap3FT firstf fs''FT lastf (x1, x2, x3)
-             RigidFull r@(Rigid s pr _m sf) -> Seq $
-                   Deep (s * length fs)
-                        (fmap (fmap firstf) (nodeToDigit pr))
-                        (aptyMiddle (fmap firstf) (fmap lastf) fmap fs''FT r)
-                        (fmap (fmap lastf) (nodeToDigit sf))
+apSeq :: Seq (a -> b) -> Seq a -> Seq b
+apSeq fs xs@(Seq xsFT) = case viewl fs of
+  EmptyL -> empty
+  firstf :< fs' -> case viewr fs' of
+    EmptyR -> fmap firstf xs
+    Seq fs''FT :> lastf -> case rigidify xsFT of
+         RigidEmpty -> empty
+         RigidOne (Elem x) -> fmap ($x) fs
+         RigidTwo (Elem x1) (Elem x2) ->
+            Seq $ ap2FT firstf fs''FT lastf (x1, x2)
+         RigidThree (Elem x1) (Elem x2) (Elem x3) ->
+            Seq $ ap3FT firstf fs''FT lastf (x1, x2, x3)
+         RigidFull r@(Rigid s pr _m sf) -> Seq $
+               Deep (s * length fs)
+                    (fmap (fmap firstf) (nodeToDigit pr))
+                    (aptyMiddle (fmap firstf) (fmap lastf) fmap fs''FT r)
+                    (fmap (fmap lastf) (nodeToDigit sf))
+{-# NOINLINE [1] apSeq #-}
 
+{-# RULES
+"ap/fmap1" forall f xs ys . apSeq (fmapSeq f xs) ys = liftA2Seq f xs ys
+"ap/fmap2" forall f gs xs . apSeq gs (fmapSeq f xs) =
+                              liftA2Seq (\g x -> g (f x)) gs xs
+"fmap/ap" forall f gs xs . fmapSeq f (gs `apSeq` xs) =
+                             liftA2Seq (\g x -> f (g x)) gs xs
+"fmap/liftA2" forall f g m n . fmapSeq f (liftA2Seq g m n) =
+                       liftA2Seq (\x y -> f (g x y)) m n
+"liftA2/fmap1" forall f g m n . liftA2Seq f (fmapSeq g m) n =
+                       liftA2Seq (\x y -> f (g x) y) m n
+"liftA2/fmap2" forall f g m n . liftA2Seq f m (fmapSeq g n) =
+                       liftA2Seq (\x y -> f x (g y)) m n
+ #-}
 
 ap2FT :: (a -> b) -> FingerTree (Elem (a->b)) -> (a -> b) -> (a,a) -> FingerTree (Elem b)
 ap2FT firstf fs lastf (x,y) =
@@ -464,7 +485,47 @@
                         (mapMulFT 3 (\(Elem f) -> Node3 3 (Elem (f x)) (Elem (f y)) (Elem (f z))) fs)
                         (Three (Elem $ lastf x) (Elem $ lastf y) (Elem $ lastf z))
 
+lift2FT :: (a -> b -> c) -> a -> FingerTree (Elem a) -> a -> (b,b) -> FingerTree (Elem c)
+lift2FT f firstx xs lastx (y1,y2) =
+                 Deep (size xs * 2 + 4)
+                      (Two (Elem $ f firstx y1) (Elem $ f firstx y2))
+                      (mapMulFT 2 (\(Elem x) -> Node2 2 (Elem (f x y1)) (Elem (f x y2))) xs)
+                      (Two (Elem $ f lastx y1) (Elem $ f lastx y2))
 
+lift3FT :: (a -> b -> c) -> a -> FingerTree (Elem a) -> a -> (b,b,b) -> FingerTree (Elem c)
+lift3FT f firstx xs lastx (y1,y2,y3) =
+                 Deep (size xs * 3 + 6)
+                      (Three (Elem $ f firstx y1) (Elem $ f firstx y2) (Elem $ f firstx y3))
+                      (mapMulFT 3 (\(Elem x) -> Node3 3 (Elem (f x y1)) (Elem (f x y2)) (Elem (f x y3))) xs)
+                      (Three (Elem $ f lastx y1) (Elem $ f lastx y2) (Elem $ f lastx y3))
+
+liftA2Seq :: (a -> b -> c) -> Seq a -> Seq b -> Seq c
+liftA2Seq f xs ys@(Seq ysFT) = case viewl xs of
+  EmptyL -> empty
+  firstx :< xs' -> case viewr xs' of
+    EmptyR -> f firstx <$> ys
+    Seq xs''FT :> lastx -> case rigidify ysFT of
+      RigidEmpty -> empty
+      RigidOne (Elem y) -> fmap (\x -> f x y) xs
+      RigidTwo (Elem y1) (Elem y2) ->
+        Seq $ lift2FT f firstx xs''FT lastx (y1, y2)
+      RigidThree (Elem y1) (Elem y2) (Elem y3) ->
+        Seq $ lift3FT f firstx xs''FT lastx (y1, y2, y3)
+      RigidFull r@(Rigid s pr _m sf) -> Seq $
+        Deep (s * length xs)
+             (fmap (fmap (f firstx)) (nodeToDigit pr))
+             (aptyMiddle (fmap (f firstx)) (fmap (f lastx)) (lift_elem f) xs''FT r)
+             (fmap (fmap (f lastx)) (nodeToDigit sf))
+  where
+    lift_elem :: (a -> b -> c) -> a -> Elem b -> Elem c
+#if __GLASGOW_HASKELL__ >= 708
+    lift_elem = coerce
+#else
+    lift_elem f x (Elem y) = Elem (f x y)
+#endif
+{-# NOINLINE [1] liftA2Seq #-}
+
+
 data Rigidified a = RigidEmpty
                   | RigidOne a
                   | RigidTwo a a
@@ -514,12 +575,12 @@
 -- class, but as it is we have to build up 'map23' explicitly through the
 -- recursion.
 aptyMiddle
-  :: (c -> d)
-     -> (c -> d)
-     -> ((a -> b) -> c -> d)
-     -> FingerTree (Elem (a -> b))
-     -> Rigid c
-     -> FingerTree (Node d)
+  :: (b -> c)
+     -> (b -> c)
+     -> (a -> b -> c)
+     -> FingerTree (Elem a)
+     -> Rigid b
+     -> FingerTree (Node c)
 
 -- Not at the bottom yet
 
@@ -846,8 +907,8 @@
     traverse _ EmptyT = pure EmptyT
     traverse f (Single x) = Single <$> f x
     traverse f (Deep v pr m sf) =
-        deep' v <$> traverse f pr <*> traverse (traverse f) m <*>
-            traverse f sf
+        liftA3 (Deep v) (traverse f pr) (traverse (traverse f) m)
+            (traverse f sf)
 
 instance NFData a => NFData (FingerTree a) where
     rnf EmptyT = ()
@@ -929,9 +990,9 @@
 instance Traversable Digit where
     {-# INLINE traverse #-}
     traverse f (One a) = One <$> f a
-    traverse f (Two a b) = Two <$> f a <*> f b
-    traverse f (Three a b c) = Three <$> f a <*> f b <*> f c
-    traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d
+    traverse f (Two a b) = liftA2 Two (f a) (f b)
+    traverse f (Three a b c) = liftA3 Three (f a) (f b) (f c)
+    traverse f (Four a b c d) = liftA3 Four (f a) (f b) (f c) <*> f d
 
 instance NFData a => NFData (Digit a) where
     rnf (One a) = rnf a
@@ -968,24 +1029,6 @@
     deriving Show
 #endif
 
--- Sometimes, we need to apply a Node2, Node3, or Deep constructor
--- to a size and pass the result to a function. If we calculate,
--- say, `Node2 n <$> x <*> y`, then according to -ddump-simpl,
--- GHC boxes up `n`, passes it to the strict constructor for `Node2`,
--- and passes the result to `fmap`. Using `node2'` instead prevents
--- this, forming a closure with the unboxed size.
-{-# INLINE node2' #-}
-node2' :: Int -> a -> a -> Node a
-node2' !s = \a b -> Node2 s a b
-
-{-# INLINE node3' #-}
-node3' :: Int -> a -> a -> a -> Node a
-node3' !s = \a b c -> Node3 s a b c
-
-{-# INLINE deep' #-}
-deep' :: Int -> Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a
-deep' !s = \pr m sf -> Deep s pr m sf
-
 instance Foldable Node where
     foldMap f (Node2 _ a b) = f a <> f b
     foldMap f (Node3 _ a b c) = f a <> f b <> f c
@@ -1011,8 +1054,8 @@
 
 instance Traversable Node where
     {-# INLINE traverse #-}
-    traverse f (Node2 v a b) = node2' v <$> f a <*> f b
-    traverse f (Node3 v a b c) = node3' v <$> f a <*> f b <*> f c
+    traverse f (Node2 v a b) = liftA2 (Node2 v) (f a) (f b)
+    traverse f (Node3 v a b c) = liftA3 (Node3 v) (f a) (f b) (f c)
 
 instance NFData a => NFData (Node a) where
     rnf (Node2 _ a b) = rnf a `seq` rnf b
@@ -1130,12 +1173,12 @@
            (q,1) -> deepA two (applicativeTree (q - 1) mSize' n3) two
            (q,_) -> deepA three (applicativeTree (q - 1) mSize' n3) two
       where !mSize' = 3 * mSize
-            n3 = liftA3 (node3' mSize') m m m
+            n3 = liftA3 (Node3 mSize') m m m
   where
     one = fmap One m
     two = liftA2 Two m m
     three = liftA3 Three m m m
-    deepA = liftA3 (deep' (n * mSize))
+    deepA = liftA3 (Deep (n * mSize))
     emptyTree = pure EmptyT
 
 ------------------------------------------------------------------------
@@ -1157,7 +1200,7 @@
   | otherwise   = error "replicate takes a nonnegative integer argument"
 
 -- | 'replicateA' is an 'Applicative' version of 'replicate', and makes
--- /O(log n)/ calls to '<*>' and 'pure'.
+-- /O(log n)/ calls to 'liftA2' and 'pure'.
 --
 -- > replicateA n x = sequenceA (replicate n x)
 replicateA :: Applicative f => Int -> f a -> f (Seq a)
@@ -1661,7 +1704,7 @@
 
 instance Traversable ViewL where
     traverse _ EmptyL       = pure EmptyL
-    traverse f (x :< xs)    = (:<) <$> f x <*> traverse f xs
+    traverse f (x :< xs)    = liftA2 (:<) (f x) (traverse f xs)
 
 -- | /O(1)/. Analyse the left end of a sequence.
 viewl           ::  Seq a -> ViewL a
@@ -1728,7 +1771,7 @@
 
 instance Traversable ViewR where
     traverse _ EmptyR       = pure EmptyR
-    traverse f (xs :> x)    = (:>) <$> traverse f xs <*> f x
+    traverse f (xs :> x)    = liftA2 (:>) (traverse f xs) (f x)
 
 -- | /O(1)/. Analyse the right end of a sequence.
 viewr           ::  Seq a -> ViewR a
@@ -2666,10 +2709,10 @@
   traverseWithIndexTreeE _ !_s EmptyT = pure EmptyT
   traverseWithIndexTreeE f s (Single xs) = Single <$> f s xs
   traverseWithIndexTreeE f s (Deep n pr m sf) =
-          deep' n <$>
-               traverseWithIndexDigitE f s pr <*>
-               traverseWithIndexTreeN (traverseWithIndexNodeE f) sPspr m <*>
-               traverseWithIndexDigitE f sPsprm sf
+          liftA3 (Deep n)
+               (traverseWithIndexDigitE f s pr)
+               (traverseWithIndexTreeN (traverseWithIndexNodeE f) sPspr m)
+               (traverseWithIndexDigitE f sPsprm sf)
     where
       !sPspr = s + size pr
       !sPsprm = sPspr + size m
@@ -2678,10 +2721,10 @@
   traverseWithIndexTreeN _ !_s EmptyT = pure EmptyT
   traverseWithIndexTreeN f s (Single xs) = Single <$> f s xs
   traverseWithIndexTreeN f s (Deep n pr m sf) =
-          deep' n <$>
-               traverseWithIndexDigitN f s pr <*>
-               traverseWithIndexTreeN (traverseWithIndexNodeN f) sPspr m <*>
-               traverseWithIndexDigitN f sPsprm sf
+          liftA3 (Deep n)
+               (traverseWithIndexDigitN f s pr)
+               (traverseWithIndexTreeN (traverseWithIndexNodeN f) sPspr m)
+               (traverseWithIndexDigitN f sPsprm sf)
     where
       !sPspr = s + size pr
       !sPsprm = sPspr + size m
@@ -2695,16 +2738,16 @@
   {-# INLINE traverseWithIndexDigit #-}
   traverseWithIndexDigit :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Digit a -> f (Digit b)
   traverseWithIndexDigit f !s (One a) = One <$> f s a
-  traverseWithIndexDigit f s (Two a b) = Two <$> f s a <*> f sPsa b
+  traverseWithIndexDigit f s (Two a b) = liftA2 Two (f s a) (f sPsa b)
     where
       !sPsa = s + size a
   traverseWithIndexDigit f s (Three a b c) =
-                                      Three <$> f s a <*> f sPsa b <*> f sPsab c
+                                      liftA3 Three (f s a) (f sPsa b) (f sPsab c)
     where
       !sPsa = s + size a
       !sPsab = sPsa + size b
   traverseWithIndexDigit f s (Four a b c d) =
-                          Four <$> f s a <*> f sPsa b <*> f sPsab c <*> f sPsabc d
+                          liftA3 Four (f s a) (f sPsa b) (f sPsab c) <*> f sPsabc d
     where
       !sPsa = s + size a
       !sPsab = sPsa + size b
@@ -2718,11 +2761,11 @@
 
   {-# INLINE traverseWithIndexNode #-}
   traverseWithIndexNode :: (Applicative f, Sized a) => (Int -> a -> f b) -> Int -> Node a -> f (Node b)
-  traverseWithIndexNode f !s (Node2 ns a b) = node2' ns <$> f s a <*> f sPsa b
+  traverseWithIndexNode f !s (Node2 ns a b) = liftA2 (Node2 ns) (f s a) (f sPsa b)
     where
       !sPsa = s + size a
   traverseWithIndexNode f s (Node3 ns a b c) =
-                                     node3' ns <$> f s a <*> f sPsa b <*> f sPsab c
+                           liftA3 (Node3 ns) (f s a) (f sPsa b) (f sPsab c)
     where
       !sPsa = s + size a
       !sPsab = sPsa + size b
diff --git a/Data/Set/Internal.hs b/Data/Set/Internal.hs
--- a/Data/Set/Internal.hs
+++ b/Data/Set/Internal.hs
@@ -239,7 +239,7 @@
 import Utils.Containers.Internal.PtrEquality
 
 #if __GLASGOW_HASKELL__
-import GHC.Exts ( build )
+import GHC.Exts ( build, lazy )
 #if __GLASGOW_HASKELL__ >= 708
 import qualified GHC.Exts as GHCExts
 #endif
@@ -505,42 +505,49 @@
 -- it is replaced with the new value.
 
 -- See Note: Type of local 'go' function
+-- See Note: Avoiding worker/wrapper (in Data.Map.Internal)
 insert :: Ord a => a -> Set a -> Set a
-insert = go
+insert x0 = go x0 x0
   where
-    go :: Ord a => a -> Set a -> Set a
-    go !x Tip = singleton x
-    go !x t@(Bin sz y l r) = case compare x y of
+    go :: Ord a => a -> a -> Set a -> Set a
+    go orig !_ Tip = singleton (lazy orig)
+    go orig !x t@(Bin sz y l r) = case compare x y of
         LT | l' `ptrEq` l -> t
            | otherwise -> balanceL y l' r
-           where !l' = go x l
+           where !l' = go orig x l
         GT | r' `ptrEq` r -> t
            | otherwise -> balanceR y l r'
-           where !r' = go x r
-        EQ | x `ptrEq` y -> t
-           | otherwise -> Bin sz x l r
+           where !r' = go orig x r
+        EQ | lazy orig `seq` (orig `ptrEq` y) -> t
+           | otherwise -> Bin sz (lazy orig) l r
 #if __GLASGOW_HASKELL__
 {-# INLINABLE insert #-}
 #else
 {-# INLINE insert #-}
 #endif
 
+#ifndef __GLASGOW_HASKELL__
+lazy :: a -> a
+lazy a = a
+#endif
+
 -- Insert an element to the set only if it is not in the set.
 -- Used by `union`.
 
 -- See Note: Type of local 'go' function
+-- See Note: Avoiding worker/wrapper (in Data.Map.Internal)
 insertR :: Ord a => a -> Set a -> Set a
-insertR = go
+insertR x0 = go x0 x0
   where
-    go :: Ord a => a -> Set a -> Set a
-    go !x Tip = singleton x
-    go !x t@(Bin _ y l r) = case compare x y of
+    go :: Ord a => a -> a -> Set a -> Set a
+    go orig !_ Tip = singleton (lazy orig)
+    go orig !x t@(Bin _ y l r) = case compare x y of
         LT | l' `ptrEq` l -> t
            | otherwise -> balanceL y l' r
-           where !l' = go x l
+           where !l' = go orig x l
         GT | r' `ptrEq` r -> t
            | otherwise -> balanceR y l r'
-           where !r' = go x r
+           where !r' = go orig x r
         EQ -> t
 #if __GLASGOW_HASKELL__
 {-# INLINABLE insertR #-}
@@ -669,7 +676,7 @@
 {-# INLINABLE unions #-}
 #endif
 
--- | /O(m*log(n/m + 1)), m <= n/. The union of two sets, preferring the first set when
+-- | /O(m*log(n\/m + 1)), m <= n/. The union of two sets, preferring the first set when
 -- equal elements are encountered.
 union :: Ord a => Set a -> Set a -> Set a
 union t1 Tip  = t1
@@ -689,7 +696,7 @@
 {--------------------------------------------------------------------
   Difference
 --------------------------------------------------------------------}
--- | /O(m*log(n/m + 1)), m <= n/. Difference of two sets.
+-- | /O(m*log(n\/m + 1)), m <= n/. Difference of two sets.
 difference :: Ord a => Set a -> Set a -> Set a
 difference Tip _   = Tip
 difference t1 Tip  = t1
@@ -706,7 +713,7 @@
 {--------------------------------------------------------------------
   Intersection
 --------------------------------------------------------------------}
--- | /O(m*log(n/m + 1)), m <= n/. The intersection of two sets.
+-- | /O(m*log(n\/m + 1)), m <= n/. The intersection of two sets.
 -- Elements of the result come from the first set, so for example
 --
 -- > import qualified Data.Set as S
diff --git a/Data/Tree.hs b/Data/Tree.hs
--- a/Data/Tree.hs
+++ b/Data/Tree.hs
@@ -38,8 +38,9 @@
 
 #if MIN_VERSION_base(4,8,0)
 import Data.Foldable (toList)
+import Control.Applicative (Applicative(..), liftA2)
 #else
-import Control.Applicative (Applicative(..), (<$>))
+import Control.Applicative (Applicative(..), liftA2, (<$>))
 import Data.Foldable (Foldable(foldMap), toList)
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
@@ -73,6 +74,10 @@
 import Data.Semigroup (Semigroup (..))
 #endif
 
+#if !MIN_VERSION_base(4,8,0)
+import Data.Functor ((<$))
+#endif
+
 -- | Multi-way trees, also known as /rose trees/.
 data Tree a = Node {
         rootLabel :: a,         -- ^ label value
@@ -128,6 +133,7 @@
 
 instance Functor Tree where
     fmap = fmapTree
+    x <$ Node _ ts = Node x (map (x <$) ts)
 
 fmapTree :: (a -> b) -> Tree a -> Tree b
 fmapTree f (Node x ts) = Node (f x) (map (fmapTree f) ts)
@@ -144,6 +150,14 @@
     pure x = Node x []
     Node f tfs <*> tx@(Node x txs) =
         Node (f x) (map (f <$>) txs ++ map (<*> tx) tfs)
+#if MIN_VERSION_base(4,10,0)
+    liftA2 f (Node x txs) ty@(Node y tys) =
+        Node (f x y) (map (f x <$>) tys ++ map (\tx -> liftA2 f tx ty) txs)
+#endif
+    Node x txs <* ty@(Node _ tys) =
+        Node x (map (x <$) tys ++ map (<* ty) txs)
+    Node _ txs *> ty@(Node y tys) =
+        Node y (tys ++ map (*> ty) txs)
 
 instance Monad Tree where
     return = pure
@@ -151,7 +165,7 @@
       where Node x' ts' = f x
 
 instance Traversable Tree where
-    traverse f (Node x ts) = Node <$> f x <*> traverse (traverse f) ts
+    traverse f (Node x ts) = liftA2 Node (f x) (traverse (traverse f) ts)
 
 instance Foldable Tree where
     foldMap f (Node x ts) = f x `mappend` foldMap (foldMap f) ts
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,9 +1,39 @@
 # Changelog for [`containers` package](http://github.com/haskell/containers)
 
-## 0.5.10.1
+## 0.5.10.2
 
 * Planned for GHC 8.2.
 
+* Use `COMPLETE` pragmas to declare complete sets of pattern synonyms
+  for `Data.Sequence`. At last!
+
+* Make `Data.IntMap.Strict.traverseWithKey` force the values before
+  installing them in the result. Previously, this function could be used to
+  produce an `IntMap` containing undefined values.
+
+* Fix strictness bugs in various rewrite rules for `Data.Map.Strict` and
+  `Data.IntMap.Strict`. Previously, rules could unintentionally reduce
+  strictness. The most important change in this regard is the elimination
+  of rules rewriting `*.Strict.map coerce` to `coerce`. To map a coercion
+  over a structure for free, be sure to use the lazy `map` or `fmap`.
+  It is possible to write rules that do a somewhat better job of this, but
+  it turns out to be a bit messy.
+
+* Optimize `Data.IntMap.restrictKeys` and `Data.IntMap.withoutKeys`. The
+  semantic fix in 0.5.10.1 left them rather slow in certain cases.
+
+* Speed up `size` for `IntSet` and `IntMap` (thanks, Mike Ledger!).
+
+* Define a custom `liftA2` in `Applicative` instances for base 4.10, and use
+  `liftA2` rather than `<*>` whenever it may be beneficial.
+
+* Add `liftA2`-related `RULES` for `Data.Sequence`.
+
+* Export non-deprecated versions of `showTree` and `showTreeWith` from
+  `Data.IntMap.Internal.Debug`.
+
+## 0.5.10.1
+
 * Fix completely incorrect implementations of `Data.IntMap.restrictKeys` and
   `Data.IntMap.withoutKeys`. Make the tests for these actually run. (Thanks
   to Tom Smalley for reporting this.)
@@ -15,6 +45,10 @@
 
 * Remove meaningless stability annotations (Thanks, Simon Jakobi.)
 
+## 0.5.9.2
+
+* Backport bug fixes from 0.5.10.1
+
 ## 0.5.9.1
 
 * Add `merge` and `mergeA` for `Data.IntMap`.
@@ -46,6 +80,10 @@
 total functions instead. New implementations of said functions lead to slight
 performance improvements overall.
 
+## 0.5.8.2
+
+* Backport bug fixes from 0.5.10.1.
+
 ## 0.5.8.1 *Aug 2016*
 
 ### General package changes
@@ -83,8 +121,8 @@
     Many thanks to Cale Gibbard, Ryan Trinkle, and Dan Doel for
     inspiring the merge idea and helping refine the interface.
 
-  * Add `fromDescList`, `fromDescListWith`, `fromDescListWithKey`,
-    and `fromDistinctDescList` to `Data.Map`.
+  * Add `traverseMaybeWithKey`, `fromDescList`, `fromDescListWith`,
+    `fromDescListWithKey`, and `fromDistinctDescList` to `Data.Map`.
 
   * Add `fromDescList` and `fromDistinctDescList` to `Data.Set`.
 
diff --git a/containers.cabal b/containers.cabal
--- a/containers.cabal
+++ b/containers.cabal
@@ -1,5 +1,5 @@
 name: containers
-version: 0.5.10.1
+version: 0.5.10.2
 license: BSD3
 license-file: LICENSE
 maintainer: libraries@haskell.org
@@ -45,6 +45,7 @@
         Data.IntMap.Lazy
         Data.IntMap.Strict
         Data.IntMap.Internal
+        Data.IntMap.Internal.Debug
         Data.IntMap.Merge.Lazy
         Data.IntMap.Merge.Strict
         Data.IntSet.Internal
@@ -74,6 +75,7 @@
         Utils.Containers.Internal.StrictMaybe
         Utils.Containers.Internal.PtrEquality
         Data.Map.Internal.DeprecatedShowTree
+        Data.IntMap.Internal.DeprecatedDebug
 
     include-dirs: include
 
diff --git a/tests/Makefile b/tests/Makefile
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -8,10 +8,10 @@
 all:
 
 %-properties: %-properties.hs force
-	ghc -O2 -DTESTING $< -i.. -o $@ -outputdir tmp
+	ghc -I../include -O2 -DTESTING $< -i.. -o $@ -outputdir tmp
 
 %-strict-properties: %-properties.hs force
-	ghc -O2 -DTESTING -DSTRICT $< -o $@ -i.. -outputdir tmp
+	ghc -I../include -O2 -DTESTING -DSTRICT $< -o $@ -i.. -outputdir tmp
 
 .PHONY: force clean
 force:
diff --git a/tests/intmap-properties.hs b/tests/intmap-properties.hs
--- a/tests/intmap-properties.hs
+++ b/tests/intmap-properties.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE CPP #-}
 
 #ifdef STRICT
-import Data.IntMap.Strict as Data.IntMap
+import Data.IntMap.Strict as Data.IntMap hiding (showTree)
 #else
-import Data.IntMap.Lazy as Data.IntMap
+import Data.IntMap.Lazy as Data.IntMap hiding (showTree)
 #endif
+import Data.IntMap.Internal.Debug (showTree)
 
 import Data.Monoid
 import Data.Maybe hiding (mapMaybe)
@@ -141,6 +142,7 @@
              , testProperty "alter"                prop_alter
              , testProperty "index"                prop_index
              , testProperty "null"                 prop_null
+             , testProperty "size"                 prop_size
              , testProperty "member"               prop_member
              , testProperty "notmember"            prop_notmember
              , testProperty "lookup"               prop_lookup
@@ -805,17 +807,21 @@
           ys' = List.nubBy ((==) `on` fst) ys
           f k l r = k + 2 * l + 3 * r
 
+-- TODO: the second argument should be simply an 'IntSet', but that
+-- runs afoul of our orphan instance.
 prop_restrictKeys :: IMap -> IMap -> Property
-prop_restrictKeys m s0 = m `restrictKeys` s === filterWithKey (\k _ -> k `IntSet.member` s) m
+prop_restrictKeys m s0 =
+    m `restrictKeys` s === filterWithKey (\k _ -> k `IntSet.member` s) m
   where
     s = keysSet s0
-    restricted = restrictKeys m s
 
+-- TODO: the second argument should be simply an 'IntSet', but that
+-- runs afoul of our orphan instance.
 prop_withoutKeys :: IMap -> IMap -> Property
-prop_withoutKeys m s0 = m `withoutKeys` s === filterWithKey (\k _ -> k `IntSet.notMember` s) m
+prop_withoutKeys m s0 =
+    m `withoutKeys` s === filterWithKey (\k _ -> k `IntSet.notMember` s) m
   where
     s = keysSet s0
-    reduced = withoutKeys m s
 
 prop_mergeWithKeyModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
 prop_mergeWithKeyModel xs ys
@@ -900,6 +906,11 @@
 
 prop_null :: IMap -> Bool
 prop_null m = null m == (size m == 0)
+
+prop_size :: UMap -> Property
+prop_size im = sz === foldl' (\i _ -> i + 1) (0 :: Int) im .&&.
+               sz === List.length (toList im)
+  where sz = size im
 
 prop_member :: [Int] -> Int -> Bool
 prop_member xs n =
diff --git a/tests/intset-properties.hs b/tests/intset-properties.hs
--- a/tests/intset-properties.hs
+++ b/tests/intset-properties.hs
@@ -261,8 +261,10 @@
 prop_isSubsetOf2 :: IntSet -> IntSet -> Bool
 prop_isSubsetOf2 a b = isSubsetOf a (union a b)
 
-prop_size :: IntSet -> Bool
-prop_size s = size s == List.length (toList s)
+prop_size :: IntSet -> Property
+prop_size s = sz === foldl' (\i _ -> i + 1) (0 :: Int) s .&&.
+              sz === List.length (toList s)
+  where sz = size s
 
 prop_findMax :: IntSet -> Property
 prop_findMax s = not (null s) ==> findMax s == maximum (toList s)
diff --git a/tests/seq-properties.hs b/tests/seq-properties.hs
--- a/tests/seq-properties.hs
+++ b/tests/seq-properties.hs
@@ -16,7 +16,7 @@
 
 import Data.Sequence
 
-import Control.Applicative (Applicative(..))
+import Control.Applicative (Applicative(..), liftA2)
 import Control.Arrow ((***))
 import Control.Monad.Trans.State.Strict
 import Data.Array (listArray)
@@ -133,6 +133,8 @@
        , testProperty "munzip-lazy" prop_munzipLazy
 #endif
        , testProperty "<*>" prop_ap
+       , testProperty "<*> NOINLINE" prop_ap_NOINLINE
+       , testProperty "liftA2" prop_liftA2
        , testProperty "*>" prop_then
        , testProperty "cycleTaking" prop_cycleTaking
        , testProperty "intersperse" prop_intersperse
@@ -745,6 +747,20 @@
 prop_ap :: Seq A -> Seq B -> Bool
 prop_ap xs ys =
     toList' ((,) <$> xs <*> ys) ~= ( (,) <$> toList xs <*> toList ys )
+
+prop_ap_NOINLINE :: Seq A -> Seq B -> Bool
+prop_ap_NOINLINE xs ys =
+    toList' (((,) <$> xs) `apNOINLINE` ys) ~= ( (,) <$> toList xs <*> toList ys )
+
+{-# NOINLINE apNOINLINE #-}
+apNOINLINE :: Seq (a -> b) -> Seq a -> Seq b
+apNOINLINE fs xs = fs <*> xs
+
+prop_liftA2 :: Seq A -> Seq B -> Property
+prop_liftA2 xs ys = valid q .&&.
+    toList q === liftA2 (,) (toList xs) (toList ys)
+  where
+    q = liftA2 (,) xs ys
 
 prop_then :: Seq A -> Seq B -> Bool
 prop_then xs ys =