[Git][ghc/ghc][master] Respect -XStrict in the pattern-match checker (#21761)

[Marge Bot (@marge-bot)]

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


Commits:
e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00
Respect -XStrict in the pattern-match checker (#21761)

We were missing a call to `decideBangHood` in the pattern-match checker.
There is another call in `matchWrapper.mk_eqn_info` which seems redundant
but really is not; see `Note [Desugaring -XStrict matches in Pmc]`.

Fixes #21761.

- - - - -


4 changed files:

- compiler/GHC/HsToCore/Pmc/Desugar.hs
- + testsuite/tests/pmcheck/should_compile/T21761.hs
- + testsuite/tests/pmcheck/should_compile/T21761.stderr
- testsuite/tests/pmcheck/should_compile/all.T


Changes:

=====================================
compiler/GHC/HsToCore/Pmc/Desugar.hs
=====================================
@@ -38,7 +38,7 @@ import GHC.Core.Coercion
 import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper)
 import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr)
 import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper)
-import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar)
+import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar, decideBangHood)
 import GHC.HsToCore.Match.Literal (dsLit, dsOverLit)
 import GHC.HsToCore.Monad
 import GHC.Core.TyCo.Rep
@@ -334,7 +334,10 @@ desugarMatches vars matches =
 -- Desugar a single match
 desugarMatch :: [Id] -> LMatch GhcTc (LHsExpr GhcTc) -> DsM (PmMatch Pre)
 desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do
-  pats'  <- concat <$> zipWithM desugarLPat vars pats
+  dflags <- getDynFlags
+  -- decideBangHood: See Note [Desugaring -XStrict matches in Pmc]
+  let banged_pats = map (decideBangHood dflags) pats
+  pats'  <- concat <$> zipWithM desugarLPat vars banged_pats
   grhss' <- desugarGRHSs (locA match_loc) (sep (map ppr pats)) grhss
   -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss'])
   return PmMatch { pm_pats = GrdVec pats', pm_grhss = grhss' }
@@ -533,4 +536,30 @@ the whole point.
 The place to store the 'PmLet' guards for @where@ clauses (which are per
 'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of
 @x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'.
+
+Note [Desugaring -XStrict matches in Pmc]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider (#21761)
+
+  {-# LANGUAGE Strict #-}
+  idV :: Void -> Void
+  idV v = v
+
+Without -XStrict, we would not warn here. But with -XStrict, there is an
+implicit bang on `v` and we should give an inaccessible warning for the RHS.
+The way we account for that is by calling `decideBangHood` on patterns
+in a `Match`, which inserts the implicit bang.
+
+Making the call here actually seems redundant with the call to `decideBangHood`
+in `GHC.HsToCore.Match.matchWrapper`, which does it *after* it calls the
+pattern-match checker on the Match's patterns. It would be great if we could expect
+`matchWrapper` to pass the bang-adorned `Match` to the pattern-match checker,
+but sadly then we get worse warning messages which would print `idV` as if the
+user *had* written a bang:
+
+     Pattern match has inaccessible right hand side
+-    In an equation for ‘idV’: idV v = ...
++    In an equation for ‘idV’: idV !v = ...
+
+So we live with the duplication.
 -}


=====================================
testsuite/tests/pmcheck/should_compile/T21761.hs
=====================================
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE Strict #-}
+
+module T21761 where
+
+data Void
+
+idV :: Void -> Void
+idV v = v
+
+idV' :: Void -> Void
+idV' v = case v of w -> w
+
+bangIdV :: Void -> Void
+bangIdV !v = v
+
+bangIdV' :: Void -> Void
+bangIdV' v = case v of !w -> w


=====================================
testsuite/tests/pmcheck/should_compile/T21761.stderr
=====================================
@@ -0,0 +1,24 @@
+
+T21761.hs:10:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘idV’: idV v = ...
+
+T21761.hs:13:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘idV'’: idV' v = ...
+
+T21761.hs:13:20: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In a case alternative: w -> ...
+
+T21761.hs:16:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘bangIdV’: bangIdV !v = ...
+
+T21761.hs:19:1: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In an equation for ‘bangIdV'’: bangIdV' v = ...
+
+T21761.hs:19:24: warning: [GHC-94210] [-Woverlapping-patterns (in -Wdefault)]
+    Pattern match has inaccessible right hand side
+    In a case alternative: !w -> ...


=====================================
testsuite/tests/pmcheck/should_compile/all.T
=====================================
@@ -157,3 +157,4 @@ test('EmptyCase008', [],  compile, [overlapping_incomplete])
 test('EmptyCase009', [],  compile, [overlapping_incomplete])
 test('EmptyCase010', [],  compile, [overlapping_incomplete])
 test('T19271', [],  compile, [overlapping_incomplete])
+test('T21761', [],  compile, [overlapping_incomplete])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9d74a3e47a4709502d7c1923b8611c22183b777

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9d74a3e47a4709502d7c1923b8611c22183b777
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221213/0c49084c/attachment-0001.html>