Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ae4ddd60 by Sylvain Henry at 2026-03-20T12:28:28-04:00 Core: add constant-folding rules for Addr# eq/ne (#18032) - - - - - 4 changed files: - compiler/GHC/Core/Opt/ConstantFold.hs - + testsuite/tests/simplCore/should_compile/T18032.hs - + testsuite/tests/simplCore/should_compile/T18032.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -844,6 +844,14 @@ primOpRules nm = \case -- Misc + -- See Note [Constant folding for Addr# equality] + AddrEqOp -> mkPrimOpRule nm 2 [ equalArgs >> (trueValInt <$> getPlatform) + , match_litAddr_eq True + ] + AddrNeOp -> mkPrimOpRule nm 2 [ equalArgs >> (falseValInt <$> getPlatform) + , match_litAddr_eq False + ] + AddrAddOp -> mkPrimOpRule nm 2 [ rightIdentityPlatform zeroi ] SparkOp -> mkPrimOpRule nm 4 [ sparkRule ] @@ -969,6 +977,39 @@ cmpOp cmp env = go -------------------------- +-- Note [Constant folding for Addr# equality] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- We constant-fold (eqAddr# "foo"# "bar"#) when both arguments are string +-- literals with *different* byte content. Because the bytes differ, the two +-- literals cannot reside at the same address, so the result is definitely +-- False (or True for neAddr#). +-- +-- We use exprIsLiteral_maybe (via isLiteral) rather than binaryLit/cmpOp, +-- because string literals are frequently floated out to the top level as CAF +-- bindings. That turns them into variables, and we must look through those +-- variable unfoldings to recover the underlying LitString. +-- +-- When both literals have the *same* byte content we do NOT fold to True. +-- Two distinct literal occurrences in the source may end up at different +-- addresses in the object file (the linker is not required to merge them), +-- so pointer equality is not guaranteed by equal content alone. The +-- equalArgs already handles the case where both arguments are the *same* +-- expression (provably the same pointer). + +match_litAddr_eq :: Bool -- ^ True <=> eqAddr# (fold different-content to False) + -- False <=> neAddr# (fold different-content to True) + -> RuleM CoreExpr +-- See Note [Constant folding for Addr# equality] +match_litAddr_eq is_eq = do + platform <- getPlatform + [e1, e2] <- getArgs + LitString s1 <- isLiteral e1 + LitString s2 <- isLiteral e2 + guard (s1 /= s2) + return $ if is_eq then falseValInt platform else trueValInt platform + +-------------------------- + negOp :: RuleOpts -> Literal -> Maybe CoreExpr -- Negate negOp env lit = case lit of (LitFloating prec f) -> Just $ Lit $ LitFloating prec $ ===================================== testsuite/tests/simplCore/should_compile/T18032.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE MagicHash #-} +module T18032 where + +import GHC.Exts + +-- Different byte content: eqAddr# must be False (0), neAddr# must be True (1) +a = I# (eqAddr# "foo"# "bar"#) +b = I# (neAddr# "foo"# "bar"#) + +-- Same variable on both sides: eqAddr# must be True (1), neAddr# must be False (0) +c = let s = "baz"# in I# (eqAddr# s s) +d = let s = "baz"# in I# (neAddr# s s) ===================================== testsuite/tests/simplCore/should_compile/T18032.stderr ===================================== @@ -0,0 +1,15 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 10, types: 4, coercions: 0, joins: 0/0} + +a = I# 0# + +b = I# 1# + +c = b + +d = a + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -593,3 +593,4 @@ test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds']) test('T26805', [grep_errmsg(r'fromInteger')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques']) test('T26826', normal, compile, ['-O']) test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all']) +test('T18032', normal, compile, ['-O -dsuppress-all -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae4ddd60d2a16c7463175196c3198326... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae4ddd60d2a16c7463175196c3198326... You're receiving this email because of your account on gitlab.haskell.org.