Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
-
9dab3569
by Apoorv Ingle at 2025-08-10T18:54:05-05:00
4 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Match.hs
Changes:
| ... | ... | @@ -1328,7 +1328,7 @@ second field. The resulting renamed AST would look like: |
| 1328 | 1328 | )
|
| 1329 | 1329 | |
| 1330 | 1330 | When comes the time to typecheck the program, we end up calling
|
| 1331 | -tcMonoExpr on the AST above. If this expression gives rise to
|
|
| 1331 | +tcMonoLExpr on the AST above. If this expression gives rise to
|
|
| 1332 | 1332 | a type error, then it will appear in a context line and GHC
|
| 1333 | 1333 | will pretty-print it using the 'Outputable (XXExprGhcRn a b)'
|
| 1334 | 1334 | instance defined below, which *only prints the original
|
| ... | ... | @@ -17,7 +17,7 @@ |
| 17 | 17 | module GHC.Tc.Gen.Expr
|
| 18 | 18 | ( tcCheckPolyExpr, tcCheckPolyExprNC,
|
| 19 | 19 | tcCheckMonoExpr, tcCheckMonoExprNC,
|
| 20 | - tcMonoExpr, tcMonoExprNC,
|
|
| 20 | + tcMonoLExpr, tcMonoLExprNC,
|
|
| 21 | 21 | tcInferRho, tcInferRhoNC,
|
| 22 | 22 | tcPolyLExpr, tcPolyExpr, tcExpr, tcPolyLExprSig,
|
| 23 | 23 | tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,
|
| ... | ... | @@ -243,23 +243,23 @@ tcCheckMonoExpr, tcCheckMonoExprNC |
| 243 | 243 | -> TcRhoType -- Expected type
|
| 244 | 244 | -- Definitely no foralls at the top
|
| 245 | 245 | -> TcM (LHsExpr GhcTc)
|
| 246 | -tcCheckMonoExpr expr res_ty = tcMonoExpr expr (mkCheckExpType res_ty)
|
|
| 247 | -tcCheckMonoExprNC expr res_ty = tcMonoExprNC expr (mkCheckExpType res_ty)
|
|
| 246 | +tcCheckMonoExpr expr res_ty = tcMonoLExpr expr (mkCheckExpType res_ty)
|
|
| 247 | +tcCheckMonoExprNC expr res_ty = tcMonoLExprNC expr (mkCheckExpType res_ty)
|
|
| 248 | 248 | |
| 249 | 249 | ---------------
|
| 250 | -tcMonoExpr, tcMonoExprNC
|
|
| 250 | +tcMonoLExpr, tcMonoLExprNC
|
|
| 251 | 251 | :: LHsExpr GhcRn -- Expression to type check
|
| 252 | 252 | -> ExpRhoType -- Expected type
|
| 253 | 253 | -- Definitely no foralls at the top
|
| 254 | 254 | -> TcM (LHsExpr GhcTc)
|
| 255 | 255 | |
| 256 | -tcMonoExpr (L loc expr) res_ty
|
|
| 256 | +tcMonoLExpr (L loc expr) res_ty
|
|
| 257 | 257 | = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad
|
| 258 | 258 | addExprCtxt expr $ -- Note [Error contexts in generated code]
|
| 259 | 259 | do { expr' <- tcExpr expr res_ty
|
| 260 | 260 | ; return (L loc expr') }
|
| 261 | 261 | |
| 262 | -tcMonoExprNC (L loc expr) res_ty
|
|
| 262 | +tcMonoLExprNC (L loc expr) res_ty
|
|
| 263 | 263 | = setSrcSpanA loc $
|
| 264 | 264 | do { expr' <- tcExpr expr res_ty
|
| 265 | 265 | ; return (L loc expr') }
|
| ... | ... | @@ -313,11 +313,11 @@ tcExpr e@(HsLit x lit) res_ty |
| 313 | 313 | ; tcWrapResult e (HsLit x (convertLit lit)) lit_ty res_ty }
|
| 314 | 314 | |
| 315 | 315 | tcExpr (HsPar x expr) res_ty
|
| 316 | - = do { expr' <- tcMonoExprNC expr res_ty
|
|
| 316 | + = do { expr' <- tcMonoLExprNC expr res_ty
|
|
| 317 | 317 | ; return (HsPar x expr') }
|
| 318 | 318 | |
| 319 | 319 | tcExpr (HsPragE x prag expr) res_ty
|
| 320 | - = do { expr' <- tcMonoExpr expr res_ty
|
|
| 320 | + = do { expr' <- tcMonoLExpr expr res_ty
|
|
| 321 | 321 | ; return (HsPragE x (tcExprPrag prag) expr') }
|
| 322 | 322 | |
| 323 | 323 | tcExpr (NegApp x expr neg_expr) res_ty
|
| ... | ... | @@ -471,7 +471,7 @@ tcExpr (ExplicitSum _ alt arity expr) res_ty |
| 471 | 471 | |
| 472 | 472 | tcExpr (HsLet x binds expr) res_ty
|
| 473 | 473 | = do { (binds', expr') <- tcLocalBinds binds $
|
| 474 | - tcMonoExpr expr res_ty
|
|
| 474 | + tcMonoLExpr expr res_ty
|
|
| 475 | 475 | ; return (HsLet x binds' expr') }
|
| 476 | 476 | |
| 477 | 477 | tcExpr (HsCase ctxt scrut matches) res_ty
|
| ... | ... | @@ -500,8 +500,8 @@ tcExpr (HsCase ctxt scrut matches) res_ty |
| 500 | 500 | |
| 501 | 501 | tcExpr (HsIf x pred b1 b2) res_ty
|
| 502 | 502 | = do { pred' <- tcCheckMonoExpr pred boolTy
|
| 503 | - ; (u1,b1') <- tcCollectingUsage $ tcMonoExpr b1 res_ty
|
|
| 504 | - ; (u2,b2') <- tcCollectingUsage $ tcMonoExpr b2 res_ty
|
|
| 503 | + ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty
|
|
| 504 | + ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty
|
|
| 505 | 505 | ; tcEmitBindingUsage (supUE u1 u2)
|
| 506 | 506 | ; return (HsIf x pred' b1' b2') }
|
| 507 | 507 |
| ... | ... | @@ -15,7 +15,7 @@ tcCheckPolyExpr, tcCheckPolyExprNC :: |
| 15 | 15 | -> TcSigmaType
|
| 16 | 16 | -> TcM (LHsExpr GhcTc)
|
| 17 | 17 | |
| 18 | -tcMonoExpr, tcMonoExprNC ::
|
|
| 18 | +tcMonoLExpr, tcMonoLExprNC ::
|
|
| 19 | 19 | LHsExpr GhcRn
|
| 20 | 20 | -> ExpRhoType
|
| 21 | 21 | -> TcM (LHsExpr GhcTc)
|
| ... | ... | @@ -40,7 +40,7 @@ where |
| 40 | 40 | import GHC.Prelude
|
| 41 | 41 | |
| 42 | 42 | import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC
|
| 43 | - , tcMonoExprNC, tcMonoExpr, tcExpr
|
|
| 43 | + , tcMonoLExprNC, tcMonoLExpr, tcExpr
|
|
| 44 | 44 | , tcCheckMonoExpr, tcCheckMonoExprNC
|
| 45 | 45 | , tcCheckPolyExpr, tcPolyLExpr )
|
| 46 | 46 | |
| ... | ... | @@ -404,15 +404,16 @@ tcDoStmts doExpr@(DoExpr _) ss@(L l stmts) res_ty |
| 404 | 404 | ; return (HsDo res_ty doExpr (L l stmts')) }
|
| 405 | 405 | else do { expanded_expr <- expandDoStmts doExpr stmts -- Do expansion on the fly
|
| 406 | 406 | ; let orig = HsDo noExtField doExpr ss
|
| 407 | - ; e' <- tcMonoExpr expanded_expr res_ty
|
|
| 408 | - ; return (mkExpandedExprTc orig (unLoc e'))
|
|
| 407 | + ; setInGeneratedCode (OrigExpr orig) $ do
|
|
| 408 | + { e' <- tcMonoLExpr expanded_expr res_ty
|
|
| 409 | + ; return (mkExpandedExprTc orig (unLoc e'))}
|
|
| 409 | 410 | }
|
| 410 | 411 | }
|
| 411 | 412 | |
| 412 | 413 | tcDoStmts mDoExpr ss@(L _ stmts) res_ty
|
| 413 | 414 | = do { expanded_expr <- expandDoStmts mDoExpr stmts -- Do expansion on the fly
|
| 414 | 415 | ; let orig = HsDo noExtField mDoExpr ss
|
| 415 | - ; e' <- tcMonoExpr expanded_expr res_ty
|
|
| 416 | + ; e' <- tcMonoLExpr expanded_expr res_ty
|
|
| 416 | 417 | ; return (mkExpandedExprTc orig (unLoc e'))
|
| 417 | 418 | }
|
| 418 | 419 | |
| ... | ... | @@ -567,7 +568,7 @@ tcLcStmt :: TyCon -- The list type constructor ([]) |
| 567 | 568 | -> TcExprStmtChecker
|
| 568 | 569 | |
| 569 | 570 | tcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside
|
| 570 | - = do { body' <- tcMonoExprNC body elt_ty
|
|
| 571 | + = do { body' <- tcMonoLExprNC body elt_ty
|
|
| 571 | 572 | ; thing <- thing_inside (panic "tcLcStmt: thing_inside")
|
| 572 | 573 | ; return (LastStmt x body' noret noSyntaxExpr, thing) }
|
| 573 | 574 | |
| ... | ... | @@ -970,7 +971,7 @@ tcMcStmt _ stmt _ _ |
| 970 | 971 | tcDoStmt :: TcExprStmtChecker
|
| 971 | 972 | |
| 972 | 973 | tcDoStmt _ (LastStmt x body noret _) res_ty thing_inside
|
| 973 | - = do { body' <- tcMonoExprNC body res_ty
|
|
| 974 | + = do { body' <- tcMonoLExprNC body res_ty
|
|
| 974 | 975 | ; thing <- thing_inside (panic "tcDoStmt: thing_inside")
|
| 975 | 976 | ; return (LastStmt x body' noret noSyntaxExpr, thing) }
|
| 976 | 977 | tcDoStmt ctxt (BindStmt xbsrn pat rhs) res_ty thing_inside
|