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 - rename tcMonoExpr -> tcMonoLExpr, tcMonoExprNC tcMonoLExpr - add error ctx before type checking statements to mirror record updates - - - - - 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: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1328,7 +1328,7 @@ second field. The resulting renamed AST would look like: ) When comes the time to typecheck the program, we end up calling -tcMonoExpr on the AST above. If this expression gives rise to +tcMonoLExpr on the AST above. If this expression gives rise to a type error, then it will appear in a context line and GHC will pretty-print it using the 'Outputable (XXExprGhcRn a b)' instance defined below, which *only prints the original ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Tc.Gen.Expr ( tcCheckPolyExpr, tcCheckPolyExprNC, tcCheckMonoExpr, tcCheckMonoExprNC, - tcMonoExpr, tcMonoExprNC, + tcMonoLExpr, tcMonoLExprNC, tcInferRho, tcInferRhoNC, tcPolyLExpr, tcPolyExpr, tcExpr, tcPolyLExprSig, tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType, @@ -243,23 +243,23 @@ tcCheckMonoExpr, tcCheckMonoExprNC -> TcRhoType -- Expected type -- Definitely no foralls at the top -> TcM (LHsExpr GhcTc) -tcCheckMonoExpr expr res_ty = tcMonoExpr expr (mkCheckExpType res_ty) -tcCheckMonoExprNC expr res_ty = tcMonoExprNC expr (mkCheckExpType res_ty) +tcCheckMonoExpr expr res_ty = tcMonoLExpr expr (mkCheckExpType res_ty) +tcCheckMonoExprNC expr res_ty = tcMonoLExprNC expr (mkCheckExpType res_ty) --------------- -tcMonoExpr, tcMonoExprNC +tcMonoLExpr, tcMonoLExprNC :: LHsExpr GhcRn -- Expression to type check -> ExpRhoType -- Expected type -- Definitely no foralls at the top -> TcM (LHsExpr GhcTc) -tcMonoExpr (L loc expr) res_ty +tcMonoLExpr (L loc expr) res_ty = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad addExprCtxt expr $ -- Note [Error contexts in generated code] do { expr' <- tcExpr expr res_ty ; return (L loc expr') } -tcMonoExprNC (L loc expr) res_ty +tcMonoLExprNC (L loc expr) res_ty = setSrcSpanA loc $ do { expr' <- tcExpr expr res_ty ; return (L loc expr') } @@ -313,11 +313,11 @@ tcExpr e@(HsLit x lit) res_ty ; tcWrapResult e (HsLit x (convertLit lit)) lit_ty res_ty } tcExpr (HsPar x expr) res_ty - = do { expr' <- tcMonoExprNC expr res_ty + = do { expr' <- tcMonoLExprNC expr res_ty ; return (HsPar x expr') } tcExpr (HsPragE x prag expr) res_ty - = do { expr' <- tcMonoExpr expr res_ty + = do { expr' <- tcMonoLExpr expr res_ty ; return (HsPragE x (tcExprPrag prag) expr') } tcExpr (NegApp x expr neg_expr) res_ty @@ -471,7 +471,7 @@ tcExpr (ExplicitSum _ alt arity expr) res_ty tcExpr (HsLet x binds expr) res_ty = do { (binds', expr') <- tcLocalBinds binds $ - tcMonoExpr expr res_ty + tcMonoLExpr expr res_ty ; return (HsLet x binds' expr') } tcExpr (HsCase ctxt scrut matches) res_ty @@ -500,8 +500,8 @@ tcExpr (HsCase ctxt scrut matches) res_ty tcExpr (HsIf x pred b1 b2) res_ty = do { pred' <- tcCheckMonoExpr pred boolTy - ; (u1,b1') <- tcCollectingUsage $ tcMonoExpr b1 res_ty - ; (u2,b2') <- tcCollectingUsage $ tcMonoExpr b2 res_ty + ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty + ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty ; tcEmitBindingUsage (supUE u1 u2) ; return (HsIf x pred' b1' b2') } ===================================== compiler/GHC/Tc/Gen/Expr.hs-boot ===================================== @@ -15,7 +15,7 @@ tcCheckPolyExpr, tcCheckPolyExprNC :: -> TcSigmaType -> TcM (LHsExpr GhcTc) -tcMonoExpr, tcMonoExprNC :: +tcMonoLExpr, tcMonoLExprNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc) ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -40,7 +40,7 @@ where import GHC.Prelude import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC - , tcMonoExprNC, tcMonoExpr, tcExpr + , tcMonoLExprNC, tcMonoLExpr, tcExpr , tcCheckMonoExpr, tcCheckMonoExprNC , tcCheckPolyExpr, tcPolyLExpr ) @@ -404,15 +404,16 @@ tcDoStmts doExpr@(DoExpr _) ss@(L l stmts) res_ty ; return (HsDo res_ty doExpr (L l stmts')) } else do { expanded_expr <- expandDoStmts doExpr stmts -- Do expansion on the fly ; let orig = HsDo noExtField doExpr ss - ; e' <- tcMonoExpr expanded_expr res_ty - ; return (mkExpandedExprTc orig (unLoc e')) + ; setInGeneratedCode (OrigExpr orig) $ do + { e' <- tcMonoLExpr expanded_expr res_ty + ; return (mkExpandedExprTc orig (unLoc e'))} } } tcDoStmts mDoExpr ss@(L _ stmts) res_ty = do { expanded_expr <- expandDoStmts mDoExpr stmts -- Do expansion on the fly ; let orig = HsDo noExtField mDoExpr ss - ; e' <- tcMonoExpr expanded_expr res_ty + ; e' <- tcMonoLExpr expanded_expr res_ty ; return (mkExpandedExprTc orig (unLoc e')) } @@ -567,7 +568,7 @@ tcLcStmt :: TyCon -- The list type constructor ([]) -> TcExprStmtChecker tcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside - = do { body' <- tcMonoExprNC body elt_ty + = do { body' <- tcMonoLExprNC body elt_ty ; thing <- thing_inside (panic "tcLcStmt: thing_inside") ; return (LastStmt x body' noret noSyntaxExpr, thing) } @@ -970,7 +971,7 @@ tcMcStmt _ stmt _ _ tcDoStmt :: TcExprStmtChecker tcDoStmt _ (LastStmt x body noret _) res_ty thing_inside - = do { body' <- tcMonoExprNC body res_ty + = do { body' <- tcMonoLExprNC body res_ty ; thing <- thing_inside (panic "tcDoStmt: thing_inside") ; return (LastStmt x body' noret noSyntaxExpr, thing) } tcDoStmt ctxt (BindStmt xbsrn pat rhs) res_ty thing_inside View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9dab3569adba10bc1f8a70c88be6c169... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9dab3569adba10bc1f8a70c88be6c169... You're receiving this email because of your account on gitlab.haskell.org.