Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 1d4f129b by Apoorv Ingle at 2025-11-17T10:42:07-06:00 fix quickLookArg function to blame the correct application chain head. The arguments application chain head should be blamed, not the original head when we quick look arg - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -2002,19 +2002,19 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ ; case mb_fun_ty of { Nothing -> skipQuickLook app_lspan larg sc_arg_ty ; -- fun is too complicated - Just (tc_fun, fun_sigma) -> + Just (tc_fun_arg_head, fun_sigma_arg_head) -> -- step 2: use |-inst to instantiate the head applied to the arguments - do { let tc_head = (tc_fun, fun_lspan) + 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 fun + = exprCtOrigin rn_fun_arg | otherwise = srcCodeOriginCtOrigin fun code_orig ; ((inst_args, app_res_rho), wanted) <- captureConstraints $ - tcInstFun do_ql True (arg_orig, rn_fun_arg, fun_lspan_arg) tc_fun fun_sigma rn_args + tcInstFun do_ql True (arg_orig, rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args -- We must capture type-class and equality constraints here, but -- not equality constraints. See (QLA6) in Note [Quick Look at -- value arguments] @@ -2049,7 +2049,7 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ ; return (EValArgQL { eaql_loc_span = app_lspan , eaql_arg_ty = sc_arg_ty , eaql_larg = larg - , eaql_tc_fun = tc_head + , eaql_tc_fun = arg_tc_head , eaql_rn_fun = rn_fun_arg , eaql_fun_ue = fun_ue , eaql_args = inst_args ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1506,7 +1506,6 @@ expandRecordUpd record_expr possible_parents rbnds res_ty , text "ds_res_ty:" <+> ppr ds_res_ty , text "ds_expr:" <+> ppr ds_expr ] - ; return (ds_expr, ds_res_ty, RecordUpdCtxt relevant_cons upd_fld_names ex_tvs) } ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -465,7 +465,7 @@ tcInferAppHead_maybe fun = case fun of HsVar _ nm -> Just <$> tcInferId nm XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f - XExpr (ExpandedThingRn o e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ + XExpr (ExpandedThingRn _ e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ -- ANI: TODO this is fishy.. -- We do not want to instantiate c.f. T19167 tcExprSigma False e ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d4f129bd363d5ab45ef2b2d44822454... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d4f129bd363d5ab45ef2b2d44822454... You're receiving this email because of your account on gitlab.haskell.org.