Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

4 changed files:

Changes:

  • changelog.d/T27360
    1 
    +section: compiler
    2 
    +issues: #27360
    3 
    +mrs: !16161
    4 
    +synopsis:
    5 
    +  Recognise ``considerAccessible`` under ticks (``-g``, ``-finfo-table-map``, ``-fhpc`` etc)
    6 
    +description:
    7 
    +  The pattern-match checker now properly recognises ``considerAccessible`` even
    8 
    +  when it is surrounded by ticks (e.g. debug info ticks with ``-g``, with
    9 
    +  ``-finfo-table-map``, etc). This ensures it works as advertised, suppressing
    10 
    +  redundant pattern-match warnings, even when it occurs under a tick.

  • compiler/GHC/HsToCore/Pmc/Desugar.hs
    ... ... @@ -12,7 +12,8 @@ import GHC.Prelude
    12 12
    13 13 
     import GHC.HsToCore.Pmc.Types
    14 14 
     import GHC.HsToCore.Pmc.Utils
    15 
    -import GHC.Core (Expr(Var,App))
    15 
    +import GHC.Core (CoreExpr, Expr(Var,App))
    16 
    +import GHC.Core.Utils (stripTicksTopE)
    16 17 
     import GHC.Data.FastString (unpackFS, lengthFS, mkFastStringShortText)
    17 18 
     import GHC.Driver.DynFlags
    18 19 
     import GHC.Hs
    ... ... @@ -474,24 +475,28 @@ desugarLocalBinds _binds = return GdEnd
    474 475 
     -- | Desugar a pattern guard
    475 476 
     --   @pat <- e ==>  let x = e;  <guards for pat <- x>@
    476 477 
     desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM GrdDag
    477 
    -desugarBind p e = dsLExpr e >>= \case
    478 
    -  Var y
    479 
    -    | Nothing <- isDataConId_maybe y
    480 
    -    -- RHS is a variable, so that will allow us to omit the let
    481 
    -    -> desugarLPat y p
    482 
    -  rhs -> do
    483 
    -    (x, grds) <- desugarLPatV p
    484 
    -    pure (PmLet x rhs `consGrdDag` grds)
    478 
    +desugarBind p e =
    479 
    +  dsLExpr_stripTicks e >>= \case
    480 
    +    Var y
    481 
    +      | Nothing <- isDataConId_maybe y
    482 
    +      -- RHS is a variable, so that will allow us to omit the let
    483 
    +      -> desugarLPat y p
    484 
    +    rhs -> do
    485 
    +      (x, grds) <- desugarLPatV p
    486 
    +      pure (PmLet x rhs `consGrdDag` grds)
    485 487
    486 488 
     -- | Desugar a boolean guard
    487 489 
     --   @e ==>  let x = e; True <- x@
    488 490 
     desugarBoolGuard :: LHsExpr GhcTc -> DsM GrdDag
    489 491 
     desugarBoolGuard e
    490 
    -  | isJust (isTrueLHsExpr e) = return GdEnd
    492 
    +  | isJust (isTrueLHsExpr e) -- NB: looks through ticks
    491 493 
         -- The formal thing to do would be to generate (True <- True)
    492 494 
         -- but it is trivial to solve so instead we give back an empty
    493 495 
         -- GrdDag for efficiency
    494 
    -  | otherwise = dsLExpr e >>= \case
    496 
    +  = return GdEnd
    497 
    +
    498 
    +  | otherwise
    499 
    +  = dsLExpr_stripTicks e >>= \case
    495 500 
           Var y
    496 501 
             | Nothing <- isDataConId_maybe y
    497 502 
             -- Omit the let by matching on y
    ... ... @@ -500,6 +505,19 @@ desugarBoolGuard e
    500 505 
             x <- mkPmId boolTy
    501 506 
             pure $ sequencePmGrds [PmLet x rhs, vanillaConGrd x trueDataCon []]
    502 507
    508 
    +-- | Desugar an expression, stripping off top-level ticks from the resulting
    509 
    +-- Core expression.
    510 
    +--
    511 
    +-- This function is used instead of 'dsLExpr' when we are immediately going to
    512 
    +-- inspect the Core (as we do in e.g. 'desugarBoolGuard' or 'desugarBind') to
    513 
    +-- make sure we properly look through intervening ticks (fixing #27360).
    514 
    +--
    515 
    +-- It's not needed when all we do is stash the resulting 'CoreExpr' into a
    516 
    +-- 'GrdDag', as the rest of the machinery (such as 'GHC.HsToCore.Pmc.Solver.addCoreCt')
    517 
    +-- looks through ticks.
    518 
    +dsLExpr_stripTicks :: LHsExpr GhcTc -> DsM CoreExpr
    519 
    +dsLExpr_stripTicks e = stripTicksTopE (const True) <$> dsLExpr e
    520 
    +
    503 521 
     {- Note [Field match order for RecCon]
    504 522 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    505 523 
     The order for RecCon field patterns actually determines evaluation order of

  • testsuite/tests/pmcheck/should_compile/T27360.hs
    1 
    +module T27360 where
    2 
    +
    3 
    +import GHC.Exts
    4 
    +
    5 
    +f :: ()
    6 
    +f | False, considerAccessible = ()
    7 
    +  | otherwise = ()
    8 
    +
    9 
    +g :: ()
    10 
    +g | False, True <- considerAccessible = ()
    11 
    +  | otherwise = ()

  • testsuite/tests/pmcheck/should_compile/all.T
    ... ... @@ -182,3 +182,4 @@ test('T24845', [], compile, [overlapping_incomplete])
    182 182 
     test('T22652', [], compile, [overlapping_incomplete])
    183 183 
     test('T22652a', [], compile, [overlapping_incomplete])
    184 184 
     test('T24867', [], compile_fail, [overlapping_incomplete])
    185 
    +test('T27360', normal, compile, [overlapping_incomplete + '-g3'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/d43a7b7ad90047f1445c88d796ee7b15a0a605d7 at 1784170746