Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
-
21a0194e
by Apoorv Ingle at 2025-11-10T00:51:08-06:00
5 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
Changes:
| ... | ... | @@ -676,12 +676,6 @@ data SrcCodeOrigin |
| 676 | 676 | = OrigExpr (HsExpr GhcRn) -- ^ The source, user written, expression
|
| 677 | 677 | | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from
|
| 678 | 678 | | OrigPat (Pat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints
|
| 679 | - | PopErrCtxt -- A hint for typechecker to pop
|
|
| 680 | - -- the top of the error context stack
|
|
| 681 | - -- Does not presist post renaming phase
|
|
| 682 | - -- See Part 3. of Note [Expanding HsDo with XXExprGhcRn]
|
|
| 683 | - -- in `GHC.Tc.Gen.Do`
|
|
| 684 | - -- INVARIANT: SHOULD NEVER APPEAR IN A ExpansionCodeCtxt in CodeSrcFlag ErrCtxt on stack
|
|
| 685 | 679 | |
| 686 | 680 | data XXExprGhcRn
|
| 687 | 681 | = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages
|
| ... | ... | @@ -713,12 +707,6 @@ mkExpandedStmt |
| 713 | 707 | mkExpandedStmt oStmt flav eExpr = XExpr (ExpandedThingRn { xrn_orig = OrigStmt oStmt flav
|
| 714 | 708 | , xrn_expanded = eExpr })
|
| 715 | 709 | |
| 716 | -mkExpandedLastStmt
|
|
| 717 | - :: HsExpr GhcRn -- ^ expanded expression
|
|
| 718 | - -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn'
|
|
| 719 | -mkExpandedLastStmt eExpr = XExpr (ExpandedThingRn { xrn_orig = PopErrCtxt
|
|
| 720 | - , xrn_expanded = eExpr })
|
|
| 721 | - |
|
| 722 | 710 | data XXExprGhcTc
|
| 723 | 711 | = WrapExpr -- Type and evidence application and abstractions
|
| 724 | 712 | HsWrapper (HsExpr GhcTc)
|
| ... | ... | @@ -1089,7 +1077,6 @@ instance Outputable SrcCodeOrigin where |
| 1089 | 1077 | OrigExpr x -> ppr_builder "<OrigExpr>:" x
|
| 1090 | 1078 | OrigStmt x _ -> ppr_builder "<OrigStmt>:" x
|
| 1091 | 1079 | OrigPat x -> ppr_builder "<OrigPat>:" x
|
| 1092 | - PopErrCtxt -> text "<PopErrCtxt>"
|
|
| 1093 | 1080 | where ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens (ppr x))) (ppr x)
|
| 1094 | 1081 | |
| 1095 | 1082 | instance Outputable XXExprGhcRn where
|
| ... | ... | @@ -174,11 +174,12 @@ Note [Instantiation variables are short lived] |
| 174 | 174 | -- cf. T19167. the head is an expanded expression applied to a type
|
| 175 | 175 | -- TODO: Use runInfer for tcExprSigma?
|
| 176 | 176 | -- Caution: Currently we assume that the expression is compiler generated/expanded
|
| 177 | --- Becuase that is that T19167 testcase generates. This function can possibly
|
|
| 177 | +-- Because that is that T19167 testcase generates. This function can possibly
|
|
| 178 | 178 | -- take in the rn_expr and its location to pass into tcValArgs
|
| 179 | 179 | tcExprSigma :: Bool -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
|
| 180 | 180 | tcExprSigma inst rn_expr
|
| 181 | - = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr
|
|
| 181 | + = do { traceTc "tcExprSigma" (ppr rn_expr)
|
|
| 182 | + ; (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr
|
|
| 182 | 183 | ; do_ql <- wantQuickLook rn_fun
|
| 183 | 184 | ; (tc_fun, fun_sigma) <- tcInferAppHead fun
|
| 184 | 185 | ; code_orig <- getSrcCodeOrigin
|
| ... | ... | @@ -611,6 +612,7 @@ tcValArg do_ql pos (fun, fun_lspan) (EValArg { ea_loc_span = lspan |
| 611 | 612 | , text "fun_lspan" <+> ppr fun_lspan
|
| 612 | 613 | , text "sigma_type" <+> ppr (mkCheckExpType exp_arg_ty)
|
| 613 | 614 | , text "arg:" <+> ppr larg
|
| 615 | + , text "arg_loc:" <+> ppr arg_loc
|
|
| 614 | 616 | ]
|
| 615 | 617 | |
| 616 | 618 | |
| ... | ... | @@ -954,12 +956,16 @@ addArgCtxt :: Int -> (HsExpr GhcRn, SrcSpan) -> LHsExpr GhcRn |
| 954 | 956 | -- See Note [Expanding HsDo with XXExprGhcRn] in GHC.Tc.Gen.Do
|
| 955 | 957 | addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside
|
| 956 | 958 | | isGoodSrcSpan app_head_lspan
|
| 957 | - = setSrcSpanA arg_loc $
|
|
| 958 | - addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $
|
|
| 959 | - thing_inside
|
|
| 959 | + = do { traceTc "addArgCtxt" (vcat [text "goodSrcSpan", ppr app_head, ppr app_head_lspan, ppr arg_loc, ppr arg, ppr arg_no])
|
|
| 960 | + ; setSrcSpanA arg_loc $
|
|
| 961 | + addErrCtxt (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $
|
|
| 962 | + thing_inside
|
|
| 963 | + }
|
|
| 960 | 964 | | otherwise
|
| 961 | - = addLExprCtxt (locA arg_loc) arg $
|
|
| 962 | - thing_inside
|
|
| 965 | + = do { traceTc "addArgCtxt" (vcat [text "generatedHead", ppr app_head, ppr app_head_lspan, ppr arg_loc, ppr arg])
|
|
| 966 | + ; addLExprCtxt (locA arg_loc) arg $
|
|
| 967 | + thing_inside
|
|
| 968 | + }
|
|
| 963 | 969 | |
| 964 | 970 | |
| 965 | 971 | |
| ... | ... | @@ -1823,9 +1829,14 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ |
| 1823 | 1829 | -- step 2: use |-inst to instantiate the head applied to the arguments
|
| 1824 | 1830 | do { let tc_head = (tc_fun, fun_lspan)
|
| 1825 | 1831 | ; do_ql <- wantQuickLook rn_fun
|
| 1832 | + ; code_orig <- getSrcCodeOrigin
|
|
| 1833 | + ; let arg_orig | isGoodSrcSpan fun_lspan
|
|
| 1834 | + = exprCtOrigin fun
|
|
| 1835 | + | otherwise
|
|
| 1836 | + = srcCodeOriginCtOrigin fun code_orig
|
|
| 1826 | 1837 | ; ((inst_args, app_res_rho), wanted)
|
| 1827 | 1838 | <- captureConstraints $
|
| 1828 | - tcInstFun do_ql True (exprCtOrigin arg, rn_fun, fun_lspan) tc_fun fun_sigma rn_args
|
|
| 1839 | + tcInstFun do_ql True (arg_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args
|
|
| 1829 | 1840 | -- We must capture type-class and equality constraints here, but
|
| 1830 | 1841 | -- not equality constraints. See (QLA6) in Note [Quick Look at
|
| 1831 | 1842 | -- value arguments]
|
| ... | ... | @@ -234,4 +234,3 @@ srcCodeOriginErrCtxMsg :: SrcCodeOrigin -> ErrCtxtMsg |
| 234 | 234 | srcCodeOriginErrCtxMsg (OrigExpr e) = ExprCtxt e
|
| 235 | 235 | srcCodeOriginErrCtxMsg (OrigStmt s f) = StmtErrCtxt (HsDoStmt f) (unLoc s)
|
| 236 | 236 | srcCodeOriginErrCtxMsg (OrigPat p) = PatCtxt p |
| 237 | -srcCodeOriginErrCtxMsg (PopErrCtxt) = error "Shouldn't happen srcCodeOriginErr" |
| ... | ... | @@ -207,8 +207,6 @@ setLclEnvSrcCodeOrigin ec = modifyLclCtxt (setLclCtxtSrcCodeOrigin ec) |
| 207 | 207 | -- See Note [ErrCtxt Stack Manipulation]
|
| 208 | 208 | setLclCtxtSrcCodeOrigin :: ErrCtxt -> TcLclCtxt -> TcLclCtxt
|
| 209 | 209 | setLclCtxtSrcCodeOrigin ec lclCtxt
|
| 210 | - | MkErrCtxt (ExpansionCodeCtxt PopErrCtxt) _ <- ec
|
|
| 211 | - = lclCtxt { tcl_err_ctxt = tail (tcl_err_ctxt lclCtxt) }
|
|
| 212 | 210 | | MkErrCtxt (ExpansionCodeCtxt _) _ : ecs <- tcl_err_ctxt lclCtxt
|
| 213 | 211 | , MkErrCtxt (ExpansionCodeCtxt _) _ <- ec
|
| 214 | 212 | = lclCtxt { tcl_err_ctxt = ec : ecs }
|
| ... | ... | @@ -888,7 +888,6 @@ pprCtOrigin (ExpansionOrigin o) |
| 888 | 888 | OrigExpr (ExplicitList{}) -> text "an overloaded list"
|
| 889 | 889 | OrigExpr (HsIf{}) -> text "an if-then-else expression"
|
| 890 | 890 | OrigExpr e -> text "the expression" <+> (ppr e)
|
| 891 | - PopErrCtxt -> text "Shouldn't Happen PopErrCtxt"
|
|
| 892 | 891 | |
| 893 | 892 | pprCtOrigin (GivenSCOrigin sk d blk)
|
| 894 | 893 | = vcat [ ctoHerald <+> pprSkolInfo sk
|
| ... | ... | @@ -1121,7 +1120,6 @@ ppr_br (ExpansionOrigin (OrigExpr (HsIf{}))) = text "an if-then-else expression" |
| 1121 | 1120 | ppr_br (ExpansionOrigin (OrigExpr e)) = text "an expression" <+> ppr e
|
| 1122 | 1121 | ppr_br (ExpansionOrigin (OrigStmt{})) = text "a do statement"
|
| 1123 | 1122 | ppr_br (ExpansionOrigin (OrigPat{})) = text "a do statement"
|
| 1124 | -ppr_br (ExpansionOrigin PopErrCtxt) = text "SHOULDN'T HAPPEN POPERRORCTXT"
|
|
| 1125 | 1123 | ppr_br (ExpectedTySyntax o _) = ppr_br o
|
| 1126 | 1124 | ppr_br (ExpectedFunTySyntaxOp{}) = text "a rebindable syntax operator"
|
| 1127 | 1125 | ppr_br (ExpectedFunTyViewPat{}) = text "a view pattern"
|