Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 564a3947 by Apoorv Ingle at 2025-11-17T11:57:15-06:00 deepsubsumption wibbles - - - - - 3 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -897,9 +897,9 @@ ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e ppr_expr (SectionL _ expr op) | Just pp_op <- ppr_infix_expr (unLoc op) - = pp_infixly pp_op + = text "<SectionL>" <+> pp_infixly pp_op | otherwise - = pp_prefixly + = text "<SectionL>" <+> pp_prefixly where pp_expr = pprDebugParendExpr opPrec expr @@ -910,9 +910,9 @@ ppr_expr (SectionL _ expr op) ppr_expr (SectionR _ op expr) | Just pp_op <- ppr_infix_expr (unLoc op) - = pp_infixly pp_op + = text "<SectionR>" <+> pp_infixly pp_op | otherwise - = pp_prefixly + = text "<SectionR>" <+> pp_prefixly where pp_expr = pprDebugParendExpr opPrec expr ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -185,17 +185,18 @@ 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 { traceTc "tcExprSigma" (ppr rn_expr) - ; (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr - ; do_ql <- wantQuickLook rn_fun + = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr + ; ds_flag <- getDeepSubsumptionFlag_DataConHead rn_fun + -- ; do_ql <- wantQuickLook rn_fun ; (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 - ; (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 + ; traceTc "tcExprSigma" (vcat [text "rn_expr:" <+> ppr rn_expr, ppr tc_fun]) + ; (inst_args, app_res_sigma) <- tcInstFun DoQL inst (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args + ; tc_args <- tcValArgs DoQL (rn_fun, fun_lspan) inst_args ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args ; return (tc_expr, app_res_sigma) } ===================================== 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 _ e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ -- ANI: TODO this is fishy.. + XExpr (ExpandedThingRn o 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/564a394730f7642f4091d2f7a57fe692... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/564a394730f7642f4091d2f7a57fe692... You're receiving this email because of your account on gitlab.haskell.org.