`IntSet.difference`: SpecConstr reboxing defeats the `NOM -> t1` sharing at -O2

[sjakobi]

containers/containers/src/Data/IntSet/Internal.hs

Lines 700 to 720 in 722218d

	difference :: IntSet -> IntSet -> IntSet
	difference t1@(Bin p1 l1 r1) t2@(Bin p2 l2 r2) = case treeTreeBranch p1 p2 of
	ABL -> binCheckL p1 (difference l1 t2) r1
	ABR -> binCheckR p1 l1 (difference r1 t2)
	BAL -> difference t1 l2
	BAR -> difference t1 r2
	EQL -> bin p1 (difference l1 l2) (difference r1 r2)
	NOM -> t1
	difference t@(Bin _ _ _) (Tip kx bm) = deleteBM kx bm t
	difference t@(Bin _ _ _) Nil = t
	difference t1@(Tip kx bm) t2 = differenceTip t2
	where differenceTip (Bin p2 l2 r2) | nomatch kx p2 = t1
	| left kx p2 = differenceTip l2
	| otherwise = differenceTip r2
	differenceTip (Tip kx2 bm2) | kx == kx2 = tip kx (bm .&. complement bm2)
	| otherwise = t1
	differenceTip Nil = t1
	difference Nil _ = Nil

Reproducer:

{-# LANGUAGE MagicHash #-}
module Main (main) where

import Control.Exception (evaluate)
import GHC.Exts (reallyUnsafePtrEquality#, isTrue#)
import qualified Data.IntSet as IS

ptrEq :: a -> a -> Bool
ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y)

main :: IO ()
main = do
  -- t1 nests inside t2's prefix range: BAL/BAR descent ending in NOM
  t1 <- evaluate $ IS.fromList [256..511]
  t2 <- evaluate $ IS.fromList [0, 1024, 4096, 65536]
  d1 <- evaluate $ IS.difference t1 t2
  putStrLn $ "nested/NOM : " ++ show (d1 `ptrEq` t1)

  -- absent single key (Bin/Tip -> deleteBM path)
  d2 <- evaluate $ IS.difference t1 (IS.singleton 5000)
  putStrLn $ "absent tip : " ++ show (d2 `ptrEq` t1)

With GHC 9.14.1:

	-O2	-O2 -fno-spec-constr
nested/NOM	False	True
absent tip	False	True

Core:

Data.IntSet.Internal.difference_$sdifference1
  :: GHC.Exts.Int# -> IntSet -> IntSet -> IntSet -> IntSet
Data.IntSet.Internal.difference_$sdifference1
  = \ (sc :: GHC.Exts.Int#)
      (sc1 :: IntSet)
      (sc2 :: IntSet)
      (t2 :: IntSet) ->
      ...
      case t2 of {
        Bin bx l2 r2 ->
          ...
              -- NOM -> t1
              __DEFAULT -> Data.IntSet.Internal.Bin sc sc3 sc4;
          ...
        -- difference t@(Bin _ _ _) Nil = t
        Nil -> Data.IntSet.Internal.Bin sc sc3 sc4
      }

Analysis from Claude

The BAL/BAR branches call difference t1 l2 where t1 is a case binder with a statically known Bin constructor. SpecConstr (on by default at -O2) specializes difference on the exploded fields of t1, and every "return t1 unchanged" branch of the specialization must rebox them into a fresh Bin. This is SpecConstr's known reboxing problem (Note [Reboxing] in GHC.Core.Opt.SpecConstr, https://gitlab.haskell.org/ghc/ghc/-/issues/27628); GHC #13331 is the same failure shape for Map.insert via worker/wrapper.

Likely affected in the same way: IntSet.intersection, and IntMap.difference (to be fixed together with adding ptrEq checks in #1241). IntMap.withoutKeys/restrictKeys and any future ptrEq-based sharing (#835, #1220) face the same hazard.

The impact doesn't seem too bad in this case: It's just the root Bin re-allocated when it could be returned unchanged. Still a nasty footgun to be aware of. :/