Apoorv Ingle pushed to branch wip/ani/kill-popErrCtxt at Glasgow Haskell Compiler / GHC
Commits:
-
10c5938d
by Apoorv Ingle at 2025-10-03T15:51:38-05:00
4 changed files:
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
| ... | ... | @@ -934,9 +934,9 @@ looks_like_type_arg _ = False |
| 934 | 934 | addArgCtxt :: Int -> HsExpr GhcRn -> LHsExpr GhcRn
|
| 935 | 935 | -> TcM a -> TcM a
|
| 936 | 936 | -- There are 2 cases:
|
| 937 | --- 1. In the normal case, we add an informative context (<=> `isGeneratedCode` is `False`)
|
|
| 937 | +-- 1. In the normal case, we add an informative context (<=> `inGeneratedCode` is `False`)
|
|
| 938 | 938 | -- "In the third argument of f, namely blah"
|
| 939 | --- 2. If we are inside generated code (<=> `isGeneratedCode` is `True`)
|
|
| 939 | +-- 2. If we are inside generated code (<=> `inGeneratedCode` is `True`)
|
|
| 940 | 940 | -- (i) If arg_loc is generated do nothing to to LclEnv/LclCtxt
|
| 941 | 941 | -- (ii) If arg_loc is Unhelpful UnhelpfulNoLocationInfo set `tcl_in_gen_code` to `True`
|
| 942 | 942 | -- (iii) if arg_loc is RealSrcLoc then update tcl_loc and add "In the expression: arg" to ErrCtxtStack
|
| ... | ... | @@ -948,13 +948,13 @@ addArgCtxt arg_no fun (L arg_loc arg) thing_inside |
| 948 | 948 | ; env0 <- liftZonkM tcInitTidyEnv
|
| 949 | 949 | ; err_ctx_msg <- mkErrCtxt env0 err_ctx
|
| 950 | 950 | ; traceTc "addArgCtxt" (vcat [ text "generated:" <+> ppr in_generated_code
|
| 951 | - , text "arg: " <+> ppr arg
|
|
| 951 | + , text "arg: " <+> ppr (arg, arg_no)
|
|
| 952 | 952 | , text "arg_loc:" <+> ppr arg_loc
|
| 953 | 953 | , text "fun:" <+> ppr fun
|
| 954 | 954 | , text "err_ctx" <+> vcat (fmap (\ (x, y) -> case x of
|
| 955 | - UserCodeCtxt{} -> text "<USER>" <+> pprErrCtxtMsg y
|
|
| 956 | - ExpansionCodeCtxt{} -> text "<EXPN>" <+> pprErrCtxtMsg y)
|
|
| 957 | - (take 2 (zip err_ctx err_ctx_msg)))
|
|
| 955 | + UserCodeCtxt{} -> text "<USER>" <+> pprErrCtxtMsg y
|
|
| 956 | + ExpansionCodeCtxt{} -> text "<EXPN>" <+> pprErrCtxtMsg y)
|
|
| 957 | + (take 4 (zip err_ctx err_ctx_msg)))
|
|
| 958 | 958 | ])
|
| 959 | 959 | ; if in_generated_code
|
| 960 | 960 | then updCtxtForArg (locA arg_loc) arg $
|
| ... | ... | @@ -666,7 +666,8 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr |
| 666 | 666 | ; (ds_expr, ds_res_ty, err_msg)
|
| 667 | 667 | <- expandRecordUpd record_expr possible_parents rbnds res_ty
|
| 668 | 668 | ; addErrCtxt err_msg $
|
| 669 | - setInGeneratedCode (OrigExpr expr) $
|
|
| 669 | + updLclCtxt setLclCtxtInGenCode $
|
|
| 670 | + -- setInGeneratedCode (OrigExpr expr) $
|
|
| 670 | 671 | do { -- Typecheck the expanded expression.
|
| 671 | 672 | expr' <- tcExpr ds_expr (Check ds_res_ty)
|
| 672 | 673 | -- NB: it's important to use ds_res_ty and not res_ty here.
|
| ... | ... | @@ -1462,7 +1463,7 @@ expandRecordUpd record_expr possible_parents rbnds res_ty |
| 1462 | 1463 | ds_expr = HsLet noExtField let_binds (wrapGenSpan case_expr)
|
| 1463 | 1464 | |
| 1464 | 1465 | case_expr :: HsExpr GhcRn
|
| 1465 | - case_expr = HsCase RecUpd record_expr
|
|
| 1466 | + case_expr = HsCase RecUpd (wrapGenSpan (unLoc record_expr))
|
|
| 1466 | 1467 | $ mkMatchGroup (Generated OtherExpansion DoPmc) (wrapGenSpan matches)
|
| 1467 | 1468 | matches :: [LMatch GhcRn (LHsExpr GhcRn)]
|
| 1468 | 1469 | matches = map make_pat (NE.toList relevant_cons)
|
| ... | ... | @@ -200,7 +200,9 @@ setLclEnvErrCtxt ctxt = modifyLclCtxt (\env -> env { tcl_err_ctxt = ctxt }) |
| 200 | 200 | |
| 201 | 201 | addLclEnvErrCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv
|
| 202 | 202 | addLclEnvErrCtxt (ExpansionCodeCtxt co) = setLclEnvSrcCodeOrigin co
|
| 203 | -addLclEnvErrCtxt ec = modifyLclCtxt (\env -> env { tcl_err_ctxt = ec : (tcl_err_ctxt env) })
|
|
| 203 | +addLclEnvErrCtxt ec = modifyLclCtxt (\env -> if (tcl_in_gen_code env)
|
|
| 204 | + then env -- no op if we are in generated code
|
|
| 205 | + else env { tcl_err_ctxt = ec : (tcl_err_ctxt env) })
|
|
| 204 | 206 | |
| 205 | 207 | getLclEnvSrcCodeOrigin :: TcLclEnv -> Maybe SrcCodeOrigin
|
| 206 | 208 | getLclEnvSrcCodeOrigin = get_src_code_origin . tcl_err_ctxt . tcl_lcl_ctxt
|
| ... | ... | @@ -60,7 +60,7 @@ module GHC.Tc.Utils.Monad( |
| 60 | 60 | -- * Error management
|
| 61 | 61 | getSrcCodeOrigin,
|
| 62 | 62 | getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
|
| 63 | - inGeneratedCode, setInGeneratedCode, setInUserCode,
|
|
| 63 | + inGeneratedCode, setInGeneratedCode, setInUserCode, setLclCtxtInGenCode,
|
|
| 64 | 64 | wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
|
| 65 | 65 | wrapLocMA_,wrapLocMA,
|
| 66 | 66 | getErrsVar, setErrsVar,
|