Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: ae8ba85a by Apoorv Ingle at 2025-11-26T11:24:48-06:00 refactor building CtOrigin before instantiations as a function - - - - - 1 changed file: - compiler/GHC/Tc/Gen/App.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -188,11 +188,8 @@ tcExprSigma :: Bool -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) tcExprSigma inst rn_expr = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr ; (tc_fun, fun_sigma) <- tcInferAppHead fun - ; code_orig <- getSrcCodeOrigin - ; let fun_orig | not (isGeneratedSrcSpan fun_lspan) - = exprCtOrigin rn_fun - | otherwise - = srcCodeOriginCtOrigin rn_fun code_orig + ; fun_orig <- mk_origin fun_lspan rn_fun rn_fun + ; traceTc "tcExprSigma" (vcat [ text "rn_expr:" <+> ppr rn_expr , text "tc_fun" <+> ppr tc_fun ]) ; (inst_args, app_res_sigma) <- tcInstFun DoQL inst (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args @@ -426,11 +423,7 @@ tcApp rn_expr exp_res_ty -- If it is generated code location span, blame it on the -- source code origin stored in the lclEnv. -- See Note [Error contexts in generated code] - ; code_orig <- getSrcCodeOrigin - ; let fun_orig | not (isGeneratedSrcSpan fun_lspan) - = exprCtOrigin rn_fun - | otherwise - = srcCodeOriginCtOrigin rn_fun code_orig + ; fun_orig <- mk_origin fun_lspan rn_fun rn_fun ; traceTc "tcApp:inferAppHead" $ vcat [ text "tc_fun:" <+> ppr tc_fun @@ -484,6 +477,7 @@ quickLookResultType _ _ = return () getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag getDeepSubsumptionFlag_DataConHead app_head = do { user_ds <- xoptM LangExt.DeepSubsumption + ; traceTc "getDeepSubsumptionFlag_DataConHead" (ppr app_head) ; return $ if | user_ds -> Deep DeepSub @@ -2026,11 +2020,9 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ -- step 2: use |-inst to instantiate the head applied to the arguments do { let arg_tc_head = (tc_fun_arg_head, fun_lspan_arg) ; do_ql <- wantQuickLook rn_fun_arg - ; code_orig <- getSrcCodeOrigin - ; let arg_orig | not (isGeneratedSrcSpan fun_lspan_arg) - = exprCtOrigin rn_fun_arg - | otherwise - = srcCodeOriginCtOrigin fun code_orig + + ; arg_orig <- mk_origin fun_lspan_arg rn_fun_arg fun + ; ((inst_args, app_res_rho), wanted) <- captureConstraints $ tcInstFun do_ql True (arg_orig, rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args @@ -2076,6 +2068,19 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ , eaql_encl = arg_influences_enclosing_call , eaql_res_rho = app_res_rho }) }}} +mk_origin :: SrcSpan -- SrcSpan of the argument + -> HsExpr GhcRn -- The head of the expression application chain + -> HsExpr GhcRn -- Fallback expression to appear in the error message + -> TcM CtOrigin +mk_origin fun_lspan_arg rn_fun_arg rn_fun + | not (isGeneratedSrcSpan fun_lspan_arg) + = return $ exprCtOrigin rn_fun_arg + | otherwise + = do { code_orig <- getSrcCodeOrigin + ; return $ srcCodeOriginCtOrigin rn_fun code_orig + } + + {- ********************************************************************* * * Folding over instantiation variables View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae8ba85ac3bd9516646e925b688ade74... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae8ba85ac3bd9516646e925b688ade74... You're receiving this email because of your account on gitlab.haskell.org.