Introduce 'hashOfLeafOrCollision'

Core size reduction with GHC 9.12.2:

* Lazy.unionWithKey: 2256 terms -> 1286
* Strict.unionWithKey: 2101 terms -> 1167
* union @int in fine-grained: 1245 terms -> 1134

Author: sjakobi

Data/HashMap/Internal.hs

@@ -146,6 +146,7 @@ module Data.HashMap.Internal
     , deleteKeyExists
     , insertModifying
     , ptrEq
+    , hashOfLeafOrCollision
     , adjust#
     ) where
 
@@ -1625,7 +1626,7 @@ unionWithKey f = go 0
                                    go (nextShift s) st1 t2
                            in BitmapIndexed b1 ary'
         where
-          h2 = leafHashCode t2
+          h2 = hashOfLeafOrCollision t2
           m2 = mask h2 s
           i = sparseIndex b1 m2
     go s t1 (BitmapIndexed b2 ary2)
@@ -1636,24 +1637,20 @@ unionWithKey f = go 0
                                    go (nextShift s) t1 st2
                            in BitmapIndexed b2 ary'
       where
-        h1 = leafHashCode t1
+        h1 = hashOfLeafOrCollision t1
         m1 = mask h1 s
         i = sparseIndex b2 m1
     go s (Full ary1) t2 =
-        let h2   = leafHashCode t2
+        let h2   = hashOfLeafOrCollision t2
             i    = index h2 s
             ary' = updateFullArrayWith' ary1 i $ \st1 -> go (nextShift s) st1 t2
         in Full ary'
     go s t1 (Full ary2) =
-        let h1   = leafHashCode t1
+        let h1   = hashOfLeafOrCollision t1
             i    = index h1 s
             ary' = updateFullArrayWith' ary2 i $ \st2 -> go (nextShift s) t1 st2
         in Full ary'
 
-    leafHashCode (Leaf h _) = h
-    leafHashCode (Collision h _) = h
-    leafHashCode _ = error "leafHashCode"
-
     goDifferentHash s h1 h2 t1 t2
         | m1 == m2  = BitmapIndexed m1 (A.singleton $! goDifferentHash (nextShift s) h1 h2 t1 t2)
         | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)
@@ -2841,6 +2838,19 @@ otherOfOneOrZero :: Int -> Int
 otherOfOneOrZero i = 1 - i
 {-# INLINE otherOfOneOrZero #-}
 
+------------------------------------------------------------------------
+-- Tools for reducing duplication in code handling 'Leaf' and 'Collision' nodes
+
+-- | The 'Hash' of a 'Leaf' or 'Collision' node.
+--
+-- This function is marked @NOINLINE@ to prevent GHC from generating separate
+-- alternatives for 'Leaf' and 'Collision' nodes.
+hashOfLeafOrCollision :: HashMap k v -> Hash
+hashOfLeafOrCollision (Leaf h _) = h
+hashOfLeafOrCollision (Collision h _) = h
+hashOfLeafOrCollision _ = error "hashOfLeafOrCollision"
+{-# NOINLINE hashOfLeafOrCollision #-}
+
 ------------------------------------------------------------------------
 -- IsList instance
 instance (Eq k, Hashable k) => Exts.IsList (HashMap k v) where

Data/HashMap/Internal/Strict.hs

@@ -505,7 +505,7 @@ unionWithKey f = go 0
                                    go (nextShift s) st1 t2
                            in BitmapIndexed b1 ary'
         where
-          h2 = leafHashCode t2
+          h2 = HM.hashOfLeafOrCollision t2
           m2 = mask h2 s
           i = sparseIndex b1 m2
     go s t1 (BitmapIndexed b2 ary2)
@@ -516,24 +516,20 @@ unionWithKey f = go 0
                                    go (nextShift s) t1 st2
                            in BitmapIndexed b2 ary'
       where
-        h1 = leafHashCode t1
+        h1 = HM.hashOfLeafOrCollision t1
         m1 = mask h1 s
         i = sparseIndex b2 m1
     go s (Full ary1) t2 =
-        let h2   = leafHashCode t2
+        let h2   = HM.hashOfLeafOrCollision t2
             i    = index h2 s
             ary' = HM.updateFullArrayWith' ary1 i $ \st1 -> go (nextShift s) st1 t2
         in Full ary'
     go s t1 (Full ary2) =
-        let h1   = leafHashCode t1
+        let h1   = HM.hashOfLeafOrCollision t1
             i    = index h1 s
             ary' = HM.updateFullArrayWith' ary2 i $ \st2 -> go (nextShift s) t1 st2
         in Full ary'
 
-    leafHashCode (Leaf h _) = h
-    leafHashCode (Collision h _) = h
-    leafHashCode _ = error "leafHashCode"
-
     goDifferentHash s h1 h2 t1 t2
         | m1 == m2  = BitmapIndexed m1 (A.singleton $! goDifferentHash (nextShift s) h1 h2 t1 t2)
         | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)