June 2026 - ghc-commits

[Git][ghc/ghc][master] Remove deprecated flag `-ddump-json` (see #24113)
by Marge Bot (＠marge-bot) 27 Jun '26

27 Jun '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d86d2644 by Simon Hengel at 2026-06-26T20:57:10-04:00 Remove deprecated flag `-ddump-json` (see #24113) This was first deprecated in 9.10.1. - - - - - 13 changed files: - + changelog.d/remove-ddump-json-flag - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Logger.hs - docs/users_guide/debugging.rst - ghc/GHCi/UI.hs - testsuite/tests/driver/T16167.stderr - − testsuite/tests/driver/T16167.stdout - testsuite/tests/driver/all.T - testsuite/tests/driver/json2.stderr - − testsuite/tests/driver/json_dump.hs - − testsuite/tests/driver/json_dump.stderr Changes: ===================================== changelog.d/remove-ddump-json-flag ===================================== @@ -0,0 +1,4 @@ +section: compiler +synopsis: Remove deprecated flag `-ddump-json` +issues: #24113 +mrs: !16258 ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -527,7 +527,6 @@ data DumpFlag | Opt_D_dump_view_pattern_commoning | Opt_D_verbose_core2core | Opt_D_dump_debug - | Opt_D_dump_json | Opt_D_ppr_debug | Opt_D_no_debug_output | Opt_D_dump_faststrings ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1694,9 +1694,6 @@ dynamic_flags_deps = [ (NoArg (setGeneralFlag Opt_NoBignumRules)) , make_ord_flag defGhcFlag "ddump-debug" (setDumpFlag Opt_D_dump_debug) - , make_dep_flag defGhcFlag "ddump-json" - (setDumpFlag Opt_D_dump_json) - "Use `-fdiagnostics-as-json` instead" , make_ord_flag defGhcFlag "dppr-debug" (setDumpFlag Opt_D_ppr_debug) , make_ord_flag defGhcFlag "ddebug-output" ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -558,15 +558,6 @@ instance ToJson Severity where json SevWarning = JSString "Warning" json SevError = JSString "Error" -instance ToJson MessageClass where - json MCOutput = JSString "MCOutput" - json MCFatal = JSString "MCFatal" - json MCInteractive = JSString "MCInteractive" - json MCDump = JSString "MCDump" - json MCInfo = JSString "MCInfo" - json (MCDiagnostic sev reason code) = - JSString $ renderWithContext defaultSDocContext (ppr $ text "MCDiagnostic" <+> ppr sev <+> ppr reason <+> ppr code) - instance ToJson DiagnosticCode where json c = JSInt (fromIntegral (diagnosticCodeNumber c)) ===================================== compiler/GHC/Utils/Logger.hs ===================================== @@ -95,7 +95,6 @@ import GHC.Utils.Panic import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet -import GHC.Data.FastString import System.Directory import System.FilePath ( takeDirectory, (</>) ) @@ -360,7 +359,6 @@ makeThreadSafe logger = do $ pushTraceHook trc $ logger --- See Note [JSON Error Messages] defaultLogJsonAction :: LogJsonAction defaultLogJsonAction logflags msg_class jsdoc = case msg_class of @@ -377,33 +375,6 @@ defaultLogJsonAction logflags msg_class jsdoc = putStrSDoc = defaultLogActionHPutStrDoc logflags False stdout msg = renderJSON jsdoc --- See Note [JSON Error Messages] --- this is to be removed -jsonLogActionWithHandle :: Handle {-^ Standard out -} -> LogAction -jsonLogActionWithHandle _ _ (MCDiagnostic SevIgnore _ _) _ _ = return () -- suppress the message -jsonLogActionWithHandle out logflags msg_class srcSpan msg - = - defaultLogActionHPutStrDoc logflags True out - (withPprStyle PprCode (doc $$ text "")) - where - str = renderWithContext (log_default_user_context logflags) msg - doc = renderJSON $ - JSObject [ ( "span", spanToDumpJSON srcSpan ) - , ( "doc" , JSString str ) - , ( "messageClass", json msg_class ) - ] - spanToDumpJSON :: SrcSpan -> JsonDoc - spanToDumpJSON s = case s of - (RealSrcSpan rss _) -> JSObject [ ("file", json file) - , ("startLine", json $ srcSpanStartLine rss) - , ("startCol", json $ srcSpanStartCol rss) - , ("endLine", json $ srcSpanEndLine rss) - , ("endCol", json $ srcSpanEndCol rss) - ] - where file = unpackFS $ srcSpanFile rss - GeneratedSrcSpan{} -> JSNull - UnhelpfulSpan{} -> JSNull - -- | The default 'LogAction' prints to 'stdout' and 'stderr'. -- -- To replicate the default log action behaviour with different @out@ and @err@ @@ -415,8 +386,7 @@ defaultLogAction = defaultLogActionWithHandles stdout stderr -- Allows clients to replicate the log message formatting of GHC with custom handles. defaultLogActionWithHandles :: Handle {-^ Handle for standard output -} -> Handle {-^ Handle for standard errors -} -> LogAction defaultLogActionWithHandles out err logflags msg_class srcSpan msg - | log_dopt Opt_D_dump_json logflags = jsonLogActionWithHandle out logflags msg_class srcSpan msg - | otherwise = case msg_class of + = case msg_class of MCOutput -> printOut msg MCDump -> printOut (msg $$ blankLine) MCInteractive -> putStrSDoc msg @@ -442,10 +412,6 @@ defaultLogActionWithHandles out err logflags msg_class srcSpan msg -- 2. GHC uses two different code paths for JSON and non-JSON diagnostics. For -- that reason we can not decorate the message in `defaultLogActionWithHandles`. -- --- See also Note [JSON Error Messages]: --- --- `jsonLogAction` should be removed along with -ddump-json --- -- Also note that (1) is the reason why some parts of the compiler produce -- diagnostics that don't respect `-fdiagnostics-as-json`. -- @@ -493,28 +459,6 @@ defaultLogActionHPutStrDoc logflags asciiSpace h d -- calls to this log-action can output all on the same line = printSDoc (log_default_user_context logflags) (Pretty.PageMode asciiSpace) h d --- --- Note [JSON Error Messages] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- When the user requests the compiler output to be dumped as json --- we used to collect them all in an IORef and then print them at the end. --- This doesn't work very well with GHCi. (See #14078) So instead we now --- use the simpler method of just outputting a JSON document inplace to --- stdout. --- --- Before the compiler calls log_action, it has already turned the `ErrMsg` --- into a formatted message. This means that we lose some possible --- information to provide to the user but refactoring log_action is quite --- invasive as it is called in many places. So, for now I left it alone --- and we can refine its behaviour as users request different output. --- --- The recent work here replaces the purpose of flag -ddump-json with --- -fdiagnostics-as-json. For temporary backwards compatibility while --- -ddump-json is being deprecated, `jsonLogAction` has been added in, but --- it should be removed along with -ddump-json. Similarly, the guard in --- `defaultLogAction` should be removed. This cleanup is tracked in #24113. - -- | Default action for 'dumpAction' hook defaultDumpAction :: DumpCache -> LogAction -> DumpAction defaultDumpAction dumps log_action logflags sty flag title _fmt doc = ===================================== docs/users_guide/debugging.rst ===================================== @@ -55,13 +55,6 @@ Dumping out compiler intermediate structures ``Main.p.dump-simpl`` and ``Main.dump-simpl`` instead of overwriting the output of one way with the output of another. -.. ghc-flag:: -ddump-json - :shortdesc: *(deprecated)* Use :ghc-flag:`-fdiagnostics-as-json` instead - :type: dynamic - - This flag was previously used to generated JSON formatted GHC diagnostics, - but has been deprecated. Instead, use :ghc-flag:`-fdiagnostics-as-json`. - .. ghc-flag:: -dshow-passes :shortdesc: Print out each pass name as it happens :type: dynamic ===================================== ghc/GHCi/UI.hs ===================================== @@ -508,8 +508,6 @@ interactiveUI config baseDFlags srcs maybe_exprs = do installInteractiveHomeUnits baseDFlags - -- Update the LogAction. Ensure we don't override the user's log action lest - -- we break -ddump-json (#14078) lastErrLocationsRef <- liftIO $ newIORef [] pushLogHookM (ghciLogAction lastErrLocationsRef) ===================================== testsuite/tests/driver/T16167.stderr ===================================== @@ -1 +1 @@ -*** Exception: ExitFailure 1 +{"version":"1.2","ghcVersion":"ghc-9.15.20250819","span":{"file":"T16167.hs","start":{"line":1,"column":8},"end":{"line":1,"column":9}},"severity":"Error","code":58481,"rendered":"T16167.hs:1:8: error: [GHC-58481] parse error on input \u2018f\u2019\n","message":["parse error on input \u2018f\u2019"],"hints":[]} ===================================== testsuite/tests/driver/T16167.stdout deleted ===================================== @@ -1,2 +0,0 @@ -{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"} -{"span":{"file":"T16167.hs","startLine":1,"startCol":8,"endLine":1,"endCol":9},"doc":"parse error on input \u2018f\u2019","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-58481"} ===================================== testsuite/tests/driver/all.T ===================================== @@ -271,12 +271,10 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, makefile_test, []) test('T12971', [when(opsys('mingw32'), fragile(17945)), ignore_stdout], makefile_test, []) -test('json_dump', normal, compile_fail, ['-ddump-json']) test('json', normalise_version('ghc'), compile_fail, ['-fdiagnostics-as-json']) test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches -Wx-partial']) -test('json2', normalise_version('ghc-internal', 'base','ghc-prim'), compile, ['-ddump-types -ddump-json -Wno-unsupported-llvm-version']) -test('T16167', [normalise_version('ghc'),req_interp,exit_code(1)], run_command, - ['{compiler} -x hs -e ":set prog T16167.hs" -ddump-json T16167.hs']) +test('json2', normalise_version('ghc-internal', 'base','ghc-prim'), compile, ['-ddump-types -fdiagnostics-as-json -Wno-unsupported-llvm-version']) +test('T16167', normalise_version('ghc'), compile_fail, ['-fdiagnostics-as-json']) test('T13604', [], makefile_test, []) test('T13604a', [ js_broken(22261) # require HPC support ===================================== testsuite/tests/driver/json2.stderr ===================================== @@ -1,2 +1,4 @@ -{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"} -{"span":null,"doc":"TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [(normal, base-4.21.0.0)]","messageClass":"MCOutput"} +TYPE SIGNATURES + foo :: forall a. a -> a +Dependent modules: [] +Dependent packages: [(normal, base-4.21.0.0)] ===================================== testsuite/tests/driver/json_dump.hs deleted ===================================== @@ -1,6 +0,0 @@ -module Foo where - -import Data.List - -id1 :: a -> a -id1 = 5 ===================================== testsuite/tests/driver/json_dump.stderr deleted ===================================== @@ -1,2 +0,0 @@ -{"span":null,"doc":"-ddump-json is deprecated: Use `-fdiagnostics-as-json` instead","messageClass":"MCDiagnostic SevWarning WarningWithFlags Opt_WarnDeprecatedFlags :| [] Just GHC-53692"} -{"span":{"file":"json_dump.hs","startLine":6,"startCol":7,"endLine":6,"endCol":8},"doc":"\u2022 No instance for \u2018Num (a -> a)\u2019 arising from the literal \u20185\u2019\n (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n In an equation for \u2018id1\u2019: id1 = 5","messageClass":"MCDiagnostic SevError ErrorWithoutFlag Just GHC-39999"} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d86d2644a05263d23f592549a718fd0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d86d2644a05263d23f592549a718fd0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 6 commits: Encapsulate options of occurAnalysePgm in a record
by Marge Bot (＠marge-bot) 27 Jun '26

27 Jun '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6f212121 by Facundo Domínguez at 2026-06-26T20:56:27-04:00 Encapsulate options of occurAnalysePgm in a record - - - - - adfbb179 by Facundo Domínguez at 2026-06-26T20:56:27-04:00 Allow to configure the occurrence analyser to retain some dead bindings This is needed by plugins that are the only consumers of a binding which is otherwise unused in the program. See Note [Controlling elimination of dead bindings in occurrence analysis] added in this commit, or https://gitlab.haskell.org/ghc/ghc/-/issues/27240 for more discussion. - - - - - c745b11f by Copilot at 2026-06-26T20:56:27-04:00 Address documentation feedback - - - - - 2c2a4a2a by Copilot at 2026-06-26T20:56:27-04:00 Keep the imp_rules parameter of occurPgmAnalysePgm and add occ_opts to OccEnv - - - - - e2262b0e by Copilot at 2026-06-26T20:56:27-04:00 Strengthen T27240.hs with a binding that should be removed - - - - - 5f9d9268 by Copilot at 2026-06-26T20:56:27-04:00 Move the reference #27240 to a related paragraph - - - - - 7 changed files: - + changelog.d/add_can_drop_to_occurence_analyser - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Config.hs - + testsuite/tests/ghc-api/T27240.hs - testsuite/tests/ghc-api/all.T Changes: ===================================== changelog.d/add_can_drop_to_occurence_analyser ===================================== @@ -0,0 +1,19 @@ +section: ghc-lib +synopsis: Add ``oa_can_drop`` option to the occurrence analyser which selects + bindings to preserve. + +issues: #27240 +mrs: !16253 + +description: { + This is only relevant to clients of the GHC API. + + The ``oa_can_drop`` option of the occurrence analyser indicates whether a + binding is ok to drop. The option is also exposed in the simple optimiser as + ``so_can_drop``. + + In addition, the function ``occurAnalysePgm`` earned a record parameter of + type ``OccurAnalOpts`` which aggregates former parameters of the function. + The record type ``OccEnv`` in turn, replaces its fields ``occ_unf_act`` and + ``occ_rule_act`` with a field ``occ_opts`` of type ``OccurAnalOpts``. +} ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -26,6 +26,7 @@ core expression with (hopefully) improved usage information. -} module GHC.Core.Opt.OccurAnal ( + OccurAnalOpts(..), occurAnalysePgm, occurAnalyseExpr, occurAnalyseBndrsAndExpr, occurAnalyseExpr_Prep, @@ -103,12 +104,21 @@ occurAnalyseExpr_Prep expr = expr' where WUD _ expr' = occAnal (initOccEnv { occ_allow_weak_joins = True }) expr +-- | Options for occurrence analysis of a program +data OccurAnalOpts = OccurAnalOpts + { oa_active_unf :: Id -> Bool -- ^ Active unfoldings + , oa_active_rule :: ActivationGhc -> Bool -- ^ Active rules + , oa_can_drop :: Id -> Bool + -- ^ Can we drop this Id if it is dead? + -- See Note [Controlling elimination of dead bindings in occurrence analysis]. + } + occurAnalysePgm :: Module -- Used only in debug output - -> (Id -> Bool) -- Active unfoldings - -> (ActivationGhc -> Bool) -- Active rules - -> [CoreRule] -- Local rules for imported Ids - -> CoreProgram -> CoreProgram -occurAnalysePgm this_mod active_unf active_rule imp_rules binds + -> OccurAnalOpts + -> [CoreRule] -- Local rules for imported Ids + -> CoreProgram + -> CoreProgram +occurAnalysePgm this_mod opts imp_rules binds | isEmptyDetails final_usage = occ_anald_binds @@ -116,8 +126,7 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds = warnPprTrace True "Glomming in" (hang (ppr this_mod <> colon) 2 (ppr final_usage)) occ_anald_glommed_binds where - init_env = initOccEnv { occ_rule_act = active_rule - , occ_unf_act = active_unf } + init_env = initOccEnv { occ_opts = opts } WUD final_usage occ_anald_binds = go binds init_env WUD _ occ_anald_glommed_binds = occAnalRecBind init_env TopLevel @@ -1033,6 +1042,27 @@ Note [Occurrences in stable unfoldings and RULES]: occurrences in an unfolding or RULE are treated as ManyOcc anyway. But NB that tail-call info is preserved so that we don't thereby lose join points. + +Note [Controlling elimination of dead bindings in occurrence analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Sometimes, plugins might want to retain dead bindings. + +For instance, Liquid Haskell might be the sole consumer of a binding that is +providing a proof. Or it might provide a lemma that is needed to check other +parts of the program. Or it might provide a value that is only referred from a +refinement type, but not from the Haskell code itself. See #27240 for more +details. + +For this reason, the occurrence analyser can be configured to retain +some bindings even if they are dead. This is done by setting the `oa_can_drop` +field of `OccAnalOpts` to a function that returns `False` for the bindings that +should be retained. All calls to the occurrence analyser from within GHC itself +use `const True` for this predicate; only calls from plugins might return +`False` in some cases. + +Alternatively, the plugin could avoid running the occurrence analyser, but that +would also disable other effects, such as the split of the program in strongly +connected components. -} ------------------------------------------------------------------ @@ -1078,7 +1108,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine !(WUD body_uds (occ, body)) = occAnalNonRecBody env_body bndr' $ \env -> thing_inside (addJoinPoint env bndr' rhs_uds) in - if isDeadOcc occ -- Drop dead code; see Note [Dead code] + if isDeadOcc occ && oa_can_drop (occ_opts env) bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body else WUD (combineJoinPointUDs env rhs_uds body_uds) -- Note `orUDs` (combine [NonRec (fst (tagNonRecBinder lvl occ bndr')) rhs'] @@ -1088,7 +1118,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- Analyse the body and /then/ the RHS | let env_body = addLocalLet env lvl bndr , WUD body_uds (occ,body) <- occAnalNonRecBody env_body bndr thing_inside - = if isDeadOcc occ -- Drop dead code; see Note [Dead code] + = if isDeadOcc occ && oa_can_drop (occ_opts env) bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body else let -- Get the join info from the *new* decision; NB: bndr is not already a JoinId @@ -1225,10 +1255,10 @@ occAnalRec :: OccEnv -> TopLevelFlag -> WithUsageDetails [CoreBind] -- The NonRec case is just like a Let (NonRec ...) above -occAnalRec !_ lvl +occAnalRec !env lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = wtuds })) (WUD body_uds binds) - | isDeadOcc occ -- Check for dead code: see Note [Dead code] + | isDeadOcc occ && oa_can_drop (occ_opts env) bndr -- Check for dead code: see Note [Dead code] = WUD body_uds binds | otherwise = let (bndr', mb_join) = tagNonRecBinder lvl occ bndr @@ -1463,8 +1493,8 @@ However, tagZero can only be inlined in phase 1 and later, while the RULE is only active *before* phase 1. So there's no problem. To make this work, we look for the RHS free vars only for -*active* rules. That's the reason for the occ_rule_act field -of the OccEnv. +*active* rules. That's the reason for the oa_active_rule field +of occ_opts in OccEnv. Note [loopBreakNodes] ~~~~~~~~~~~~~~~~~~~~~ @@ -1854,7 +1884,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- of Note [Join arity prediction based on joinRhsArity] --------- IMP-RULES -------- - is_active = occ_rule_act env :: ActivationGhc -> Bool + is_active = oa_active_rule (occ_opts env) :: ActivationGhc -> Bool imp_rule_info = lookupImpRules imp_rule_edges bndr imp_rule_uds = impRulesScopeUsage imp_rule_info imp_rule_fvs = impRulesActiveFvs is_active bndr_set imp_rule_info @@ -1963,8 +1993,8 @@ nodeScore !env new_bndr lb_deps | old_bndr `elemVarSet` lb_deps -- Self-recursive things are great loop breakers = (0, 0, True) -- See Note [Self-recursion and loop breakers] - | not (occ_unf_act env old_bndr) -- A binder whose inlining is inactive (e.g. has - = (0, 0, True) -- a NOINLINE pragma) makes a great loop breaker + | not (oa_active_unf (occ_opts env) old_bndr) -- A binder whose inlining is inactive (e.g. has + = (0, 0, True) -- a NOINLINE pragma) makes a great loop breaker | exprIsTrivial rhs = mk_score 10 -- Practically certain to be inlined @@ -2985,8 +3015,7 @@ scrutinised y). data OccEnv = OccEnv { occ_encl :: !OccEncl -- Enclosing context information , occ_one_shots :: !OneShots -- See Note [OneShots] - , occ_unf_act :: Id -> Bool -- Which Id unfoldings are active - , occ_rule_act :: ActivationGhc -> Bool -- Which rules are active + , occ_opts :: !OccurAnalOpts -- See Note [Finding rule RHS free vars] , occ_allow_weak_joins :: !Bool @@ -3055,18 +3084,19 @@ initOccEnv :: OccEnv initOccEnv = OccEnv { occ_encl = OccVanilla , occ_one_shots = [] - - -- To be conservative, we say that all - -- inlines and rules are active - , occ_unf_act = \_ -> True - , occ_rule_act = \_ -> True - , occ_allow_weak_joins = False - , occ_join_points = emptyVarEnv , occ_bs_env = emptyVarEnv , occ_bs_rng = emptyVarSet - , occ_nested_lets = emptyVarSet } + , occ_nested_lets = emptyVarSet + -- To be conservative, we say that all + -- inlines and rules are active + , occ_opts = OccurAnalOpts + { oa_active_rule = \_ -> True + , oa_active_unf = \_ -> True + , oa_can_drop = \_ -> True + } + } noBinderSwaps :: OccEnv -> Bool noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -12,7 +12,7 @@ import GHC.Driver.Flags import GHC.Core import GHC.Core.Rules import GHC.Core.Ppr ( pprCoreBindings, pprCoreExpr ) -import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) +import GHC.Core.Opt.OccurAnal ( OccurAnalOpts(..), occurAnalysePgm, occurAnalyseExpr ) import GHC.Core.Stats ( coreBindsSize, coreBindsStats, exprSize ) import GHC.Core.FVs ( exprFreeVars ) import GHC.Core.Utils ( mkTicks, stripTicksTop ) @@ -252,8 +252,15 @@ simplifyPgm logger unit_env name_ppr_ctx opts = do { -- Occurrence analysis let { tagged_binds = {-# SCC "OccAnal" #-} - occurAnalysePgm this_mod active_unf active_rule - local_rules binds + occurAnalysePgm + this_mod + OccurAnalOpts + { oa_active_unf = active_unf + , oa_active_rule = active_rule + , oa_can_drop = const True + } + local_rules + binds } ; Logger.putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis" FormatCore ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Core.FVs import GHC.Core.Unfold import GHC.Core.Unfold.Make import GHC.Core.Make -import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs ) +import GHC.Core.Opt.OccurAnal( OccurAnalOpts(..), occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs ) import GHC.Core.DataCon import GHC.Core.Coercion.Opt ( optCoercion, optTransCo, OptCoercionOpts (..) ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList @@ -208,6 +208,8 @@ data SimpleOpts = SimpleOpts -- used-once things -- -- See Note [Controlling inlining in the simple optimiser] + , so_can_drop :: !(Var -> Bool) -- ^ True <=> can drop the given binding if it is dead + -- See 'oa_can_drop' in 'OccurAnalOpts'. } -- | Default options for the Simple optimiser. @@ -217,6 +219,7 @@ defaultSimpleOpts = SimpleOpts , so_co_opts = OptCoercionOpts { optCoercionEnabled = False } , so_eta_red = False , so_inline = const True + , so_can_drop = const True } simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr @@ -282,10 +285,15 @@ simpleOptPgm :: SimpleOpts simpleOptPgm opts this_mod binds rules = (reverse binds', rules', occ_anald_binds) where - occ_anald_binds = occurAnalysePgm this_mod - (\_ -> True) {- All unfoldings active -} - (\_ -> False) {- No rules active -} - rules binds + occ_anald_binds = occurAnalysePgm + this_mod + OccurAnalOpts + { oa_active_unf = \_ -> True {- All unfoldings active -} + , oa_active_rule = \_ -> False {- No rules active -} + , oa_can_drop = so_can_drop opts + } + rules + binds (final_env, binds') = foldl' do_one (emptyEnv opts, []) occ_anald_binds final_subst = soe_subst final_env ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -27,6 +27,7 @@ initSimpleOpts dflags = SimpleOpts , so_co_opts = initOptCoercionOpts dflags , so_eta_red = gopt Opt_DoEtaReduction dflags , so_inline = const True + , so_can_drop = const True } -- | Instruct the interpreter evaluation to break... ===================================== testsuite/tests/ghc-api/T27240.hs ===================================== @@ -0,0 +1,128 @@ + +-- This test checks that bindings are preserved when configuring the occurrence +-- analyzer and the simple optimizer to not drop dead bindings with names +-- selected by a predicate. +-- +-- This feature is important for the LiquidHaskell plugin, which relies on the +-- simple optimizer to make core programs easier to read, but needs to preserve +-- bindings that are relevant for verification. +-- +-- See https://gitlab.haskell.org/ghc/ghc/-/issues/27240 for the full discussion. +-- + +import Control.Monad +import Data.List (find) +import Data.Time (getCurrentTime) +import GHC +import GHC.Core +import GHC.Core.SimpleOpt +import GHC.Data.StringBuffer +import GHC.Driver.Config +import GHC.Driver.DynFlags +import GHC.Driver.Env.Types +import GHC.Types.Name +import GHC.Unit.Module.ModGuts +import GHC.Unit.Types +import GHC.Utils.Error +import GHC.Utils.Outputable + +import System.Environment (getArgs) + + +main :: IO () +main = + testLocalBindingsDesugaring + +testLocalBindingsDesugaring :: IO () +testLocalBindingsDesugaring = do + let inputSource = unlines + [ "module LocalDeadBindingsDesugaring where" + , "f :: ()" + , "f = ()" + , " where" + , " w = ()" + , " z = ()" + ] + + isExpectedDesugaring p = case findExpr "f" p of + Just (Let (NonRec b _) _) + -> isIdNamed "z" b + _ -> False + + isIdNamed name v = occNameString (occName v) == name + + coreProgram <- + compileToCore + (not . isIdNamed "z") + "LocalDeadBindingsDesugaring" + inputSource + unless (isExpectedDesugaring coreProgram) $ + fail $ unlines $ + "Unexpected desugaring: No local binding for `z` found in the Core program." + : map showPprQualified coreProgram + +-- | Find the Core expression bound to the given name. +findExpr :: String -> CoreProgram -> Maybe CoreExpr +findExpr _ [] = + Nothing +findExpr name (p:ps) = case p of + NonRec b e + | occNameString (occName b) == name + -> Just e + Rec binds + | Just (_, e) <- find (\(b, _e) -> occNameString (occName b) == name) binds + -> Just e + _ -> findExpr name ps + +showPprQualified :: Outputable a => a -> String +showPprQualified = showSDocQualified . ppr + +showSDocQualified :: SDoc -> String +showSDocQualified = renderWithContext ctx + where + ctx = defaultSDocContext { sdocStyle = cmdlineParserStyle } + + + +compileToCore :: (Id -> Bool) -> String -> String -> IO [CoreBind] +compileToCore canDrop modName inputSource = do + [libdir] <- getArgs + now <- getCurrentTime + runGhc (Just libdir) $ do + df1 <- getSessionDynFlags + GHC.setSessionDynFlags $ df1 { GHC.backend = GHC.bytecodeBackend } + let target = Target { + targetId = TargetFile (modName ++ ".hs") Nothing + , targetUnitId = homeUnitId_ df1 + , targetAllowObjCode = False + , targetContents = Just (stringToStringBuffer inputSource, now) + } + setTargets [target] + void $ GHC.depanal [] False + + dsMod <- getModSummary + (mkModule mainUnit (mkModuleName modName)) + >>= parseModule + >>= typecheckModule NoTcMPlugins + >>= desugarModule + hsc_env <- getSession + return $ mg_binds $ simpleOptimize canDrop hsc_env $ dm_core_module dsMod + +-- Run the simple optimizer +simpleOptimize :: (Id -> Bool) -> GHC.HscEnv -> ModGuts -> ModGuts +simpleOptimize canDrop hsc_env guts@(ModGuts + { mg_module = mgmod + , mg_binds = binds + , mg_rules = rules + }) = + let dflags = hsc_dflags hsc_env + simpl_opts = (initSimpleOpts dflags) + { so_inline = canDrop + , so_can_drop = canDrop + } + (binds2, rules2, _occ_anald_binds) = + simpleOptPgm simpl_opts mgmod binds rules + in guts + { mg_binds = binds2 + , mg_rules = rules2 + } ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -82,6 +82,7 @@ test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc']) test('T25121_status', normal, compile_and_run, ['-package ghc']) test('T24386', [extra_run_opts(f'"{config.libdir}"')], compile_and_run, ['-package ghc']) +test('T27240', [extra_run_opts(f'"{config.libdir}"')], compile_and_run, ['-package ghc']) test('T27273', [extra_run_opts(f'"{config.libdir}"')], compile_and_run, ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/412f16756dff9d3b71ba1c4646c8bc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/412f16756dff9d3b71ba1c4646c8bc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Rename `MCDiagnostic` to `InternalMCDiagnostic`
by Marge Bot (＠marge-bot) 27 Jun '26

27 Jun '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 412f1675 by Simon Hengel at 2026-06-26T20:55:41-04:00 Rename `MCDiagnostic` to `InternalMCDiagnostic` `MCDiagnostic` is meant to be used for compiler diagnostics. Any code that creates `MCDiagnostic` directly, without going through `GHC.Driver.Errors.printMessage`, sidesteps `-fdiagnostics-as-json` (see e.g. !14616, !14475, !14492 !14548). To avoid this in the future, this change more narrowly controls who creates `MCDiagnostic` (see #24113). - - - - - 15 changed files: - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error.hs - − compiler/GHC/Types/Error.hs-boot - compiler/GHC/Types/SourceError.hs - compiler/GHC/Utils/Error.hs - ghc/GHCi/UI/Exception.hs - utils/check-exact/Main.hs - utils/check-exact/Preprocess.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs Changes: ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-x-InternalMCDiagnostic #-} module GHC.Driver.Errors ( reportError , reportDiagnostic @@ -66,7 +67,7 @@ printMessage logger msg_opts opts message doc = updSDocContext (\_ -> ctx) (messageWithHints diagnostic) messageClass :: MessageClass - messageClass = MCDiagnostic severity (errMsgReason message) (diagnosticCode diagnostic) + messageClass = InternalMCDiagnostic severity (errMsgReason message) (diagnosticCode diagnostic) style :: PprStyle style = mkErrStyle (errMsgContext message) ===================================== compiler/GHC/Driver/Main/Passes.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE MultiWayIf #-} {-# OPTIONS_GHC -fprof-auto-top #-} +{-# OPTIONS_GHC -Wwarn=x-internalPprMessages #-} ------------------------------------------------------------------------------- -- | Aspects of GHC.Driver.Main dealing with running particular passes. @@ -1401,9 +1402,15 @@ markUnsafeInfer tcg_env whyUnsafe = do whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" , nest 4 $ (vcat $ badFlags df) $+$ - -- MP: Using defaultDiagnosticOpts here is not right but it's also not right to handle these - -- unsafety error messages in an unstructured manner. - (vcat $ pprMsgEnvelopeBagWithLoc (defaultDiagnosticOpts @e) (getMessages whyUnsafe)) $+$ + + -- FIXME: `GHC.Utils.Error.internalPprMessages` is an + -- internal function! + -- + -- Use `GHC.Driver.Errors.printMessages` to report the + -- diagnostics here and remove `internalPprMessages` + -- from the export list of "GHC.Utils.Error". + (vcat $ internalPprMessages (getMessages whyUnsafe)) $+$ + (vcat $ badInsts $ tcg_insts tcg_env) ] badFlags df = concatMap (badFlag df) unsafeFlagsForInfer ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -101,7 +101,7 @@ import GHC.Iface.Recomp import GHC.Runtime.Loader ( initializePlugins ) import GHC.Types.Basic ( SuccessFlag(..), ForeignSrcLang(..) ) -import GHC.Types.Error ( singleMessage, getMessages, mkSimpleUnknownDiagnostic, defaultDiagnosticOpts ) +import GHC.Types.Error ( singleMessage, getMessages, mkSimpleUnknownDiagnostic ) import GHC.Types.ForeignStubs ( ForeignStubs (NoStubs) ) import GHC.Types.Target import GHC.Types.SrcLoc @@ -169,9 +169,7 @@ preprocess hsc_env input_fn mb_input_buf mb_phase = to_driver_messages :: Messages GhcMessage -> Messages DriverMessage to_driver_messages msgs = case traverse to_driver_message msgs of - Nothing -> pprPanic "non-driver message in preprocess" - -- MP: Default config is fine here as it's just in a panic. - (vcat $ pprMsgEnvelopeBagWithLoc (defaultDiagnosticOpts @GhcMessage) (getMessages msgs)) + Nothing -> panicMessage "non-driver message in preprocess" (getMessages msgs) Just msgs' -> msgs' to_driver_message = \case ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -404,7 +404,7 @@ initTcDsForSolver thing_inside thing_inside ; case mb_ret of Just ret -> pure ret - Nothing -> pprPanic "initTcDsForSolver" (vcat $ pprMsgEnvelopeBagWithLocDefault (getErrorMessages msgs)) } + Nothing -> panicMessage "initTcDsForSolver" (getErrorMessages msgs) } mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv -> TcMPluginsRun ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -71,7 +71,7 @@ import GHC.Core.TyCo.FVs import GHC.Core.InstEnv import GHC.Core.TyCon -import GHC.Utils.Error (diagReasonSeverity, pprLocMsgEnvelope ) +import GHC.Utils.Error (diagReasonSeverity, deferredTypeErrorMessage ) import GHC.Utils.Misc import GHC.Utils.Outputable as O import GHC.Utils.Panic @@ -1395,9 +1395,8 @@ mkErrorTerm ct_loc ty ctxt msg supp hints hints -- This will be reported at runtime, so we always want "error:" in the report, never "warning:" ; dflags <- getDynFlags - ; let err_msg = pprLocMsgEnvelope (initTcMessageOpts dflags) msg - err_str = showSDoc dflags $ - err_msg $$ text "(deferred type error)" + ; let err_msg = deferredTypeErrorMessage (initTcMessageOpts dflags) msg + err_str = showSDoc dflags err_msg ; return $ evDelayedError ty err_str } ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-x-internalDebugPprMsgEnvelope #-} {- (c) The University of Glasgow 2006 @@ -1432,7 +1433,7 @@ reportDiagnostics = mapM_ reportDiagnostic reportDiagnostic :: MsgEnvelope TcRnMessage -> TcRn () reportDiagnostic msg - = do { traceTc "Adding diagnostic:" (pprLocMsgEnvelopeDefault msg) ; + = do { traceTc "Adding diagnostic:" (internalDebugPprMsgEnvelope msg) ; errs_var <- getErrsVar ; msgs <- readTcRef errs_var ; writeTcRef errs_var (msg `addMessage` msgs) } ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Types.Error -- * Classifying Messages - , MessageClass (..) + , MessageClass (MCDiagnostic, ..) , Severity (..) , Diagnostic (..) , UnknownDiagnostic (..) @@ -482,7 +482,7 @@ data MessageClass -- ^ Log messages intended for end users. -- No file\/line\/column stuff. - | MCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode) + | InternalMCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode) -- ^ Diagnostics from the compiler. This constructor is very powerful as -- it allows the construction of a 'MessageClass' with a completely -- arbitrary permutation of 'Severity' and 'DiagnosticReason'. As such, @@ -492,10 +492,19 @@ data MessageClass -- 'GHC.Utils.Error'. In all the other circumstances, /especially/ when -- emitting compiler diagnostics, use higher level primitives. -- + -- For deconstruction use `MCDiagnostic`. + -- -- The @Maybe 'DiagnosticCode'@ field carries a code (if available) for -- this diagnostic. If you are creating a message not tied to any -- error-message type, then use Nothing. In the long run, this really -- should always have a 'DiagnosticCode'. See Note [Diagnostic codes]. + -- +{-# WARNING in "x-InternalMCDiagnostic" InternalMCDiagnostic + "This is an internal constructor. Use `MCDiagnostic` or `GHC.Driver.Errors.printMessages` instead." #-} + +{-# COMPLETE MCOutput, MCFatal, MCInteractive, MCDump, MCInfo, MCDiagnostic #-} +pattern MCDiagnostic :: Severity -> ResolvedDiagnosticReason -> Maybe DiagnosticCode -> MessageClass +pattern MCDiagnostic severity reason code <- InternalMCDiagnostic severity reason code {- Note [Suppressing Messages] ===================================== compiler/GHC/Types/Error.hs-boot deleted ===================================== @@ -1,24 +0,0 @@ -module GHC.Types.Error where - -import GHC.Prelude (Maybe, Bool, IO) -import GHC.Utils.Outputable (SDoc) -import GHC.Types.SrcLoc (SrcSpan) - -data MessageClass - = MCOutput - | MCFatal - | MCInteractive - | MCDump - | MCInfo - | MCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode) - -data Severity - = SevIgnore - | SevWarning - | SevError - -data DiagnosticCode -data ResolvedDiagnosticReason - -mkLocMessageWarningGroups :: Bool -> MessageClass -> SrcSpan -> SDoc -> SDoc -getCaretDiagnostic :: MessageClass -> SrcSpan -> IO SDoc ===================================== compiler/GHC/Types/SourceError.hs ===================================== @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-x-internalDebugShowMessages #-} -- | Source errors module GHC.Types.SourceError ( SourceError (..) @@ -16,8 +17,7 @@ import GHC.Types.Error import GHC.Utils.Monad import GHC.Utils.Panic import GHC.Utils.Exception -import GHC.Utils.Error (pprMsgEnvelopeBagWithLocDefault, DiagOpts, diag_ppr_ctx) -import GHC.Utils.Outputable +import GHC.Utils.Error (internalDebugShowMessages, DiagOpts) import GHC.Driver.Config.Diagnostic (initDiagOpts, initPrintConfig) import GHC.Driver.DynFlags (DynFlags, HasDynFlags (getDynFlags)) @@ -73,15 +73,12 @@ initSourceErrorContext dflags = in SEC diag_opts print_config instance Show SourceError where - -- We implement 'Show' because it's required by the 'Exception' instance, but diagnostics - -- shouldn't be shown via the 'Show' typeclass, but rather rendered using the ppr functions. + -- We implement 'Show' because it's required by the 'Exception' instance, but + -- diagnostics must not be shown via 'Show', but instead reported via + -- `GHC.Driver.Errors.printMessages`. + -- -- This also explains why there is no 'Show' instance for a 'MsgEnvelope'. - show (SourceError (SEC diag_opts _) msgs) = - renderWithContext (diag_ppr_ctx diag_opts) - . vcat - . pprMsgEnvelopeBagWithLocDefault - . getMessages - $ msgs + show (SourceError _ msgs) = internalDebugShowMessages msgs instance Exception SourceError ===================================== compiler/GHC/Utils/Error.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-x-InternalMCDiagnostic #-} + {- (c) The AQUA Project, Glasgow University, 1994-1998 @@ -22,10 +24,11 @@ module GHC.Utils.Error ( errorsFound, isEmptyMessages, -- ** Formatting - pprMessageBag, pprMsgEnvelopeBagWithLoc, pprMsgEnvelopeBagWithLocDefault, - pprMessages, - pprLocMsgEnvelope, pprLocMsgEnvelopeDefault, - formatBulleted, + pprMessageBag, formatBulleted, + deferredTypeErrorMessage, + panicMessage, internalDebugShowMessages, internalDebugPprMsgEnvelope, + + internalPprMessages, -- FIXME: remove this export -- ** Construction DiagOpts (..), emptyDiagOpts, diag_wopt, diag_fatal_wopt, @@ -265,29 +268,40 @@ formatBulleted (unDecorated -> docs) msgs ctx = filter (not . Outputable.isEmpty ctx) docs starred = (bullet<+>) -pprMessages :: Diagnostic e => DiagnosticOpts e -> Messages e -> SDoc -pprMessages e = vcat . pprMsgEnvelopeBagWithLoc e . getMessages - -pprMsgEnvelopeBagWithLoc :: Diagnostic e => DiagnosticOpts e -> Bag (MsgEnvelope e) -> [SDoc] -pprMsgEnvelopeBagWithLoc e bag = [ pprLocMsgEnvelope e item | item <- sortMsgBag Nothing bag ] - --- | Print the messages with the suitable default configuration, usually not what you want but sometimes you don't really --- care about what the configuration is (for example, if the message is in a panic). -pprMsgEnvelopeBagWithLocDefault :: forall e . Diagnostic e => Bag (MsgEnvelope e) -> [SDoc] -pprMsgEnvelopeBagWithLocDefault bag = [ pprLocMsgEnvelopeDefault item | item <- sortMsgBag Nothing bag ] - -pprLocMsgEnvelopeDefault :: forall e . Diagnostic e => MsgEnvelope e -> SDoc -pprLocMsgEnvelopeDefault = pprLocMsgEnvelope (defaultDiagnosticOpts @e) - -pprLocMsgEnvelope :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc -pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s +deferredTypeErrorMessage :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc +deferredTypeErrorMessage opts msg = internalPprMessage opts msg $$ text "(deferred type error)" + +panicMessage :: Diagnostic e => String -> Bag (MsgEnvelope e) -> a +panicMessage name msgs = pprPanic name (vcat $ internalPprMessages msgs) + +{-# WARNING in "x-internalDebugShowMessages" internalDebugShowMessages + "Don't use this function for reporting diagnostics! Use `GHC.Driver.Errors.printMessages` instead." #-} +internalDebugShowMessages :: Diagnostic e => Messages e -> String +internalDebugShowMessages = + renderWithContext defaultSDocContext + . vcat + . internalPprMessages + . getMessages + +{-# WARNING in "x-internalDebugPprMsgEnvelope" internalDebugPprMsgEnvelope + "Don't use this function for reporting diagnostics! Use `GHC.Driver.Errors.printMessage` instead." #-} +internalDebugPprMsgEnvelope :: forall e. Diagnostic e => MsgEnvelope e -> SDoc +internalDebugPprMsgEnvelope = internalPprMessage (defaultDiagnosticOpts @e) + +{-# WARNING in "x-internalPprMessages" internalPprMessages + "Don't use this function for new code! It sidesteps the structured error machinery. Use `GHC.Driver.Errors.printMessages` instead." #-} +internalPprMessages :: forall e . Diagnostic e => Bag (MsgEnvelope e) -> [SDoc] +internalPprMessages = map (internalPprMessage (defaultDiagnosticOpts @e)) . sortMsgBag Nothing + +internalPprMessage :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc +internalPprMessage opts (MsgEnvelope { errMsgSpan = s , errMsgDiagnostic = e , errMsgSeverity = sev , errMsgContext = name_ppr_ctx , errMsgReason = reason }) = withErrStyle name_ppr_ctx $ mkLocMessage - (MCDiagnostic sev reason (diagnosticCode e)) + (InternalMCDiagnostic sev reason (diagnosticCode e)) s (formatBulleted $ diagnosticMessage opts e) ===================================== ghc/GHCi/UI/Exception.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-x-internalDebugShowMessages #-} module GHCi.UI.Exception ( GhciCommandError(..) , throwGhciCommandError @@ -51,15 +52,12 @@ newtype GhciCommandError = GhciCommandError (Messages GhciMessage) instance Exception GhciCommandError instance Show GhciCommandError where - -- We implement 'Show' because it's required by the 'Exception' instance, but diagnostics - -- shouldn't be shown via the 'Show' typeclass, but rather rendered using the ppr functions. + -- We implement 'Show' because it's required by the 'Exception' instance, but + -- diagnostics must not be shown via 'Show', but instead reported via + -- `GHC.Driver.Errors.printMessages`. + -- -- This also explains why there is no 'Show' instance for a 'MsgEnvelope'. - show (GhciCommandError msgs) = - renderWithContext defaultSDocContext - . vcat - . pprMsgEnvelopeBagWithLocDefault - . getMessages - $ msgs + show (GhciCommandError msgs) = internalDebugShowMessages msgs -- | Perform the given action and call the exception handler if the action -- throws a 'GhciCommandError'. See 'GhciCommandError' for more information. ===================================== utils/check-exact/Main.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE BangPatterns #-} +{-# OPTIONS_GHC -Wno-x-internalDebugShowMessages #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -11,14 +12,11 @@ import Data.Data import Data.List (intercalate) import GHC hiding (moduleName) -import GHC.Driver.Errors.Types import GHC.Driver.Ppr import GHC.Hs.Dump -import GHC.Types.Error import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader import GHC.Utils.Error -import GHC.Utils.Outputable import System.Environment( getArgs ) import System.Exit import System.FilePath @@ -369,19 +367,11 @@ parseOneFile :: FilePath -> FilePath -> IO (ParsedSource, [Located Token]) parseOneFile libdir fileName = do res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName case res of - Left m -> error (showErrorMessages m) + Left m -> error (internalDebugShowMessages m) Right (injectedComments, _dflags, pmod) -> do let !pmodWithComments = insertCppComments pmod injectedComments return (pmodWithComments, []) -showErrorMessages :: Messages GhcMessage -> String -showErrorMessages msgs = - renderWithContext defaultSDocContext - $ vcat - $ pprMsgEnvelopeBagWithLocDefault - $ getMessages - $ msgs - -- --------------------------------------------------------------------- exactprintWithChange :: FilePath -> Changer -> ParsedSource -> IO (String, ParsedSource) ===================================== utils/check-exact/Preprocess.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-x-internalDebugShowMessages #-} -- | This module provides support for CPP, interpreter directives and line -- pragmas. module Preprocess @@ -26,13 +27,11 @@ import qualified GHC.Driver.Phases as GHC import qualified GHC.Driver.Pipeline as GHC import qualified GHC.Parser.Lexer as GHC import qualified GHC.Settings as GHC -import qualified GHC.Types.Error as GHC import qualified GHC.Types.SourceError as GHC import qualified GHC.Types.SourceFile as GHC import qualified GHC.Types.SrcLoc as GHC import qualified GHC.Utils.Error as GHC import qualified GHC.Utils.Fingerprint as GHC -import qualified GHC.Utils.Outputable as GHC import GHC.Types.SrcLoc (mkSrcSpan, mkSrcLoc) import GHC.Data.FastString (mkFastString) @@ -216,20 +215,12 @@ getPreprocessedSrcDirectPrim cppOptions src_fn = do new_env = hsc_env { GHC.hsc_dflags = injectCppOptions cppOptions dfs } r <- GHC.liftIO $ GHC.preprocess new_env src_fn Nothing (Just (GHC.Cpp GHC.HsSrcFile)) case r of - Left err -> error $ showErrorMessages err + Left err -> error $ GHC.internalDebugShowMessages err Right (dflags', hspp_fn) -> do buf <- GHC.liftIO $ GHC.hGetStringBuffer hspp_fn txt <- GHC.liftIO $ readFileGhc hspp_fn return (txt, buf, dflags') -showErrorMessages :: GHC.Messages GHC.DriverMessage -> String -showErrorMessages msgs = - GHC.renderWithContext GHC.defaultSDocContext - $ GHC.vcat - $ GHC.pprMsgEnvelopeBagWithLocDefault - $ GHC.getMessages - $ msgs - injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags injectCppOptions CppOptions{..} dflags = folded_opt where ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker.hs ===================================== @@ -97,7 +97,7 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = do mast | M.size asts == 1 = snd <$> M.lookupMin asts | otherwise = M.lookup (HiePath (mkFastString file)) asts - tokens' = parse parserOpts sDocContext file rawSrc + tokens' = parse parserOpts file rawSrc ast = fromMaybe (emptyHieAst fileFs) mast fullAst = recoverFullIfaceTypes sDocContext types ast ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs ===================================== @@ -9,7 +9,6 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import qualified Data.ByteString as BS import Data.List (isPrefixOf, isSuffixOf) -import GHC.Data.Bag (bagToList) import GHC.Data.FastString (mkFastString) import GHC.Data.StringBuffer (StringBuffer, atEnd) import GHC.Parser.Errors.Ppr () @@ -26,10 +25,7 @@ import GHC.Parser.Lexer as Lexer import qualified GHC.Types.Error as E import GHC.Types.SourceText import GHC.Types.SrcLoc -import GHC.Utils.Error (pprLocMsgEnvelopeDefault) -import GHC.Utils.Outputable (SDocContext, text, ($$)) -import qualified GHC.Utils.Outputable as Outputable -import GHC.Utils.Panic (panic) +import GHC.Utils.Error (panicMessage) import Haddock.Backends.Hyperlinker.Types as T import Haddock.GhcUtils @@ -40,19 +36,14 @@ import Haddock.GhcUtils -- whitespace, and CPP). parse :: ParserOpts - -> SDocContext -> FilePath -- ^ Path to the source of this module -> BS.ByteString -- ^ Raw UTF-8 encoded source of this module -> [T.Token] -parse parserOpts sDocContext fpath bs = case unP (go False []) initState of +parse parserOpts fpath bs = case unP (go False []) initState of POk _ toks -> reverse toks - PFailed pst -> - let err : _ = bagToList (E.getMessages $ getPsErrorMessages pst) - in panic $ - Outputable.renderWithContext sDocContext $ - text "Hyperlinker parse error:" $$ pprLocMsgEnvelopeDefault err + PFailed pst -> panicMessage "Hyperlinker parse error:" (E.getMessages $ getPsErrorMessages pst) where initState = initParserState parserOpts buf start buf = stringBufferFromByteString bs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/412f16756dff9d3b71ba1c4646c8bce… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/412f16756dff9d3b71ba1c4646c8bce… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] perf: Share Module in Iface Symbol Table
by Marge Bot (＠marge-bot) 27 Jun '26

27 Jun '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 27463426 by Rodrigo Mesquita at 2026-06-26T20:54:58-04:00 perf: Share Module in Iface Symbol Table This commit modifies the structure of the serialized `SymbolTable Name` to then re-use and share the `Module` (both on disk and in memory) across all `Name`s from the same module. The new structure looks like: <total name count> $modules.size for (mod, names) in $modules: $mod $names.size for table_ix, occ in $names $table_ix $occ i.e. we put the module just once, followed by all names in that module. When deserializing, we deserialize the module just once, and all the following `Name`s are constructed with a pointer to that same decoded `Module`. In `hoogle-test`, we must use `DNameEnv` rather than `Map Name`, otherwise the output fixities order was susceptible to changes in the uniques assigned to each Names, which is not stable. Fixes #27401 ------------------------- Metric Decrease: InstanceMatching LinkableUsage01 LinkableUsage02 hard_hole_fits ------------------------- - - - - - 12 changed files: - compiler/GHC/Iface/Binary.hs - compiler/GHC/Unit/Module/Env.hs - testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout - testsuite/tests/rename/should_compile/T1792_imports.stdout - testsuite/tests/rename/should_compile/T18264.stdout - testsuite/tests/rename/should_compile/T4239.stdout - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs Changes: ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -37,7 +37,6 @@ import GHC.Unit import GHC.Unit.Module.ModIface import GHC.Types.Name import GHC.Platform.Profile -import GHC.Types.Unique.FM import GHC.Utils.Panic import GHC.Utils.Binary as Binary import GHC.Data.FastMutInt @@ -61,7 +60,8 @@ import System.IO.Unsafe import Data.Typeable (Typeable) import qualified GHC.Data.Strict as Strict import Data.Function ((&)) - +import GHC.Types.Name.Env +import Data.Maybe -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -618,25 +618,27 @@ initNameReaderTable cache = do } data BinSymbolTable = BinSymbolTable { - bin_symtab_next :: !FastMutInt, -- The next index to use - bin_symtab_map :: !(IORef (UniqFM Name (Int,Name))) - -- indexed by Name + bin_symtab_next :: !FastMutInt, + -- ^ The next index to use + bin_symtab_map :: !(IORef (NameEnv Int, ModuleEnv [(Int,Name)])) + -- ^ Deduplication indexed by Name + -- ; Group table data by module for serialization } initNameWriterTable :: IO (WriterTable, BinaryWriter Name) initNameWriterTable = do symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM + symtab_map <- newIORef (emptyNameEnv, emptyModuleEnv) let bin_symtab = BinSymbolTable { bin_symtab_next = symtab_next - , bin_symtab_map = symtab_map + , bin_symtab_map = symtab_map } let put_symtab bh = do name_count <- readFastMutInt symtab_next - symtab_map <- readIORef symtab_map - putSymbolTable bh name_count symtab_map + (_, symtab_tbl) <- readIORef symtab_map + putSymbolTable bh name_count symtab_tbl pure name_count return @@ -647,40 +649,53 @@ initNameWriterTable = do ) -putSymbolTable :: WriteBinHandle -> Int -> UniqFM Name (Int,Name) -> IO () +{- | +The symbol table payload will look like: + + <total name count> + $modules.size + for (mod, names) in $modules: + $mod + $names.size + for table_ix, occ in $names + $table_ix + $occ +-} +putSymbolTable :: WriteBinHandle -> Int -> ModuleEnv [(Int, Name)] -> IO () putSymbolTable bh name_count symtab = do put_ bh name_count - let names = elems (array (0,name_count-1) (nonDetEltsUFM symtab)) - -- It's OK to use nonDetEltsUFM here because the elements have - -- indices that array uses to create order - mapM_ (\n -> serialiseName bh n symtab) names - - + put_ bh (sizeModuleEnv symtab) + forM_ (moduleEnvToList symtab) $ \(mod,names) -> do + put_ bh mod + put_ bh (length names) + forM_ names $ \(table_ix, name) -> do + let occ = assertPpr (isExternalName name) (ppr name) (nameOccName name) + put_ bh table_ix + put_ bh occ + +-- | Decode the symbol table -- layout set by 'putSymbolTable'. getSymbolTable :: ReadBinHandle -> NameCache -> IO (SymbolTable Name) getSymbolTable bh name_cache = do sz <- get bh :: IO Int -- create an array of Names for the symbols and add them to the NameCache updateNameCache' name_cache $ \cache0 -> do - mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int Name) - cache <- foldGet' (fromIntegral sz) bh cache0 $ \i (uid, mod_name, occ) cache -> do - let mod = mkModule uid mod_name - case lookupOrigNameCache cache mod occ of - Just name -> do - writeArray mut_arr (fromIntegral i) name - return cache - Nothing -> do - uniq <- takeUniqFromNameCache name_cache - let name = mkExternalName uniq mod occ noSrcSpan - new_cache = extendOrigNameCache cache mod occ name - writeArray mut_arr (fromIntegral i) name - return new_cache - arr <- unsafeFreeze mut_arr - return (cache, arr) - -serialiseName :: WriteBinHandle -> Name -> UniqFM key (Int,Name) -> IO () -serialiseName bh name _ = do - let mod = assertPpr (isExternalName name) (ppr name) (nameModule name) - put_ bh (moduleUnit mod, moduleName mod, nameOccName name) + mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int Name) + mods_sz <- get bh :: IO Int + cache <- + foldGet' (fromIntegral mods_sz) bh cache0 $ \_mod_ix (mod,mod_nms_sz) cache1 -> do + foldGet' (fromIntegral (mod_nms_sz::Int)) bh cache1 $ \_mod_nms_ix (table_ix, occ) cache2 -> do + case lookupOrigNameCache cache2 mod occ of + Just name -> do + writeArray mut_arr table_ix name + return cache2 + Nothing -> do + uniq <- takeUniqFromNameCache name_cache + let name = mkExternalName uniq mod occ noSrcSpan + cache3 = extendOrigNameCache cache2 mod occ name + writeArray mut_arr table_ix name + return cache3 + arr <- unsafeFreeze mut_arr + return (cache, arr) -- Note [Symbol table representation of names] @@ -714,16 +729,26 @@ putName BinSymbolTable{ .|. (fromIntegral u :: Word32)) | otherwise - = do symtab_map <- readIORef symtab_map_ref - case lookupUFM symtab_map name of - Just (off,_) -> put_ bh (fromIntegral off :: Word32) + = do (symtab_map,symtab_tbl) <- readIORef symtab_map_ref + case lookupNameEnv symtab_map name of + Just off -> put_ bh (fromIntegral off :: Word32) Nothing -> do - off <- readFastMutInt symtab_next - -- massert (off < 2^(30 :: Int)) - writeFastMutInt symtab_next (off+1) - writeIORef symtab_map_ref - $! addToUFM symtab_map name (off,name) - put_ bh (fromIntegral off :: Word32) + off <- freshIndex + let mod = nameModule name + let mod_nms = fromMaybe [] (lookupModuleEnv symtab_tbl mod) + + let !symtab_map' = extendNameEnv symtab_map name off + let !symtab_tbl' = extendModuleEnv symtab_tbl mod ((off,name):mod_nms) + writeIORef symtab_map_ref $! ( symtab_map', symtab_tbl' ) + + put_ bh (fromIntegral off :: Word32) + where + freshIndex :: IO Int + freshIndex = do + off <- readFastMutInt symtab_next + -- massert (off < 2^(30 :: Int)) + writeFastMutInt symtab_next (off+1) + return off -- See Note [Symbol table representation of names] getSymtabName :: SymbolTable Name ===================================== compiler/GHC/Unit/Module/Env.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Unit.Module.Env , alterModuleEnv , partitionModuleEnv , moduleEnvKeys, moduleEnvElts, moduleEnvToList - , unitModuleEnv, isEmptyModuleEnv + , unitModuleEnv, isEmptyModuleEnv, sizeModuleEnv , extendModuleEnvWith, filterModuleEnv, mapMaybeModuleEnv -- * ModuleName mappings @@ -176,6 +176,9 @@ unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x) isEmptyModuleEnv :: ModuleEnv a -> Bool isEmptyModuleEnv (ModuleEnv e) = Map.null e +sizeModuleEnv :: ModuleEnv a -> Int +sizeModuleEnv (ModuleEnv e) = Map.size e + -- | A set of 'Module's type ModuleSet = Set NDModule ===================================== testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout ===================================== @@ -1 +1 @@ -import DRFPatSynExport_A ( MkT, m ) +import DRFPatSynExport_A ( m, MkT ) ===================================== testsuite/tests/rename/should_compile/T1792_imports.stdout ===================================== @@ -1 +1 @@ -import qualified Data.ByteString as B ( putStr, readFile ) +import qualified Data.ByteString as B ( readFile, putStr ) ===================================== testsuite/tests/rename/should_compile/T18264.stdout ===================================== @@ -1,6 +1,6 @@ import Data.Char ( isDigit, isLetter ) import Data.List ( sortOn ) -import Data.Maybe ( fromJust, isJust ) +import Data.Maybe ( isJust, fromJust ) import qualified Data.Char as C ( isLetter, isDigit ) import qualified Data.List as S ( sort ) import qualified Data.List as T ( nub ) ===================================== testsuite/tests/rename/should_compile/T4239.stdout ===================================== @@ -1 +1 @@ -import T4239A ( (·), type (:+++)((:---), (:+++), X) ) +import T4239A ( type (:+++)((:---), (:+++), X), (·) ) ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -19,49 +19,53 @@ docs: export docs: [] declaration docs: - [elem -> [text: - -- | '()', 'elem'. - identifiers: - {DocsInHiFile.hs:14:13-16} - GHC.Internal.Data.Foldable.elem - {DocsInHiFile.hs:14:13-16} - elem], - D -> [text: - -- | A datatype. + [F -> [text: + -- | A type family identifiers:], - D0 -> [text: - -- ^ A constructor for 'D'. ' - identifiers: - {DocsInHiFile.hs:20:32} - D], - D1 -> [text: - -- ^ Another constructor + D:R:FInt -> [text: + -- | A type family instance + identifiers:], + D' -> [text: + -- | Another datatype... + identifiers:, + text: + -- ^ ...with two docstrings. identifiers:], - P -> [text: - -- | A class - identifiers:], - p -> [text: - -- | A class method - identifiers:], $fShowD -> [text: -- ^ 'Show' instance identifiers: {DocsInHiFile.hs:22:25-28} GHC.Internal.Show.Show], - D' -> [text: - -- | Another datatype... - identifiers:, - text: - -- ^ ...with two docstrings. + p -> [text: + -- | A class method + identifiers:], + P -> [text: + -- | A class + identifiers:], + D1 -> [text: + -- ^ Another constructor identifiers:], - D:R:FInt -> [text: - -- | A type family instance - identifiers:], - F -> [text: - -- | A type family - identifiers:]] + D0 -> [text: + -- ^ A constructor for 'D'. ' + identifiers: + {DocsInHiFile.hs:20:32} + D], + D -> [text: + -- | A datatype. + identifiers:], + elem -> [text: + -- | '()', 'elem'. + identifiers: + {DocsInHiFile.hs:14:13-16} + GHC.Internal.Data.Foldable.elem + {DocsInHiFile.hs:14:13-16} + elem]] arg docs: - [add -> 0: + [p -> 0: + text: + -- ^ An argument + identifiers:, + add -> 0: text: -- ^ First summand for 'add' identifiers: @@ -74,11 +78,7 @@ docs: 2: text: -- ^ Sum - identifiers:, - p -> 0: - text: - -- ^ An argument - identifiers:] + identifiers:] documentation structure: avails: [elem] ===================================== testsuite/tests/showIface/DocsInHiFileTH.stdout ===================================== @@ -6,137 +6,153 @@ docs: export docs: [] declaration docs: - [Tup2 -> [text: - -- |Matches a tuple of (a, a) - identifiers:], - f -> [text: - -- |The meaning of life - identifiers:], - g -> [text: - -- |Some documentation - identifiers:], - qux -> [text: - -- |This is qux + [D:R:WD13Foo -> [text: + -- |13 + identifiers:], + D:R:WD11Int0 -> [text: + -- |This is a data instance + identifiers:], + D:R:WD11Foo0 -> [text: + -- |11 + identifiers:], + D:R:WD11Bool0 -> [text: + -- |This is a newtype instance + identifiers:], + D:R:EBool -> [text: + -- |A type family instance + identifiers:], + $fF -> [text: + -- |14 identifiers:], - sin -> [text: - -- |15 + $fDka -> [text: + -- |Another new instance + identifiers:], + $fCTYPEList -> [text: + -- |Another new instance + identifiers:], + $fCTYPEInt -> [text: + -- |A new instance + identifiers:], + $fCTYPEFoo -> [text: + -- |7 + identifiers:], + WD6 -> [text: + -- |6 identifiers:], - wd1 -> [text: - -- |1 + WD5 -> [text: + -- |5 identifiers:], - wd17 -> [text: - -- |17 + WD4 -> [text: + -- |4 + identifiers:], + WD3 -> [text: + -- |3 + identifiers:], + WD12 -> [text: + -- |12 identifiers:], - wd18 -> [text: - -- |18 + WD11Int -> [text: + -- |This is a data instance constructor + identifiers:], + WD11Bool -> [text: + -- |This is a newtype instance constructor + identifiers:], + WD10 -> [text: + -- |10 identifiers:], - wd2 -> [text: - -- |2 - identifiers:], - wd20 -> [text: - -- |20 + quuz1_a -> [text: + -- |This is the record constructor's argument + identifiers:], + Quuz -> [text: + -- |This is a record constructor identifiers:], - wd8 -> [text: - -- |8 + Quux2 -> [text: + -- |This is Quux2 + identifiers:], + Quux1 -> [text: + -- |This is Quux1 + identifiers:], + Quux -> [text: + -- |This is Quux + identifiers:], + prettyPrint -> [text: + -- |Prettily prints the object + identifiers:], + Pretty -> [text: + -- |My cool class + identifiers:], + Foo -> [text: + -- |A new constructor identifiers:], - C -> [text: - -- |A new class + Foo -> [text: + -- |A new data type + identifiers:], + E -> [text: + -- |A type family identifiers:], - Corge -> [text: - -- |This is a newtype record constructor - identifiers:], runCorge -> [text: -- |This is the newtype record constructor's argument identifiers:], - E -> [text: - -- |A type family + Corge -> [text: + -- |This is a newtype record constructor + identifiers:], + C -> [text: + -- |A new class identifiers:], - Foo -> [text: - -- |A new data type - identifiers:], - Foo -> [text: - -- |A new constructor + wd8 -> [text: + -- |8 identifiers:], - Pretty -> [text: - -- |My cool class - identifiers:], - prettyPrint -> [text: - -- |Prettily prints the object - identifiers:], - Quux -> [text: - -- |This is Quux - identifiers:], - Quux1 -> [text: - -- |This is Quux1 - identifiers:], - Quux2 -> [text: - -- |This is Quux2 - identifiers:], - Quuz -> [text: - -- |This is a record constructor + wd20 -> [text: + -- |20 identifiers:], - quuz1_a -> [text: - -- |This is the record constructor's argument - identifiers:], - WD10 -> [text: - -- |10 + wd2 -> [text: + -- |2 + identifiers:], + wd18 -> [text: + -- |18 identifiers:], - WD11Bool -> [text: - -- |This is a newtype instance constructor - identifiers:], - WD11Int -> [text: - -- |This is a data instance constructor - identifiers:], - WD12 -> [text: - -- |12 + wd17 -> [text: + -- |17 identifiers:], - WD3 -> [text: - -- |3 - identifiers:], - WD4 -> [text: - -- |4 - identifiers:], - WD5 -> [text: - -- |5 + wd1 -> [text: + -- |1 identifiers:], - WD6 -> [text: - -- |6 + sin -> [text: + -- |15 identifiers:], - $fCTYPEFoo -> [text: - -- |7 - identifiers:], - $fCTYPEInt -> [text: - -- |A new instance - identifiers:], - $fCTYPEList -> [text: - -- |Another new instance - identifiers:], - $fDka -> [text: - -- |Another new instance - identifiers:], - $fF -> [text: - -- |14 + qux -> [text: + -- |This is qux identifiers:], - D:R:EBool -> [text: - -- |A type family instance - identifiers:], - D:R:WD11Bool0 -> [text: - -- |This is a newtype instance - identifiers:], - D:R:WD11Foo0 -> [text: - -- |11 - identifiers:], - D:R:WD11Int0 -> [text: - -- |This is a data instance - identifiers:], - D:R:WD13Foo -> [text: - -- |13 - identifiers:]] + g -> [text: + -- |Some documentation + identifiers:], + f -> [text: + -- |The meaning of life + identifiers:], + Tup2 -> [text: + -- |Matches a tuple of (a, a) + identifiers:]] arg docs: - [Tup2 -> 0: - text: - -- |The thing to match twice - identifiers:, + [WD11Int -> 0: + text: + -- |This is a data instance constructor argument + identifiers:, + WD11Bool -> 0: + text: + -- |This is a newtype instance constructor argument + identifiers:, + Quux2 -> 1: + text: + -- |I am a bool + identifiers:, + Quux1 -> 0: + text: + -- |I am an integer + identifiers:, + qux -> 1: + text: + -- |Arg dos + identifiers:, h -> 0: text: -- ^Your favourite number @@ -149,26 +165,10 @@ docs: text: -- ^A return value identifiers:, - qux -> 1: - text: - -- |Arg dos - identifiers:, - Quux1 -> 0: - text: - -- |I am an integer - identifiers:, - Quux2 -> 1: - text: - -- |I am a bool - identifiers:, - WD11Bool -> 0: - text: - -- |This is a newtype instance constructor argument - identifiers:, - WD11Int -> 0: - text: - -- |This is a data instance constructor argument - identifiers:] + Tup2 -> 0: + text: + -- |The thing to match twice + identifiers:] documentation structure: avails: [f] ===================================== testsuite/tests/showIface/NoExportList.stdout ===================================== @@ -6,7 +6,10 @@ docs: export docs: [] declaration docs: - [fα -> [text: + [$fEqR -> [text: + -- | A very lazy Eq instance + identifiers:], + fα -> [text: -- ^ Documentation for 'R'\'s 'fα' field. identifiers: {NoExportList.hs:14:38} @@ -14,10 +17,7 @@ docs: {NoExportList.hs:14:38} R {NoExportList.hs:14:45-46} - fα], - $fEqR -> [text: - -- | A very lazy Eq instance - identifiers:]] + fα]] arg docs: [] documentation structure: @@ -99,3 +99,4 @@ docs: ListTuplePuns ImplicitStagePersistence extensible fields: + ===================================== testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr ===================================== @@ -5,10 +5,10 @@ subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdef • Relevant bindings include f :: [String] (bound at subsumption_sort_hole_fits.hs:2:1) Valid hole fits include - lines :: String -> [String] + words :: String -> [String] (imported from ‘Prelude’ (and originally defined in ‘GHC.Internal.Data.OldList’)) - words :: String -> [String] + lines :: String -> [String] (imported from ‘Prelude’ (and originally defined in ‘GHC.Internal.Data.OldList’)) repeat :: forall a. a -> [a] ===================================== utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs ===================================== @@ -251,10 +251,12 @@ attachToExportItem cls_index fam_index index expInfo getInstDoc getFixity getIns } where fixities :: [(Name, Fixity)] - !fixities = force . Map.toList $ List.foldl' f Map.empty all_names + -- Use DNameEnv to guarantee a deterministic output regardless of the + -- uniques assigned to each_name e.g. off of the interface file. + !fixities = force . eltsDNameEnv $ List.foldl' f emptyDNameEnv all_names - f :: Map.Map Name Fixity -> Name -> Map.Map Name Fixity - f !fs n = Map.alter (<|> getFixity n) n fs + f :: DNameEnv (Name, Fixity) -> Name -> DNameEnv (Name, Fixity) + f !fs n = alterDNameEnv (<|> ((,) n <$> getFixity n)) fs n patsyn_names :: [Name] patsyn_names = concatMap (getMainDeclBinder emptyOccEnv . fst) patsyns ===================================== utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs ===================================== @@ -40,6 +40,7 @@ import Data.Coerce (coerce) import Data.Function ((&)) import Data.IORef import Data.Map (Map) +import Data.Maybe (fromMaybe) import Data.Version import Data.Word import GHC hiding (NoLink) @@ -50,7 +51,9 @@ import GHC.Iface.Type (IfaceType, putIfaceType) import GHC.Types.Name.Cache import GHC.Types.Unique import GHC.Types.Unique.FM +import GHC.Types.Name.Env import GHC.Unit.State +import GHC.Unit.Module.Env import GHC.Utils.Binary import Haddock.Types import Text.ParserCombinators.ReadP (readP_to_S) @@ -171,7 +174,7 @@ writeInterfaceFile filename iface = do -- Make some intial state symtab_next <- newFastMutInt 0 - symtab_map <- newIORef emptyUFM + symtab_map <- newIORef (emptyNameEnv, emptyModuleEnv) let bin_symtab = BinSymbolTable { bin_symtab_next = symtab_next @@ -211,8 +214,8 @@ writeInterfaceFile filename iface = do -- write the symbol table itself symtab_next' <- readFastMutInt symtab_next - symtab_map' <- readIORef symtab_map - putSymbolTable bh symtab_next' symtab_map' + (_, symtab_tbl') <- readIORef symtab_map + putSymbolTable bh symtab_next' symtab_tbl' -- write the dictionary pointer at the fornt of the file dict_p <- tellBinWriter bh @@ -269,20 +272,30 @@ putName bh name = do - symtab_map <- readIORef symtab_map_ref - case lookupUFM symtab_map name of - Just (off, _) -> put_ bh (fromIntegral off :: Word32) + (symtab_map, symtab_tbl) <- readIORef symtab_map_ref + case lookupNameEnv symtab_map name of + Just off -> put_ bh (fromIntegral off :: Word32) Nothing -> do - off <- readFastMutInt symtab_next - writeFastMutInt symtab_next (off + 1) - writeIORef symtab_map_ref $! - addToUFM symtab_map name (off, name) + off <- freshIndex + let mod' = nameModule name + let mod_nms = fromMaybe [] (lookupModuleEnv symtab_tbl mod') + + let !symtab_map' = extendNameEnv symtab_map name off + let !symtab_tbl' = extendModuleEnv symtab_tbl mod' ((off, name):mod_nms) + writeIORef symtab_map_ref $! (symtab_map', symtab_tbl') put_ bh (fromIntegral off :: Word32) + where + freshIndex :: IO Int + freshIndex = do + off <- readFastMutInt symtab_next + writeFastMutInt symtab_next (off + 1) + return off data BinSymbolTable = BinSymbolTable { bin_symtab_next :: !FastMutInt -- The next index to use - , bin_symtab_map :: !(IORef (UniqFM Name (Int, Name))) - -- indexed by Name + , bin_symtab_map :: !(IORef (NameEnv Int, ModuleEnv [(Int, Name)])) + -- ^ Deduplication indexed by Name + -- ; Group table data by module for serialization } putFastString :: BinDictionary -> WriteBinHandle -> FastString -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/274634267f7ac8ccecbb425ab3fd340… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/274634267f7ac8ccecbb425ab3fd340… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/T27448
by Simon Jakobi (＠sjakobi2) 27 Jun '26

27 Jun '26

Simon Jakobi pushed new branch wip/sjakobi/T27448 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/T27448 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26971] Decoupling 'L.H.S' from 'GHC.Hs.Doc'
by recursion-ninja (＠recursion-ninja) 27 Jun '26

27 Jun '26

recursion-ninja pushed to branch wip/fix-26971 at Glasgow Haskell Compiler / GHC Commits: eb9f93e6 by Recursion Ninja at 2026-06-26T14:53:15-04:00 Decoupling 'L.H.S' from 'GHC.Hs.Doc' * Migrated 'GHC.Hs.Doc' and 'GHC.Hs.DocString' AST defintions from 'GHC.*' namespace, to new 'Language.Haskell.Syntax.Doc' module in the 'L.H.S' "namespace." * Updated 'HsDocString to be TTG-parameterised as 'HsDocString pass'. * Added 'GHC.Hs.Extension.Pass': splits 'GhcPass'/'Pass' and all 'HsDocString' TTG instances out of 'GHC.Hs.Extension', which re-exports it unchanged (this is backwards compatible and prevents the introduction of a boot file). * Deleted 'GHC.Hs.Doc.hs-boot'; removed all 'L.H.S.*' imports of 'GHC.Hs.Doc'. * Updated 'GHC.Hs.DocString' to be TTG pass-parameterised throughout; moved 'mkHsDocStringChunk'/'unpackHDSC' here (require 'GHC.Utils.Encoding'). * Split 'GHC.Rename.Doc.rnHsDoc' from 'rnHsDocIdentifiersOnly'. * Updated parser, renamer, typechecker, HIE, and exact-print for new types. * Added 'HsDocString' TTG instances for 'DocNameI' to 'Haddock.Types'. Resolves #26971 - - - - - 34 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Doc.hs - − compiler/GHC/Hs/Doc.hs-boot - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/Extension.hs - + compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Decls.hs - + compiler/Language/Haskell/Syntax/Doc.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb9f93e6cfb364808872755f05b26b7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb9f93e6cfb364808872755f05b26b7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26971] Decoupling 'L.H.S' from 'GHC.Hs.Doc'
by recursion-ninja (＠recursion-ninja) 27 Jun '26

27 Jun '26

recursion-ninja pushed to branch wip/fix-26971 at Glasgow Haskell Compiler / GHC Commits: 95ba7313 by Recursion Ninja at 2026-06-26T14:42:45-04:00 Decoupling 'L.H.S' from 'GHC.Hs.Doc' * Migrated 'GHC.Hs.Doc' and 'GHC.Hs.DocString' AST defintions from 'GHC.*' namespace, to new 'Language.Haskell.Syntax.Doc' module in the 'L.H.S' "namespace." * Updated 'HsDocString to be TTG-parameterised as 'HsDocString pass'. * Added 'GHC.Hs.Extension.Pass': splits 'GhcPass'/'Pass' and all 'HsDocString' TTG instances out of 'GHC.Hs.Extension', which re-exports it unchanged (this is backwards compatible and prevents the introduction of a boot file). * Deleted 'GHC.Hs.Doc.hs-boot'; removed all 'L.H.S.*' imports of 'GHC.Hs.Doc'. * Updated 'GHC.Hs.DocString' to be TTG pass-parameterised throughout; moved 'mkHsDocStringChunk'/'unpackHDSC' here (require 'GHC.Utils.Encoding'). * Split 'GHC.Rename.Doc.rnHsDoc' from 'rnHsDocIdentifiersOnly'. * Updated parser, renamer, typechecker, HIE, and exact-print for new types. * Added 'HsDocString' TTG instances for 'DocNameI' to 'Haddock.Types'. Resolves #26971 - - - - - 34 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Doc.hs - − compiler/GHC/Hs/Doc.hs-boot - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/Extension.hs - + compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Decls.hs - + compiler/Language/Haskell/Syntax/Doc.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95ba7313cc4bab6b40b4325e67bbaa9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95ba7313cc4bab6b40b4325e67bbaa9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26971] 13 commits: Add -dstable-core-dump-order for stable Core dump ordering (#27296)
by recursion-ninja (＠recursion-ninja) 27 Jun '26

27 Jun '26

recursion-ninja pushed to branch wip/fix-26971 at Glasgow Haskell Compiler / GHC Commits: 2f6a5534 by Simon Jakobi at 2026-06-23T15:46:20+02:00 Add -dstable-core-dump-order for stable Core dump ordering (#27296) The order of top-level bindings in Core dumps (-ddump-simpl etc.) is the compiler's Unique-sensitive internal processing order, so an unrelated upstream change can reorder them and defeat a textual diff of two dumps. This adds an opt-in flag -dstable-core-dump-order that reorders the top-level bindings of dumps routed through dumpPassResult into a stable, Unique-independent order, so two dumps line up across rebuilds. See Note [Stable Core dump order] in GHC.Core.Ppr for the sort key and its rationale. Adds tests T27296 (binders GHC emits in non-source order by default, asserted to come out stably ordered under the flag) and T27296b (an untidied -ddump-float-out dump pinning the ordering of the anonymous lvl floats by literal value). Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com> - - - - - 141986e3 by mangoiv at 2026-06-24T15:51:14-04:00 compiler: refactor error reporting code for ExplicitLevelImports Refactors error reporting code for ExplicitLevelImports to pass in a RdrName and a GlobalReaderElt to be able to report errors that are faithful to the source and to more precisely distinguish between names that are in scope from different qualifications. Fixes #27385 and #26616 - - - - - aa7df6b6 by Simon Hengel at 2026-06-24T15:52:18-04:00 Set GHC_VERSION when calling custom pre-processors (see #25952) (so that pre-processors can emit backwards compatible code) - - - - - a9e494f2 by Simon Hengel at 2026-06-24T15:54:08-04:00 Add a flag to control GHCi specific error hints (close #27409) - - - - - a805b2a2 by Simon Hengel at 2026-06-24T15:55:20-04:00 Reference correct package in error messages for reexported modules (fixes #27417) - - - - - f235d183 by Simon Jakobi at 2026-06-25T05:51:18-04:00 Add explicit setBit/clearBit/complementBit for instance Bits Integer (#21176) The default setBit, clearBit, and complementBit methods allocate intermediate Integers per call. Define them explicitly via the new integerSetBit[#], integerClearBit[#] and integerComplementBit[#], built on the BigNat# primitives, which avoid those allocations. Allocation is not eliminated entirely -- the negative (IN) cases would need in-place mutation, which is left as future work. The default methods constant-folded on literal arguments via the integerOr/integerAnd/integerXor rules, which fold literal Integers of any size. The explicit functions have no such rule, so they (their Word-argument wrappers, and the Bits Integer methods) are marked INLINE to expose the underlying primops to the simplifier; see Note [INLINE for constant folding of bit operations]. This restores folding only on the small-int (IS) path -- large literal Integers (IP/IN) are no longer constant-folded, a minor regression for that case. T8832 covers the IS-path folding. The new golden-output test T21176 checks all three operations against the default implementations across the sign/size boundaries, recording each result plus its integerCheck validity. The base and ghc-bignum interface- stability export goldens gain the new functions. The main changelog entry lives in changelog.d under a new ghc-internal section (renamed from ghc-prim). CLC proposal: https://github.com/haskell/core-libraries-committee/issues/423 Co-Authored-By: Claude Opus 4.7 <noreply(a)anthropic.com> - - - - - 202ed264 by Marc Scholten at 2026-06-25T05:52:21-04:00 haddock: use Text in documentation pipeline This patch moves Haddock's documentation pipeline from String to Text where the data is already textual. It avoids repeated conversions while keeping the existing decoding behavior for invalid UTF-8 docstring chunks. The main changes are: * Render and carry docstrings as Text in Haddock-facing paths. * Use the Binary Text instance from GHC.Utils.Binary for Haddock interface files, and bump the Haddock binary interface version. * Add a FastString HTML instance so XHTML rendering avoids intermediate String allocation. * Keep HsDocStringChunk decoding lenient, matching the previous unpackHDSC behavior on invalid UTF-8 input. * Update the xhtml submodule to 3000.4.1.0, which contains the apostrophe escaping fix used by the Haddock test output. Co-authored-by: copilot-swe-agent[bot] <198982749%2BCopilot(a)users.noreply.github.com> Co-authored-by: Claude Opus 4.5 <noreply(a)anthropic.com> Assisted-by: Codex <codex(a)openai.com> - - - - - a72ff58f by mangoiv at 2026-06-25T05:53:07-04:00 compiler: rename ZonkAny to UnusedType and add pretty printing logic ZonkAny is a hard to understand name for users who do not know how the compiler works internally. Additionally, it is confusing that ZonkAny, while being a concrete type *represents* a meta variable, espeically in the compiler output. This patch changes the name of ZonkAny to UnusedType which is closer to its intended semantics and adds special pretty printing logic to display this type in the same fashion the compiler displays meta variables in other places, whenever they leak from the implementation to the user. It also exports the type from ghc-internal:GHC.Internal.Types in order to expose documentation. Fixes #27390 Co-Authored-By: Sam Derbyshire <sam.derbyshire(a)gmail.com> - - - - - 6813f002 by Simon Jakobi at 2026-06-26T04:51:47-04:00 Reg.Linear: drop Platform argument from most FR (FreeRegs) methods The FR class has one instance per CPU architecture, so any architecture-constant information its methods derived from the Platform argument can instead be baked into the instance. This removes the now needless Platform argument from frAllocateReg, frGetFreeRegs and frReleaseReg. frInitFreeRegs keeps its Platform argument: the initial allocatable set is genuinely platform-dependent, see Note [Aarch64 Register x18 at Darwin and Windows]. Fixes #26665 Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com> - - - - - 3b2a9409 by Zubin Duggal at 2026-06-26T04:52:39-04:00 testsuite: Report fragile failures as skipped in JUnit output - - - - - bc16fb06 by Recursion Ninja at 2026-06-26T13:31:53-04:00 Decoupling 'L.H.S' from 'GHC.Types.SourceText' * Migrated 'IntegralLit' to 'L.H.S.Lit'. * Migrated 'FractionalLit' to 'L.H.S.Lit'. * Migrated 'StringLiteral' to 'L.H.S.Lit'. * Added TTG extension points to the types above. * Added nice export list to 'GHC.Hs.Lit'. * Added 'rnOverLitVal' and 'tcOverLitVal' functions to 'GHC.Hs.Lit'. * Added instance 'Anno (StringLiteral (GhcPass p)) = SrcSpanAnnN' * Moved [Notes] about 'SourceText' from 'L.H.S.*' to 'GHC.*'. * Removed all references to 'SourceText' from 'L.H.S'. * Removed the trailing comma record field from 'StringLiteral' * Renamed exported functions for nomenclature consistency. * Deprecated the renamed functions Fixes #26953 - - - - - 00568ff7 by Recursion Ninja at 2026-06-26T13:59:20-04:00 Monomorphising GHC pass parameters where appropriate - - - - - 71ad4e36 by Recursion Ninja at 2026-06-26T14:35:43-04:00 Decoupling 'L.H.S' from 'GHC.Hs.Doc' * Migrated 'GHC.Hs.Doc' and 'GHC.Hs.DocString' AST defintions from 'GHC.*' namespace, to new 'Language.Haskell.Syntax.Doc' module in the 'L.H.S' "namespace." * Updated 'HsDocString to be TTG-parameterised as 'HsDocString pass'. * Added 'GHC.Hs.Extension.Pass': splits 'GhcPass'/'Pass' and all 'HsDocString' TTG instances out of 'GHC.Hs.Extension', which re-exports it unchanged (this is backwards compatible and prevents the introduction of a boot file). * Deleted 'GHC.Hs.Doc.hs-boot'; removed all 'L.H.S.*' imports of 'GHC.Hs.Doc'. * Updated 'GHC.Hs.DocString' to be TTG pass-parameterised throughout; moved 'mkHsDocStringChunk'/'unpackHDSC' here (require 'GHC.Utils.Encoding'). * Split 'GHC.Rename.Doc.rnHsDoc' from 'rnHsDocIdentifiersOnly'. * Updated parser, renamer, typechecker, HIE, and exact-print for new types. * Added 'HsDocString' TTG instances for 'DocNameI' to 'Haddock.Types'. Resolves #26971 - - - - - 241 changed files: - + changelog.d/26616 - + changelog.d/T21176 - changelog.d/config - + changelog.d/interactive-error-hints - + changelog.d/pp-set-ghc-version - + changelog.d/reexported-module-errors - + changelog.d/stable-core-dump-order-27296 - + changelog.d/unused-type - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs - compiler/GHC/CmmToAsm/Reg/Linear/X86.hs - compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs - compiler/GHC/CmmToAsm/X86/RegInfo.hs - compiler/GHC/CmmToAsm/X86/Regs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Doc.hs - − compiler/GHC/Hs/Doc.hs-boot - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - + compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors.hs - compiler/GHC/Iface/Errors/Ppr.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/PkgQual.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - + compiler/Language/Haskell/Syntax/Doc.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - docs/users_guide/debugging.rst - docs/users_guide/ghci.rst - docs/users_guide/phases.rst - ghc/GHCi/UI/Exception.hs - ghc/Main.hs - libraries/base/changelog.md - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Exts.hs - libraries/ghc-bignum/changelog.md - libraries/ghc-experimental/src/GHC/PrimOps.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs - libraries/ghc-internal/src/GHC/Internal/Bits.hs - libraries/ghc-internal/src/GHC/Internal/Types.hs - libraries/process - libraries/xhtml - testsuite/driver/junit.py - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail04.stderr - testsuite/tests/annotations/should_fail/annfail06.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - testsuite/tests/ghc-api/annotations-literals/literals.stdout - testsuite/tests/ghc-api/annotations-literals/parsed.hs - testsuite/tests/ghci/prog-mhu002/prog-mhu002c.stdout - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - testsuite/tests/interface-stability/ghc-bignum-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - + testsuite/tests/numeric/should_run/T21176.hs - + testsuite/tests/numeric/should_run/T21176.stdout - + testsuite/tests/numeric/should_run/T21176.stdout-ws-32 - testsuite/tests/numeric/should_run/all.T - + testsuite/tests/package/ImportReexport.hs - + testsuite/tests/package/ImportReexport.stderr - testsuite/tests/package/all.T - testsuite/tests/perf/compiler/T11068.stdout - testsuite/tests/pmcheck/should_compile/T12957.stderr - testsuite/tests/profiling/should_run/staticcallstack002.stdout - testsuite/tests/quasiquotation/qq001/qq001.stderr - testsuite/tests/quasiquotation/qq002/qq002.stderr - testsuite/tests/quasiquotation/qq003/qq003.stderr - testsuite/tests/quasiquotation/qq004/qq004.stderr - testsuite/tests/quotes/LiftErrMsg.stderr - testsuite/tests/quotes/LiftErrMsgDefer.stderr - testsuite/tests/quotes/LiftErrMsgTyped.stderr - testsuite/tests/quotes/T10384.stderr - testsuite/tests/quotes/T5721.stderr - testsuite/tests/quotes/TH_localname.stderr - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T13156.stdout - testsuite/tests/simplCore/should_compile/T26615.stderr - + testsuite/tests/simplCore/should_compile/T27296.hs - + testsuite/tests/simplCore/should_compile/T27296.stdout - + testsuite/tests/simplCore/should_compile/T27296b.hs - + testsuite/tests/simplCore/should_compile/T27296b.stdout - testsuite/tests/simplCore/should_compile/T8832.hs - testsuite/tests/simplCore/should_compile/T8832.stdout - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/splice-imports/SI03.stderr - testsuite/tests/splice-imports/SI05.stderr - testsuite/tests/splice-imports/SI08.stderr - testsuite/tests/splice-imports/SI08_oneshot.stderr - testsuite/tests/splice-imports/SI16.stderr - testsuite/tests/splice-imports/SI18.stderr - testsuite/tests/splice-imports/SI20.stderr - testsuite/tests/splice-imports/SI25.stderr - testsuite/tests/splice-imports/SI28.stderr - testsuite/tests/splice-imports/SI29.stderr - testsuite/tests/splice-imports/SI31.stderr - testsuite/tests/splice-imports/SI36.stderr - testsuite/tests/splice-imports/T26088.stderr - testsuite/tests/splice-imports/T26090.stderr - + testsuite/tests/splice-imports/T26616.hs - + testsuite/tests/splice-imports/T26616.stderr - testsuite/tests/splice-imports/all.T - testsuite/tests/th/T16976z.stderr - testsuite/tests/th/T17820a.stderr - testsuite/tests/th/T17820b.stderr - testsuite/tests/th/T17820c.stderr - testsuite/tests/th/T17820d.stderr - testsuite/tests/th/T17820e.stderr - testsuite/tests/th/T21547.stderr - testsuite/tests/th/T23829_hasty.stderr - testsuite/tests/th/T23829_hasty_b.stderr - testsuite/tests/th/T23829_tardy.ghc.stderr - testsuite/tests/th/T26098_local.stderr - testsuite/tests/th/T26098_quote.stderr - testsuite/tests/th/T26098_splice.stderr - testsuite/tests/th/T26099.stderr - testsuite/tests/th/T26568.stderr - testsuite/tests/th/T5795.stderr - testsuite/tests/typecheck/should_fail/T13292.stderr - + testsuite/tests/typecheck/should_fail/T27390-explicit-kinds.stderr - + testsuite/tests/typecheck/should_fail/T27390.hs - + testsuite/tests/typecheck/should_fail/T27390.stderr - + testsuite/tests/typecheck/should_fail/T27390a.hs - testsuite/tests/typecheck/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Meta.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Names.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs - utils/haddock/haddock-api/src/Haddock/Doc.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/Json.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs - utils/haddock/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs - utils/haddock/haddock-api/src/Haddock/Options.hs - utils/haddock/haddock-api/src/Haddock/Parser.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - utils/haddock/haddock-api/src/Haddock/Utils/Json.hs - utils/haddock/haddock-api/src/Haddock/Utils/Json/Parser.hs - utils/haddock/haddock-api/src/Haddock/Utils/Json/Types.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Doc.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Markup.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Parser/Util.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Types.hs - utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3db12611073a444a79e7c91047654… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3db12611073a444a79e7c91047654… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/T27437] Deleted 2 commits: Revert "NCG: avoid boxing the insert-lookup result in livenessBlock"
by Simon Jakobi (＠sjakobi2) 27 Jun '26

27 Jun '26

Simon Jakobi pushed to branch wip/sjakobi/T27437 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 090ac14a by Simon Jakobi at 2026-06-26T18:28:35+02:00 Revert "NCG: avoid boxing the insert-lookup result in livenessBlock" This reverts commit 94670147695768dab9a9cdb4c7f40334539e2d36. - - - - - 3613ce02 by Simon Jakobi at 2026-06-26T18:28:39+02:00 Revert "NCG: fuse the liveness fixpoint change-detection lookup into the insert" This reverts commit d8a819e71e67f9e372cd92126f2fb63bcdea0419. - - - - - 2 changed files: - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs Changes: ===================================== compiler/GHC/Cmm/Dataflow/Label.hs ===================================== @@ -35,7 +35,6 @@ module GHC.Cmm.Dataflow.Label , mapEmpty , mapSingleton , mapInsert - , mapInsertLookup , mapInsertWith , mapDelete , mapAlter @@ -200,14 +199,6 @@ mapSingleton (Label k) v = LM (M.singleton k v) mapInsert :: Label -> v -> LabelMap v -> LabelMap v mapInsert (Label k) v (LM m) = LM (M.insert k v m) --- | Insert a value, also returning the value previously bound to the key (if --- any). Fuses the insert and lookup into a single traversal of the map. -mapInsertLookup :: Label -> v -> LabelMap v -> (Maybe v, LabelMap v) -{-# INLINE mapInsertLookup #-} -mapInsertLookup (Label k) v (LM m) = - case M.insertLookupWithKey (\_ new _ -> new) k v m of - (old, m') -> (old, LM m') - mapInsertWith :: (v -> v -> v) -> Label -> v -> LabelMap v -> LabelMap v mapInsertWith f (Label k) v (LM m) = LM (M.insertWith f k v m) ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -891,7 +891,7 @@ livenessSCCs _ blockmap done [] = (done, blockmap) livenessSCCs platform blockmap done (AcyclicSCC block : sccs) - = let (_, blockmap', block') = livenessBlock platform blockmap block + = let (blockmap', block') = livenessBlock platform blockmap block in livenessSCCs platform blockmap' (AcyclicSCC block' : done) sccs livenessSCCs platform blockmap done @@ -909,9 +909,8 @@ livenessSCCs platform blockmap done | otherwise = (bm', blocks'') where (changed, bm', blocks'') = linearLiveness bm blocks - -- Like @mapAccumL (livenessBlock platform)@, but also OR's together - -- the per-block changed flags reported by livenessBlock, so the - -- caller can detect the fixed point without comparing block maps. + -- Like @mapAccumL (livenessBlock platform)@, but also reports whether + -- any of the SCC's blocks changed. linearLiveness :: Instruction instr => BlockMap Regs -> [LiveBasicBlock instr] @@ -921,8 +920,10 @@ livenessSCCs platform blockmap done go !changed bm [] = (changed, bm, []) go !changed bm (block : blks') = case livenessBlock platform bm block of - (blockChanged, bm', block') -> - let !changed' = changed || blockChanged + (bm', block') -> + let bid = blockId block + !changed' = changed + || mapLookup bid bm /= mapLookup bid bm' in case go changed' bm' blks' of (changed'', bm'', blks'') -> (changed'', bm'', block' : blks'') @@ -935,24 +936,19 @@ livenessBlock => Platform -> BlockMap Regs -> LiveBasicBlock instr - -> (Bool, BlockMap Regs, LiveBasicBlock instr) + -> (BlockMap Regs, LiveBasicBlock instr) livenessBlock platform blockmap (BasicBlock block_id instrs) = let (regsLiveOnEntry, instrs1) = livenessBack platform noRegs blockmap [] (reverse instrs) + blockmap' = mapInsert block_id regsLiveOnEntry blockmap instrs2 = livenessForward platform regsLiveOnEntry instrs1 output = BasicBlock block_id instrs2 - -- Fuse the insert with the lookup of the old entry, so the fixpoint loop in - -- livenessSCCs can tell whether this block changed for free, without a - -- separate map traversal. A single 'case' lets the pair from mapInsertLookup - -- cancel away rather than being allocated. - in case mapInsertLookup block_id regsLiveOnEntry blockmap of - (oldEntry, blockmap') -> - (oldEntry /= Just regsLiveOnEntry, blockmap', output) + in ( blockmap', output) -- | Calculate liveness going forwards, -- filling in when regs are born View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94670147695768dab9a9cdb4c7f403… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94670147695768dab9a9cdb4c7f403… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26953] Monomorphising GHC pass parameters where appropriate
by recursion-ninja (＠recursion-ninja) 27 Jun '26

27 Jun '26

recursion-ninja pushed to branch wip/fix-26953 at Glasgow Haskell Compiler / GHC Commits: 00568ff7 by Recursion Ninja at 2026-06-26T13:59:20-04:00 Monomorphising GHC pass parameters where appropriate - - - - - 3 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Warnings.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -671,7 +671,7 @@ fromIfaceWarningTxt = \case fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers (StringLiteral GhcRn) GhcRn fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) -fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral (GhcPass p) +fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral GhcRn fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs ===================================== compiler/GHC/Iface/Warnings.hs ===================================== @@ -28,6 +28,6 @@ toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt src (map (toIfaceSt toIfaceStringLiteralWithNames :: WithHsDocIdentifiers (StringLiteral GhcRn) GhcRn -> (IfaceStringLiteral, [IfExtName]) toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names) -toIfaceStringLiteral :: StringLiteral (GhcPass p) -> IfaceStringLiteral +toIfaceStringLiteral :: StringLiteral GhcRn -> IfaceStringLiteral toIfaceStringLiteral sLit = IfStringLiteral (stringLitSourceText sLit) (sl_fs sLit) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1584,7 +1584,7 @@ instance ExactPrint (LocatedP (WarningTxt GhcPs)) where c' <- markEpToken c return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (DeprecatedTxt src ws')) -instance Typeable p => ExactPrint (InWarningCategory (GhcPass p)) where +instance ExactPrint (InWarningCategory GhcPs) where getAnnotationEntry _ = NoEntryVal setAnnotationAnchor a _ _ _ = a @@ -1969,7 +1969,7 @@ exactNsSpec (DataNamespaceSpecifier data_) = do -- --------------------------------------------------------------------- -instance Typeable p => ExactPrint (StringLiteral (GhcPass p)) where +instance ExactPrint (StringLiteral GhcPs) where getAnnotationEntry = const NoEntryVal setAnnotationAnchor a _ _ _ = a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00568ff76697b50e27ecbd481eb1da7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00568ff76697b50e27ecbd481eb1da7… You're receiving this email because of your account on gitlab.haskell.org.

1 0