From a0d9fbe2a1f3e24695d35370d742a99e8c106140 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Fri, 21 Nov 2025 22:51:54 +0100
Subject: [PATCH 01/15] WIP: disjoint

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

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 886ead2a..efd9d5c8 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -83,6 +83,7 @@ module Data.HashMap.Internal
     , intersectionWith
     , intersectionWithKey
     , intersectionWithKey#
+    , disjoint
 
       -- * Folds
     , foldr'
@@ -2315,6 +2316,67 @@ searchSwap mary n toFind start = go start toFind start
           else go i0 k (i + 1)
 {-# INLINE searchSwap #-}
 
+disjoint :: Eq k => HashMap k a -> HashMap k b -> Bool
+disjoint = disjointSubtrees 0
+{-# INLINE disjoint #-}
+
+disjointSubtrees :: Eq k => Shift -> HashMap k a -> HashMap k b -> Bool
+disjointSubtrees _s Empty _b = True
+disjointSubtrees _s _a Empty = True
+disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) = hA == hB && kA /= kB
+disjointSubtrees s (Leaf hA (L kA _)) b = lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
+disjointSubtrees s a (Leaf hB (L kB _)) = lookupCont (\_ -> True) (\_ _ -> False) hB kB s a
+disjointSubtrees s (BitmapIndexed bA aryA) (BitmapIndexed bB aryB)
+  | bA .&. bB == 0 = True
+  | aryA `A.unsafeSameArray` aryB = False
+  | otherwise = disjointArrays s bA aryA bB aryB
+disjointSubtrees s (Full aryA) (Full aryB)
+  | aryA `A.unsafeSameArray` aryB = False
+  | otherwise = disjointArrays s fullBitmap aryA fullBitmap aryB
+disjointSubtrees s (BitmapIndexed bA aryA) (Full aryB) =
+  disjointArrays s bA aryA fullBitmap aryB
+disjointSubtrees s (Full aryA) (BitmapIndexed bB aryB) =
+  disjointArrays s fullBitmap aryA bB aryB
+disjointSubtrees s a@(Collision hA _) (BitmapIndexed bB aryB)
+  | m .&. bB == 0 = True
+  | otherwise = case A.index# aryB i of
+      (# stB #) -> disjointSubtrees (nextShift s) a stB
+  where
+    m = mask hA s
+    i = sparseIndex bB m
+disjointSubtrees s a@(Collision hA _) (Full aryB) =
+    case A.index# aryB i of
+      (# stB #) -> disjointSubtrees (nextShift s) a stB
+  where
+    i = index hA s
+disjointSubtrees _ (Collision hA aryA) (Collision hB aryB) =
+  disjointCollisions hA aryA hB aryB
+disjointSubtrees s a b@Collision{} = disjointSubtrees s b a
+{-# INLINABLE disjointSubtrees #-}
+
+disjointArrays :: Eq k => Shift -> Bitmap -> A.Array (HashMap k a) -> Bitmap -> A.Array (HashMap k b) -> Bool
+disjointArrays !s !bA !aryA !bB !aryB = go (bA .&. bB)
+  where
+    go 0 = True
+    go b = case A.index# aryA iA of
+        (# stA #) -> case A.index# aryB iB of
+          (# stB #) ->
+            disjointSubtrees (nextShift s) stA stB &&
+            go (b .&. complement m)
+      where
+        m = b .&. negate b
+        iA = sparseIndex bA m
+        iB = sparseIndex bB m
+{-# INLINABLE disjointArrays #-}
+
+disjointCollisions :: Eq k => Hash -> A.Array (Leaf k a) -> Hash -> A.Array (Leaf k b) -> Bool
+disjointCollisions !hA !aryA !hB !aryB
+  | hA /= hB = True
+  | otherwise = A.all f aryA
+  where
+    f (L kA _) = lookupInArrayCont (\_ -> True) (\_ _ -> False) kA aryB
+{-# INLINABLE disjointCollisions #-}
+
 ------------------------------------------------------------------------
 -- * Folds
 

From 48297284411d8d8e6ad1cbbe8c8d22828c7e9ed3 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Tue, 25 Nov 2025 19:58:00 +0100
Subject: [PATCH 02/15] WIP

---
 Data/HashMap/Internal/Strict.hs | 1 +
 Data/HashMap/Lazy.hs            | 1 +
 Data/HashMap/Strict.hs          | 1 +
 Data/HashSet.hs                 | 1 +
 Data/HashSet/Internal.hs        | 5 +++++
 tests/Properties/HashMapLazy.hs | 5 +++++
 6 files changed, 14 insertions(+)

diff --git a/Data/HashMap/Internal/Strict.hs b/Data/HashMap/Internal/Strict.hs
index 6951fa3b..786001aa 100644
--- a/Data/HashMap/Internal/Strict.hs
+++ b/Data/HashMap/Internal/Strict.hs
@@ -96,6 +96,7 @@ module Data.HashMap.Internal.Strict
     , HM.intersection
     , intersectionWith
     , intersectionWithKey
+    , HM.disjoint
 
       -- * Folds
     , HM.foldMapWithKey
diff --git a/Data/HashMap/Lazy.hs b/Data/HashMap/Lazy.hs
index f981ca09..10c433a3 100644
--- a/Data/HashMap/Lazy.hs
+++ b/Data/HashMap/Lazy.hs
@@ -76,6 +76,7 @@ module Data.HashMap.Lazy
     , intersection
     , intersectionWith
     , intersectionWithKey
+    , disjoint
 
       -- * Folds
     , foldMapWithKey
diff --git a/Data/HashMap/Strict.hs b/Data/HashMap/Strict.hs
index 866e0b7a..60c652dd 100644
--- a/Data/HashMap/Strict.hs
+++ b/Data/HashMap/Strict.hs
@@ -75,6 +75,7 @@ module Data.HashMap.Strict
     , intersection
     , intersectionWith
     , intersectionWithKey
+    , disjoint
 
       -- * Folds
     , foldMapWithKey
diff --git a/Data/HashSet.hs b/Data/HashSet.hs
index 25b2d35c..592b4890 100644
--- a/Data/HashSet.hs
+++ b/Data/HashSet.hs
@@ -118,6 +118,7 @@ module Data.HashSet
       -- * Difference and intersection
     , difference
     , intersection
+    , disjoint
 
     -- * Folds
     , foldl'
diff --git a/Data/HashSet/Internal.hs b/Data/HashSet/Internal.hs
index 671c680f..626bac01 100644
--- a/Data/HashSet/Internal.hs
+++ b/Data/HashSet/Internal.hs
@@ -67,6 +67,7 @@ module Data.HashSet.Internal
       -- * Difference and intersection
     , difference
     , intersection
+    , disjoint
 
     -- * Folds
     , foldr
@@ -404,6 +405,10 @@ intersection :: Eq a => HashSet a -> HashSet a -> HashSet a
 intersection (HashSet a) (HashSet b) = HashSet (H.intersection a b)
 {-# INLINABLE intersection #-}
 
+disjoint :: Eq k => HashSet k -> HashSet k -> Bool
+disjoint (HashSet a) (HashSet b) = H.disjoint a b
+{-# INLINE disjoint #-}
+
 -- | \(O(n)\) Reduce this set by applying a binary operator to all
 -- elements, using the given starting value (typically the
 -- left-identity of the operator).  Each application of the operator
diff --git a/tests/Properties/HashMapLazy.hs b/tests/Properties/HashMapLazy.hs
index 7f7f66e8..85bcd94f 100644
--- a/tests/Properties/HashMapLazy.hs
+++ b/tests/Properties/HashMapLazy.hs
@@ -357,6 +357,11 @@ tests =
         \(Fn3 f :: Fun (Key, A, B) C) (x :: HMK A) (y :: HMK B) ->
           isValid (HM.intersectionWithKey f x y)
       ]
+    , testGroup "disjoint"
+      [ testProperty "model" $
+        \(x :: HMKI) (y :: HMKI) ->
+          HM.disjoint x y === M.disjoint (toOrdMap x) (toOrdMap y)
+      ]
     , testGroup "compose"
       [ testProperty "valid" $
         \(x :: HMK Int) (y :: HMK Key) -> isValid (HM.compose x y)

From 81ceb49911d93a2d36a43df15454c3c521f0e3bc Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Tue, 25 Nov 2025 19:58:07 +0100
Subject: [PATCH 03/15] WIP

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

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index efd9d5c8..049c9a4a 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2322,10 +2322,8 @@ disjoint = disjointSubtrees 0
 
 disjointSubtrees :: Eq k => Shift -> HashMap k a -> HashMap k b -> Bool
 disjointSubtrees _s Empty _b = True
-disjointSubtrees _s _a Empty = True
-disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) = hA == hB && kA /= kB
+disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) = hA /= hB || kA /= kB
 disjointSubtrees s (Leaf hA (L kA _)) b = lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
-disjointSubtrees s a (Leaf hB (L kB _)) = lookupCont (\_ -> True) (\_ _ -> False) hB kB s a
 disjointSubtrees s (BitmapIndexed bA aryA) (BitmapIndexed bB aryB)
   | bA .&. bB == 0 = True
   | aryA `A.unsafeSameArray` aryB = False
@@ -2351,6 +2349,8 @@ disjointSubtrees s a@(Collision hA _) (Full aryB) =
     i = index hA s
 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
 {-# INLINABLE disjointSubtrees #-}
 
@@ -2367,14 +2367,14 @@ disjointArrays !s !bA !aryA !bB !aryB = go (bA .&. bB)
         m = b .&. negate b
         iA = sparseIndex bA m
         iB = sparseIndex bB m
-{-# INLINABLE disjointArrays #-}
+{-# INLINE disjointArrays #-}
 
 disjointCollisions :: Eq k => Hash -> A.Array (Leaf k a) -> Hash -> A.Array (Leaf k b) -> Bool
 disjointCollisions !hA !aryA !hB !aryB
-  | hA /= hB = True
-  | otherwise = A.all f aryA
+  | hA == hB = A.all predicate aryA
+  | otherwise = True
   where
-    f (L kA _) = lookupInArrayCont (\_ -> True) (\_ _ -> False) kA aryB
+    predicate (L kA _) = lookupInArrayCont (\_ -> True) (\_ _ -> False) kA aryB
 {-# INLINABLE disjointCollisions #-}
 
 ------------------------------------------------------------------------

From e8a9848934cba13375f35525bae6b8d9458a344a Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 00:00:32 +0100
Subject: [PATCH 04/15] Tweak Full vs. Full

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

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 049c9a4a..f5617b97 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2325,16 +2325,24 @@ disjointSubtrees _s Empty _b = True
 disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) = hA /= hB || kA /= kB
 disjointSubtrees s (Leaf hA (L kA _)) b = lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
 disjointSubtrees s (BitmapIndexed bA aryA) (BitmapIndexed bB aryB)
-  | bA .&. bB == 0 = True
+  | bA .&. bB == 0 = True -- Skip this?!
   | aryA `A.unsafeSameArray` aryB = False
   | otherwise = disjointArrays s bA aryA bB aryB
-disjointSubtrees s (Full aryA) (Full aryB)
-  | aryA `A.unsafeSameArray` aryB = False
-  | otherwise = disjointArrays s fullBitmap aryA fullBitmap aryB
 disjointSubtrees s (BitmapIndexed bA aryA) (Full aryB) =
   disjointArrays s bA aryA fullBitmap aryB
 disjointSubtrees s (Full aryA) (BitmapIndexed bB aryB) =
   disjointArrays s fullBitmap aryA bB aryB
+disjointSubtrees s (Full aryA) (Full aryB)
+  | aryA `A.unsafeSameArray` aryB = False
+  | otherwise = go (maxChildren - 1)
+  where
+    go i
+      | i < 0 = True
+      | otherwise = case A.index# aryA i of
+          (# stA #) -> case A.index# aryB i of
+            (# stB #) ->
+              disjointSubtrees (nextShift s) stA stB &&
+              go (i - 1)
 disjointSubtrees s a@(Collision hA _) (BitmapIndexed bB aryB)
   | m .&. bB == 0 = True
   | otherwise = case A.index# aryB i of

From 2fa6ed36e983244bf9cdfb96480dbe93c858997c Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 00:34:51 +0100
Subject: [PATCH 05/15] Fix specialization

---
 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 f5617b97..79e3801a 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2321,7 +2321,7 @@ disjoint = disjointSubtrees 0
 {-# INLINE disjoint #-}
 
 disjointSubtrees :: Eq k => Shift -> HashMap k a -> HashMap k b -> Bool
-disjointSubtrees _s Empty _b = True
+disjointSubtrees !_s Empty _b = True
 disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) = hA /= hB || kA /= kB
 disjointSubtrees s (Leaf hA (L kA _)) b = lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
 disjointSubtrees s (BitmapIndexed bA aryA) (BitmapIndexed bB aryB)

From a98de8d8cebeb39cbdc62f8e90c9814df1d22682 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 00:35:20 +0100
Subject: [PATCH 06/15] Add TODO

---
 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 79e3801a..14ac75fb 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2325,7 +2325,7 @@ disjointSubtrees !_s Empty _b = True
 disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) = hA /= hB || kA /= kB
 disjointSubtrees s (Leaf hA (L kA _)) b = lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
 disjointSubtrees s (BitmapIndexed bA aryA) (BitmapIndexed bB aryB)
-  | bA .&. bB == 0 = True -- Skip this?!
+  | bA .&. bB == 0 = True -- TODO: Maybe skip this Skip this?!
   | aryA `A.unsafeSameArray` aryB = False
   | otherwise = disjointArrays s bA aryA bB aryB
 disjointSubtrees s (BitmapIndexed bA aryA) (Full aryB) =

From 51216a1aa8ddcb0469fd12a70d468274ab672c94 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 01:42:02 +0100
Subject: [PATCH 07/15] Reword TODO

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

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 14ac75fb..f7401bcf 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2325,7 +2325,8 @@ disjointSubtrees !_s Empty _b = True
 disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) = hA /= hB || kA /= kB
 disjointSubtrees s (Leaf hA (L kA _)) b = lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
 disjointSubtrees s (BitmapIndexed bA aryA) (BitmapIndexed bB aryB)
-  | bA .&. bB == 0 = True -- TODO: Maybe skip this Skip this?!
+    -- TODO: Try removing this check and just rely on disjointArrays.
+  | bA .&. bB == 0 = True
   | aryA `A.unsafeSameArray` aryB = False
   | otherwise = disjointArrays s bA aryA bB aryB
 disjointSubtrees s (BitmapIndexed bA aryA) (Full aryB) =

From 44ef5eee5255500da711b89102305568d6c83028 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 01:43:25 +0100
Subject: [PATCH 08/15] Formatting

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

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index f7401bcf..6fb499f9 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2322,8 +2322,10 @@ disjoint = disjointSubtrees 0
 
 disjointSubtrees :: Eq k => Shift -> HashMap k a -> HashMap k b -> Bool
 disjointSubtrees !_s Empty _b = True
-disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) = hA /= hB || kA /= kB
-disjointSubtrees s (Leaf hA (L kA _)) b = lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
+disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) =
+  hA /= hB || kA /= kB
+disjointSubtrees s (Leaf hA (L kA _)) b =
+  lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
 disjointSubtrees s (BitmapIndexed bA aryA) (BitmapIndexed bB aryB)
     -- TODO: Try removing this check and just rely on disjointArrays.
   | bA .&. bB == 0 = True
@@ -2359,7 +2361,8 @@ disjointSubtrees s a@(Collision hA _) (Full aryB) =
 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 (Leaf hB (L kB _)) =
+  lookupCont (\_ -> True) (\_ _ -> False) hB kB s a
 disjointSubtrees s a b@Collision{} = disjointSubtrees s b a
 {-# INLINABLE disjointSubtrees #-}
 

From b715959bad575e44cb596d2456bb12d532e625b6 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 01:45:01 +0100
Subject: [PATCH 09/15] Rename inner loops of some functions

...to improve the readability of the generated code.
---
 Data/HashMap/Internal.hs       | 27 ++++++++++++++-------------
 Data/HashMap/Internal/Array.hs |  6 +++---
 2 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 6fb499f9..85fe540a 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -720,23 +720,23 @@ lookupCont ::
   -> k
   -> Shift
   -> HashMap k v -> r
-lookupCont absent present !h0 !k0 !s0 m0 = go h0 k0 s0 m0
+lookupCont absent present !h0 !k0 !s0 m0 = lookupCont_ h0 k0 s0 m0
   where
-    go :: Eq k => Hash -> k -> Shift -> HashMap k v -> r
-    go !_ !_ !_ Empty = absent (# #)
-    go h k _ (Leaf hx (L kx x))
+    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 (# #)
-    go h k s (BitmapIndexed b v)
+    lookupCont_ h k s (BitmapIndexed b v)
         | b .&. m == 0 = absent (# #)
         | otherwise =
             case A.index# v (sparseIndex b m) of
-              (# st #) -> go h k (nextShift s) st
+              (# st #) -> lookupCont_ h k (nextShift s) st
       where m = mask h s
-    go h k s (Full v) =
+    lookupCont_ h k s (Full v) =
       case A.index# v (index h s) of
-        (# st #) -> go h k (nextShift s) st
-    go h k _ (Collision hx v)
+        (# st #) -> lookupCont_ h k (nextShift s) st
+    lookupCont_ h k _ (Collision hx v)
         | h == hx   = lookupInArrayCont absent present k v
         | otherwise = absent (# #)
 {-# INLINE lookupCont #-}
@@ -2713,15 +2713,16 @@ lookupInArrayCont ::
   forall r k v.
 #endif
   Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r
-lookupInArrayCont absent present k0 ary0 = go k0 ary0 0 (A.length ary0)
+lookupInArrayCont absent present k0 ary0 =
+    lookupInArrayCont_ k0 ary0 0 (A.length ary0)
   where
-    go :: Eq k => k -> A.Array (Leaf k v) -> Int -> Int -> r
-    go !k !ary !i !n
+    lookupInArrayCont_ :: Eq k => k -> A.Array (Leaf k v) -> Int -> Int -> r
+    lookupInArrayCont_ !k !ary !i !n
         | i >= n    = absent (# #)
         | otherwise = case A.index# ary i of
             (# L kx v #)
                 | k == kx   -> present v i
-                | otherwise -> go k ary (i+1) n
+                | otherwise -> lookupInArrayCont_ k ary (i+1) n
 {-# INLINE lookupInArrayCont #-}
 
 -- | \(O(n)\) Lookup the value associated with the given key in this
diff --git a/Data/HashMap/Internal/Array.hs b/Data/HashMap/Internal/Array.hs
index f49064e8..e151f123 100644
--- a/Data/HashMap/Internal/Array.hs
+++ b/Data/HashMap/Internal/Array.hs
@@ -399,13 +399,13 @@ foldr' f = \ z0 ary0 -> go ary0 (length ary0 - 1) z0
 {-# INLINE foldr' #-}
 
 foldr :: (a -> b -> b) -> b -> Array a -> b
-foldr f = \ z0 ary0 -> go ary0 (length ary0) 0 z0
+foldr f = \ z0 ary0 -> foldr_ ary0 (length ary0) 0 z0
   where
-    go ary n i z
+    foldr_ ary n i z
         | i >= n = z
         | otherwise
         = case index# ary i of
-            (# x #) -> f x (go ary n (i+1) z)
+            (# x #) -> f x (foldr_ ary n (i+1) z)
 {-# INLINE foldr #-}
 
 foldl :: (b -> a -> b) -> b -> Array a -> b

From 03638a84bfb5b0b00b406dc984ac0881eb51a8c7 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 01:54:11 +0100
Subject: [PATCH 10/15] Rename

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

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 85fe540a..daf66e9c 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2326,15 +2326,15 @@ disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) =
   hA /= hB || kA /= kB
 disjointSubtrees s (Leaf hA (L kA _)) b =
   lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
-disjointSubtrees s (BitmapIndexed bA aryA) (BitmapIndexed bB aryB)
+disjointSubtrees s (BitmapIndexed bmA aryA) (BitmapIndexed bmB aryB)
     -- TODO: Try removing this check and just rely on disjointArrays.
-  | bA .&. bB == 0 = True
+  | bmA .&. bmB == 0 = True
   | aryA `A.unsafeSameArray` aryB = False
-  | otherwise = disjointArrays s bA aryA bB aryB
-disjointSubtrees s (BitmapIndexed bA aryA) (Full aryB) =
-  disjointArrays s bA aryA fullBitmap aryB
-disjointSubtrees s (Full aryA) (BitmapIndexed bB aryB) =
-  disjointArrays s fullBitmap aryA bB aryB
+  | otherwise = disjointArrays s bmA aryA bmB aryB
+disjointSubtrees s (BitmapIndexed bmA aryA) (Full aryB) =
+  disjointArrays s bmA aryA fullBitmap aryB
+disjointSubtrees s (Full aryA) (BitmapIndexed bmB aryB) =
+  disjointArrays s fullBitmap aryA bmB aryB
 disjointSubtrees s (Full aryA) (Full aryB)
   | aryA `A.unsafeSameArray` aryB = False
   | otherwise = go (maxChildren - 1)
@@ -2346,13 +2346,13 @@ disjointSubtrees s (Full aryA) (Full aryB)
             (# stB #) ->
               disjointSubtrees (nextShift s) stA stB &&
               go (i - 1)
-disjointSubtrees s a@(Collision hA _) (BitmapIndexed bB aryB)
-  | m .&. bB == 0 = True
+disjointSubtrees s a@(Collision hA _) (BitmapIndexed bmB aryB)
+  | m .&. bmB == 0 = True
   | otherwise = case A.index# aryB i of
       (# stB #) -> disjointSubtrees (nextShift s) a stB
   where
     m = mask hA s
-    i = sparseIndex bB m
+    i = sparseIndex bmB m
 disjointSubtrees s a@(Collision hA _) (Full aryB) =
     case A.index# aryB i of
       (# stB #) -> disjointSubtrees (nextShift s) a stB
@@ -2367,18 +2367,18 @@ disjointSubtrees s a b@Collision{} = disjointSubtrees s b a
 {-# INLINABLE disjointSubtrees #-}
 
 disjointArrays :: Eq k => Shift -> Bitmap -> A.Array (HashMap k a) -> Bitmap -> A.Array (HashMap k b) -> Bool
-disjointArrays !s !bA !aryA !bB !aryB = go (bA .&. bB)
+disjointArrays !s !bmA !aryA !bmB !aryB = go (bmA .&. bmB)
   where
     go 0 = True
-    go b = case A.index# aryA iA of
+    go bm = case A.index# aryA iA of
         (# stA #) -> case A.index# aryB iB of
           (# stB #) ->
             disjointSubtrees (nextShift s) stA stB &&
-            go (b .&. complement m)
+            go (bm .&. complement m)
       where
-        m = b .&. negate b
-        iA = sparseIndex bA m
-        iB = sparseIndex bB m
+        m = bm .&. negate bm
+        iA = sparseIndex bmA m
+        iB = sparseIndex bmB m
 {-# INLINE disjointArrays #-}
 
 disjointCollisions :: Eq k => Hash -> A.Array (Leaf k a) -> Hash -> A.Array (Leaf k b) -> Bool

From 3f3c5c274fbe4f0d373904bf4ec91acd91d98bba Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 02:00:02 +0100
Subject: [PATCH 11/15] Tweak

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

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index daf66e9c..042e9355 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2354,10 +2354,8 @@ disjointSubtrees s a@(Collision hA _) (BitmapIndexed bmB aryB)
     m = mask hA s
     i = sparseIndex bmB m
 disjointSubtrees s a@(Collision hA _) (Full aryB) =
-    case A.index# aryB i of
-      (# stB #) -> disjointSubtrees (nextShift s) a stB
-  where
-    i = index hA s
+  case A.index# aryB (index hA s) of
+    (# stB #) -> disjointSubtrees (nextShift s) a stB
 disjointSubtrees _ (Collision hA aryA) (Collision hB aryB) =
   disjointCollisions hA aryA hB aryB
 disjointSubtrees _s _a Empty = True

From 9a7416eb0292d8fefe108045b982cbf869ddda94 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Thu, 27 Nov 2025 13:40:31 +0100
Subject: [PATCH 12/15] WIP: Haddocks

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

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 042e9355..c11fe6f3 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2316,6 +2316,11 @@ searchSwap mary n toFind start = go start toFind start
           else go i0 k (i + 1)
 {-# INLINE searchSwap #-}
 
+-- | Check whether the key sets of two maps are disjoint (i.e., their 'intersection' is empty).
+--
+-- @
+-- xs ``disjoint`` ys = null (xs ``intersection`` ys)
+-- @
 disjoint :: Eq k => HashMap k a -> HashMap k b -> Bool
 disjoint = disjointSubtrees 0
 {-# INLINE disjoint #-}

From 370ee24963cd7da86540a5980d670d1f3a0f3ee8 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Fri, 28 Nov 2025 01:17:46 +0100
Subject: [PATCH 13/15] WIP: haddocks

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

diff --git a/Data/HashSet/Internal.hs b/Data/HashSet/Internal.hs
index 626bac01..da78fe9f 100644
--- a/Data/HashSet/Internal.hs
+++ b/Data/HashSet/Internal.hs
@@ -405,6 +405,11 @@ intersection :: Eq a => HashSet a -> HashSet a -> HashSet a
 intersection (HashSet a) (HashSet b) = HashSet (H.intersection a b)
 {-# INLINABLE intersection #-}
 
+-- | Check whether two sets are disjoint (i.e., their intersection is empty).
+--
+-- @
+-- xs ``disjoint`` ys = null (xs ``intersection`` ys)
+-- @
 disjoint :: Eq k => HashSet k -> HashSet k -> Bool
 disjoint (HashSet a) (HashSet b) = H.disjoint a b
 {-# INLINE disjoint #-}

From e6e66f79cee80f7b12cd06ff2eb4b334e40c3b7a Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Fri, 28 Nov 2025 01:40:24 +0100
Subject: [PATCH 14/15] Remove pointer equality checks

---
 Data/HashMap/Internal.hs | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index c11fe6f3..96b7165c 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2331,18 +2331,22 @@ disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) =
   hA /= hB || kA /= kB
 disjointSubtrees s (Leaf hA (L kA _)) b =
   lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
-disjointSubtrees s (BitmapIndexed bmA aryA) (BitmapIndexed bmB aryB)
-    -- TODO: Try removing this check and just rely on disjointArrays.
-  | bmA .&. bmB == 0 = True
-  | aryA `A.unsafeSameArray` aryB = False
-  | otherwise = disjointArrays s bmA aryA bmB aryB
+disjointSubtrees s (BitmapIndexed bmA aryA) (BitmapIndexed bmB aryB) =
+  -- We could do a pointer equality check here but it's probably not worth it
+  -- since it would save only O(1) extra work:
+  --
+  -- not (aryA `A.unsafeSameArray` aryB) &&
+  disjointArrays s bmA aryA bmB aryB
 disjointSubtrees s (BitmapIndexed bmA aryA) (Full aryB) =
   disjointArrays s bmA aryA fullBitmap aryB
 disjointSubtrees s (Full aryA) (BitmapIndexed bmB aryB) =
   disjointArrays s fullBitmap aryA bmB aryB
-disjointSubtrees s (Full aryA) (Full aryB)
-  | aryA `A.unsafeSameArray` aryB = False
-  | otherwise = go (maxChildren - 1)
+disjointSubtrees s (Full aryA) (Full aryB) =
+    -- We could do a pointer equality check here but it's probably not worth it
+    -- since it would save only O(1) extra work:
+    --
+    -- not (aryA `A.unsafeSameArray` aryB) &&
+    go (maxChildren - 1)
   where
     go i
       | i < 0 = True

From 334423541259d35227dc266ecdab927f002d040e Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Fri, 28 Nov 2025 01:40:48 +0100
Subject: [PATCH 15/15] Remove Leaf vs Leaf case

lookupCont can do the work
---
 Data/HashMap/Internal.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
index 96b7165c..8763fd79 100644
--- a/Data/HashMap/Internal.hs
+++ b/Data/HashMap/Internal.hs
@@ -2327,8 +2327,6 @@ disjoint = disjointSubtrees 0
 
 disjointSubtrees :: Eq k => Shift -> HashMap k a -> HashMap k b -> Bool
 disjointSubtrees !_s Empty _b = True
-disjointSubtrees _ (Leaf hA (L kA _)) (Leaf hB (L kB _)) =
-  hA /= hB || kA /= kB
 disjointSubtrees s (Leaf hA (L kA _)) b =
   lookupCont (\_ -> True) (\_ _ -> False) hA kA s b
 disjointSubtrees s (BitmapIndexed bmA aryA) (BitmapIndexed bmB aryB) =