[Git][ghc/ghc][wip/match-pat] WIP: Introduce RnMatchCtxt
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Sun Aug 27 05:34:03 UTC 2023
Vladislav Zavialov pushed to branch wip/match-pat at Glasgow Haskell Compiler / GHC
Commits:
0d429b6c by Vladislav Zavialov at 2023-08-27T08:33:52+03:00
WIP: Introduce RnMatchCtxt
- - - - -
5 changed files:
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Match.hs
Changes:
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -25,6 +25,7 @@ module GHC.Rename.Bind (
-- Other bindings
rnMethodBinds, renameSigs,
+ RnMatchCtxt(..),
rnMatchGroup, rnGRHSs, rnGRHS, rnSrcFixityDecl,
makeMiniFixityEnv, MiniFixityEnv,
HsSigCtxt(..),
@@ -494,7 +495,10 @@ rnBind _ bind@(PatBind { pat_lhs = pat
-- after processing the LHS
, pat_ext = pat_fvs })
= do { mod <- getModule
- ; (grhss', rhs_fvs) <- rnGRHSs PatBindRhs rnLExpr grhss
+ ; let match_ctxt = RnMC { rnmc_what = PatBindRhs
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLExpr }
+ ; (grhss', rhs_fvs) <- rnGRHSs match_ctxt grhss
-- No scoped type variables for pattern bindings
; let all_fvs = pat_fvs `plusFV` rhs_fvs
@@ -520,10 +524,12 @@ rnBind sig_fn bind@(FunBind { fun_id = name
-- invariant: no free vars here when it's a FunBind
= do { let plain_name = unLoc name
+ ; let match_ctxt = RnMC { rnmc_what = mkPrefixFunRhs name
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLExpr }
; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
-- bindSigTyVars tests for LangExt.ScopedTyVars
- rnMatchGroup (mkPrefixFunRhs name)
- rnPats rnLExpr matches
+ rnMatchGroup match_ctxt matches
; let is_infix = isInfixFunBind bind
; when is_infix $ checkPrecMatch plain_name matches'
@@ -768,9 +774,11 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
Unidirectional -> return (Unidirectional, emptyFVs)
ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
ExplicitBidirectional mg ->
- do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $
- rnMatchGroup (mkPrefixFunRhs (L l name))
- rnPats rnLExpr mg
+ do { let match_ctxt = RnMC { rnmc_what = mkPrefixFunRhs (L l name)
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLExpr }
+ ; (mg', fvs) <- bindSigTyVarsFV scoped_tvs $
+ rnMatchGroup match_ctxt mg
; return (ExplicitBidirectional mg', fvs) }
; mod <- getModule
@@ -1238,6 +1246,18 @@ checkDupMinimalSigs sigs
************************************************************************
-}
+data RnMatchCtxt pat body
+ = RnMC
+ { rnmc_what :: HsMatchContext GhcRn
+ , rnmc_pats :: forall a.
+ HsMatchContext GhcRn
+ -> [LocatedA (pat GhcPs)]
+ -> ([LocatedA (pat GhcRn)]
+ -> RnM (a, FreeVars))
+ -> RnM (a, FreeVars)
+ , rnmc_body :: LocatedA (body GhcPs)
+ -> RnM (LocatedA (body GhcRn), FreeVars) }
+
type AnnoBody body
= ( Anno (GRHS GhcRn (LocatedA (body GhcRn))) ~ SrcAnn NoEpAnns
, Anno (GRHS GhcPs (LocatedA (body GhcPs))) ~ SrcAnn NoEpAnns
@@ -1279,43 +1299,37 @@ type AnnoPatBody pat body
-- MatchGroup but -XEmptyCases is disabled, we add an error.
rnMatchGroup :: (AnnoPatBody pat body)
- => HsMatchContext GhcRn
- -> (forall a. HsMatchContext GhcRn -> [LocatedA (pat GhcPs)] -> ([LocatedA (pat GhcRn)] -> RnM (a, FreeVars)) -> RnM (a, FreeVars))
- -> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
+ => RnMatchCtxt pat body
-> MatchGroup GhcPs (LocatedA (pat GhcPs)) (LocatedA (body GhcPs))
-> RnM (MatchGroup GhcRn (LocatedA (pat GhcRn)) (LocatedA (body GhcRn)), FreeVars)
-rnMatchGroup ctxt rnMatchPats rnBody (MG { mg_alts = L lm ms, mg_ext = origin })
+rnMatchGroup ctxt (MG { mg_alts = L lm ms, mg_ext = origin })
-- see Note [Empty MatchGroups]
- = do { whenM ((null ms &&) <$> mustn't_be_empty) (addErr (TcRnEmptyCase ctxt))
- ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnMatchPats rnBody) ms
+ = do { whenM ((null ms &&) <$> mustn't_be_empty) (addErr (TcRnEmptyCase (rnmc_what ctxt)))
+ ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt) ms
; return (mkMatchGroup origin (L lm new_ms), ms_fvs) }
where
- mustn't_be_empty = case ctxt of
+ mustn't_be_empty = case rnmc_what ctxt of
LamCaseAlt LamCases -> return True
ArrowMatchCtxt (ArrowLamCaseAlt LamCases) -> return True
_ -> not <$> xoptM LangExt.EmptyCase
rnMatch :: (AnnoPatBody pat body)
- => HsMatchContext GhcRn
- -> (forall a. HsMatchContext GhcRn -> [LocatedA (pat GhcPs)] -> ([LocatedA (pat GhcRn)] -> RnM (a, FreeVars)) -> RnM (a, FreeVars))
- -> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
+ => RnMatchCtxt pat body
-> LMatch GhcPs (LocatedA (pat GhcPs)) (LocatedA (body GhcPs))
-> RnM (LMatch GhcRn (LocatedA (pat GhcRn)) (LocatedA (body GhcRn)), FreeVars)
-rnMatch ctxt rnMatchPats rnBody = wrapLocFstMA (rnMatch' ctxt rnMatchPats rnBody)
+rnMatch ctxt = wrapLocFstMA (rnMatch' ctxt)
rnMatch' :: (AnnoPatBody pat body)
- => HsMatchContext GhcRn
- -> (forall a. HsMatchContext GhcRn -> [LocatedA (pat GhcPs)] -> ([LocatedA (pat GhcRn)] -> RnM (a, FreeVars)) -> RnM (a, FreeVars))
- -> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
+ => RnMatchCtxt pat body
-> Match GhcPs (LocatedA (pat GhcPs)) (LocatedA (body GhcPs))
-> RnM (Match GhcRn (LocatedA (pat GhcRn)) (LocatedA (body GhcRn)), FreeVars)
-rnMatch' ctxt rnMatchPats rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss })
- = rnMatchPats ctxt pats $ \ pats' -> do
- { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
- ; let mf' = case (ctxt, mf) of
+rnMatch' ctxt (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss })
+ = rnmc_pats ctxt (rnmc_what ctxt) pats $ \ pats' -> do
+ { (grhss', grhss_fvs) <- rnGRHSs ctxt grhss
+ ; let mf' = case (rnmc_what ctxt, mf) of
(FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ })
-> mf { mc_fun = L lf funid }
- _ -> ctxt
+ _ -> rnmc_what ctxt
; return (Match { m_ext = noAnn, m_ctxt = mf', m_pats = pats'
, m_grhss = grhss'}, grhss_fvs ) }
@@ -1329,30 +1343,27 @@ rnMatch' ctxt rnMatchPats rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss =
-}
rnGRHSs :: AnnoBody body
- => HsMatchContext GhcRn
- -> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
+ => RnMatchCtxt pat body
-> GRHSs GhcPs (LocatedA (body GhcPs))
-> RnM (GRHSs GhcRn (LocatedA (body GhcRn)), FreeVars)
-rnGRHSs ctxt rnBody (GRHSs _ grhss binds)
+rnGRHSs ctxt (GRHSs _ grhss binds)
= rnLocalBindsAndThen binds $ \ binds' _ -> do
- (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss
+ (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt) grhss
return (GRHSs emptyComments grhss' binds', fvGRHSs)
rnGRHS :: AnnoBody body
- => HsMatchContext GhcRn
- -> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
+ => RnMatchCtxt pat body
-> LGRHS GhcPs (LocatedA (body GhcPs))
-> RnM (LGRHS GhcRn (LocatedA (body GhcRn)), FreeVars)
-rnGRHS ctxt rnBody = wrapLocFstMA (rnGRHS' ctxt rnBody)
+rnGRHS ctxt = wrapLocFstMA (rnGRHS' ctxt)
-rnGRHS' :: HsMatchContext GhcRn
- -> (LocatedA (body GhcPs) -> RnM (LocatedA (body GhcRn), FreeVars))
+rnGRHS' :: RnMatchCtxt pat body
-> GRHS GhcPs (LocatedA (body GhcPs))
-> RnM (GRHS GhcRn (LocatedA (body GhcRn)), FreeVars)
-rnGRHS' ctxt rnBody (GRHS _ guards rhs)
+rnGRHS' ctxt (GRHS _ guards rhs)
= do { pattern_guards_allowed <- xoptM LangExt.PatternGuards
- ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) rnExpr guards $ \ _ ->
- rnBody rhs
+ ; ((guards', rhs'), fvs) <- rnStmts stmt_ctxt rnExpr guards $ \ _ ->
+ rnmc_body ctxt rhs
; unless (pattern_guards_allowed || is_standard_guard guards') $
addDiagnostic (nonStdGuardErr guards')
@@ -1366,6 +1377,8 @@ rnGRHS' ctxt rnBody (GRHS _ guards rhs)
is_standard_guard [L _ (BodyStmt {})] = True
is_standard_guard _ = False
+ stmt_ctxt = PatGuard (rnmc_what ctxt)
+
{-
*********************************************************
* *
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -31,8 +31,8 @@ module GHC.Rename.Expr (
import GHC.Prelude
import GHC.Data.FastString
-import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS
- , rnMatchGroup, rnGRHS, makeMiniFixityEnv)
+import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
+ RnMatchCtxt(..), rnMatchGroup, rnGRHS, makeMiniFixityEnv)
import GHC.Hs
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Env ( isBrackStage )
@@ -418,17 +418,29 @@ rnExpr (HsPragE x prag expr)
rn_prag (HsPragSCC x ann) = HsPragSCC x ann
rnExpr (HsLam x matches)
- = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnPats rnLExpr matches
+ = do { (matches', fvMatch) <- rnMatchGroup match_ctxt matches
; return (HsLam x matches', fvMatch) }
+ where
+ match_ctxt = RnMC { rnmc_what = LambdaExpr
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLExpr }
rnExpr (HsLamCase x lc_variant matches)
- = do { (matches', fvs_ms) <- rnMatchGroup (LamCaseAlt lc_variant) rnPats rnLExpr matches
+ = do { (matches', fvs_ms) <- rnMatchGroup match_ctxt matches
; return (HsLamCase x lc_variant matches', fvs_ms) }
+ where
+ match_ctxt = RnMC { rnmc_what = LamCaseAlt lc_variant
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLExpr }
rnExpr (HsCase _ expr matches)
= do { (new_expr, e_fvs) <- rnLExpr expr
- ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnPats rnLExpr matches
+ ; (new_matches, ms_fvs) <- rnMatchGroup match_ctxt matches
; return (HsCase CaseAlt new_expr new_matches, e_fvs `plusFV` ms_fvs) }
+ where
+ match_ctxt = RnMC { rnmc_what = CaseAlt
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLExpr }
rnExpr (HsLet _ tkLet binds tkIn expr)
= rnLocalBindsAndThen binds $ \binds' _ -> do
@@ -550,8 +562,12 @@ rnExpr (HsIf _ p b1 b2)
; return (mkExpandedExpr rn_if ds_if, fvs) } }
rnExpr (HsMultiIf _ alts)
- = do { (alts', fvs) <- mapFvRn (rnGRHS IfAlt rnLExpr) alts
+ = do { (alts', fvs) <- mapFvRn (rnGRHS match_ctxt) alts
; return (HsMultiIf noExtField alts', fvs) }
+ where
+ match_ctxt = RnMC { rnmc_what = IfAlt
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLExpr }
rnExpr (ArithSeq _ _ seq)
= do { opt_OverloadedLists <- xoptM LangExt.OverloadedLists
@@ -883,8 +899,12 @@ rnCmd (HsCmdApp x fun arg)
; return (HsCmdApp x fun' arg', fvFun `plusFV` fvArg) }
rnCmd (HsCmdLam _ matches)
- = do { (matches', fvMatch) <- rnMatchGroup (ArrowMatchCtxt KappaExpr) rnPats rnLCmd matches
+ = do { (matches', fvMatch) <- rnMatchGroup match_ctxt matches
; return (HsCmdLam noExtField matches', fvMatch) }
+ where
+ match_ctxt = RnMC { rnmc_what = ArrowMatchCtxt KappaExpr
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLCmd }
rnCmd (HsCmdPar x lpar e rpar)
= do { (e', fvs_e) <- rnLCmd e
@@ -892,14 +912,21 @@ rnCmd (HsCmdPar x lpar e rpar)
rnCmd (HsCmdCase _ expr matches)
= do { (new_expr, e_fvs) <- rnLExpr expr
- ; (new_matches, ms_fvs) <- rnMatchGroup (ArrowMatchCtxt ArrowCaseAlt) rnPats rnLCmd matches
+ ; (new_matches, ms_fvs) <- rnMatchGroup match_ctxt matches
; return (HsCmdCase noExtField new_expr new_matches
, e_fvs `plusFV` ms_fvs) }
+ where
+ match_ctxt = RnMC { rnmc_what = (ArrowMatchCtxt ArrowCaseAlt)
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLCmd }
rnCmd (HsCmdLamCase x lc_variant matches)
- = do { (new_matches, ms_fvs) <-
- rnMatchGroup (ArrowMatchCtxt $ ArrowLamCaseAlt lc_variant) rnPats rnLCmd matches
+ = do { (new_matches, ms_fvs) <- rnMatchGroup match_ctxt matches
; return (HsCmdLamCase x lc_variant new_matches, ms_fvs) }
+ where
+ match_ctxt = RnMC { rnmc_what = ArrowMatchCtxt $ ArrowLamCaseAlt lc_variant
+ , rnmc_pats = rnPats
+ , rnmc_body = rnLCmd }
rnCmd (HsCmdIf _ _ p b1 b2)
= do { (p', fvP) <- rnLExpr p
=====================================
compiler/GHC/Tc/Gen/Arrow.hs
=====================================
@@ -326,9 +326,9 @@ tcCmdMatches :: CmdEnv
tcCmdMatches env scrut_ty matches (stk, res_ty)
= tcMatchesCase match_ctxt (unrestricted scrut_ty) matches (mkCheckExpType res_ty)
where
- match_ctxt = MC { mc_what = ArrowMatchCtxt ArrowCaseAlt,
- mc_pats = tcPats,
- mc_body = mc_body }
+ match_ctxt = TcMC { tcmc_what = ArrowMatchCtxt ArrowCaseAlt,
+ tcmc_pats = tcPats,
+ tcmc_body = mc_body }
mc_body body res_ty' = do { res_ty' <- expTypeToType res_ty'
; tcCmd env body (stk, res_ty') }
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -267,19 +267,18 @@ tcExpr (HsLam _ match) res_ty
= do { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty
; return (mkHsWrap wrap (HsLam noExtField match')) }
where
- match_ctxt = MC { mc_what = LambdaExpr
- , mc_pats = tcPats
- , mc_body = tcBody }
+ match_ctxt = TcMC { tcmc_what = LambdaExpr
+ , tcmc_pats = tcPats
+ , tcmc_body = tcBody }
herald = ExpectedFunTyLam match
tcExpr e@(HsLamCase x lc_variant matches) res_ty
- = do { (wrap, matches')
- <- tcMatchLambda herald match_ctxt matches res_ty
+ = do { (wrap, matches') <- tcMatchLambda herald match_ctxt matches res_ty
; return (mkHsWrap wrap $ HsLamCase x lc_variant matches') }
where
- match_ctxt = MC { mc_what = LamCaseAlt lc_variant
- , mc_pats = tcPats
- , mc_body = tcBody }
+ match_ctxt = TcMC { tcmc_what = LamCaseAlt lc_variant
+ , tcmc_pats = tcPats
+ , tcmc_body = tcBody }
herald = ExpectedFunTyLamCase lc_variant e
@@ -391,9 +390,9 @@ tcExpr (HsCase x scrut matches) res_ty
; matches' <- tcMatchesCase match_ctxt (Scaled mult scrut_ty) matches res_ty
; return (HsCase x scrut' matches') }
where
- match_ctxt = MC { mc_what = x,
- mc_pats = tcPats,
- mc_body = tcBody }
+ match_ctxt = TcMC { tcmc_what = x,
+ tcmc_pats = tcPats,
+ tcmc_body = tcBody }
tcExpr (HsIf x pred b1 b2) res_ty
= do { pred' <- tcCheckMonoExpr pred boolTy
@@ -431,7 +430,9 @@ tcExpr (HsMultiIf _ alts) res_ty
; res_ty <- readExpType res_ty
; tcEmitBindingUsage (supUEs ues) -- See Note [MultiWayIf linearity checking]
; return (HsMultiIf res_ty alts') }
- where match_ctxt = MC { mc_what = IfAlt, mc_pats = tcPats, mc_body = tcBody }
+ where match_ctxt = TcMC { tcmc_what = IfAlt
+ , tcmc_pats = tcPats
+ , tcmc_body = tcBody }
tcExpr (HsDo _ do_or_lc stmts) res_ty
= tcDoStmts do_or_lc stmts res_ty
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -128,7 +128,7 @@ tcMatchesFun fun_name matches exp_ty
ctxt = GenSigCtxt -- Was: FunSigCtxt fun_name True
-- But that's wrong for f :: Int -> forall a. blah
what = FunRhs { mc_fun = fun_name, mc_fixity = Prefix, mc_strictness = strictness }
- match_ctxt = MC { mc_what = what, mc_pats = tcPats, mc_body = tcBody }
+ match_ctxt = TcMC { tcmc_what = what, tcmc_pats = tcPats, tcmc_body = tcBody }
strictness
| [L _ match] <- unLoc $ mg_alts matches
, FunRhs{ mc_strictness = SrcStrict } <- m_ctxt match
@@ -159,7 +159,7 @@ tcMatchLambda :: ExpectedFunTyOrigin -- see Note [Herald for matchExpectedFunTys
-> ExpRhoType
-> TcM (HsWrapper, MatchGroup GhcTc (LPat GhcTc) (LHsExpr GhcTc))
tcMatchLambda herald match_ctxt match res_ty
- = do { checkArgCounts (mc_what match_ctxt) match
+ = do { checkArgCounts (tcmc_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
tcMatches match_ctxt pat_tys rhs_ty match }
@@ -182,9 +182,9 @@ tcGRHSsPat grhss res_ty
tcGRHSs match_ctxt grhss res_ty
where
match_ctxt :: TcMatchCtxt Pat HsExpr -- AZ
- match_ctxt = MC { mc_what = PatBindRhs,
- mc_pats = tcPats,
- mc_body = tcBody }
+ match_ctxt = TcMC { tcmc_what = PatBindRhs,
+ tcmc_pats = tcPats,
+ tcmc_body = tcBody }
{- *********************************************************************
* *
@@ -193,17 +193,18 @@ tcGRHSsPat grhss res_ty
********************************************************************* -}
data TcMatchCtxt pat body -- c.f. TcStmtCtxt, also in this module
- = MC { mc_what :: HsMatchContext GhcTc -- What kind of thing this is
- , mc_pats :: forall a. -- Type checker for match patterns
- HsMatchContext GhcTc
- -> [LocatedA (pat GhcRn)] -- patterns
- -> [ExpPatType] -- types of the patterns
- -> TcM a -- checker for the body
- -> TcM ([LocatedA (pat GhcTc)], a)
- , mc_body :: LocatedA (body GhcRn) -- Type checker for a body of
- -- an alternative
- -> ExpRhoType
- -> TcM (LocatedA (body GhcTc)) }
+ = TcMC
+ { tcmc_what :: HsMatchContext GhcTc -- What kind of thing this is
+ , tcmc_pats :: forall a. -- Type checker for match patterns
+ HsMatchContext GhcTc
+ -> [LocatedA (pat GhcRn)] -- patterns
+ -> [ExpPatType] -- types of the patterns
+ -> TcM a -- checker for the body
+ -> TcM ([LocatedA (pat GhcTc)], a)
+ , tcmc_body :: LocatedA (body GhcRn) -- Type checker for a body of
+ -- an alternative
+ -> ExpRhoType
+ -> TcM (LocatedA (body GhcTc)) }
type AnnoBody body
= ( Outputable (body GhcRn)
@@ -277,17 +278,17 @@ tcMatch ctxt pat_tys rhs_ty match
tc_match ctxt pat_tys rhs_ty
match@(Match { m_pats = pats, m_grhss = grhss })
= add_match_ctxt match $
- do { (pats', grhss') <- (mc_pats ctxt) (mc_what ctxt) pats pat_tys $
+ do { (pats', grhss') <- tcmc_pats ctxt (tcmc_what ctxt) pats pat_tys $
tcGRHSs ctxt grhss rhs_ty
; return (Match { m_ext = noAnn
- , m_ctxt = mc_what ctxt
+ , m_ctxt = tcmc_what ctxt
, m_pats = filter_out_type_pats pats'
, m_grhss = grhss' }) }
-- For (\x -> e), tcExpr has already said "In the expression \x->e"
-- so we don't want to add "In the lambda abstraction \x->e"
add_match_ctxt match thing_inside
- = case mc_what ctxt of
+ = case tcmc_what ctxt of
LambdaExpr -> thing_inside
_ -> addErrCtxt (pprMatchInCtxt match) thing_inside
@@ -325,10 +326,10 @@ tcGRHS :: TcMatchCtxt pat body -> ExpRhoType -> GRHS GhcRn (LocatedA (body GhcRn
tcGRHS ctxt res_ty (GRHS _ guards rhs)
= do { (guards', rhs')
<- tcStmtsAndThen stmt_ctxt tcGuardStmt guards res_ty $
- mc_body ctxt rhs
+ tcmc_body ctxt rhs
; return (GRHS noAnn guards' rhs') }
where
- stmt_ctxt = PatGuard (mc_what ctxt)
+ stmt_ctxt = PatGuard (tcmc_what ctxt)
{-
************************************************************************
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d429b6cc4a43ff0e5da9ded6655099a5f9aa8d8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d429b6cc4a43ff0e5da9ded6655099a5f9aa8d8
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/20230827/7e38f096/attachment-0001.html>
More information about the ghc-commits
mailing list