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 make sure context is not updated when tcl_in_gen is set - - - - - 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: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -934,9 +934,9 @@ looks_like_type_arg _ = False addArgCtxt :: Int -> HsExpr GhcRn -> LHsExpr GhcRn -> TcM a -> TcM a -- There are 2 cases: --- 1. In the normal case, we add an informative context (<=> `isGeneratedCode` is `False`) +-- 1. In the normal case, we add an informative context (<=> `inGeneratedCode` is `False`) -- "In the third argument of f, namely blah" --- 2. If we are inside generated code (<=> `isGeneratedCode` is `True`) +-- 2. If we are inside generated code (<=> `inGeneratedCode` is `True`) -- (i) If arg_loc is generated do nothing to to LclEnv/LclCtxt -- (ii) If arg_loc is Unhelpful UnhelpfulNoLocationInfo set `tcl_in_gen_code` to `True` -- (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 ; env0 <- liftZonkM tcInitTidyEnv ; err_ctx_msg <- mkErrCtxt env0 err_ctx ; traceTc "addArgCtxt" (vcat [ text "generated:" <+> ppr in_generated_code - , text "arg: " <+> ppr arg + , text "arg: " <+> ppr (arg, arg_no) , text "arg_loc:" <+> ppr arg_loc , text "fun:" <+> ppr fun , text "err_ctx" <+> vcat (fmap (\ (x, y) -> case x of - UserCodeCtxt{} -> text "<USER>" <+> pprErrCtxtMsg y - ExpansionCodeCtxt{} -> text "<EXPN>" <+> pprErrCtxtMsg y) - (take 2 (zip err_ctx err_ctx_msg))) + UserCodeCtxt{} -> text "<USER>" <+> pprErrCtxtMsg y + ExpansionCodeCtxt{} -> text "<EXPN>" <+> pprErrCtxtMsg y) + (take 4 (zip err_ctx err_ctx_msg))) ]) ; if in_generated_code then updCtxtForArg (locA arg_loc) arg $ ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -666,7 +666,8 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr ; (ds_expr, ds_res_ty, err_msg) <- expandRecordUpd record_expr possible_parents rbnds res_ty ; addErrCtxt err_msg $ - setInGeneratedCode (OrigExpr expr) $ + updLclCtxt setLclCtxtInGenCode $ + -- setInGeneratedCode (OrigExpr expr) $ do { -- Typecheck the expanded expression. expr' <- tcExpr ds_expr (Check ds_res_ty) -- 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 ds_expr = HsLet noExtField let_binds (wrapGenSpan case_expr) case_expr :: HsExpr GhcRn - case_expr = HsCase RecUpd record_expr + case_expr = HsCase RecUpd (wrapGenSpan (unLoc record_expr)) $ mkMatchGroup (Generated OtherExpansion DoPmc) (wrapGenSpan matches) matches :: [LMatch GhcRn (LHsExpr GhcRn)] matches = map make_pat (NE.toList relevant_cons) ===================================== compiler/GHC/Tc/Types/LclEnv.hs ===================================== @@ -200,7 +200,9 @@ setLclEnvErrCtxt ctxt = modifyLclCtxt (\env -> env { tcl_err_ctxt = ctxt }) addLclEnvErrCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv addLclEnvErrCtxt (ExpansionCodeCtxt co) = setLclEnvSrcCodeOrigin co -addLclEnvErrCtxt ec = modifyLclCtxt (\env -> env { tcl_err_ctxt = ec : (tcl_err_ctxt env) }) +addLclEnvErrCtxt ec = modifyLclCtxt (\env -> if (tcl_in_gen_code env) + then env -- no op if we are in generated code + else env { tcl_err_ctxt = ec : (tcl_err_ctxt env) }) getLclEnvSrcCodeOrigin :: TcLclEnv -> Maybe SrcCodeOrigin getLclEnvSrcCodeOrigin = get_src_code_origin . tcl_err_ctxt . tcl_lcl_ctxt ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -60,7 +60,7 @@ module GHC.Tc.Utils.Monad( -- * Error management getSrcCodeOrigin, getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM, - inGeneratedCode, setInGeneratedCode, setInUserCode, + inGeneratedCode, setInGeneratedCode, setInUserCode, setLclCtxtInGenCode, wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_, wrapLocMA_,wrapLocMA, getErrsVar, setErrsVar, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10c5938d29e3ded1e003b01464d7ec5b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10c5938d29e3ded1e003b01464d7ec5b... You're receiving this email because of your account on gitlab.haskell.org.