Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 82766264 by Apoorv Ingle at 2025-11-04T09:57:14-06:00 rename fun_ctxt to fun_lspan, fun_orig passed in tcInstFun to default to app chain head if its user located, fall back to srcCodeOrigin if it's a generated location - - - - - 2 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -178,14 +178,17 @@ Note [Instantiation variables are short lived] -- take in the rn_expr and its location to pass into tcValArgs tcExprSigma :: Bool -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) tcExprSigma inst rn_expr - = do { (fun@(rn_fun,fun_ctxt), rn_args) <- splitHsApps rn_expr + = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr ; do_ql <- wantQuickLook rn_fun ; (tc_fun, fun_sigma) <- tcInferAppHead fun ; code_orig <- getSrcCodeOrigin - ; let fun_orig = srcCodeOriginCtOrigin rn_expr code_orig - ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_ctxt) tc_fun fun_sigma rn_args - ; tc_args <- tcValArgs do_ql (rn_fun, generatedSrcSpan) inst_args - ; let tc_expr = rebuildHsApps (tc_fun, fun_ctxt) tc_args + ; let fun_orig | isGoodSrcSpan fun_lspan + = exprCtOrigin rn_fun + | otherwise + = srcCodeOriginCtOrigin rn_fun code_orig + ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args + ; tc_args <- tcValArgs do_ql (rn_fun, fun_lspan) inst_args + ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args ; return (tc_expr, app_res_sigma) } @@ -2239,7 +2242,7 @@ tcTagToEnum :: (HsExpr GhcTc, SrcSpan) -> [HsExprArg 'TcpTc] -> TcM (HsExpr GhcTc) -- tagToEnum# :: forall a. Int# -> a -- See Note [tagToEnum#] Urgh! -tcTagToEnum (tc_fun, fun_ctxt) tc_args res_ty +tcTagToEnum (tc_fun, fun_lspan) tc_args res_ty | [val_arg] <- dropWhile (not . isHsValArg) tc_args = do { res_ty <- liftZonkM $ zonkTcType res_ty @@ -2261,14 +2264,14 @@ tcTagToEnum (tc_fun, fun_ctxt) tc_args res_ty ; let rep_ty = mkTyConApp rep_tc rep_args tc_fun' = mkHsWrap (WpTyApp rep_ty) tc_fun df_wrap = mkWpCastR (mkSymCo coi) - tc_expr = rebuildHsApps (tc_fun', fun_ctxt) [val_arg] + tc_expr = rebuildHsApps (tc_fun', fun_lspan) [val_arg] ; return (mkHsWrap df_wrap tc_expr) }}}}} | otherwise = failWithTc TcRnTagToEnumMissingValArg where - vanilla_result = return (rebuildHsApps (tc_fun, fun_ctxt) tc_args) + vanilla_result = return (rebuildHsApps (tc_fun, fun_lspan) tc_args) check_enumeration ty' tc | -- isTypeDataTyCon: see wrinkle (W1) in ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -457,7 +457,7 @@ tcInferAppHead :: (HsExpr GhcRn, SrcSpan) -- -- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App tcInferAppHead (fun,fun_lspan) - = addLExprCtxt fun_lspan fun $ + = setSrcSpan fun_lspan $ do { mb_tc_fun <- tcInferAppHead_maybe fun ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) @@ -471,10 +471,10 @@ tcInferAppHead_maybe fun = case fun of HsVar _ nm -> Just <$> tcInferId nm XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f - XExpr (ExpandedThingRn _ e) -> Just <$> -- (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ + XExpr (ExpandedThingRn o e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ -- We do not want to instantiate c.f. T19167 tcExprSigma False e - -- ) + ) ExprWithTySig _ e hs_ty -> Just <$> tcExprWithSig e hs_ty HsOverLit _ lit -> Just <$> tcInferOverLit lit _ -> return Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82766264d33b174dd966d6efa7d3ec4a... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82766264d33b174dd966d6efa7d3ec4a... You're receiving this email because of your account on gitlab.haskell.org.