Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 45e4940f by Apoorv Ingle at 2025-11-16T20:12:02-06:00 In `addArgCtxt` the nth argument's err ctxt adds a generated error ctxt if the argument is XExpr - - - - - 2 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -183,7 +183,7 @@ tcExprSigma inst rn_expr ; do_ql <- wantQuickLook rn_fun ; (tc_fun, fun_sigma) <- tcInferAppHead fun ; code_orig <- getSrcCodeOrigin - ; let fun_orig | isGoodSrcSpan fun_lspan + ; let fun_orig | not (isGeneratedSrcSpan fun_lspan) = exprCtOrigin rn_fun | otherwise = srcCodeOriginCtOrigin rn_fun code_orig @@ -435,7 +435,7 @@ tcApp rn_expr exp_res_ty -- See Note [Error contexts in generated code] -- See Note [Error Context Stack] ; code_orig <- getSrcCodeOrigin - ; let fun_orig | isGoodSrcSpan fun_lspan + ; let fun_orig | not (isGeneratedSrcSpan fun_lspan) = exprCtOrigin rn_fun | otherwise = srcCodeOriginCtOrigin rn_fun code_orig @@ -962,9 +962,7 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside , ppr arg_loc , ppr arg , ppr arg_no]) - ; setSrcSpanA arg_loc $ - addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $ - thing_inside + ; setSrcSpanA arg_loc $ mkNthFunArgErrCtxt app_head arg arg_no thing_inside } | otherwise = do { traceTc "addArgCtxt" (vcat [text "generated Head" @@ -975,6 +973,15 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside ; addLExprCtxt (locA arg_loc) arg $ thing_inside } + where + mkNthFunArgErrCtxt :: HsExpr GhcRn -> HsExpr GhcRn -> Int -> TcM a -> TcM a + mkNthFunArgErrCtxt app_head arg arg_no thing_inside + | XExpr (ExpandedThingRn o _) <- arg + = addExpansionErrCtxt o (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $ + thing_inside + | otherwise + = addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $ + thing_inside @@ -1839,7 +1846,7 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ do { let tc_head = (tc_fun, fun_lspan) ; do_ql <- wantQuickLook rn_fun ; code_orig <- getSrcCodeOrigin - ; let arg_orig | isGoodSrcSpan fun_lspan + ; let arg_orig | not (isGeneratedSrcSpan fun_lspan) = exprCtOrigin fun | otherwise = srcCodeOriginCtOrigin fun code_orig ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -264,9 +264,9 @@ splitHsApps e = go e noSrcSpan [] -- See Note [Desugar OpApp in the typechecker] go e@(OpApp _ arg1 (L l op) arg2) _ args = pure ( (op, locA l) - , mkEValArg generatedSrcSpan arg1 - : mkEValArg generatedSrcSpan arg2 - -- generatedSrcSpan because this the span of the call, + , mkEValArg noSrcSpan arg1 + : mkEValArg noSrcSpan arg2 + -- noSrcSpan because this the span of the call, -- and its hard to say exactly what that is : EWrap (EExpand e) : args ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45e4940f052d8e9994eac4da1aa9d00d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45e4940f052d8e9994eac4da1aa9d00d... You're receiving this email because of your account on gitlab.haskell.org.