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
3 changed files:
Changes:
| ... | ... | @@ -897,9 +897,9 @@ ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e |
| 897 | 897 | |
| 898 | 898 | ppr_expr (SectionL _ expr op)
|
| 899 | 899 | | Just pp_op <- ppr_infix_expr (unLoc op)
|
| 900 | - = pp_infixly pp_op
|
|
| 900 | + = text "<SectionL>" <+> pp_infixly pp_op
|
|
| 901 | 901 | | otherwise
|
| 902 | - = pp_prefixly
|
|
| 902 | + = text "<SectionL>" <+> pp_prefixly
|
|
| 903 | 903 | where
|
| 904 | 904 | pp_expr = pprDebugParendExpr opPrec expr
|
| 905 | 905 | |
| ... | ... | @@ -910,9 +910,9 @@ ppr_expr (SectionL _ expr op) |
| 910 | 910 | |
| 911 | 911 | ppr_expr (SectionR _ op expr)
|
| 912 | 912 | | Just pp_op <- ppr_infix_expr (unLoc op)
|
| 913 | - = pp_infixly pp_op
|
|
| 913 | + = text "<SectionR>" <+> pp_infixly pp_op
|
|
| 914 | 914 | | otherwise
|
| 915 | - = pp_prefixly
|
|
| 915 | + = text "<SectionR>" <+> pp_prefixly
|
|
| 916 | 916 | where
|
| 917 | 917 | pp_expr = pprDebugParendExpr opPrec expr
|
| 918 | 918 |
| ... | ... | @@ -185,17 +185,18 @@ Note [Instantiation variables are short lived] |
| 185 | 185 | -- take in the rn_expr and its location to pass into tcValArgs
|
| 186 | 186 | tcExprSigma :: Bool -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
|
| 187 | 187 | tcExprSigma inst rn_expr
|
| 188 | - = do { traceTc "tcExprSigma" (ppr rn_expr)
|
|
| 189 | - ; (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr
|
|
| 190 | - ; do_ql <- wantQuickLook rn_fun
|
|
| 188 | + = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr
|
|
| 189 | + ; ds_flag <- getDeepSubsumptionFlag_DataConHead rn_fun
|
|
| 190 | + -- ; do_ql <- wantQuickLook rn_fun
|
|
| 191 | 191 | ; (tc_fun, fun_sigma) <- tcInferAppHead fun
|
| 192 | 192 | ; code_orig <- getSrcCodeOrigin
|
| 193 | 193 | ; let fun_orig | not (isGeneratedSrcSpan fun_lspan)
|
| 194 | 194 | = exprCtOrigin rn_fun
|
| 195 | 195 | | otherwise
|
| 196 | 196 | = srcCodeOriginCtOrigin rn_fun code_orig
|
| 197 | - ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args
|
|
| 198 | - ; tc_args <- tcValArgs do_ql (rn_fun, fun_lspan) inst_args
|
|
| 197 | + ; traceTc "tcExprSigma" (vcat [text "rn_expr:" <+> ppr rn_expr, ppr tc_fun])
|
|
| 198 | + ; (inst_args, app_res_sigma) <- tcInstFun DoQL inst (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args
|
|
| 199 | + ; tc_args <- tcValArgs DoQL (rn_fun, fun_lspan) inst_args
|
|
| 199 | 200 | ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args
|
| 200 | 201 | ; return (tc_expr, app_res_sigma) }
|
| 201 | 202 |
| ... | ... | @@ -465,7 +465,7 @@ tcInferAppHead_maybe fun = |
| 465 | 465 | case fun of
|
| 466 | 466 | HsVar _ nm -> Just <$> tcInferId nm
|
| 467 | 467 | XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f
|
| 468 | - XExpr (ExpandedThingRn _ e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ -- ANI: TODO this is fishy..
|
|
| 468 | + XExpr (ExpandedThingRn o e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ -- ANI: TODO this is fishy..
|
|
| 469 | 469 | -- We do not want to instantiate c.f. T19167
|
| 470 | 470 | tcExprSigma False e
|
| 471 | 471 | )
|