27 Jun '26
Simon Hengel deleted branch wip/sol/rename-mc-diagnostics at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org.
1
0
27 Jun '26
Simon Hengel deleted branch wip/sol/remove-ddump-json-flag at Glasgow Haskell Compiler / GHC
--
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sol/remove-ddump-json] 16 commits: Reg.Linear: drop Platform argument from most FR (FreeRegs) methods
by Simon Hengel (＠sol) 27 Jun '26
by Simon Hengel (＠sol) 27 Jun '26
27 Jun '26
Simon Hengel pushed to branch wip/sol/remove-ddump-json at Glasgow Haskell Compiler / GHC
Commits:
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
- - - - -
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
-------------------------
- - - - -
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).
- - - - -
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
- - - - -
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.
- - - - -
e6470796 by Simon Hengel at 2026-06-27T13:59:35+07:00
Add SrcSpan to MCDiagnostic
- - - - -
b64a6d78 by Simon Hengel at 2026-06-27T13:59:39+07:00
Get rid of mkLocMessage
- - - - -
ac58180e by Simon Hengel at 2026-06-27T13:59:39+07:00
Add Message data type
- - - - -
63f0d2bb by Simon Hengel at 2026-06-27T13:59:39+07:00
Get rid of MessageClass
- - - - -
9f33490d by Simon Hengel at 2026-06-27T13:59:39+07:00
Remove JSON logging
- - - - -
65 changed files:
- + changelog.d/add_can_drop_to_occurence_analyser
- + changelog.d/remove-ddump-json-flag
- 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/Opt/Monad.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Driver/Config.hs
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Monad.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/LogQueue.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Debugger.hs
- compiler/GHC/Runtime/Interpreter.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/Unit/Module/Env.hs
- compiler/GHC/Utils/Error.hs
- compiler/GHC/Utils/Logger.hs
- docs/users_guide/debugging.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- testsuite/driver/junit.py
- 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
- + testsuite/tests/ghc-api/T27240.hs
- testsuite/tests/ghc-api/T7478/T7478.hs
- testsuite/tests/ghc-api/all.T
- testsuite/tests/overloadedrecflds/should_compile/DRFPatSynExport.stdout
- testsuite/tests/plugins/hooks-plugin/Hooks/LogPlugin.hs
- 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/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
- utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcf52d24aafa78a9ed9705d8310146…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcf52d24aafa78a9ed9705d8310146…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Remove deprecated flag `-ddump-json` (see #24113)
by Marge Bot (＠marge-bot) 27 Jun '26
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
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
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
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
26 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) 26 Jun '26
by recursion-ninja (＠recursion-ninja) 26 Jun '26
26 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) 26 Jun '26
by recursion-ninja (＠recursion-ninja) 26 Jun '26
26 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