[Git][ghc/ghc][wip/expand-do] generate incomplete uni patterns warnings if the origin context is a generated do expansion

[Apoorv Ingle (@ani)]

Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC


Commits:
b8040095 by Apoorv Ingle at 2023-06-02T08:39:15-05:00
generate incomplete uni patterns warnings if the origin context is a generated do expansion

- - - - -


3 changed files:

- compiler/GHC/HsToCore/Match.hs
- + compiler/GHC/Tc/Gen/.#Expr.hs
- compiler/GHC/Tc/Gen/Match.hs


Changes:

=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -28,7 +28,7 @@ import Language.Haskell.Syntax.Basic (Boxity(..))
 
 import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr)
 
-import GHC.Types.Basic ( Origin(..), isGenerated )
+import GHC.Types.Basic ( Origin(..), isGenerated, isDoExpansionGenerated )
 import GHC.Types.SourceText
 import GHC.Driver.DynFlags
 import GHC.Hs
@@ -830,7 +830,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches'
                             , eqn_rhs  = match_result } }
 
     discard_warnings_if_generated orig =
-      if isGenerated orig
+      if isGenerated orig && not (isDoExpansionGenerated orig) -- better abstraction?
       then discardWarningsDs
       else id
 


=====================================
compiler/GHC/Tc/Gen/.#Expr.hs
=====================================
@@ -0,0 +1 @@
+aningle at CS-M030.71606
\ No newline at end of file


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -1344,7 +1344,7 @@ expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) =
             , app_arg_pattern = pat@(L loc _)
             , arg_expr        = rhs
             }) =
-      return ((pat, mb_fail_op), wrapGenSpan (mkExpandedStmt (L loc (BindStmt xbsn pat rhs)) rhs))
+      return ((pat, mb_fail_op), L loc (mkExpandedStmt (L loc (BindStmt xbsn pat rhs)) rhs))
     do_arg (ApplicativeArgMany _ stmts ret pat ctxt) =
       do { expr <- expand_do_stmts ctxt $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)]
          ; return ((pat, Nothing), expr) }



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b804009505e9aa7c06ee6d48af3a7d691267d888
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/20230602/3e0087a2/attachment-0001.html>