[Git][ghc/ghc][wip/expand-do] push the `match_ctxt` business inside `tcMatchLambda`

[Apoorv Ingle (@ani)]

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


Commits:
6054e134 by Gergő Érdi at 2023-11-06T12:12:07+01:00
push the `match_ctxt` business inside `tcMatchLambda`

- - - - -


3 changed files:

- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Match.hs


Changes:

=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -326,12 +326,12 @@ The {l1} etc are location/source span information stored in the AST by the parse
 
 The 3 non-obvious points to consider are:
  1. Wrap the expression with a `fail` block if the pattern match is not irrefutable.
-    See Part 1. Below
+    See Part 1. below
  2. Generate appropriate warnings for discarded results in a body statement
     eg. say `do { .. ; (g p :: m Int) ; ... }`
-    See Part 2. Below
+    See Part 2. below
  3. Generating appropriate type error messages which blame the correct source spans
-    See Part 3 Below
+    See Part 3. below
 
 Part 1. Expanding Patterns Bindings
 -----------------------------------


=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -265,19 +265,9 @@ tcExpr e@(HsIPVar _ x) res_ty
   origin = IPOccOrigin x
 
 tcExpr e@(HsLam x lam_variant matches) res_ty
-  = do { (wrap, matches') <- tcMatchLambda herald match_ctxt matches res_ty
+  = do { (wrap, matches') <- tcMatchLambda herald lam_variant matches res_ty
        ; return (mkHsWrap wrap $ HsLam x lam_variant matches') }
   where
-    match_ctxt
-      | Just f <- doExpansionFlavour (mg_ext matches)
-      -- See Part 3. B. of Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`. Testcase: Typeable1
-      = MC { mc_what = StmtCtxt (HsDoStmt f)
-           , mc_body = tcBodyNC -- NB: Do not add any error contexts
-                                -- It has already been done
-           }
-      | otherwise
-      = MC { mc_what = LamAlt lam_variant
-           , mc_body = tcBody }
     herald = ExpectedFunTyLam lam_variant e
 
 


=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -77,6 +77,7 @@ import GHC.Types.Fixity (LexicalFixity(..))
 import GHC.Types.Name
 import GHC.Types.Id
 import GHC.Types.SrcLoc
+import GHC.Types.Basic
 
 import Control.Monad
 import Control.Arrow ( second )
@@ -155,11 +156,11 @@ tcMatchesCase ctxt (Scaled scrut_mult scrut_ty) matches res_ty
   = tcMatches ctxt [ExpFunPatTy (Scaled scrut_mult (mkCheckExpType scrut_ty))] res_ty matches
 
 tcMatchLambda :: ExpectedFunTyOrigin -- see Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify
-              -> TcMatchCtxt HsExpr
+              -> HsLamVariant
               -> MatchGroup GhcRn (LHsExpr GhcRn)
               -> ExpRhoType
               -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
-tcMatchLambda herald match_ctxt match res_ty
+tcMatchLambda herald lam_variant match res_ty
   =  do { checkArgCounts (mc_what match_ctxt) match
         ; matchExpectedFunTys herald GenSigCtxt n_pats res_ty $ \ pat_tys rhs_ty -> do
             -- checking argument counts since this is also used for \cases
@@ -168,6 +169,18 @@ tcMatchLambda herald match_ctxt match res_ty
     n_pats | isEmptyMatchGroup match = 1   -- must be lambda-case
            | otherwise               = matchGroupArity match
 
+    match_ctxt
+           | Just f <- doExpansionFlavour (mg_ext match)
+            -- See Part 3. B. of Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`. Testcase: Typeable1
+           = MC { mc_what = StmtCtxt (HsDoStmt f)
+                , mc_body = tcBodyNC -- NB: Do not add any error contexts
+                                -- It has already been done
+                }
+           | otherwise
+           = MC { mc_what = LamAlt lam_variant
+                , mc_body = tcBody }
+
+
 -- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind at .
 
 tcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn) -> ExpRhoType



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6054e13486fe64cfe6146a2751f1652ccc9b72cd
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/20231106/4ed21806/attachment-0001.html>