From 6bb62f34042df14ccc7877f1c802c825cc06d7cf Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Sat, 13 Dec 2025 02:19:21 +0100
Subject: [PATCH 01/15] Bench more sizes

---
 benchmarks/FineGrained.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/benchmarks/FineGrained.hs b/benchmarks/FineGrained.hs
index 4906eaee..ac01d684 100644
--- a/benchmarks/FineGrained.hs
+++ b/benchmarks/FineGrained.hs
@@ -42,7 +42,7 @@ main =
     ]
 
 defaultSizes :: [Int]
-defaultSizes = [0, 1, 10, 100, 1000, 10_000, 100_000]
+defaultSizes = [0, 1, 5, 10, 50, 100, 500, 1_000, 5_000, 10_000, 50_000, 100_000, 500_000]
 
 -- | Length of a 'Bytes' key in bytes.
 --

From 419f3662a68b9839325ef3e062e2982b2acc1458 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 15:34:24 +0100
Subject: [PATCH 02/15] fine-grained: Add benchmarks for `size`

---
 benchmarks/FineGrained.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/benchmarks/FineGrained.hs b/benchmarks/FineGrained.hs
index ac01d684..6dfde285 100644
--- a/benchmarks/FineGrained.hs
+++ b/benchmarks/FineGrained.hs
@@ -26,7 +26,8 @@ main =
   defaultMain
     [ bgroup
         "HashMap.Strict"
-        [ bFromList,
+        [ bSize,
+          bFromList,
           bLookup,
           bInsert,
           bUpdate,
@@ -56,6 +57,11 @@ bytesLength = 32
 defaultGen :: StdGen
 defaultGen = mkStdGen 42
 
+bSize :: Benchmark
+bSize = bgroup "size" [bgroup' "Int" genIntMap b]
+  where
+    b s = bench (show s) . whnf (\m -> HM.size m)
+
 bFromList :: Benchmark
 bFromList =
   bgroup

From 07212f99c46db39ee4d5eca06cf4e0b969424a88 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Sun, 14 Dec 2025 23:32:09 +0100
Subject: [PATCH 03/15] WIP: Change representation of empty HashMaps

---
 Data/HashMap/Internal.hs | 112 ++++++++++++---------------------------
 1 file changed, 33 insertions(+), 79 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index b67f6a04..3526dac4 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -216,20 +216,18 @@ instance NFData2 Leaf where
 -- | A map from keys to values.  A map cannot contain duplicate keys;
 -- each key can map to at most one value.
 data HashMap k v
-    = Empty
-    -- ^ Invariants:
-    --
-    -- * 'Empty' is not a valid sub-node. It can only appear at the root. (INV1)
-    | BitmapIndexed !Bitmap !(Array (HashMap k v))
+    = BitmapIndexed !Bitmap !(Array (HashMap k v))
     -- ^ Invariants:
     --
     -- * Only the lower @maxChildren@ bits of the 'Bitmap' may be set. The
     --   remaining upper bits must be 0. (INV2)
-    -- * The array of a 'BitmapIndexed' node stores at least 1 and at most
+    -- * The array of a 'BitmapIndexed' node stores at most
     --   @'maxChildren' - 1@ sub-nodes. (INV3)
     -- * The number of sub-nodes is equal to the number of 1-bits in its
     --   'Bitmap'. (INV4)
-    -- * If a 'BitmapIndexed' node has only one sub-node, this sub-node must
+    -- * A bitmap of 0 is only valid in the root node. In sub-nodes the bitmap
+    --   must be non-zero. (INV1)
+    -- * If a 'BitmapIndexed' node has exactly one sub-node, this sub-node must
     --   be a 'BitmapIndexed' or a 'Full' node. (INV5)
     | Leaf !Hash !(Leaf k v)
     -- ^ Invariants:
@@ -260,7 +258,6 @@ type role HashMap nominal representational
 deriving instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v)
 
 instance (NFData k, NFData v) => NFData (HashMap k v) where
-    rnf Empty                 = ()
     rnf (BitmapIndexed _ ary) = rnf ary
     rnf (Leaf _ l)            = rnf l
     rnf (Full ary)            = rnf ary
@@ -272,7 +269,6 @@ instance NFData k => NFData1 (HashMap k) where
 
 -- | @since 0.2.14.0
 instance NFData2 HashMap where
-    liftRnf2 _ _ Empty                       = ()
     liftRnf2 rnf1 rnf2 (BitmapIndexed _ ary) = liftRnf (liftRnf2 rnf1 rnf2) ary
     liftRnf2 rnf1 rnf2 (Leaf _ l)            = liftRnf2 rnf1 rnf2 l
     liftRnf2 rnf1 rnf2 (Full ary)            = liftRnf (liftRnf2 rnf1 rnf2) ary
@@ -433,7 +429,6 @@ equal1 :: Eq k
        -> HashMap k v -> HashMap k v' -> Bool
 equal1 eq = go
   where
-    go Empty Empty = True
     go (BitmapIndexed bm1 ary1) (BitmapIndexed bm2 ary2)
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
@@ -521,7 +516,6 @@ equalKeys :: Eq k => HashMap k v -> HashMap k v' -> Bool
 equalKeys = go
   where
     go :: Eq k => HashMap k v -> HashMap k v' -> Bool
-    go Empty Empty = True
     go (BitmapIndexed bm1 ary1) (BitmapIndexed bm2 ary2)
       = bm1 == bm2 && A.sameArray1 go ary1 ary2
     go (Leaf h1 l1) (Leaf h2 l2) = h1 == h2 && leafEq l1 l2
@@ -562,7 +556,6 @@ instance (Hashable k, Hashable v) => Hashable (HashMap k v) where
     hashWithSalt salt hm = go salt hm
       where
         go :: Int -> HashMap k v -> Int
-        go !s Empty = s
         go s (BitmapIndexed _ a) = A.foldl' go s a
         go s (Leaf h (L _ v))
           = s `H.hashWithSalt` h `H.hashWithSalt` v
@@ -588,7 +581,6 @@ leavesAndCollisions (BitmapIndexed _ ary) a = A.foldr leavesAndCollisions a ary
 leavesAndCollisions (Full ary)            a = A.foldr leavesAndCollisions a ary
 leavesAndCollisions l@(Leaf _ _)          a = l : a
 leavesAndCollisions c@(Collision _ _)     a = c : a
-leavesAndCollisions Empty                 a = a
 
 -- | Helper function to detect 'Leaf's and 'Collision's.
 isLeafOrCollision :: HashMap k v -> Bool
@@ -601,7 +593,7 @@ isLeafOrCollision _               = False
 
 -- | \(O(1)\) Construct an empty map.
 empty :: HashMap k v
-empty = Empty
+empty = BitmapIndexed 0 []
 
 -- | \(O(1)\) Construct a map with a single element.
 singleton :: (Hashable k) => k -> v -> HashMap k v
@@ -612,15 +604,14 @@ singleton k v = Leaf (hash k) (L k v)
 
 -- | \(O(1)\) Return 'True' if this map is empty, 'False' otherwise.
 null :: HashMap k v -> Bool
-null Empty = True
-null _   = False
+null (BitmapIndexed 0 _) = True
+null _ = False
 
 -- | \(O(n)\) Return the number of key-value mappings in this map.
 size :: HashMap k v -> Int
 size t = go t 0
   where
-    go Empty                !n = n
-    go (Leaf _ _)            n = n + 1
+    go (Leaf _ _)           !n = n + 1
     go (BitmapIndexed _ ary) n = A.foldl' (flip go) n ary
     go (Full ary)            n = A.foldl' (flip go) n ary
     go (Collision _ ary)     n = n + A.length ary
@@ -725,7 +716,6 @@ lookupCont ::
 lookupCont absent present !h0 !k0 !s0 m0 = lookupCont_ h0 k0 s0 m0
   where
     lookupCont_ :: Eq k => Hash -> k -> Shift -> HashMap k v -> r
-    lookupCont_ !_ !_ !_ Empty = absent (# #)
     lookupCont_ h k _ (Leaf hx (L kx x))
         | h == hx && k == kx = present x (-1)
         | otherwise          = absent (# #)
@@ -803,7 +793,6 @@ lookupKey k = \m -> fromMaybe# (lookupKeyInSubtree# 0 (hash k) k m)
 
 lookupKeyInSubtree# :: Eq k => Shift -> Hash -> k -> HashMap k v -> (# (##) | k #)
 lookupKeyInSubtree# !s !hx kx = \case
-  Empty -> (# (##) | #)
   Leaf hy (L ky _)
     | hx == hy && kx == ky -> (# | ky #)
     | otherwise -> (# (##) | #)
@@ -853,7 +842,6 @@ insert k v m = insert' (hash k) k v m
 insert' :: Eq k => Hash -> k -> v -> HashMap k v -> HashMap k v
 insert' h0 k0 v0 m0 = go h0 k0 v0 0 m0
   where
-    go !h !k x !_ Empty = Leaf h (L k x)
     go h k x s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then if x `ptrEq` y
@@ -897,7 +885,6 @@ insert' h0 k0 v0 m0 = go h0 k0 v0 0 m0
 insertNewKey :: Hash -> k -> v -> HashMap k v -> HashMap k v
 insertNewKey !h0 !k0 x0 m0 = go h0 k0 x0 0 m0
   where
-    go !h !k x !_ Empty = Leaf h (L k x)
     go h k x s t@(Leaf hy l)
       | hy == h = collision h l (L k x)
       | otherwise = runST (two s h k x hy t)
@@ -951,8 +938,7 @@ insertKeyExists !collPos0 !h0 !k0 x0 m0 = go collPos0 h0 k0 x0 m0
       where i = indexSH shiftedHash
     go collPos _shiftedHash k x (Collision h v)
         | collPos >= 0 = Collision h (setAtPosition collPos k x v)
-        | otherwise = Empty -- error "Internal error: go {collPos negative}"
-    go _ _ _ _ Empty = Empty -- error "Internal error: go Empty"
+        | otherwise = empty -- error "Internal error: go {collPos negative}"
 {-# NOINLINE insertKeyExists #-}
 
 -- | Replace the ith Leaf with Leaf k v.
@@ -969,7 +955,6 @@ unsafeInsert k0 v0 m0 = runST (go h0 k0 v0 0 m0)
   where
     h0 = hash k0
     go :: forall s. Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
-    go !h !k x !_ Empty = return $! Leaf h (L k x)
     go h k x s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then if x `ptrEq` y
@@ -1058,7 +1043,6 @@ insertModifying :: Hashable k => v -> (v -> (# v #)) -> k -> HashMap k v
 insertModifying x f k0 m0 = go h0 k0 0 m0
   where
     !h0 = hash k0
-    go !h !k !_ Empty = Leaf h (L k x)
     go h k s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then case f y of
@@ -1130,7 +1114,6 @@ unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
   where
     h0 = hash k0
     go :: Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
-    go !h !k x !_ Empty = return $! Leaf h (L k x)
     go h k x s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then case f k x y of
@@ -1173,9 +1156,8 @@ delete' = deleteFromSubtree 0
 -- corresponding 'Shift' argument is supplied.
 deleteFromSubtree :: Eq k => Shift -> Hash -> k -> HashMap k v -> HashMap k v
 deleteFromSubtree !s !h !k = \case
-  Empty -> Empty
   t@(Leaf hy (L ky _))
-    | hy == h && ky == k -> Empty
+    | hy == h && ky == k -> empty
     | otherwise          -> t
   t@(BitmapIndexed b ary)
     | b .&. m == 0 -> t
@@ -1223,7 +1205,7 @@ deleteKeyExists :: Int -> Hash -> k -> HashMap k v -> HashMap k v
 deleteKeyExists !collPos0 !h0 !k0 m0 = go collPos0 h0 k0 m0
   where
     go :: Int -> ShiftedHash -> k -> HashMap k v -> HashMap k v
-    go !_collPos !_shiftedHash !_k (Leaf _ _) = Empty
+    go !_collPos !_shiftedHash !_k (Leaf _ _) = empty
     go collPos shiftedHash k (BitmapIndexed b ary) =
       case A.index# ary i of
         (# st #) -> case go collPos (nextSH shiftedHash) k st of
@@ -1251,7 +1233,6 @@ deleteKeyExists !collPos0 !h0 !k0 m0 = go collPos0 h0 k0 m0
       = case A.index# v (otherOfOneOrZero collPos) of
           (# l #) -> Leaf h l
       | otherwise = Collision h (A.delete v collPos)
-    go !_ !_ !_ Empty = Empty -- error "Internal error: deleteKeyExists empty"
 {-# NOINLINE deleteKeyExists #-}
 
 -- | \(O(\log n)\) Adjust the value tied to a given key in this map only
@@ -1272,7 +1253,6 @@ adjust# :: Hashable k => (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
 adjust# f k0 m0 = go h0 k0 0 m0
   where
     h0 = hash k0
-    go !_ !_ !_ Empty = Empty
     go h k _ t@(Leaf hy (L ky y))
         | hy == h && ky == k = case f y of
             (# y' #) | ptrEq y y' -> t
@@ -1528,12 +1508,6 @@ isSubmapOfBy :: Hashable k => (v1 -> v2 -> Bool) -> HashMap k v1 -> HashMap k v2
 -- matching key in m2, hence O(n*m).
 isSubmapOfBy comp !m1 !m2 = go 0 m1 m2
   where
-    -- An empty map is always a submap of any other map.
-    go _ Empty _ = True
-
-    -- If the second map is empty and the first is not, it cannot be a submap.
-    go _ _ Empty = False
-
     -- If the first map contains only one entry, lookup the key in the second map.
     go s (Leaf h1 (L k1 v1)) t2 = lookupCont (\_ -> False) (\v2 _ -> comp v1 v2) h1 k1 s t2
 
@@ -1633,9 +1607,6 @@ unionWithKey :: Eq k => (k -> v -> v -> v) -> HashMap k v -> HashMap k v
           -> HashMap k v
 unionWithKey f = go 0
   where
-    -- empty vs. anything
-    go !_ t1 Empty = t1
-    go _ Empty t2 = t2
     -- leaf vs. leaf
     go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
         | h1 == h2  = if k1 == k2
@@ -1783,7 +1754,6 @@ compose bc !ab
 mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
 mapWithKey f = go
   where
-    go Empty = Empty
     go (Leaf h (L k v)) = Leaf h $ L k (f k v)
     go (BitmapIndexed b ary) = BitmapIndexed b $ A.map go ary
     go (Full ary) = Full $ A.map go ary
@@ -1811,7 +1781,6 @@ traverseWithKey
   -> HashMap k v1 -> f (HashMap k v2)
 traverseWithKey f = go
   where
-    go Empty                 = pure Empty
     go (Leaf h (L k v))      = Leaf h . L k <$> f k v
     go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse go ary
     go (Full ary)            = Full <$> A.traverse go ary
@@ -1845,10 +1814,8 @@ mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []
 difference :: Hashable k => HashMap k v -> HashMap k w -> HashMap k v
 difference = go_difference 0
   where
-    go_difference !_s Empty _ = Empty
-    go_difference s t1@(Leaf h1 (L k1 _)) t2
-      = lookupCont (\_ -> t1) (\_ _ -> Empty) h1 k1 s t2
-    go_difference _ t1 Empty = t1
+    go_difference !s t1@(Leaf h1 (L k1 _)) t2
+      = lookupCont (\_ -> t1) (\_ _ -> empty) h1 k1 s t2
     go_difference s t1 (Leaf h2 (L k2 _)) = deleteFromSubtree s h2 k2 t1
 
     go_difference s t1@(BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2)
@@ -1906,7 +1873,7 @@ difference = go_difference 0
     -- each combination of 'Full' and 'BitmapIndexed`.
     differenceArrays !s !b1 !ary1 t1 !b2 !ary2
       | b1 .&. b2 == 0 = t1
-      | A.unsafeSameArray ary1 ary2 = Empty
+      | A.unsafeSameArray ary1 ary2 = empty
       | otherwise = runST $ do
         mary <- A.new_ $ A.length ary1
     
@@ -1937,7 +1904,7 @@ difference = go_difference 0
         if nChanges == 0
           then pure t1
           else case popCount bResult of
-            0 -> pure Empty
+            0 -> pure empty
             1 -> do
               l <- A.read mary 0
               if isLeafOrCollision l
@@ -1953,10 +1920,10 @@ differenceCollisions :: Eq k => Hash -> Array (Leaf k v1) -> HashMap k v1 -> Has
 differenceCollisions !h1 !ary1 t1 !h2 !ary2
   | h1 == h2 =
     if A.unsafeSameArray ary1 ary2
-      then Empty
+      then empty
       else let ary = A.filter (\(L k1 _) -> isNothing (indexOf k1 ary2)) ary1
            in case A.length ary of
-             0 -> Empty
+             0 -> empty
              1 -> case A.index# ary 0 of
                     (# l #) -> Leaf h1 l
              n | A.length ary1 == n -> t1
@@ -1981,13 +1948,11 @@ differenceWith f = differenceWithKey (const f)
 differenceWithKey :: Eq k => (k -> v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
 differenceWithKey f = go_differenceWithKey 0
   where
-    go_differenceWithKey !_s Empty _tB = Empty
-    go_differenceWithKey _s a Empty = a
     go_differenceWithKey s a@(Leaf hA (L kA vA)) b
       = lookupCont
           (\_ -> a)
           (\vB _ -> case f kA vA vB of
-              Nothing -> Empty
+              Nothing -> empty
               Just v | v `ptrEq` vA -> a
                      | otherwise -> Leaf hA (L kA v))
           hA kA s b
@@ -2099,7 +2064,7 @@ differenceWithKey f = go_differenceWithKey 0
         if nChanges == 0
           then pure tA
           else case popCount bResult of
-            0 -> pure Empty
+            0 -> pure empty
             1 -> do
               l <- A.read mary 0
               if isLeafOrCollision l
@@ -2145,7 +2110,7 @@ differenceWithKey_Collisions f !hA !aryA !tA !hB !aryB
              kA aryB
           ary = A.mapMaybe f' aryA
       in case A.length ary of
-        0 -> Empty
+        0 -> empty
         1 -> case A.index# ary 0 of
                (# l #) -> Leaf hA l
         _ -> Collision hA ary
@@ -2175,18 +2140,15 @@ intersectionWithKey f = intersectionWithKey# $ \k v1 v2 -> (# f k v1 v2 #)
 intersectionWithKey# :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
 intersectionWithKey# f = go 0
   where
-    -- empty vs. anything
-    go !_ _ Empty = Empty
-    go _ Empty _ = Empty
     -- leaf vs. anything
     go s (Leaf h1 (L k1 v1)) t2 =
       lookupCont
-        (\_ -> Empty)
+        (\_ -> empty)
         (\v _ -> case f k1 v1 v of (# v' #) -> Leaf h1 $ L k1 v')
         h1 k1 s t2
     go s t1 (Leaf h2 (L k2 v2)) =
       lookupCont
-        (\_ -> Empty)
+        (\_ -> empty)
         (\v _ -> case f k2 v v2 of (# v' #) -> Leaf h2 $ L k2 v')
         h2 k2 s t1
     -- collision vs. collision
@@ -2202,7 +2164,7 @@ intersectionWithKey# f = go 0
       intersectionArrayBy (go (nextShift s)) fullBitmap fullBitmap ary1 ary2
     -- collision vs. branch
     go s (BitmapIndexed b1 ary1) t2@(Collision h2 _ls2)
-      | b1 .&. m2 == 0 = Empty
+      | b1 .&. m2 == 0 = empty
       | otherwise =
           case A.index# ary1 i of
             (# st1 #) -> go (nextShift s) st1 t2
@@ -2210,7 +2172,7 @@ intersectionWithKey# f = go 0
         m2 = mask h2 s
         i = sparseIndex b1 m2
     go s t1@(Collision h1 _ls1) (BitmapIndexed b2 ary2)
-      | b2 .&. m1 == 0 = Empty
+      | b2 .&. m1 == 0 = empty
       | otherwise =
           case A.index# ary2 i of
             (# st2 #) -> go (nextShift s) t1 st2
@@ -2240,7 +2202,7 @@ intersectionArrayBy ::
   Array (HashMap k v2) ->
   HashMap k v3
 intersectionArrayBy f !b1 !b2 !ary1 !ary2
-  | b1 .&. b2 == 0 = Empty
+  | b1 .&. b2 == 0 = empty
   | otherwise = runST $ do
     mary <- A.new_ $ popCount bIntersect
     -- iterate over nonzero bits of b1 .|. b2
@@ -2262,7 +2224,7 @@ intersectionArrayBy f !b1 !b2 !ary1 !ary2
             b' = b .&. complement m
     (len, bFinal) <- go 0 0 0 bCombined bIntersect
     case len of
-      0 -> pure Empty
+      0 -> pure empty
       1 -> do
         l <- A.read mary 0
         if isLeafOrCollision l
@@ -2293,10 +2255,10 @@ intersectionCollisions f h1 h2 ary1 ary2
                 go (i + 1) j
     len <- go 0 0
     case len of
-      0 -> pure Empty
+      0 -> pure empty
       1 -> Leaf h1 <$> A.read mary 0
       _ -> Collision h1 <$> (A.unsafeFreeze =<< A.shrink mary len)
-  | otherwise = Empty
+  | otherwise = empty
 {-# INLINE intersectionCollisions #-}
 
 -- | Say we have
@@ -2339,7 +2301,6 @@ disjoint = disjointSubtrees 0
 -- but this worker fails to be properly specialized for different key
 -- types. See https://gitlab.haskell.org/ghc/ghc/-/issues/26615.
 disjointSubtrees :: Eq k => Shift -> HashMap k a -> HashMap k b -> Bool
-disjointSubtrees !_s Empty _b = True
 disjointSubtrees s (Leaf hA (L kA _)) b =
   lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
 disjointSubtrees s (BitmapIndexed bmA aryA) (BitmapIndexed bmB aryB) =
@@ -2378,7 +2339,6 @@ disjointSubtrees s a@(Collision hA _) (Full aryB) =
     (# stB #) -> disjointSubtrees (nextShift s) a stB
 disjointSubtrees _ (Collision hA aryA) (Collision hB aryB) =
   disjointCollisions hA aryA hB aryB
-disjointSubtrees _s _a Empty = True
 disjointSubtrees s a (Leaf hB (L kB _)) =
   lookupCont (\_ -> True) (\_ _ -> False) hB kB s a
 disjointSubtrees s a b@Collision{} = disjointSubtrees s b a
@@ -2439,8 +2399,7 @@ foldr' f = foldrWithKey' (\ _ v z -> f v z)
 foldlWithKey' :: (a -> k -> v -> a) -> a -> HashMap k v -> a
 foldlWithKey' f = go
   where
-    go !z Empty                = z
-    go z (Leaf _ (L k v))      = f z k v
+    go !z (Leaf _ (L k v))     = f z k v
     go z (BitmapIndexed _ ary) = A.foldl' go z ary
     go z (Full ary)            = A.foldl' go z ary
     go z (Collision _ ary)     = A.foldl' (\ z' (L k v) -> f z' k v) z ary
@@ -2454,7 +2413,6 @@ foldlWithKey' f = go
 foldrWithKey' :: (k -> v -> a -> a) -> a -> HashMap k v -> a
 foldrWithKey' f = flip go
   where
-    go Empty z                 = z
     go (Leaf _ (L k v)) !z     = f k v z
     go (BitmapIndexed _ ary) !z = A.foldr' go z ary
     go (Full ary) !z           = A.foldr' go z ary
@@ -2481,7 +2439,6 @@ foldl f = foldlWithKey (\a _k v -> f a v)
 foldrWithKey :: (k -> v -> a -> a) -> a -> HashMap k v -> a
 foldrWithKey f = flip go
   where
-    go Empty z                 = z
     go (Leaf _ (L k v)) z      = f k v z
     go (BitmapIndexed _ ary) z = A.foldr go z ary
     go (Full ary) z            = A.foldr go z ary
@@ -2494,7 +2451,6 @@ foldrWithKey f = flip go
 foldlWithKey :: (a -> k -> v -> a) -> a -> HashMap k v -> a
 foldlWithKey f = go
   where
-    go z Empty                 = z
     go z (Leaf _ (L k v))      = f z k v
     go z (BitmapIndexed _ ary) = A.foldl go z ary
     go z (Full ary)            = A.foldl go z ary
@@ -2506,7 +2462,6 @@ foldlWithKey f = go
 foldMapWithKey :: Monoid m => (k -> v -> m) -> HashMap k v -> m
 foldMapWithKey f = go
   where
-    go Empty = mempty
     go (Leaf _ (L k v)) = f k v
     go (BitmapIndexed _ ary) = A.foldMap go ary
     go (Full ary) = A.foldMap go ary
@@ -2554,10 +2509,9 @@ filterMapAux :: forall k v1 v2
              -> HashMap k v2
 filterMapAux onLeaf onColl = go
   where
-    go Empty = Empty
     go t@Leaf{}
         | Just t' <- onLeaf t = t'
-        | otherwise = Empty
+        | otherwise = empty
     go (BitmapIndexed b ary) = filterA ary b
     go (Full ary) = filterA ary fullBitmap
     go (Collision h ary) = filterC ary h
@@ -2573,7 +2527,7 @@ filterMapAux onLeaf onColl = go
              -> ST s (HashMap k v2)
         step !ary !mary !b i !j !bi n
             | i >= n = case j of
-                0 -> return Empty
+                0 -> return empty
                 1 -> do
                     ch <- A.read mary 0
                     case ch of
@@ -2605,7 +2559,7 @@ filterMapAux onLeaf onColl = go
              -> ST s (HashMap k v2)
         step !ary !mary i !j n
             | i >= n    = case j of
-                0 -> return Empty
+                0 -> return empty
                 1 -> do l <- A.read mary 0
                         return $! Leaf h l
                 _ | i == j -> do ary2 <- A.unsafeFreeze mary

From a62530a31e10131eee8a16ecdc54eb104e837911 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 03:35:25 +0100
Subject: [PATCH 04/15] WIP

---
 Data/HashMap/Internal.hs        | 7 ++++++-
 Data/HashMap/Internal/Array.hs  | 5 +++++
 Data/HashMap/Internal/Debug.hs  | 4 +++-
 Data/HashMap/Internal/Strict.hs | 8 --------
 4 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 3526dac4..8288a4be 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MagicHash             #-}
 {-# LANGUAGE PatternGuards         #-}
+{-# LANGUAGE PatternSynonyms       #-}
 {-# LANGUAGE PolyKinds             #-}
 {-# LANGUAGE RoleAnnotations       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
@@ -32,6 +33,7 @@
 module Data.HashMap.Internal
     (
       HashMap(..)
+    , pattern Empty
     , Leaf(..)
 
       -- * Construction
@@ -254,6 +256,8 @@ data HashMap k v
 
 type role HashMap nominal representational
 
+pattern Empty <- BitmapIndexed 0 _
+
 -- | @since 0.2.17.0
 deriving instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v)
 
@@ -593,7 +597,8 @@ isLeafOrCollision _               = False
 
 -- | \(O(1)\) Construct an empty map.
 empty :: HashMap k v
-empty = BitmapIndexed 0 []
+empty = BitmapIndexed 0 A.empty
+{-# NOINLINE empty #-}
 
 -- | \(O(1)\) Construct a map with a single element.
 singleton :: (Hashable k) => k -> v -> HashMap k v
diff --git a/Data/HashMap/Internal/Array.hs b/Data/HashMap/Internal/Array.hs
index dd9f8174..d978f74a 100644
--- a/Data/HashMap/Internal/Array.hs
+++ b/Data/HashMap/Internal/Array.hs
@@ -32,6 +32,7 @@ module Data.HashMap.Internal.Array
       -- * Creation
     , new
     , new_
+    , empty
     , singleton
     , singletonM
     , snoc
@@ -230,6 +231,10 @@ shrink mary _n@(I# n#) =
     s' -> (# s', mary #)
 {-# INLINE shrink #-}
 
+empty :: Array a
+empty = run (new_ 0)
+{-# NOINLINE empty #-}
+
 singleton :: a -> Array a
 singleton x = runST (singletonM x)
 {-# INLINE singleton #-}
diff --git a/Data/HashMap/Internal/Debug.hs b/Data/HashMap/Internal/Debug.hs
index c349f144..c8523038 100644
--- a/Data/HashMap/Internal/Debug.hs
+++ b/Data/HashMap/Internal/Debug.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP              #-}
 {-# LANGUAGE MagicHash        #-}
+{-# LANGUAGE PatternSynonyms  #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UnboxedTuples    #-}
 
@@ -32,7 +33,8 @@ import Data.Bits             (complement, countTrailingZeros, popCount, shiftL,
 import Data.Hashable         (Hashable)
 import Data.HashMap.Internal (Bitmap, Hash, HashMap (..), Leaf (..),
                               bitsPerSubkey, fullBitmap, hash,
-                              isLeafOrCollision, maxChildren, sparseIndex)
+                              isLeafOrCollision, maxChildren, pattern Empty,
+                              sparseIndex)
 import Data.Semigroup        (Sum (..))
 
 import qualified Data.HashMap.Internal.Array as A
diff --git a/Data/HashMap/Internal/Strict.hs b/Data/HashMap/Internal/Strict.hs
index 9664db7b..852133b0 100644
--- a/Data/HashMap/Internal/Strict.hs
+++ b/Data/HashMap/Internal/Strict.hs
@@ -196,7 +196,6 @@ insertWith :: Hashable k => (v -> v -> v) -> k -> v -> HashMap k v
 insertWith f k0 v0 m0 = go h0 k0 v0 0 m0
   where
     h0 = hash k0
-    go !h !k x !_ Empty = leaf h k x
     go h k x s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then leaf h k (f x y)
@@ -238,7 +237,6 @@ unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
   where
     h0 = hash k0
     go :: forall s. Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
-    go !h !k x !_ Empty = return $! leaf h k x
     go h k x s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then return $! leaf h k (f k x y)
@@ -274,7 +272,6 @@ adjust :: Hashable k => (v -> v) -> k -> HashMap k v -> HashMap k v
 adjust f k0 m0 = go h0 k0 0 m0
   where
     h0 = hash k0
-    go !_ !_ !_ Empty = Empty
     go h k _ t@(Leaf hy (L ky y))
         | hy == h && ky == k = leaf h k (f y)
         | otherwise          = t
@@ -468,9 +465,6 @@ unionWithKey :: Eq k => (k -> v -> v -> v) -> HashMap k v -> HashMap k v
           -> HashMap k v
 unionWithKey f = go 0
   where
-    -- empty vs. anything
-    go !_ t1 Empty = t1
-    go _ Empty t2 = t2
     -- leaf vs. leaf
     go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
         | h1 == h2  = if k1 == k2
@@ -555,7 +549,6 @@ unionWithKey f = go 0
 mapWithKey :: (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
 mapWithKey f = go
   where
-    go Empty                 = Empty
     go (Leaf h (L k v))      = leaf h k (f k v)
     go (BitmapIndexed b ary) = BitmapIndexed b $ A.map' go ary
     go (Full ary)            = Full $ A.map' go ary
@@ -607,7 +600,6 @@ traverseWithKey
   -> HashMap k v1 -> f (HashMap k v2)
 traverseWithKey f = go
   where
-    go Empty                 = pure Empty
     go (Leaf h (L k v))      = leaf h k <$> f k v
     go (BitmapIndexed b ary) = BitmapIndexed b <$> A.traverse' go ary
     go (Full ary)            = Full <$> A.traverse' go ary

From c4e1b17ceda61a5370f1ea642b6b23b729f819f4 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 03:53:12 +0100
Subject: [PATCH 05/15] WIP

---
 Data/HashMap/Internal.hs        | 17 +++++++++++++----
 Data/HashMap/Internal/Strict.hs |  8 ++++++--
 2 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 8288a4be..aec08c99 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -256,6 +256,7 @@ data HashMap k v
 
 type role HashMap nominal representational
 
+pattern Empty :: HashMap k v
 pattern Empty <- BitmapIndexed 0 _
 
 -- | @since 0.2.17.0
@@ -969,8 +970,12 @@ unsafeInsert k0 v0 m0 = runST (go h0 k0 v0 0 m0)
         | otherwise = two s h k x hy t
     go h k x s t@(BitmapIndexed b ary)
         | b .&. m == 0 = do
-            ary' <- A.insertM ary i $! Leaf h (L k x)
-            return $! bitmapIndexedOrFull (b .|. m) ary'
+            let !l = Leaf h (L k x)
+            if b == 0
+              then return l
+              else do
+                ary' <- A.insertM ary i l
+                return $! bitmapIndexedOrFull (b .|. m) ary'
         | otherwise = do
             st <- A.indexM ary i
             st' <- go h k x (nextShift s) st
@@ -1127,8 +1132,12 @@ unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
         | otherwise = two s h k x hy t
     go h k x s t@(BitmapIndexed b ary)
         | b .&. m == 0 = do
-            ary' <- A.insertM ary i $! Leaf h (L k x)
-            return $! bitmapIndexedOrFull (b .|. m) ary'
+            let !l = Leaf h (L k x)
+            if b == 0
+              then return l
+              else do
+                ary' <- A.insertM ary i l
+                return $! bitmapIndexedOrFull (b .|. m) ary'
         | otherwise = do
             st <- A.indexM ary i
             st' <- go h k x (nextShift s) st
diff --git a/Data/HashMap/Internal/Strict.hs b/Data/HashMap/Internal/Strict.hs
index 852133b0..2546bbc4 100644
--- a/Data/HashMap/Internal/Strict.hs
+++ b/Data/HashMap/Internal/Strict.hs
@@ -246,8 +246,12 @@ unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
         | otherwise = x `seq` HM.two s h k x hy t
     go h k x s t@(BitmapIndexed b ary)
         | b .&. m == 0 = do
-            ary' <- A.insertM ary i $! leaf h k x
-            return $! HM.bitmapIndexedOrFull (b .|. m) ary'
+            let !l = leaf h k x
+            if b == 0
+              then return l
+              else do
+                ary' <- A.insertM ary i l
+                return $! HM.bitmapIndexedOrFull (b .|. m) ary'
         | otherwise = do
             st <- A.indexM ary i
             st' <- go h k x (nextShift s) st

From a663383a49150e9eb4b8f550e29a0bf9cd3b59a4 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 03:59:30 +0100
Subject: [PATCH 06/15] WIP

---
 Data/HashMap/Internal/Strict.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/Data/HashMap/Internal/Strict.hs b/Data/HashMap/Internal/Strict.hs
index 2546bbc4..7581df84 100644
--- a/Data/HashMap/Internal/Strict.hs
+++ b/Data/HashMap/Internal/Strict.hs
@@ -203,8 +203,12 @@ insertWith f k0 v0 m0 = go h0 k0 v0 0 m0
         | otherwise = x `seq` runST (HM.two s h k x hy t)
     go h k x s (BitmapIndexed b ary)
         | b .&. m == 0 =
-            let ary' = A.insert ary i $! leaf h k x
-            in HM.bitmapIndexedOrFull (b .|. m) ary'
+            let !l = leaf h k x
+            in if b == 0
+              then l
+              else
+                let ary' = A.insert ary i l
+                in HM.bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             case A.index# ary i of
               (# st #) ->

From ff8340c4c1760ed2428e2ff5da45dcd7fd31401f Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 04:06:24 +0100
Subject: [PATCH 07/15] WIP

---
 Data/HashMap/Internal.hs | 24 ++++++++++++++++++------
 1 file changed, 18 insertions(+), 6 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index aec08c99..e48c5346 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -857,8 +857,12 @@ insert' h0 k0 v0 m0 = go h0 k0 v0 0 m0
         | otherwise = runST (two s h k x hy t)
     go h k x s t@(BitmapIndexed b ary)
         | b .&. m == 0 =
-            let !ary' = A.insert ary i $! Leaf h (L k x)
-            in bitmapIndexedOrFull (b .|. m) ary'
+            let !l = Leaf h (L k x)
+            in if b == 0
+              then l
+              else
+                let !ary' = A.insert ary i l
+                in bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             case A.index# ary i of
               (# !st #) ->
@@ -896,8 +900,12 @@ insertNewKey !h0 !k0 x0 m0 = go h0 k0 x0 0 m0
       | otherwise = runST (two s h k x hy t)
     go h k x s (BitmapIndexed b ary)
         | b .&. m == 0 =
-            let !ary' = A.insert ary i $! Leaf h (L k x)
-            in bitmapIndexedOrFull (b .|. m) ary'
+            let !l = Leaf h (L k x)
+            in if b == 0
+              then l
+              else
+                let !ary' = A.insert ary i l
+                in bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             case A.index# ary i of
               (# st #) ->
@@ -1062,8 +1070,12 @@ insertModifying x f k0 m0 = go h0 k0 0 m0
         | otherwise = runST (two s h k x hy t)
     go h k s t@(BitmapIndexed b ary)
         | b .&. m == 0 =
-            let ary' = A.insert ary i $! Leaf h (L k x)
-            in bitmapIndexedOrFull (b .|. m) ary'
+            let !l = Leaf h (L k x)
+            in if b == 0
+              then l
+              else
+                let ary' = A.insert ary i l
+                in bitmapIndexedOrFull (b .|. m) ary'
         | otherwise =
             case A.index# ary i of
               (# !st #) ->

From c4dc7eb4d09ab84422126b57e10a60ab48a328c6 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 04:21:07 +0100
Subject: [PATCH 08/15] Fix isSubmapOf[By]

---
 Data/HashMap/Internal.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index e48c5346..f0d18fb6 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -1534,6 +1534,9 @@ isSubmapOfBy :: Hashable k => (v1 -> v2 -> Bool) -> HashMap k v1 -> HashMap k v2
 -- matching key in m2, hence O(n*m).
 isSubmapOfBy comp !m1 !m2 = go 0 m1 m2
   where
+    -- An empty map is always a submap of any other map.
+    go _ Empty _ = True
+
     -- If the first map contains only one entry, lookup the key in the second map.
     go s (Leaf h1 (L k1 v1)) t2 = lookupCont (\_ -> False) (\v2 _ -> comp v1 v2) h1 k1 s t2
 

From f9b6cac3b3b82a4e7d18dbbf1f23c19f4aa46229 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 04:37:06 +0100
Subject: [PATCH 09/15] WIP

---
 Data/HashMap/Internal.hs        | 22 +++++++++++++++-------
 Data/HashMap/Internal/Strict.hs | 20 ++++++++++++++------
 2 files changed, 29 insertions(+), 13 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index f0d18fb6..a4dbdf40 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -1637,7 +1637,7 @@ unionWithKey :: Eq k => (k -> v -> v -> v) -> HashMap k v -> HashMap k v
 unionWithKey f = go 0
   where
     -- leaf vs. leaf
-    go s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
+    go !s t1@(Leaf h1 l1@(L k1 v1)) t2@(Leaf h2 l2@(L k2 v2))
         | h1 == h2  = if k1 == k2
                       then Leaf h1 (L k1 (f k1 v1 v2))
                       else collision h1 l1 l2
@@ -1668,9 +1668,13 @@ unionWithKey f = go 0
         in Full ary'
     -- leaf vs. branch
     go s (BitmapIndexed b1 ary1) t2
-        | b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2
-                               b'   = b1 .|. m2
-                           in bitmapIndexedOrFull b' ary'
+        | b1 .&. m2 == 0 =
+            if b1 == 0
+              then t2
+              else
+                let ary' = A.insert ary1 i t2
+                    b'   = b1 .|. m2
+                in bitmapIndexedOrFull b' ary'
         | otherwise      = let ary' = A.updateWith' ary1 i $ \st1 ->
                                    go (nextShift s) st1 t2
                            in BitmapIndexed b1 ary'
@@ -1679,9 +1683,13 @@ unionWithKey f = go 0
           m2 = mask h2 s
           i = sparseIndex b1 m2
     go s t1 (BitmapIndexed b2 ary2)
-        | b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1
-                               b'   = b2 .|. m1
-                           in bitmapIndexedOrFull b' ary'
+        | b2 .&. m1 == 0 =
+            if b2 == 0
+              then t1
+              else
+                let ary' = A.insert ary2 i t1
+                    b'   = b2 .|. m1
+                in bitmapIndexedOrFull b' ary'
         | otherwise      = let ary' = A.updateWith' ary2 i $ \st2 ->
                                    go (nextShift s) t1 st2
                            in BitmapIndexed b2 ary'
diff --git a/Data/HashMap/Internal/Strict.hs b/Data/HashMap/Internal/Strict.hs
index 7581df84..c10a525c 100644
--- a/Data/HashMap/Internal/Strict.hs
+++ b/Data/HashMap/Internal/Strict.hs
@@ -505,9 +505,13 @@ unionWithKey f = go 0
         in Full ary'
     -- leaf vs. branch
     go s (BitmapIndexed b1 ary1) t2
-        | b1 .&. m2 == 0 = let ary' = A.insert ary1 i t2
-                               b'   = b1 .|. m2
-                           in HM.bitmapIndexedOrFull b' ary'
+        | b1 .&. m2 == 0 =
+            if b1 == 0
+              then t2
+              else
+                let ary' = A.insert ary1 i t2
+                    b'   = b1 .|. m2
+                in HM.bitmapIndexedOrFull b' ary'
         | otherwise      = let ary' = A.updateWith' ary1 i $ \st1 ->
                                    go (nextShift s) st1 t2
                            in BitmapIndexed b1 ary'
@@ -516,9 +520,13 @@ unionWithKey f = go 0
           m2 = mask h2 s
           i = sparseIndex b1 m2
     go s t1 (BitmapIndexed b2 ary2)
-        | b2 .&. m1 == 0 = let ary' = A.insert ary2 i $! t1
-                               b'   = b2 .|. m1
-                           in HM.bitmapIndexedOrFull b' ary'
+        | b2 .&. m1 == 0 =
+            if b2 == 0
+              then t1
+              else
+                let ary' = A.insert ary2 i t1
+                    b'   = b2 .|. m1
+                in HM.bitmapIndexedOrFull b' ary'
         | otherwise      = let ary' = A.updateWith' ary2 i $ \st2 ->
                                    go (nextShift s) t1 st2
                            in BitmapIndexed b2 ary'

From 0c67d75cf93c720583fd62978475fc2cefbcbf9a Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 04:56:11 +0100
Subject: [PATCH 10/15] Bangs

---
 Data/HashMap/Internal.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index a4dbdf40..cf6e1fcc 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -1985,7 +1985,7 @@ differenceWith f = differenceWithKey (const f)
 differenceWithKey :: Eq k => (k -> v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
 differenceWithKey f = go_differenceWithKey 0
   where
-    go_differenceWithKey s a@(Leaf hA (L kA vA)) b
+    go_differenceWithKey !s a@(Leaf hA (L kA vA)) b
       = lookupCont
           (\_ -> a)
           (\vB _ -> case f kA vA vB of
@@ -2178,7 +2178,7 @@ intersectionWithKey# :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> HashMap k v1 -> H
 intersectionWithKey# f = go 0
   where
     -- leaf vs. anything
-    go s (Leaf h1 (L k1 v1)) t2 =
+    go !s (Leaf h1 (L k1 v1)) t2 =
       lookupCont
         (\_ -> empty)
         (\v _ -> case f k1 v1 v of (# v' #) -> Leaf h1 $ L k1 v')

From 3300ce3af7cf04cb81b4298a31b01a8ce7c71410 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 05:30:00 +0100
Subject: [PATCH 11/15] Array.new: Update debug check

---
 Data/HashMap/Internal/Array.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Data/HashMap/Internal/Array.hs b/Data/HashMap/Internal/Array.hs
index d978f74a..008b2792 100644
--- a/Data/HashMap/Internal/Array.hs
+++ b/Data/HashMap/Internal/Array.hs
@@ -213,7 +213,7 @@ liftRnfArray rnf0 ary0 = go ary0 n0 0
 -- value.
 new :: Int -> a -> ST s (MArray s a)
 new _n@(I# n#) b =
-    CHECK_GT("new",_n,(0 :: Int))
+    CHECK_GE("new",_n,(0 :: Int))
     ST $ \s ->
         case newSmallArray# n# b s of
             (# s', ary #) -> (# s', MArray ary #)

From 147a72371b3d9de86a7dc59bfdb6eb6a4fe5a891 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 05:45:58 +0100
Subject: [PATCH 12/15] Some bangs

---
 Data/HashMap/Internal.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index cf6e1fcc..a7ba3e3f 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -895,7 +895,7 @@ insert' h0 k0 v0 m0 = go h0 k0 v0 0 m0
 insertNewKey :: Hash -> k -> v -> HashMap k v -> HashMap k v
 insertNewKey !h0 !k0 x0 m0 = go h0 k0 x0 0 m0
   where
-    go h k x s t@(Leaf hy l)
+    go !h !k x !s t@(Leaf hy l)
       | hy == h = collision h l (L k x)
       | otherwise = runST (two s h k x hy t)
     go h k x s (BitmapIndexed b ary)
@@ -969,7 +969,7 @@ unsafeInsert k0 v0 m0 = runST (go h0 k0 v0 0 m0)
   where
     h0 = hash k0
     go :: forall s. Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
-    go h k x s t@(Leaf hy l@(L ky y))
+    go !h !k x !s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then if x `ptrEq` y
                          then return t
@@ -1061,7 +1061,7 @@ insertModifying :: Hashable k => v -> (v -> (# v #)) -> k -> HashMap k v
 insertModifying x f k0 m0 = go h0 k0 0 m0
   where
     !h0 = hash k0
-    go h k s t@(Leaf hy l@(L ky y))
+    go !h !k !s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then case f y of
                       (# v' #) | ptrEq y v' -> t
@@ -1136,7 +1136,7 @@ unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
   where
     h0 = hash k0
     go :: Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
-    go h k x s t@(Leaf hy l@(L ky y))
+    go !h !k x !s t@(Leaf hy l@(L ky y))
         | hy == h = if ky == k
                     then case f k x y of
                         (# v #) -> return $! Leaf h (L k v)
@@ -1279,7 +1279,7 @@ adjust# :: Hashable k => (v -> (# v #)) -> k -> HashMap k v -> HashMap k v
 adjust# f k0 m0 = go h0 k0 0 m0
   where
     h0 = hash k0
-    go h k _ t@(Leaf hy (L ky y))
+    go !h !k !_ t@(Leaf hy (L ky y))
         | hy == h && ky == k = case f y of
             (# y' #) | ptrEq y y' -> t
                      | otherwise -> Leaf h (L k y')

From 48fe90342410e5e1189d9b02a471fdea1e65f11f Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 08:57:47 +0100
Subject: [PATCH 13/15] Bangs

---
 Data/HashMap/Internal.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index a7ba3e3f..6bd68326 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -722,7 +722,7 @@ lookupCont ::
 lookupCont absent present !h0 !k0 !s0 m0 = lookupCont_ h0 k0 s0 m0
   where
     lookupCont_ :: Eq k => Hash -> k -> Shift -> HashMap k v -> r
-    lookupCont_ h k _ (Leaf hx (L kx x))
+    lookupCont_ !h !k !_s (Leaf hx (L kx x))
         | h == hx && k == kx = present x (-1)
         | otherwise          = absent (# #)
     lookupCont_ h k s (BitmapIndexed b v)

From f02530bf048dc96abebb0825d3d89a1acc091e29 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 16:46:24 +0100
Subject: [PATCH 14/15] Refactor `size`
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

    $ cabal run fine-grained -- -p size --stdev 1
    All
      HashMap.Strict
        size
          Int
            0:      OK
              2.04 ns ±  22 ps
            1:      OK
              3.01 ns ±  40 ps
            5:      OK
              20.0 ns ± 128 ps
            10:     OK
              45.3 ns ± 568 ps
            50:     OK
              186  ns ± 1.1 ns
            100:    OK
              396  ns ± 4.1 ns
            500:    OK
              1.88 μs ± 5.8 ns
            1000:   OK
              4.59 μs ±  84 ns
            5000:   OK
              28.3 μs ± 483 ns
            10000:  OK
              56.2 μs ± 885 ns
            50000:  OK
              387  μs ± 4.4 μs
            100000: OK
              735  μs ± 4.9 μs
            500000: OK
              5.36 ms ±  51 μs
---
 Data/HashMap/Internal.hs | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 6bd68326..ecaa02e1 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -615,12 +615,19 @@ null _ = False
 
 -- | \(O(n)\) Return the number of key-value mappings in this map.
 size :: HashMap k v -> Int
-size t = go t 0
-  where
-    go (Leaf _ _)           !n = n + 1
-    go (BitmapIndexed _ ary) n = A.foldl' (flip go) n ary
-    go (Full ary)            n = A.foldl' (flip go) n ary
-    go (Collision _ ary)     n = n + A.length ary
+size = \case
+  BitmapIndexed b ary
+    | b == 0    -> 0
+    | otherwise -> A.foldl' size_ 0 ary
+  m -> size_ 0 m
+{-# INLINE size #-}
+
+size_ :: Int -> HashMap k v -> Int
+size_ !n = \case
+  Leaf _ _            -> n + 1
+  BitmapIndexed _ ary -> A.foldl' size_ n ary
+  Full ary            -> A.foldl' size_ n ary
+  Collision _ ary     -> n + A.length ary
 
 -- | \(O(\log n)\) Return 'True' if the specified key is present in the
 -- map, 'False' otherwise.

From c775eb5e4c7d01d5a539036b63e30d03a346aeba Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 15 Dec 2025 18:03:43 +0100
Subject: [PATCH 15/15] deleteKeyExists: Help GHC form join points

...in order to reduce code size.
---
 Data/HashMap/Internal.hs | 37 +++++++++++++++++++++++++------------
 1 file changed, 25 insertions(+), 12 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index ecaa02e1..79c72963 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -1241,25 +1241,38 @@ deleteKeyExists !collPos0 !h0 !k0 m0 = go collPos0 h0 k0 m0
     go !_collPos !_shiftedHash !_k (Leaf _ _) = empty
     go collPos shiftedHash k (BitmapIndexed b ary) =
       case A.index# ary i of
-        (# st #) -> case go collPos (nextSH shiftedHash) k st of
-          Empty | A.length ary == 2
-                , (# l #) <- A.index# ary (otherOfOneOrZero i)
-                , isLeafOrCollision l
-                -> l
-                | otherwise
-                -> BitmapIndexed (b .&. complement m) (A.delete ary i)
-          st' | isLeafOrCollision st' && A.length ary == 1 -> st'
-              | otherwise -> BitmapIndexed b (A.update ary i st')
+        (# st #) ->
+          let !st' = go collPos (nextSH shiftedHash) k st
+              -- These let-bindings help GHC form join points in order to
+              -- prevent code duplication.
+              deletion = BitmapIndexed (b .&. complement m) (A.delete ary i)
+              update_ = BitmapIndexed b (A.update ary i st')
+              {-# NOINLINE update_ #-}
+          in case st' of
+            Empty | A.length ary == 2
+                  , (# l #) <- A.index# ary (otherOfOneOrZero i)
+                  , isLeafOrCollision l
+                  -> l
+                  | otherwise
+                  -> deletion
+            _ | isLeafOrCollision st' && A.length ary == 1 -> st'
+              | otherwise -> update_
       where m = maskSH shiftedHash
             i = sparseIndex b m
     go collPos shiftedHash k (Full ary) =
         case A.index# ary i of
-          (# st #) -> case go collPos (nextSH shiftedHash) k st of
-            Empty ->
+          (# st #) ->
+            let !st' = go collPos (nextSH shiftedHash) k st
+                -- This let-binding helps GHC form a join point in order to
+                -- prevent code duplication.
+                update_ = Full (updateFullArray ary i st')
+                {-# NOINLINE update_ #-}
+            in if null st'
+              then
                 let ary' = A.delete ary i
                     bm   = fullBitmap .&. complement (1 `unsafeShiftL` i)
                 in BitmapIndexed bm ary'
-            st' -> Full (updateFullArray ary i st')
+              else update_
       where i = indexSH shiftedHash
     go collPos _shiftedHash _k (Collision h v)
       | A.length v == 2