Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC
Commits:
-
c6f2ab89
by Apoorv Ingle at 2026-03-09T19:16:59-05:00
7 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Zonk/TcType.hs
Changes:
| ... | ... | @@ -1064,7 +1064,7 @@ instance Outputable XXExprGhcRn where |
| 1064 | 1064 | pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e)
|
| 1065 | 1065 | pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt)
|
| 1066 | 1066 | pprCtxt (DoStmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt)
|
| 1067 | - pprCtxt (StmtErrCtxtPat _ _ pat) = ppr_builder "<OrigPat>:" (ppr pat)
|
|
| 1067 | + pprCtxt (StmtErrCtxtPat pat) = ppr_builder "<OrigPat>:" (ppr pat)
|
|
| 1068 | 1068 | pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:" (ppr e)
|
| 1069 | 1069 | pprCtxt _ = ppr_builder "<MiscErrCtxtMsg>:" empty
|
| 1070 | 1070 | |
| ... | ... | @@ -1081,7 +1081,7 @@ instance Outputable XXExprGhcTc where |
| 1081 | 1081 | pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e)
|
| 1082 | 1082 | pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt)
|
| 1083 | 1083 | pprCtxt (DoStmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt)
|
| 1084 | - pprCtxt (StmtErrCtxtPat _ _ pat) = ppr_builder "<OrigPat>:" (ppr pat)
|
|
| 1084 | + pprCtxt (StmtErrCtxtPat pat) = ppr_builder "<OrigPat>:" (ppr pat)
|
|
| 1085 | 1085 | pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:" (ppr e)
|
| 1086 | 1086 | pprCtxt _ = ppr_builder "<MiscErrCtxtMsg>:" empty
|
| 1087 | 1087 |
| ... | ... | @@ -416,6 +416,8 @@ addTickLHsExpr e@(L pos e0) = do |
| 416 | 416 | case d of
|
| 417 | 417 | TickForBreakPoints | isGoodBreakExpr e0 -> tick_it
|
| 418 | 418 | TickForCoverage | XExpr (ExpandedThingTc StmtErrCtxt{} _) <- e0 -- expansion ticks are handled separately
|
| 419 | + -> dont_tick_it
|
|
| 420 | + | XExpr (ExpandedThingTc DoStmtErrCtxt{} _) <- e0 -- expansion ticks are handled separately
|
|
| 419 | 421 | -> dont_tick_it
|
| 420 | 422 | | otherwise -> tick_it
|
| 421 | 423 | TickCallSites | isCallSite e0 -> tick_it
|
| ... | ... | @@ -485,6 +487,7 @@ addTickLHsExprNever (L pos e0) = do |
| 485 | 487 | -- values) are good break points.
|
| 486 | 488 | isGoodBreakExpr :: HsExpr GhcTc -> Bool
|
| 487 | 489 | isGoodBreakExpr (XExpr (ExpandedThingTc (StmtErrCtxt{}) _)) = False
|
| 490 | +isGoodBreakExpr (XExpr (ExpandedThingTc (DoStmtErrCtxt{}) _)) = False
|
|
| 488 | 491 | isGoodBreakExpr e = isCallSite e
|
| 489 | 492 | |
| 490 | 493 | isCallSite :: HsExpr GhcTc -> Bool
|
| ... | ... | @@ -7884,8 +7884,7 @@ pprErrCtxtMsg = \case |
| 7884 | 7884 | -> hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon)
|
| 7885 | 7885 | 2 (ppr_stmt (unLoc stmt))
|
| 7886 | 7886 | |
| 7887 | - StmtErrCtxtPat _ _ pat ->
|
|
| 7888 | - hang (text "In the pattern:") 2 (ppr pat)
|
|
| 7887 | + StmtErrCtxtPat{} -> empty
|
|
| 7889 | 7888 | |
| 7890 | 7889 | DerivInstCtxt pred ->
|
| 7891 | 7890 | text "When deriving the instance for" <+> parens (ppr pred)
|
| ... | ... | @@ -213,7 +213,7 @@ mk_fail_block doFlav pat stmt e (Just (SyntaxExprRn fail_op)) = |
| 213 | 213 | |
| 214 | 214 | fail_op_expr :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> LHsExpr GhcRn
|
| 215 | 215 | fail_op_expr dflags pat@(L pat_lspan _) fail_op
|
| 216 | - = L pat_lspan $ mkExpandedPatRn doFlav pat stmt $ genHsApp fail_op (mk_fail_msg_expr dflags pat)
|
|
| 216 | + = L pat_lspan $ mkExpandedPatRn pat $ genHsApp fail_op (mk_fail_msg_expr dflags pat)
|
|
| 217 | 217 | |
| 218 | 218 | mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn
|
| 219 | 219 | mk_fail_msg_expr dflags pat
|
| ... | ... | @@ -481,7 +481,7 @@ It stores the original statement (with location) and the expanded expression |
| 481 | 481 | -}
|
| 482 | 482 | |
| 483 | 483 | |
| 484 | -mkExpandedPatRn :: HsDoFlavour -> LPat GhcRn -> ExprLStmt GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
|
|
| 485 | -mkExpandedPatRn flav pat stmt e = XExpr $ ExpandedThingRn
|
|
| 486 | - { xrn_orig = StmtErrCtxtPat (HsDoStmt flav) stmt pat
|
|
| 484 | +mkExpandedPatRn :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
|
|
| 485 | +mkExpandedPatRn pat e = XExpr $ ExpandedThingRn
|
|
| 486 | + { xrn_orig = StmtErrCtxtPat pat
|
|
| 487 | 487 | , xrn_expanded = e} |
| ... | ... | @@ -340,7 +340,7 @@ data ErrCtxtMsg |
| 340 | 340 | | DoStmtErrCtxt !HsStmtContextRn !(ExprLStmt GhcRn)
|
| 341 | 341 | |
| 342 | 342 | -- | In patten of the do statement. (c.f. MonadFailErrors)
|
| 343 | - | StmtErrCtxtPat !HsStmtContextRn !(ExprLStmt GhcRn) (LPat GhcRn)
|
|
| 343 | + | StmtErrCtxtPat (LPat GhcRn)
|
|
| 344 | 344 | |
| 345 | 345 | -- | In an rebindable syntax expression.
|
| 346 | 346 | | SyntaxNameCtxt !(HsExpr GhcRn) !CtOrigin !TcType !SrcSpan
|
| ... | ... | @@ -638,7 +638,7 @@ errCtxtCtOrigin (ExprCtxt e) = exprCtOrigin e |
| 638 | 638 | errCtxtCtOrigin (FunAppCtxt (FunAppCtxtExpr _ e) _) = exprCtOrigin e
|
| 639 | 639 | errCtxtCtOrigin (StmtErrCtxt{}) = DoStmtOrigin
|
| 640 | 640 | errCtxtCtOrigin (DoStmtErrCtxt{}) = DoStmtOrigin
|
| 641 | -errCtxtCtOrigin (StmtErrCtxtPat _ _ p) = DoPatOrigin p
|
|
| 641 | +errCtxtCtOrigin (StmtErrCtxtPat p) = DoPatOrigin p
|
|
| 642 | 642 | errCtxtCtOrigin (RecordUpdCtxt{}) = RecordUpdOrigin
|
| 643 | 643 | errCtxtCtOrigin _ = Shouldn'tHappenOrigin "errCtxtCtOrigin"
|
| 644 | 644 | |
| ... | ... | @@ -1484,11 +1484,11 @@ pprExpectedFunTyCtxt funTy_origin i = |
| 1484 | 1484 | case funTy_origin of
|
| 1485 | 1485 | ExpectedFunTySyntaxOp orig op ->
|
| 1486 | 1486 | vcat [ sep [ the_arg_of
|
| 1487 | - , text "the rebindable syntax operator"
|
|
| 1487 | + , text "The rebindable syntax operator"
|
|
| 1488 | 1488 | , quotes (ppr op) ]
|
| 1489 | 1489 | , nest 2 (ppr orig) ]
|
| 1490 | 1490 | ExpectedTySyntax orig arg ->
|
| 1491 | - vcat [ text "the expression" <+> quotes (ppr arg)
|
|
| 1491 | + vcat [ text "The expression" <+> quotes (ppr arg)
|
|
| 1492 | 1492 | , nest 2 (ppr orig) ]
|
| 1493 | 1493 | ExpectedFunTyViewPat expr ->
|
| 1494 | 1494 | vcat [ the_arg_of <+> text "the view pattern"
|
| ... | ... | @@ -805,9 +805,6 @@ zonkTidyErrCtxtMsg env e@(ExprCtxt{}) = return (env, e) |
| 805 | 805 | zonkTidyErrCtxtMsg env (ThetaCtxt ctxt theta_ty) = do
|
| 806 | 806 | (env', theta_ty') <- zonkTidyTcTypes env theta_ty
|
| 807 | 807 | return $ (env', ThetaCtxt ctxt theta_ty')
|
| 808 | --- zonkTidyErrCtxtMsg env (QuantifiedCtCtxt ty) = do
|
|
| 809 | --- (env', ty') <- zonkTidyTcTypes env ty
|
|
| 810 | --- return $ QuantifiedCtCtxt ty'
|
|
| 811 | 808 | zonkTidyErrCtxtMsg env (InferredTypeCtxt n ty) = do
|
| 812 | 809 | (env', ty') <- zonkTidyTcType env ty
|
| 813 | 810 | return $ (env', InferredTypeCtxt n ty')
|
| ... | ... | @@ -826,4 +823,7 @@ zonkTidyErrCtxtMsg env (FunResCtxt e i1 ty1 ty2 i2 i3) = do |
| 826 | 823 | (env', ty1') <- zonkTidyTcType env ty1
|
| 827 | 824 | (env', ty2') <- zonkTidyTcType env' ty2
|
| 828 | 825 | return $ (env', FunResCtxt e i1 ty1' ty2' i2 i3)
|
| 826 | +-- zonkTidyErrCtxtMsg env (PatSigErrCtxt sig_ty res_ty) = do
|
|
| 827 | +-- (env', sig_ty) <- zonkTidyTcType env sig_ty
|
|
| 828 | +-- (env', res_ty) <- zonkZidy
|
|
| 829 | 829 | zonkTidyErrCtxtMsg env p = return (env, p) |