Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d43a7b7a by Brian McKenna at 2026-07-15T20:10:04+02:00 Strip ticks when desugaring bool guards The special `considerAccessible` pattern was broken when compiling with debug info. Compiling with debug info wraps expressions with `SourceNote` ticks, which broke the internals of the `desugarBoolGuard` function. Ticks are now ignored within this function. Fixes #27360 - - - - - 4 changed files: - + changelog.d/T27360 - compiler/GHC/HsToCore/Pmc/Desugar.hs - + testsuite/tests/pmcheck/should_compile/T27360.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== changelog.d/T27360 ===================================== @@ -0,0 +1,10 @@ +section: compiler +issues: #27360 +mrs: !16161 +synopsis: + Recognise ``considerAccessible`` under ticks (``-g``, ``-finfo-table-map``, ``-fhpc`` etc) +description: + The pattern-match checker now properly recognises ``considerAccessible`` even + when it is surrounded by ticks (e.g. debug info ticks with ``-g``, with + ``-finfo-table-map``, etc). This ensures it works as advertised, suppressing + redundant pattern-match warnings, even when it occurs under a tick. ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -12,7 +12,8 @@ import GHC.Prelude import GHC.HsToCore.Pmc.Types import GHC.HsToCore.Pmc.Utils -import GHC.Core (Expr(Var,App)) +import GHC.Core (CoreExpr, Expr(Var,App)) +import GHC.Core.Utils (stripTicksTopE) import GHC.Data.FastString (unpackFS, lengthFS, mkFastStringShortText) import GHC.Driver.DynFlags import GHC.Hs @@ -474,24 +475,28 @@ desugarLocalBinds _binds = return GdEnd -- | Desugar a pattern guard -- @pat <- e ==> let x = e; <guards for pat <- x>@ desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM GrdDag -desugarBind p e = dsLExpr e >>= \case - Var y - | Nothing <- isDataConId_maybe y - -- RHS is a variable, so that will allow us to omit the let - -> desugarLPat y p - rhs -> do - (x, grds) <- desugarLPatV p - pure (PmLet x rhs `consGrdDag` grds) +desugarBind p e = + dsLExpr_stripTicks e >>= \case + Var y + | Nothing <- isDataConId_maybe y + -- RHS is a variable, so that will allow us to omit the let + -> desugarLPat y p + rhs -> do + (x, grds) <- desugarLPatV p + pure (PmLet x rhs `consGrdDag` grds) -- | Desugar a boolean guard -- @e ==> let x = e; True <- x@ desugarBoolGuard :: LHsExpr GhcTc -> DsM GrdDag desugarBoolGuard e - | isJust (isTrueLHsExpr e) = return GdEnd + | isJust (isTrueLHsExpr e) -- NB: looks through ticks -- The formal thing to do would be to generate (True <- True) -- but it is trivial to solve so instead we give back an empty -- GrdDag for efficiency - | otherwise = dsLExpr e >>= \case + = return GdEnd + + | otherwise + = dsLExpr_stripTicks e >>= \case Var y | Nothing <- isDataConId_maybe y -- Omit the let by matching on y @@ -500,6 +505,19 @@ desugarBoolGuard e x <- mkPmId boolTy pure $ sequencePmGrds [PmLet x rhs, vanillaConGrd x trueDataCon []] +-- | Desugar an expression, stripping off top-level ticks from the resulting +-- Core expression. +-- +-- This function is used instead of 'dsLExpr' when we are immediately going to +-- inspect the Core (as we do in e.g. 'desugarBoolGuard' or 'desugarBind') to +-- make sure we properly look through intervening ticks (fixing #27360). +-- +-- It's not needed when all we do is stash the resulting 'CoreExpr' into a +-- 'GrdDag', as the rest of the machinery (such as 'GHC.HsToCore.Pmc.Solver.addCoreCt') +-- looks through ticks. +dsLExpr_stripTicks :: LHsExpr GhcTc -> DsM CoreExpr +dsLExpr_stripTicks e = stripTicksTopE (const True) <$> dsLExpr e + {- Note [Field match order for RecCon] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The order for RecCon field patterns actually determines evaluation order of ===================================== testsuite/tests/pmcheck/should_compile/T27360.hs ===================================== @@ -0,0 +1,11 @@ +module T27360 where + +import GHC.Exts + +f :: () +f | False, considerAccessible = () + | otherwise = () + +g :: () +g | False, True <- considerAccessible = () + | otherwise = () ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -182,3 +182,4 @@ test('T24845', [], compile, [overlapping_incomplete]) test('T22652', [], compile, [overlapping_incomplete]) test('T22652a', [], compile, [overlapping_incomplete]) test('T24867', [], compile_fail, [overlapping_incomplete]) +test('T27360', normal, compile, [overlapping_incomplete + '-g3']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d43a7b7ad90047f1445c88d796ee7b15... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d43a7b7ad90047f1445c88d796ee7b15... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help