Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC Commits: c6f2ab89 by Apoorv Ingle at 2026-03-09T19:16:59-05:00 fixes for error message diffs for RepPolyBinds etc. - - - - - 7 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/TcType.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1064,7 +1064,7 @@ instance Outputable XXExprGhcRn where pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e) pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt) pprCtxt (DoStmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt) - pprCtxt (StmtErrCtxtPat _ _ pat) = ppr_builder "<OrigPat>:" (ppr pat) + pprCtxt (StmtErrCtxtPat pat) = ppr_builder "<OrigPat>:" (ppr pat) pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:" (ppr e) pprCtxt _ = ppr_builder "<MiscErrCtxtMsg>:" empty @@ -1081,7 +1081,7 @@ instance Outputable XXExprGhcTc where pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e) pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt) pprCtxt (DoStmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt) - pprCtxt (StmtErrCtxtPat _ _ pat) = ppr_builder "<OrigPat>:" (ppr pat) + pprCtxt (StmtErrCtxtPat pat) = ppr_builder "<OrigPat>:" (ppr pat) pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:" (ppr e) pprCtxt _ = ppr_builder "<MiscErrCtxtMsg>:" empty ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -416,6 +416,8 @@ addTickLHsExpr e@(L pos e0) = do case d of TickForBreakPoints | isGoodBreakExpr e0 -> tick_it TickForCoverage | XExpr (ExpandedThingTc StmtErrCtxt{} _) <- e0 -- expansion ticks are handled separately + -> dont_tick_it + | XExpr (ExpandedThingTc DoStmtErrCtxt{} _) <- e0 -- expansion ticks are handled separately -> dont_tick_it | otherwise -> tick_it TickCallSites | isCallSite e0 -> tick_it @@ -485,6 +487,7 @@ addTickLHsExprNever (L pos e0) = do -- values) are good break points. isGoodBreakExpr :: HsExpr GhcTc -> Bool isGoodBreakExpr (XExpr (ExpandedThingTc (StmtErrCtxt{}) _)) = False +isGoodBreakExpr (XExpr (ExpandedThingTc (DoStmtErrCtxt{}) _)) = False isGoodBreakExpr e = isCallSite e isCallSite :: HsExpr GhcTc -> Bool ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -7884,8 +7884,7 @@ pprErrCtxtMsg = \case -> hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon) 2 (ppr_stmt (unLoc stmt)) - StmtErrCtxtPat _ _ pat -> - hang (text "In the pattern:") 2 (ppr pat) + StmtErrCtxtPat{} -> empty DerivInstCtxt pred -> text "When deriving the instance for" <+> parens (ppr pred) ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -213,7 +213,7 @@ mk_fail_block doFlav pat stmt e (Just (SyntaxExprRn fail_op)) = fail_op_expr :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> LHsExpr GhcRn fail_op_expr dflags pat@(L pat_lspan _) fail_op - = L pat_lspan $ mkExpandedPatRn doFlav pat stmt $ genHsApp fail_op (mk_fail_msg_expr dflags pat) + = L pat_lspan $ mkExpandedPatRn pat $ genHsApp fail_op (mk_fail_msg_expr dflags pat) mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn mk_fail_msg_expr dflags pat @@ -481,7 +481,7 @@ It stores the original statement (with location) and the expanded expression -} -mkExpandedPatRn :: HsDoFlavour -> LPat GhcRn -> ExprLStmt GhcRn -> HsExpr GhcRn -> HsExpr GhcRn -mkExpandedPatRn flav pat stmt e = XExpr $ ExpandedThingRn - { xrn_orig = StmtErrCtxtPat (HsDoStmt flav) stmt pat +mkExpandedPatRn :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn +mkExpandedPatRn pat e = XExpr $ ExpandedThingRn + { xrn_orig = StmtErrCtxtPat pat , xrn_expanded = e} ===================================== compiler/GHC/Tc/Types/ErrCtxt.hs ===================================== @@ -340,7 +340,7 @@ data ErrCtxtMsg | DoStmtErrCtxt !HsStmtContextRn !(ExprLStmt GhcRn) -- | In patten of the do statement. (c.f. MonadFailErrors) - | StmtErrCtxtPat !HsStmtContextRn !(ExprLStmt GhcRn) (LPat GhcRn) + | StmtErrCtxtPat (LPat GhcRn) -- | In an rebindable syntax expression. | SyntaxNameCtxt !(HsExpr GhcRn) !CtOrigin !TcType !SrcSpan ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -638,7 +638,7 @@ errCtxtCtOrigin (ExprCtxt e) = exprCtOrigin e errCtxtCtOrigin (FunAppCtxt (FunAppCtxtExpr _ e) _) = exprCtOrigin e errCtxtCtOrigin (StmtErrCtxt{}) = DoStmtOrigin errCtxtCtOrigin (DoStmtErrCtxt{}) = DoStmtOrigin -errCtxtCtOrigin (StmtErrCtxtPat _ _ p) = DoPatOrigin p +errCtxtCtOrigin (StmtErrCtxtPat p) = DoPatOrigin p errCtxtCtOrigin (RecordUpdCtxt{}) = RecordUpdOrigin errCtxtCtOrigin _ = Shouldn'tHappenOrigin "errCtxtCtOrigin" @@ -1484,11 +1484,11 @@ pprExpectedFunTyCtxt funTy_origin i = case funTy_origin of ExpectedFunTySyntaxOp orig op -> vcat [ sep [ the_arg_of - , text "the rebindable syntax operator" + , text "The rebindable syntax operator" , quotes (ppr op) ] , nest 2 (ppr orig) ] ExpectedTySyntax orig arg -> - vcat [ text "the expression" <+> quotes (ppr arg) + vcat [ text "The expression" <+> quotes (ppr arg) , nest 2 (ppr orig) ] ExpectedFunTyViewPat expr -> vcat [ the_arg_of <+> text "the view pattern" ===================================== compiler/GHC/Tc/Zonk/TcType.hs ===================================== @@ -805,9 +805,6 @@ zonkTidyErrCtxtMsg env e@(ExprCtxt{}) = return (env, e) zonkTidyErrCtxtMsg env (ThetaCtxt ctxt theta_ty) = do (env', theta_ty') <- zonkTidyTcTypes env theta_ty return $ (env', ThetaCtxt ctxt theta_ty') --- zonkTidyErrCtxtMsg env (QuantifiedCtCtxt ty) = do --- (env', ty') <- zonkTidyTcTypes env ty --- return $ QuantifiedCtCtxt ty' zonkTidyErrCtxtMsg env (InferredTypeCtxt n ty) = do (env', ty') <- zonkTidyTcType env ty return $ (env', InferredTypeCtxt n ty') @@ -826,4 +823,7 @@ zonkTidyErrCtxtMsg env (FunResCtxt e i1 ty1 ty2 i2 i3) = do (env', ty1') <- zonkTidyTcType env ty1 (env', ty2') <- zonkTidyTcType env' ty2 return $ (env', FunResCtxt e i1 ty1' ty2' i2 i3) +-- zonkTidyErrCtxtMsg env (PatSigErrCtxt sig_ty res_ty) = do +-- (env', sig_ty) <- zonkTidyTcType env sig_ty +-- (env', res_ty) <- zonkZidy zonkTidyErrCtxtMsg env p = return (env, p) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6f2ab89a300c9756352e360bb8f361d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6f2ab89a300c9756352e360bb8f361d... You're receiving this email because of your account on gitlab.haskell.org.