Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
-
c5cd0302
by Apoorv Ingle at 2025-06-08T22:45:10-05:00
2 changed files:
Changes:
| ... | ... | @@ -408,6 +408,7 @@ tcApp fun_orig rn_expr exp_res_ty |
| 408 | 408 | vcat [ text "rn_expr:" <+> ppr rn_expr
|
| 409 | 409 | , text "rn_fun:" <+> ppr rn_fun
|
| 410 | 410 | , text "fun_ctxt:" <+> ppr fun_ctxt
|
| 411 | + , text "orig:" <+> ppr fun_orig
|
|
| 411 | 412 | , text "rn_args:" <+> ppr rn_args ]
|
| 412 | 413 | |
| 413 | 414 | -- Step 2: Infer the type of `fun`, the head of the application
|
| ... | ... | @@ -769,7 +770,7 @@ tcInstFun do_ql inst_final fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args |
| 769 | 770 | = do { (_inst_tvs, wrap, fun_rho) <-
|
| 770 | 771 | -- addHeadCtxt: important for the class constraints
|
| 771 | 772 | -- that may be emitted from instantiating fun_sigma
|
| 772 | - addHeadCtxt fun_ctxt $
|
|
| 773 | + setSrcSpan fun_ctxt $
|
|
| 773 | 774 | instantiateSigma fun_orig fun_conc_tvs tvs theta body2
|
| 774 | 775 | -- See Note [Representation-polymorphism checking built-ins]
|
| 775 | 776 | -- in GHC.Tc.Utils.Concrete.
|
| ... | ... | @@ -26,7 +26,7 @@ module GHC.Tc.Gen.Head |
| 26 | 26 | , nonBidirectionalErr
|
| 27 | 27 | |
| 28 | 28 | , pprArgInst
|
| 29 | - , addHeadCtxt, addExprCtxt, addFunResCtxt ) where
|
|
| 29 | + , addExprCtxt, addFunResCtxt ) where
|
|
| 30 | 30 | |
| 31 | 31 | import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckPolyExprNC, tcPolyLExprSig )
|
| 32 | 32 | import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody )
|
| ... | ... | @@ -458,8 +458,8 @@ tcInferAppHead :: (HsExpr GhcRn, SrcSpan) |
| 458 | 458 | -- cases are dealt with by splitHsApps.
|
| 459 | 459 | --
|
| 460 | 460 | -- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App
|
| 461 | -tcInferAppHead (fun,ctxt)
|
|
| 462 | - = addHeadCtxt ctxt $
|
|
| 461 | +tcInferAppHead (fun,fun_loc)
|
|
| 462 | + = setSrcSpan fun_loc $
|
|
| 463 | 463 | do { mb_tc_fun <- tcInferAppHead_maybe fun
|
| 464 | 464 | ; case mb_tc_fun of
|
| 465 | 465 | Just (fun', fun_sigma) -> return (fun', fun_sigma)
|
| ... | ... | @@ -480,13 +480,6 @@ tcInferAppHead_maybe fun = |
| 480 | 480 | HsOverLit _ lit -> Just <$> tcInferOverLit lit
|
| 481 | 481 | _ -> return Nothing
|
| 482 | 482 | |
| 483 | -addHeadCtxt :: SrcSpan -> TcM a -> TcM a --TODO ANI: Why not just setSrcSpan?
|
|
| 484 | -addHeadCtxt fun_loc thing_inside
|
|
| 485 | - | not (isGoodSrcSpan fun_loc) -- noSrcSpan => no arguments
|
|
| 486 | - = thing_inside -- => context is already set
|
|
| 487 | - | otherwise
|
|
| 488 | - = setSrcSpan fun_loc thing_inside
|
|
| 489 | - |
|
| 490 | 483 | |
| 491 | 484 | {- *********************************************************************
|
| 492 | 485 | * *
|