Apoorv Ingle pushed to branch wip/ani/kill-popErrCtxt at Glasgow Haskell Compiler / GHC Commits: 106e67d2 by Apoorv Ingle at 2025-09-22T08:14:06-05:00 wombat - - - - - 5 changed files: - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Types/LclEnv.hs - compiler/GHC/Tc/Utils/Monad.hs Changes: ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Rename.Utils ( DeprecationWarnings(..), warnIfDeprecated, checkUnusedRecordWildcard, badQualBndrErr, typeAppErr, badFieldConErr, - wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps, + wrapGenSpan, wrapNoSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genHsExpApps, genLHsApp, genAppType, genLHsLit, genHsIntegralLit, genHsTyLit, genSimpleConPat, genVarPat, genWildPat, @@ -706,6 +706,12 @@ wrapGenSpan :: (HasAnnotation an) => a -> GenLocated an a -- See Note [Rebindable syntax and XXExprGhcRn] wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x +wrapNoSpan :: (HasAnnotation an) => a -> GenLocated an a +-- Wrap something in a "noSrcSpan" +-- See Note [Rebindable syntax and XXExprGhcRn] +wrapNoSpan x = L (noAnnSrcSpan noSrcSpan) x + + -- | Make a 'SyntaxExpr' from a 'Name' (the "rn" is because this is used in the -- renamer). mkRnSyntaxExpr :: Name -> SyntaxExprRn ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Tc.Gen.Do (expandDoStmts) where import GHC.Prelude -import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet, +import GHC.Rename.Utils ( wrapGenSpan, wrapNoSpan, genHsExpApps, genHsApp, genHsLet, genHsLamDoExp, genHsCaseAltDoExp, genWildPat ) import GHC.Rename.Env ( irrefutableConLikeRn ) @@ -126,7 +126,7 @@ expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) -- e ; stmts ~~> (>>) e stmts' do expand_stmts_expr <- expand_do_stmts doFlavour lstmts let expansion = genHsExpApps then_op -- (>>) - [ e + [ e -- Span is set becuase of statement loc , expand_stmts_expr ] return $ L loc (mkExpandedStmt stmt doFlavour expansion) ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1109,5 +1109,4 @@ addExprCtxt e thing_inside -- f x = _ -- when we don't want to say "In the expression: _", -- because it is mentioned in the error message itself - XExpr (ExpandedThingRn o _) -> setInGeneratedCode o thing_inside _ -> addErrCtxt (ExprCtxt e) thing_inside -- no op in generated code ===================================== compiler/GHC/Tc/Types/LclEnv.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Tc.Types.LclEnv ( , setLclEnvSrcCodeOrigin , setLclCtxtSrcCodeOrigin , lclEnvInGeneratedCode + , setLclCtxtInGenCode , addLclEnvErrCtxt @@ -206,6 +207,9 @@ getLclEnvSrcCodeOrigin = get_src_code_origin . tcl_err_ctxt . tcl_lcl_ctxt setLclEnvSrcCodeOrigin :: SrcCodeOrigin -> TcLclEnv -> TcLclEnv setLclEnvSrcCodeOrigin o = modifyLclCtxt (setLclCtxtSrcCodeOrigin o) +setLclCtxtInGenCode :: TcLclCtxt -> TcLclCtxt +setLclCtxtInGenCode lclCtxt = lclCtxt { tcl_in_gen_code = True } + -- See Note [ErrCtxt Stack Manipulation] setLclCtxtSrcCodeOrigin :: SrcCodeOrigin -> TcLclCtxt -> TcLclCtxt setLclCtxtSrcCodeOrigin o lclCtxt ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -985,10 +985,10 @@ inGeneratedCode = lclEnvInGeneratedCode <$> getLclEnv setSrcSpan :: SrcSpan -> TcRn a -> TcRn a -- See Note [Error contexts in generated code] setSrcSpan (RealSrcSpan loc _) thing_inside - = updLclCtxt (\env -> env { tcl_loc = loc }) thing_inside + = updLclCtxt (\env -> env { tcl_loc = loc, tcl_in_gen_code = False }) thing_inside setSrcSpan (UnhelpfulSpan _) thing_inside - = thing_inside + = updLclCtxt setLclCtxtInGenCode thing_inside getSrcCodeOrigin :: TcRn (Maybe SrcCodeOrigin) getSrcCodeOrigin = getLclEnvSrcCodeOrigin <$> getLclEnv @@ -999,6 +999,7 @@ getSrcCodeOrigin = getLclEnvSrcCodeOrigin <$> getLclEnv -- See Note [Error Context Stack] setInGeneratedCode :: SrcCodeOrigin -> TcRn a -> TcRn a setInGeneratedCode sco thing_inside = + updLclCtxt setLclCtxtInGenCode $ updLclCtxt (setLclCtxtSrcCodeOrigin sco) thing_inside setSrcSpanA :: EpAnn ann -> TcRn a -> TcRn a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/106e67d29460c92da4fe57d1b2facc06... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/106e67d29460c92da4fe57d1b2facc06... You're receiving this email because of your account on gitlab.haskell.org.