July 2025 - ghc-commits

[Git][ghc/ghc][master] Fix documentation about deriving from generics
by Marge Bot (＠marge-bot) 21 Jul '25

21 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d751a9f1 by Pierre Thierry at 2025-07-21T13:37:28-04:00 Fix documentation about deriving from generics - - - - - 1 changed file: - libraries/base/src/GHC/Generics.hs Changes: ===================================== libraries/base/src/GHC/Generics.hs ===================================== @@ -392,9 +392,14 @@ module GHC.Generics ( -- instance (Encode a) => Encode (Tree a) -- @ -- --- The generic default is being used. In the future, it will hopefully be --- possible to use @deriving Encode@ as well, but GHC does not yet support --- that syntax for this situation. +-- The generic default is being used. Alternatively the @DeriveAnyClass@ language extension can be +-- used to derive Encode: +-- +-- @ +-- {-# LANGUAGE DeriveAnyClass #-} +-- data Tree a = Leaf a | Node (Tree a) (Tree a) +-- deriving (Generic, Encode) +-- @ -- -- Having @Encode@ as a class has the advantage that we can define -- non-generic special cases, which is particularly useful for abstract View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d751a9f1b45d65f38805b9d103af707… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d751a9f1b45d65f38805b9d103af707… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] level imports: Fix infinite loop with cyclic module imports
by Marge Bot (＠marge-bot) 21 Jul '25

21 Jul '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8b731e3c by Matthew Pickering at 2025-07-21T13:36:43-04:00 level imports: Fix infinite loop with cyclic module imports I didn't anticipate that downsweep would run before we checked for cyclic imports. Therefore we need to use the reachability function which handles cyclic graphs. Fixes #26087 - - - - - 5 changed files: - compiler/GHC/Unit/Module/Graph.hs - + testsuite/tests/splice-imports/T26087.stderr - + testsuite/tests/splice-imports/T26087A.hs - + testsuite/tests/splice-imports/T26087B.hs - testsuite/tests/splice-imports/all.T Changes: ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -866,7 +866,7 @@ mkTransZeroDeps = first graphReachability {- module graph is acyclic -} . module -- | Transitive dependencies, but with the stage that each module is required at. mkStageDeps :: [ModuleGraphNode] -> (ReachabilityIndex StageSummaryNode, (NodeKey, ModuleStage) -> Maybe StageSummaryNode) -mkStageDeps = first graphReachability . moduleGraphNodesStages +mkStageDeps = first cyclicGraphReachability . moduleGraphNodesStages type ZeroSummaryNode = Node Int ZeroScopeKey ===================================== testsuite/tests/splice-imports/T26087.stderr ===================================== @@ -0,0 +1,6 @@ +./T26087B.hs: error: [GHC-92213] + Module graph contains a cycle: + module ‘main:T26087B’ (./T26087B.hs) + imports module ‘main:T26087A’ (T26087A.hs) + which imports module ‘main:T26087B’ (./T26087B.hs) + ===================================== testsuite/tests/splice-imports/T26087A.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE ExplicitLevelImports #-} +module T26087A where + +import quote T26087B ===================================== testsuite/tests/splice-imports/T26087B.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-} +module T26087B where + +import T26087A ===================================== testsuite/tests/splice-imports/all.T ===================================== @@ -46,3 +46,4 @@ test('SI35', compile_and_run, ['-package ghc']) test('SI36', [extra_files(["SI36_A.hs", "SI36_B1.hs", "SI36_B2.hs", "SI36_B3.hs", "SI36_C1.hs", "SI36_C2.hs", "SI36_C3.hs"])], multimod_compile_fail, ['SI36', '-v0']) +test('T26087', [], multimod_compile_fail, ['T26087A', '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b731e3c900291655a767123bcda55e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b731e3c900291655a767123bcda55e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26115] Wibble origin of Deriv
by Simon Peyton Jones (＠simonpj) 21 Jul '25

21 Jul '25

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: d724cbc6 by Simon Peyton Jones at 2025-07-21T17:44:22+01:00 Wibble origin of Deriv - - - - - 1 changed file: - compiler/GHC/Tc/Deriv/Utils.hs Changes: ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -55,16 +55,18 @@ import GHC.Unit.Module (getModule) import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface (mi_fix) -import GHC.Types.Fixity.Env (lookupFixity) import GHC.Iface.Load (loadInterfaceForName) + +import GHC.Types.Fixity.Env (lookupFixity) import GHC.Types.Name import GHC.Types.SrcLoc -import GHC.Utils.Misc import GHC.Types.Var.Set +import GHC.Types.Id( idName ) import GHC.Builtin.Names import GHC.Builtin.Names.TH (liftClassKey) +import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Error @@ -714,7 +716,13 @@ emitPredSpecConstraints _ (SimplePredSpec { sps_pred = wanted_pred -- but here when we are trying to infer the context for an instance decl, we -- need that half-solved implication. See deriving/should_compile/T20815 -- and Note [Inferred contexts from method constraints] - = do { let skol_info_anon = DerivSkol wanted_pred + = do { let skol_info_anon + = case orig of + DerivOriginCoerce meth _ _ _ -> MethSkol (idName meth) False + _ -> pprPanic "emitPredSpecConstraints" (ppr orig $$ ppr wanted_pred) + -- We only get a polymorphic wanted_pred from DerivOriginCoerce + -- This is a bit messy, but arises from the fact that SimplePredSpe + -- is not really simple! ; skol_info <- mkSkolemInfo skol_info_anon ; (_wrapper, tv_prs, givens, wanted_rho) <- topSkolemise skol_info wanted_pred -- _wrapper: we ignore the evidence from all these constraints View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d724cbc65c0d1da25402f80cc320884… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d724cbc65c0d1da25402f80cc320884… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] remove locations from orig payload
by Apoorv Ingle (＠ani) 21 Jul '25

21 Jul '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 9bc44eb4 by Apoorv Ingle at 2025-07-21T10:43:26-05:00 remove locations from orig payload - - - - - 4 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Do.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -674,11 +674,11 @@ type instance XXExpr GhcTc = XXExprGhcTc -- See Note [Handling overloaded and rebindable constructs] in `GHC.Rename.Expr` data SrcCodeOrigin = OrigExpr (HsExpr GhcRn) -- ^ The source, user written, expression - | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from - | OrigPat (LPat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints + | OrigStmt (ExprStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from + | OrigPat (Pat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints data XXExprGhcRn - = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages + = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages , xrn_expanded :: HsExpr GhcRn -- The compiler generated expanded thing } @@ -706,7 +706,7 @@ mkExpandedExpr oExpr eExpr = XExpr (ExpandedThingRn { xrn_orig = OrigExpr oExpr -- and the two components of the expansion: original do stmt and -- expanded expression mkExpandedStmt - :: ExprLStmt GhcRn -- ^ source statement + :: ExprStmt GhcRn -- ^ source statement -> HsDoFlavour -- ^ source statement do flavour -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -659,23 +659,26 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts)) _ -> Nothing addTickHsExpanded :: SrcCodeOrigin -> HsExpr GhcTc -> TM (HsExpr GhcTc) -addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of - -- We always want statements to get a tick, so we can step over each one. - -- To avoid duplicates we blacklist SrcSpans we already inserted here. - OrigStmt (L pos _) _ -> do_tick_black pos - _ -> skip - where - skip = addTickHsExpr e - do_tick_black pos = do - d <- getDensity - case d of - TickForCoverage -> tick_it_black pos - TickForBreakPoints -> tick_it_black pos - _ -> skip - tick_it_black pos = - unLoc <$> allocTickBox (ExpBox False) False False (locA pos) - (withBlackListed (locA pos) $ - addTickHsExpr e) +addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ addTickHsExpr e + + + -- case o of + -- -- We always want statements to get a tick, so we can step over each one. + -- -- To avoid duplicates we blacklist SrcSpans we already inserted here. + -- OrigStmt (L pos _) _ -> do_tick_black pos + -- _ -> skip + -- where + -- skip = addTickHsExpr e + -- do_tick_black pos = do + -- d <- getDensity + -- case d of + -- TickForCoverage -> tick_it_black pos + -- TickForBreakPoints -> tick_it_black pos + -- _ -> skip + -- tick_it_black pos = + -- unLoc <$> allocTickBox (ExpBox False) False False (locA pos) + -- (withBlackListed (locA pos) $ + -- addTickHsExpr e) addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc) addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -7239,7 +7239,7 @@ pprTyConInstFlavour pprErrCtxtMsg :: ErrCtxtMsg -> SDoc pprErrCtxtMsg = \case ExprCtxt expr - | XExpr (ExpandedThingRn (OrigStmt (L _ stmt) flav) _) <- expr + | XExpr (ExpandedThingRn (OrigStmt stmt flav) _) <- expr -> hang (text "In a stmt of" <+> pprAStmtContext @(LIdP GhcRn) (HsDoStmt flav) <> colon) 2 (ppr_stmt stmt) | otherwise ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -75,7 +75,7 @@ expand_do_stmts _ (stmt@(L _ (XStmtLR ApplicativeStmt{})): _) = expand_do_stmts _ [] = pprPanic "expand_do_stmts: impossible happened. Empty stmts" empty -expand_do_stmts flav [stmt@(L sloc (LastStmt _ body@(L body_loc _) _ ret_expr))] +expand_do_stmts flav [L sloc stmt@(LastStmt _ body@(L body_loc _) _ ret_expr)] -- See Note [Expanding HsDo with XXExprGhcRn] Equation (5) below -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` @@ -90,7 +90,7 @@ expand_do_stmts flav [stmt@(L sloc (LastStmt _ body@(L body_loc _) _ ret_expr))] = do let expansion = L body_loc (genHsApp ret body) return $ L sloc (mkExpandedStmt stmt flav (HsPar noExtField expansion)) -expand_do_stmts doFlavour (stmt@(L loc (LetStmt _ bs)) : lstmts) = +expand_do_stmts doFlavour (L loc stmt@(LetStmt _ bs) : lstmts) = -- See Note [Expanding HsDo with XXExprGhcRn] Equation (3) below -- stmts ~~> stmts' -- ------------------------------------------------ @@ -99,7 +99,7 @@ expand_do_stmts doFlavour (stmt@(L loc (LetStmt _ bs)) : lstmts) = let expansion = genHsLet bs (genPopErrCtxtExpr expand_stmts_expr) return $ L loc (mkExpandedStmt stmt doFlavour expansion) -expand_do_stmts doFlavour (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) +expand_do_stmts doFlavour (L loc stmt@(BindStmt xbsrn pat e) : lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn -- See Note [Expanding HsDo with XXExprGhcRn] Equation (2) below @@ -117,7 +117,7 @@ expand_do_stmts doFlavour (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | otherwise = pprPanic "expand_do_stmts: The impossible happened, missing bind operator from renamer" (text "stmt" <+> ppr stmt) -expand_do_stmts doFlavour (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) : lstmts) = +expand_do_stmts doFlavour (L loc stmt@(BodyStmt _ e (SyntaxExprRn then_op) _) : lstmts) = -- See Note [BodyStmt] in Language.Haskell.Syntax.Expr -- See Note [Expanding HsDo with XXExprGhcRn] Equation (1) below -- stmts ~~> stmts' @@ -214,7 +214,7 @@ mk_fail_block doFlav pat e (Just (SyntaxExprRn fail_op)) = fail_op_expr :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn fail_op_expr dflags pat fail_op - = mkExpandedPatRn pat $ genHsApp fail_op (mk_fail_msg_expr dflags pat) + = mkExpandedPatRn (unLoc 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 @@ -489,5 +489,5 @@ mkPopErrCtxtExpr a = XExpr (PopErrCtxt a) genPopErrCtxtExpr :: LHsExpr GhcRn -> LHsExpr GhcRn genPopErrCtxtExpr (L loc a) = L loc (mkPopErrCtxtExpr a) -mkExpandedPatRn :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn +mkExpandedPatRn :: Pat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn mkExpandedPatRn pat e = XExpr (ExpandedThingRn (OrigPat pat) e) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9bc44eb4b3b222a44f7532e32b2596a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9bc44eb4b3b222a44f7532e32b2596a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] remove locations from orig payload
by Apoorv Ingle (＠ani) 21 Jul '25

21 Jul '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 11b5f135 by Apoorv Ingle at 2025-07-21T10:16:02-05:00 remove locations from orig payload - - - - - 4 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Do.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -674,11 +674,11 @@ type instance XXExpr GhcTc = XXExprGhcTc -- See Note [Handling overloaded and rebindable constructs] in `GHC.Rename.Expr` data SrcCodeOrigin = OrigExpr (HsExpr GhcRn) -- ^ The source, user written, expression - | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from - | OrigPat (LPat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints + | OrigStmt (ExprStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from + | OrigPat (Pat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints data XXExprGhcRn - = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages + = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages , xrn_expanded :: HsExpr GhcRn -- The compiler generated expanded thing } @@ -706,7 +706,7 @@ mkExpandedExpr oExpr eExpr = XExpr (ExpandedThingRn { xrn_orig = OrigExpr oExpr -- and the two components of the expansion: original do stmt and -- expanded expression mkExpandedStmt - :: ExprLStmt GhcRn -- ^ source statement + :: ExprStmt GhcRn -- ^ source statement -> HsDoFlavour -- ^ source statement do flavour -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -659,23 +659,26 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts)) _ -> Nothing addTickHsExpanded :: SrcCodeOrigin -> HsExpr GhcTc -> TM (HsExpr GhcTc) -addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of - -- We always want statements to get a tick, so we can step over each one. - -- To avoid duplicates we blacklist SrcSpans we already inserted here. - OrigStmt (L pos _) _ -> do_tick_black pos - _ -> skip - where - skip = addTickHsExpr e - do_tick_black pos = do - d <- getDensity - case d of - TickForCoverage -> tick_it_black pos - TickForBreakPoints -> tick_it_black pos - _ -> skip - tick_it_black pos = - unLoc <$> allocTickBox (ExpBox False) False False (locA pos) - (withBlackListed (locA pos) $ - addTickHsExpr e) +addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ addTickHsExpr e + + + -- case o of + -- -- We always want statements to get a tick, so we can step over each one. + -- -- To avoid duplicates we blacklist SrcSpans we already inserted here. + -- OrigStmt (L pos _) _ -> do_tick_black pos + -- _ -> skip + -- where + -- skip = addTickHsExpr e + -- do_tick_black pos = do + -- d <- getDensity + -- case d of + -- TickForCoverage -> tick_it_black pos + -- TickForBreakPoints -> tick_it_black pos + -- _ -> skip + -- tick_it_black pos = + -- unLoc <$> allocTickBox (ExpBox False) False False (locA pos) + -- (withBlackListed (locA pos) $ + -- addTickHsExpr e) addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc) addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -7239,7 +7239,7 @@ pprTyConInstFlavour pprErrCtxtMsg :: ErrCtxtMsg -> SDoc pprErrCtxtMsg = \case ExprCtxt expr - | XExpr (ExpandedThingRn (OrigStmt (L _ stmt) flav) _) <- expr + | XExpr (ExpandedThingRn (OrigStmt stmt flav) _) <- expr -> hang (text "In a stmt of" <+> pprAStmtContext @(LIdP GhcRn) (HsDoStmt flav) <> colon) 2 (ppr_stmt stmt) | otherwise ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -214,7 +214,7 @@ mk_fail_block doFlav pat e (Just (SyntaxExprRn fail_op)) = fail_op_expr :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn fail_op_expr dflags pat fail_op - = mkExpandedPatRn pat $ genHsApp fail_op (mk_fail_msg_expr dflags pat) + = mkExpandedPatRn (unLoc 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 @@ -489,5 +489,5 @@ mkPopErrCtxtExpr a = XExpr (PopErrCtxt a) genPopErrCtxtExpr :: LHsExpr GhcRn -> LHsExpr GhcRn genPopErrCtxtExpr (L loc a) = L loc (mkPopErrCtxtExpr a) -mkExpandedPatRn :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn +mkExpandedPatRn :: Pat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn mkExpandedPatRn pat e = XExpr (ExpandedThingRn (OrigPat pat) e) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11b5f135c6c7407850c26dff4a029e7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11b5f135c6c7407850c26dff4a029e7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/T25897] hi: Don't sort re-exported module avails
by Rodrigo Mesquita (＠alt-romes) 21 Jul '25

21 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/T25897 at Glasgow Haskell Compiler / GHC Commits: 6a35cfdf by Rodrigo Mesquita at 2025-07-21T14:41:45+01:00 hi: Don't sort re-exported module avails The order of the avails in a re-exported module should be the order in which they were exported from the original module. This order is already deterministic (inductively, since all base cases for module re-exports are either deterministic by being explicit or implictly sorted). If we have many imports for a re-exported module, like: module A (module B) where import B (b) import B (a) The order is unchanged from the order in which they are imported, which should be deterministic. We also add tests for this. Fixes #25897 - - - - - 15 changed files: - compiler/GHC/HsToCore/Docs.hs - + testsuite/tests/determinism/T25897d/A.hs - + testsuite/tests/determinism/T25897d/B.hs - + testsuite/tests/determinism/T25897d/C.hs - + testsuite/tests/determinism/T25897d/Makefile - + testsuite/tests/determinism/T25897d/T25897d.stdout - + testsuite/tests/determinism/T25897d/T25897e.stdout - + testsuite/tests/determinism/T25897d/all.T - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/Makefile - + testsuite/tests/showIface/T25897.hs - + testsuite/tests/showIface/T25897.stdout - + testsuite/tests/showIface/T25897b.hs - + testsuite/tests/showIface/T25897c.hs - testsuite/tests/showIface/all.T Changes: ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -173,7 +173,9 @@ mkDocStructureFromExportList mdl import_avails export_list = -> Avails -> DocStructureItem moduleExport alias avails = - DsiModExport (nubSortNE orig_names) (sortAvails (nubAvails avails)) + {- For module re-exports, use the original order (which is already deterministic) -} + DsiModExport (nubSortNE orig_names) + (DefinitelyDeterministicAvails (nubAvails avails)) where orig_names = M.findWithDefault aliasErr alias aliasMap aliasErr = error $ "mkDocStructureFromExportList: " ===================================== testsuite/tests/determinism/T25897d/A.hs ===================================== @@ -0,0 +1,12 @@ +module A + ( b, a, c + ) where + +a :: () +a = () + +b :: () +b = () + +c :: () +c = () ===================================== testsuite/tests/determinism/T25897d/B.hs ===================================== @@ -0,0 +1,8 @@ +module B + ( module A + ) where + +import A (a) +import A (b) +import A (c) + ===================================== testsuite/tests/determinism/T25897d/C.hs ===================================== @@ -0,0 +1,9 @@ +module B + ( module A + ) where + +-- The order of the imports is the order in the module re-exports +import A (a) +import A (c) +import A (b) + ===================================== testsuite/tests/determinism/T25897d/Makefile ===================================== @@ -0,0 +1,31 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T25897d: + $(RM) A.hi A.o B.hi B.o + # Use -haddock to get docs: output in the interface file + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -haddock B.hs + '$(TEST_HC)' --show-iface A.hi > A_clean_iface + '$(TEST_HC)' --show-iface B.hi > B_clean_iface + '$(TEST_HC)' $(TEST_HC_OPTS) -dinitial-unique=16777215 -dunique-increment=-1 -v0 -haddock A.hs B.hs -fforce-recomp + '$(TEST_HC)' --show-iface A.hi > A_dirty_iface + '$(TEST_HC)' --show-iface B.hi > B_dirty_iface + diff A_clean_iface A_dirty_iface + diff B_clean_iface B_dirty_iface + cat B_clean_iface | grep -A7 "documentation structure" + cat B_dirty_iface | grep -A7 "documentation structure" + +T25897e: + $(RM) A.hi A.o C.hi C.o + # Use -haddock to get docs: output in the interface file + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -haddock C.hs + '$(TEST_HC)' --show-iface A.hi > A_clean_iface + '$(TEST_HC)' --show-iface C.hi > C_clean_iface + '$(TEST_HC)' $(TEST_HC_OPTS) -dinitial-unique=16777215 -dunique-increment=-1 -v0 -haddock A.hs C.hs -fforce-recomp + '$(TEST_HC)' --show-iface A.hi > A_dirty_iface + '$(TEST_HC)' --show-iface C.hi > C_dirty_iface + diff A_clean_iface A_dirty_iface + diff C_clean_iface C_dirty_iface + cat C_clean_iface | grep -A7 "documentation structure" + cat C_dirty_iface | grep -A7 "documentation structure" ===================================== testsuite/tests/determinism/T25897d/T25897d.stdout ===================================== @@ -0,0 +1,16 @@ + documentation structure: + re-exported module(s): [A] + [A.a, A.b, A.c] + named chunks: + haddock options: + language: + Nothing + language extensions: + documentation structure: + re-exported module(s): [A] + [A.a, A.b, A.c] + named chunks: + haddock options: + language: + Nothing + language extensions: ===================================== testsuite/tests/determinism/T25897d/T25897e.stdout ===================================== @@ -0,0 +1,16 @@ + documentation structure: + re-exported module(s): [A] + [A.a, A.c, A.b] + named chunks: + haddock options: + language: + Nothing + language extensions: + documentation structure: + re-exported module(s): [A] + [A.a, A.c, A.b] + named chunks: + haddock options: + language: + Nothing + language extensions: ===================================== testsuite/tests/determinism/T25897d/all.T ===================================== @@ -0,0 +1,2 @@ +test('T25897d', [extra_files(['A.hs', 'B.hs'])], makefile_test, ['T25897d']) +test('T25897e', [extra_files(['A.hs', 'C.hs'])], makefile_test, ['T25897e']) ===================================== testsuite/tests/showIface/HaddockIssue849.stdout ===================================== @@ -11,12 +11,12 @@ docs: re-exported module(s): [Data.Functor.Identity] [] re-exported module(s): [Data.Maybe] - [GHC.Internal.Data.Maybe.maybe, - GHC.Internal.Maybe.Maybe{GHC.Internal.Maybe.Maybe, - GHC.Internal.Maybe.Just, GHC.Internal.Maybe.Nothing}] + [GHC.Internal.Maybe.Maybe{GHC.Internal.Maybe.Maybe, + GHC.Internal.Maybe.Nothing, GHC.Internal.Maybe.Just}, + GHC.Internal.Data.Maybe.maybe] re-exported module(s): [Data.Tuple] - [GHC.Internal.Data.Tuple.curry, GHC.Internal.Data.Tuple.fst, - GHC.Internal.Data.Tuple.snd, GHC.Internal.Data.Tuple.swap, + [GHC.Internal.Data.Tuple.swap, GHC.Internal.Data.Tuple.curry, + GHC.Internal.Data.Tuple.fst, GHC.Internal.Data.Tuple.snd, GHC.Internal.Data.Tuple.uncurry] named chunks: haddock options: ===================================== testsuite/tests/showIface/Makefile ===================================== @@ -49,3 +49,7 @@ HaddockSpanIssueT24378: MagicHashInHaddocks: '$(TEST_HC)' $(TEST_HC_OPTS) -c -haddock MagicHashInHaddocks.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface MagicHashInHaddocks.hi | grep -A 200 'docs:' + +T25897: + '$(TEST_HC)' $(TEST_HC_OPTS) -haddock -v0 T25897.hs T25897b.hs T25897c.hs + '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T25897.hi | grep -A 4 'documentation structure:' ===================================== testsuite/tests/showIface/T25897.hs ===================================== @@ -0,0 +1,9 @@ +-- | Re-exports should display `b` first and `a` second, as per the explicit +-- exports of that module. +module T25897 + ( module T25897c + , module T25897b + ) where + +import T25897b +import T25897c ===================================== testsuite/tests/showIface/T25897.stdout ===================================== @@ -0,0 +1,5 @@ + documentation structure: + re-exported module(s): [T25897c] + [T25897c.d, T25897c.c] + re-exported module(s): [T25897b] + [T25897b.b, T25897b.a] ===================================== testsuite/tests/showIface/T25897b.hs ===================================== @@ -0,0 +1,14 @@ +-- #hide +module T25897b + ( b + , a + ) + where + +-- | This should appear in second, as per the explicit export list +a :: () +a = () + +-- | This should appear in first, as per the explicit export list +b :: () +b = () ===================================== testsuite/tests/showIface/T25897c.hs ===================================== @@ -0,0 +1,14 @@ +-- #hide +module T25897c + ( d + , c + ) + where + +-- | This should appear in second, as per the explicit export list +c :: () +c = () + +-- | This should appear in first, as per the explicit export list +d :: () +d = () ===================================== testsuite/tests/showIface/all.T ===================================== @@ -13,3 +13,4 @@ test('ReExports', extra_files(['Inner0.hs', 'Inner1.hs', 'Inner2.hs', 'Inner3.hs test('HaddockIssue849', normal, makefile_test, []) test('HaddockSpanIssueT24378', normal, makefile_test, []) test('MagicHashInHaddocks', normal, makefile_test, []) +test('T25897', extra_files(['T25897b.hs', 'T25897c.hs']), makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a35cfdf06271018eebf3d75a70e9c7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a35cfdf06271018eebf3d75a70e9c7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] OrigPat pprCtO says a do statement to mimic DoPatOrigin
by Apoorv Ingle (＠ani) 21 Jul '25

21 Jul '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: a786d76d by Apoorv Ingle at 2025-07-21T08:17:52-05:00 OrigPat pprCtO says a do statement to mimic DoPatOrigin - - - - - 1 changed file: - compiler/GHC/Tc/Types/Origin.hs Changes: ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1096,7 +1096,7 @@ pprCtO (ExpansionOrigin (OrigExpr (ExplicitList{}))) = text "an overloaded list" pprCtO (ExpansionOrigin (OrigExpr (HsIf{}))) = text "an if-then-else expression" pprCtO (ExpansionOrigin (OrigExpr e)) = text "an expression" <+> ppr e pprCtO (ExpansionOrigin (OrigStmt{})) = text "a do statement" -pprCtO (ExpansionOrigin (OrigPat{})) = text "a pattern" +pprCtO (ExpansionOrigin (OrigPat{})) = text "a do statement" pprCtO (ExpectedTySyntax o _) = pprCtO o pprCtO (ExpectedFunTySyntaxOp{}) = text "a rebindable syntax operator" pprCtO (ExpectedFunTyViewPat{}) = text "a view pattern" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a786d76df56523a80ac678cdfc70afd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a786d76df56523a80ac678cdfc70afd… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] rep poly test case error messages
by Apoorv Ingle (＠ani) 21 Jul '25

21 Jul '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: ef506888 by Apoorv Ingle at 2025-07-21T07:57:11-05:00 rep poly test case error messages - - - - - 5 changed files: - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr Changes: ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr ===================================== @@ -1,9 +1,14 @@ - RecordDotSyntaxFail10.hs:40:11: error: [GHC-18872] • Couldn't match type ‘Int’ with ‘[Char]’ + arising from a functional dependency between: + constraint ‘HasField "quux" Quux String’ + arising from a record update + instance ‘HasField "quux" Quux Int’ + at RecordDotSyntaxFail10.hs:34:10-33 • In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’ In a stmt of a 'do' block: print $ a {foo.bar.baz.quux} In the expression: do let a = ... let quux = "Expecto patronum!" print $ a {foo.bar.baz.quux} + ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr ===================================== @@ -16,6 +16,7 @@ RecordDotSyntaxFail11.hs:8:3: error: [GHC-39999] RecordDotSyntaxFail11.hs:8:11: error: [GHC-39999] • No instance for ‘GHC.Internal.Records.HasField "baz" Int a0’ + arising from the expression (.foo.bar.baz) • In the second argument of ‘($)’, namely ‘(.foo.bar.baz) a’ In a stmt of a 'do' block: print $ (.foo.bar.baz) a In the expression: ===================================== testsuite/tests/rep-poly/RepPolyDoBind.stderr ===================================== @@ -1,5 +1,5 @@ RepPolyDoBind.hs:26:3: error: [GHC-55287] - • The first argument of the rebindable syntax operator ‘(>>=)’ + • The expression ‘undefined’ arising from a do statement does not have a fixed runtime representation. Its type is: ===================================== testsuite/tests/rep-poly/RepPolyDoBody1.stderr ===================================== @@ -1,5 +1,5 @@ RepPolyDoBody1.hs:24:3: error: [GHC-55287] - • The first argument of the rebindable syntax operator ‘(>>)’ + • The expression ‘undefined :: ma’ arising from a do statement does not have a fixed runtime representation. Its type is: ===================================== testsuite/tests/rep-poly/RepPolyDoBody2.stderr ===================================== @@ -1,5 +1,5 @@ RepPolyDoBody2.hs:23:3: error: [GHC-55287] - • The first argument of the rebindable syntax operator ‘(>>)’ + • The expression ‘return ()’ arising from a do statement does not have a fixed runtime representation. Its type is: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef50688837d5bf60008ed9ede2f0d71… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef50688837d5bf60008ed9ede2f0d71… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/backtraces-decoders] Allow users to customise the collection of exception annotations
by Hannes Siebenhandl (＠fendor) 21 Jul '25

21 Jul '25

Hannes Siebenhandl pushed to branch wip/fendor/backtraces-decoders at Glasgow Haskell Compiler / GHC Commits: 7f60c07b by fendor at 2025-07-21T14:16:43+02:00 Allow users to customise the collection of exception annotations Add a global `CollectExceptionAnnotationMechanism` which determines how `ExceptionAnnotation`s are collected upon throwing an `Exception`. By overriding how we collect `Backtraces`, we can control how the `Backtraces` are displayed to the user by newtyping `Backtraces` and giving a different instance for `ExceptionAnnotation`. A concrete use-case for this feature is allowing us to experiment with alternative stack decoders, without having to modify `base`, which take additional information from the stack frames. This commit does not modify how `Backtraces` are currently collected or displayed. - - - - - 9 changed files: - libraries/base/src/Control/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Exception.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot - libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/src/Control/Exception/Backtrace.hs ===================================== @@ -54,6 +54,11 @@ module Control.Exception.Backtrace , Backtraces(..) , displayBacktraces , collectBacktraces + -- * Collecting exception annotations (like backtraces) + , CollectExceptionAnnotationMechanism + , getCollectExceptionAnnotationMechanism + , setCollectExceptionAnnotation + , collectExceptionAnnotation ) where import GHC.Internal.Exception.Backtrace ===================================== libraries/ghc-internal/src/GHC/Internal/Exception.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Internal.Show import GHC.Internal.Stack.Types import GHC.Internal.IO.Unsafe import {-# SOURCE #-} GHC.Internal.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc, withFrozenCallStack) -import {-# SOURCE #-} GHC.Internal.Exception.Backtrace (collectBacktraces) +import {-# SOURCE #-} GHC.Internal.Exception.Backtrace (collectExceptionAnnotation) import GHC.Internal.Exception.Type -- | Throw an exception. Exceptions may be thrown from purely @@ -166,8 +166,8 @@ toExceptionWithBacktrace :: (HasCallStack, Exception e) => e -> IO SomeException toExceptionWithBacktrace e | backtraceDesired e = do - bt <- collectBacktraces - return (addExceptionContext bt (toException e)) + ea <- collectExceptionAnnotation + return (addExceptionContext ea (toException e)) | otherwise = return (toException e) -- | This is thrown when the user calls 'error'. The @String@ is the ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs ===================================== @@ -12,7 +12,7 @@ import GHC.Internal.IO.Unsafe (unsafePerformIO) import GHC.Internal.Exception.Context import GHC.Internal.Ptr import GHC.Internal.Data.Maybe (fromMaybe) -import GHC.Internal.Stack.Types as GHC.Stack (CallStack) +import GHC.Internal.Stack.Types as GHC.Stack (CallStack, HasCallStack) import qualified GHC.Internal.Stack as HCS import qualified GHC.Internal.ExecutionStack.Internal as ExecStack import qualified GHC.Internal.Stack.CloneStack as CloneStack @@ -86,6 +86,40 @@ setBacktraceMechanismState bm enabled = do _ <- atomicModifyIORef'_ enabledBacktraceMechanismsRef (setBacktraceMechanismEnabled bm enabled) return () +-- | How to collect 'ExceptionAnnotation's on throwing 'Exception's. +-- +-- @since base-4.23.0.0 +data CollectExceptionAnnotationMechanism = CollectExceptionAnnotationMechanism + { ceaCollectExceptionAnnotationMechanism :: HasCallStack => IO SomeExceptionAnnotation + } + +defaultCollectExceptionAnnotationMechanism :: CollectExceptionAnnotationMechanism +defaultCollectExceptionAnnotationMechanism = CollectExceptionAnnotationMechanism + { ceaCollectExceptionAnnotationMechanism = SomeExceptionAnnotation `fmap` collectBacktraces + } + +collectExceptionAnnotationMechanismRef :: IORef CollectExceptionAnnotationMechanism +collectExceptionAnnotationMechanismRef = + unsafePerformIO $ newIORef defaultCollectExceptionAnnotationMechanism +{-# NOINLINE collectExceptionAnnotationMechanismRef #-} + +-- | Returns the current callback for collecting 'ExceptionAnnotation's on throwing 'Exception's. +-- +-- @since base-4.23.0.0 +getCollectExceptionAnnotationMechanism :: IO CollectExceptionAnnotationMechanism +getCollectExceptionAnnotationMechanism = readIORef collectExceptionAnnotationMechanismRef + +-- | Set the callback for collecting an 'ExceptionAnnotation'. +-- +-- @since base-4.23.0.0 +setCollectExceptionAnnotation :: ExceptionAnnotation a => (HasCallStack => IO a) -> IO () +setCollectExceptionAnnotation collector = do + let cea = CollectExceptionAnnotationMechanism + { ceaCollectExceptionAnnotationMechanism = fmap SomeExceptionAnnotation collector + } + _ <- atomicModifyIORef'_ collectExceptionAnnotationMechanismRef (const cea) + return () + -- | A collection of backtraces. data Backtraces = Backtraces { @@ -124,6 +158,15 @@ displayBacktraces bts = concat instance ExceptionAnnotation Backtraces where displayExceptionAnnotation = displayBacktraces +-- | Collect 'SomeExceptionAnnotation' based on the configuration of the +-- global 'CollectExceptionAnnotationMechanism'. +-- +-- @since base-4.23.0.0 +collectExceptionAnnotation :: HasCallStack => IO SomeExceptionAnnotation +collectExceptionAnnotation = HCS.withFrozenCallStack $ do + cea <- getCollectExceptionAnnotationMechanism + ceaCollectExceptionAnnotationMechanism cea + -- | Collect a set of 'Backtraces'. collectBacktraces :: (?callStack :: CallStack) => IO Backtraces collectBacktraces = HCS.withFrozenCallStack $ do ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot ===================================== @@ -5,11 +5,7 @@ module GHC.Internal.Exception.Backtrace where import GHC.Internal.Base (IO) import GHC.Internal.Stack.Types (HasCallStack) -import GHC.Internal.Exception.Context (ExceptionAnnotation) - -data Backtraces - -instance ExceptionAnnotation Backtraces +import GHC.Internal.Exception.Context (SomeExceptionAnnotation) -- For GHC.Exception -collectBacktraces :: HasCallStack => IO Backtraces +collectExceptionAnnotation :: HasCallStack => IO SomeExceptionAnnotation ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs ===================================== @@ -99,6 +99,9 @@ displayExceptionContext (ExceptionContext anns0) = mconcat $ intersperse "\n" $ data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a +instance ExceptionAnnotation SomeExceptionAnnotation where + displayExceptionAnnotation (SomeExceptionAnnotation ann) = displayExceptionAnnotation ann + -- | 'ExceptionAnnotation's are types which can decorate exceptions as -- 'ExceptionContext'. -- ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -324,10 +324,15 @@ module Control.Exception.Backtrace where data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace type Backtraces :: * data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe GHC.Internal.ExecutionStack.Internal.StackTrace, btrIpe :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.CloneStack.StackSnapshot} + type CollectExceptionAnnotationMechanism :: * + data CollectExceptionAnnotationMechanism = ... collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces + collectExceptionAnnotation :: GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO GHC.Internal.Exception.Context.SomeExceptionAnnotation displayBacktraces :: Backtraces -> GHC.Internal.Base.String getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool + getCollectExceptionAnnotationMechanism :: GHC.Internal.Types.IO CollectExceptionAnnotationMechanism setBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.Bool -> GHC.Internal.Types.IO () + setCollectExceptionAnnotation :: forall a. GHC.Internal.Exception.Context.ExceptionAnnotation a => (GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a) -> GHC.Internal.Types.IO () module Control.Exception.Base where -- Safety: Safe @@ -12288,6 +12293,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘G instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’ instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’ +instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Context.SomeExceptionAnnotation -- Defined in ‘GHC.Internal.Exception.Context’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -324,10 +324,15 @@ module Control.Exception.Backtrace where data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace type Backtraces :: * data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe GHC.Internal.ExecutionStack.Internal.StackTrace, btrIpe :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.CloneStack.StackSnapshot} + type CollectExceptionAnnotationMechanism :: * + data CollectExceptionAnnotationMechanism = ... collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces + collectExceptionAnnotation :: GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO GHC.Internal.Exception.Context.SomeExceptionAnnotation displayBacktraces :: Backtraces -> GHC.Internal.Base.String getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool + getCollectExceptionAnnotationMechanism :: GHC.Internal.Types.IO CollectExceptionAnnotationMechanism setBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.Bool -> GHC.Internal.Types.IO () + setCollectExceptionAnnotation :: forall a. GHC.Internal.Exception.Context.ExceptionAnnotation a => (GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a) -> GHC.Internal.Types.IO () module Control.Exception.Base where -- Safety: Safe @@ -15323,6 +15328,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘G instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’ instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’ +instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Context.SomeExceptionAnnotation -- Defined in ‘GHC.Internal.Exception.Context’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -324,10 +324,15 @@ module Control.Exception.Backtrace where data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace type Backtraces :: * data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe GHC.Internal.ExecutionStack.Internal.StackTrace, btrIpe :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.CloneStack.StackSnapshot} + type CollectExceptionAnnotationMechanism :: * + data CollectExceptionAnnotationMechanism = ... collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces + collectExceptionAnnotation :: GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO GHC.Internal.Exception.Context.SomeExceptionAnnotation displayBacktraces :: Backtraces -> GHC.Internal.Base.String getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool + getCollectExceptionAnnotationMechanism :: GHC.Internal.Types.IO CollectExceptionAnnotationMechanism setBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.Bool -> GHC.Internal.Types.IO () + setCollectExceptionAnnotation :: forall a. GHC.Internal.Exception.Context.ExceptionAnnotation a => (GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a) -> GHC.Internal.Types.IO () module Control.Exception.Base where -- Safety: Safe @@ -12547,6 +12552,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘G instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’ instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’ +instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Context.SomeExceptionAnnotation -- Defined in ‘GHC.Internal.Exception.Context’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -324,10 +324,15 @@ module Control.Exception.Backtrace where data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace type Backtraces :: * data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe GHC.Internal.ExecutionStack.Internal.StackTrace, btrIpe :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.CloneStack.StackSnapshot} + type CollectExceptionAnnotationMechanism :: * + data CollectExceptionAnnotationMechanism = ... collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces + collectExceptionAnnotation :: GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO GHC.Internal.Exception.Context.SomeExceptionAnnotation displayBacktraces :: Backtraces -> GHC.Internal.Base.String getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool + getCollectExceptionAnnotationMechanism :: GHC.Internal.Types.IO CollectExceptionAnnotationMechanism setBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.Bool -> GHC.Internal.Types.IO () + setCollectExceptionAnnotation :: forall a. GHC.Internal.Exception.Context.ExceptionAnnotation a => (GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a) -> GHC.Internal.Types.IO () module Control.Exception.Base where -- Safety: Safe @@ -12288,6 +12293,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘G instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’ instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’ +instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Context.SomeExceptionAnnotation -- Defined in ‘GHC.Internal.Exception.Context’ instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’ instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f60c07bb499e3b5856fafa1aa2bd17… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f60c07bb499e3b5856fafa1aa2bd17… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/backtraces-decoders] Allow users to customise the collection of exception annotations
by Hannes Siebenhandl (＠fendor) 21 Jul '25

21 Jul '25

Hannes Siebenhandl pushed to branch wip/fendor/backtraces-decoders at Glasgow Haskell Compiler / GHC Commits: b9374ecd by fendor at 2025-07-21T14:04:30+02:00 Allow users to customise the collection of exception annotations Add a global `CollectExceptionAnnotationMechanism` which determines how `ExceptionAnnotation`s are collected upon throwing an `Exception`. By overriding how we collect `Backtraces`, we can control how the `Backtraces` are displayed to the user by newtyping `Backtraces` and giving a different instance for `ExceptionAnnotation`. A concrete use-case for this feature is allowing us to experiment with alternative stack decoders, without having to modify `base`, which take additional information from the stack frames. This commit does not modify how `Backtraces` are currently collected or displayed. - - - - - 5 changed files: - libraries/base/src/Control/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Exception.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot - libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs Changes: ===================================== libraries/base/src/Control/Exception/Backtrace.hs ===================================== @@ -54,6 +54,11 @@ module Control.Exception.Backtrace , Backtraces(..) , displayBacktraces , collectBacktraces + -- * Collecting exception annotations (like backtraces) + , CollectExceptionAnnotationMechanism + , getCollectExceptionAnnotationMechanism + , setCollectExceptionAnnotation + , collectExceptionAnnotation ) where import GHC.Internal.Exception.Backtrace ===================================== libraries/ghc-internal/src/GHC/Internal/Exception.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Internal.Show import GHC.Internal.Stack.Types import GHC.Internal.IO.Unsafe import {-# SOURCE #-} GHC.Internal.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc, withFrozenCallStack) -import {-# SOURCE #-} GHC.Internal.Exception.Backtrace (collectBacktraces) +import {-# SOURCE #-} GHC.Internal.Exception.Backtrace (collectExceptionAnnotation) import GHC.Internal.Exception.Type -- | Throw an exception. Exceptions may be thrown from purely @@ -166,8 +166,8 @@ toExceptionWithBacktrace :: (HasCallStack, Exception e) => e -> IO SomeException toExceptionWithBacktrace e | backtraceDesired e = do - bt <- collectBacktraces - return (addExceptionContext bt (toException e)) + ea <- collectExceptionAnnotation + return (addExceptionContext ea (toException e)) | otherwise = return (toException e) -- | This is thrown when the user calls 'error'. The @String@ is the ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs ===================================== @@ -12,7 +12,7 @@ import GHC.Internal.IO.Unsafe (unsafePerformIO) import GHC.Internal.Exception.Context import GHC.Internal.Ptr import GHC.Internal.Data.Maybe (fromMaybe) -import GHC.Internal.Stack.Types as GHC.Stack (CallStack) +import GHC.Internal.Stack.Types as GHC.Stack (CallStack, HasCallStack) import qualified GHC.Internal.Stack as HCS import qualified GHC.Internal.ExecutionStack.Internal as ExecStack import qualified GHC.Internal.Stack.CloneStack as CloneStack @@ -86,6 +86,40 @@ setBacktraceMechanismState bm enabled = do _ <- atomicModifyIORef'_ enabledBacktraceMechanismsRef (setBacktraceMechanismEnabled bm enabled) return () +-- | How to collect 'ExceptionAnnotation's on throwing 'Exception's. +-- +-- @since base-4.23.0.0 +data CollectExceptionAnnotationMechanism = CollectExceptionAnnotationMechanism + { ceaCollectExceptionAnnotationMechanism :: HasCallStack => IO SomeExceptionAnnotation + } + +defaultCollectExceptionAnnotationMechanism :: CollectExceptionAnnotationMechanism +defaultCollectExceptionAnnotationMechanism = CollectExceptionAnnotationMechanism + { ceaCollectExceptionAnnotationMechanism = SomeExceptionAnnotation `fmap` collectBacktraces + } + +collectExceptionAnnotationMechanismRef :: IORef CollectExceptionAnnotationMechanism +collectExceptionAnnotationMechanismRef = + unsafePerformIO $ newIORef defaultCollectExceptionAnnotationMechanism +{-# NOINLINE collectExceptionAnnotationMechanismRef #-} + +-- | Returns the current callback for collecting 'ExceptionAnnotation's on throwing 'Exception's. +-- +-- @since base-4.23.0.0 +getCollectExceptionAnnotationMechanism :: IO CollectExceptionAnnotationMechanism +getCollectExceptionAnnotationMechanism = readIORef collectExceptionAnnotationMechanismRef + +-- | Set the callback for collecting an 'ExceptionAnnotation'. +-- +-- @since base-4.23.0.0 +setCollectExceptionAnnotation :: ExceptionAnnotation a => (HasCallStack => IO a) -> IO () +setCollectExceptionAnnotation collector = do + let cea = CollectExceptionAnnotationMechanism + { ceaCollectExceptionAnnotationMechanism = fmap SomeExceptionAnnotation collector + } + _ <- atomicModifyIORef'_ collectExceptionAnnotationMechanismRef (const cea) + return () + -- | A collection of backtraces. data Backtraces = Backtraces { @@ -124,6 +158,15 @@ displayBacktraces bts = concat instance ExceptionAnnotation Backtraces where displayExceptionAnnotation = displayBacktraces +-- | Collect 'SomeExceptionAnnotation' based on the configuration of the +-- global 'CollectExceptionAnnotationMechanism'. +-- +-- @since base-4.23.0.0 +collectExceptionAnnotation :: HasCallStack => IO SomeExceptionAnnotation +collectExceptionAnnotation = HCS.withFrozenCallStack $ do + cea <- getCollectExceptionAnnotationMechanism + ceaCollectExceptionAnnotationMechanism cea + -- | Collect a set of 'Backtraces'. collectBacktraces :: (?callStack :: CallStack) => IO Backtraces collectBacktraces = HCS.withFrozenCallStack $ do ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot ===================================== @@ -5,11 +5,7 @@ module GHC.Internal.Exception.Backtrace where import GHC.Internal.Base (IO) import GHC.Internal.Stack.Types (HasCallStack) -import GHC.Internal.Exception.Context (ExceptionAnnotation) - -data Backtraces - -instance ExceptionAnnotation Backtraces +import GHC.Internal.Exception.Context (SomeExceptionAnnotation) -- For GHC.Exception -collectBacktraces :: HasCallStack => IO Backtraces +collectExceptionAnnotation :: HasCallStack => IO SomeExceptionAnnotation ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs ===================================== @@ -99,6 +99,9 @@ displayExceptionContext (ExceptionContext anns0) = mconcat $ intersperse "\n" $ data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a +instance ExceptionAnnotation SomeExceptionAnnotation where + displayExceptionAnnotation (SomeExceptionAnnotation ann) = displayExceptionAnnotation ann + -- | 'ExceptionAnnotation's are types which can decorate exceptions as -- 'ExceptionContext'. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9374ecd9e73b6eab34f9410fc284d8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9374ecd9e73b6eab34f9410fc284d8… You're receiving this email because of your account on gitlab.haskell.org.

1 0