[Git][ghc/ghc] Pushed new branch wip/andrea/ghc-9.14.1-release
by Andrea Vezzosi (@trac-Saizan) 03 Sep '26
by Andrea Vezzosi (@trac-Saizan) 03 Sep '26
03 Sep '26
Andrea Vezzosi pushed new branch wip/andrea/ghc-9.14.1-release at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andrea/ghc-9.14.1-release
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: testsuite: Migrate perf tests off collect_compiler_stats('all')
by Marge Bot (@marge-bot) 03 Sep '26
by Marge Bot (@marge-bot) 03 Sep '26
03 Sep '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
df058f1d by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Migrate perf tests off collect_compiler_stats('all')
The 'all' metric argument applies a single tolerance to bytes
allocated, max_bytes_used and peak_megabytes_allocated, although their
noise profiles are incompatible (#27653): allocations are nearly
deterministic, residency needs 10-20%, and peak is quantized to 1 MB.
Any single tolerance is too tight for one metric or too slack for
another. This migrates the remaining users of 'all' (and of the 'all'
default) to explicit per-metric collection, ahead of removing 'all'
from the driver.
peak_megabytes_allocated is dropped everywhere: its 1 MB granularity
makes tight relative windows meaningless (#27613), and it is sensitive
to GC timing. In #27489 it drifted by -5.3% while max_bytes_used moved
by less than 0.1%. Where a test guards a memory property,
max_bytes_used covers it at byte granularity.
Where the motivating ticket was about compile-time memory
(T11545, T15304, T26425), residency remains gated via max_bytes_used,
now with a residency-appropriate tolerance.
max_bytes_used is dropped where residency was only ever an accident of
'all':
* T15630, T15630a, T20261: the underlying tickets (#15630, #20261)
contain no memory data at all. One is a simplifier-ticks blowup and
the other is stated entirely in allocation numbers, so the 20%
window never had teeth.
* T21839c: #21839's measurements show residency essentially flat
(+0.16%) while allocations moved +7%, so allocations are the
discriminating metric. They are already gated at 1% via
collect_compiler_runtime. The ghc/max gate had previously broken CI
spuriously (9fd11585eb widened it from 1% to 10% for that reason).
Allocation tolerances are tightened to the testsuite's conventional 2%
where 'all' previously left them at 10-20%.
Assisted-by: Claude Fable 5
- - - - -
72dd2432 by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Remove the 'all' metric argument of collect_stats
'all' gated bytes allocated, max_bytes_used and peak_megabytes_allocated
at a single tolerance, although their noise profiles are incompatible,
making such tests either flaky or toothless (#27653).
Closes #27653.
Assisted-by: Claude Fable 5
- - - - -
2228cb30 by Simon Jakobi at 2026-09-02T07:18:06-04:00
testsuite: Make the deviation argument of collect_stats mandatory
Almost every caller passes an explicit tolerance matched to the
metric's noise profile, and the silent 20% default is far slacker than
'bytes allocated' merits. Only two tests relied on it. They now state
their tolerance explicitly:
large-project gets 10%, in line with other large compile-time tests.
T9848 gets 2%: its metric is byte-for-byte deterministic across CI
jobs and platforms of a given test_env, has drifted only about 2.5%
since 2015, and the fusion failure it guards against would show up as
a roughly +30000% jump.
Assisted-by: Claude Fable 5
- - - - -
56291fc5 by Cheng Shao at 2026-09-02T07:18:45-04:00
autoconf/ghc-toolchain: bump llvm upper bound to support llvm 23
This commit bumps llvm upper bound to support llvm 23.
- - - - -
20eb3f41 by Cheng Shao at 2026-09-02T07:18:45-04:00
rts: fix compilation issues with clang 23
clang 23 has broadened `-Wall`/`-Wextra` ranges, exposing some minor
issues in the rts when building with validate flavours:
- Unused locals
- `#pragma GCC diagnostic pop` mismatch
This commit fixes those.
- - - - -
6e6d1609 by Simon Jakobi at 2026-09-03T04:45:17-04:00
Add -Wimplicit-field-strictness (#16836)
This opt-in warning fires when a data constructor field lacks an
explicit strictness annotation (`!` or `~`). It complements the
LazyFieldAnnotations extension (4762a8bf30f) from GHC proposal 752,
which makes `~` annotations available for this purpose.
Deciding which fields to report requires their levity, so the check
runs after typechecking. To keep the noise down, the diagnostic is
emitted once per data declaration, grouped by constructor.
Closes #16836.
Assisted-by: Claude Fable 5
- - - - -
ef675ca4 by mangoiv at 2026-09-03T04:45:18-04:00
simplifier: remove a bogus `assert` in `rebuild_app'` in `GHC.CoreToStg.Prep.cpeApp`.
Prior to this commit
commit 08bc245be70d95801bc1138804ed1de9474fbdc0
Author: sheaf <sam.derbyshire(a)gmail.com>
Date: Sat Feb 28 16:30:43 2026 +0100
Clean up join points, casts & ticks
This commit shores up the logic dealing with casts and ticks occurring
in between a join point binding and a jump
any `PlaceRuntime` ticks we observed were profiling ticks, even though that
isn't necessary.
The more liberal rules in the above commit allow e.g. breakpoint ticks
(which are valid PlaceRuntime ticks) to legitimately appear in an argument
position.
Fixes #27556
- - - - -
38 changed files:
- + changelog.d/27556
- + changelog.d/implicit-field-strictness-warning
- changelog.d/lazy-field-annotations
- + changelog.d/llvm-23
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Tickish.hs
- configure.ac
- docs/users_guide/exts/strict.rst
- docs/users_guide/using-warnings.rst
- libraries/base/tests/all.T
- rts/ProfHeap.c
- rts/eventlog/EventLog.c
- rts/prim/atomic.c
- testsuite/driver/README.md
- testsuite/driver/testlib.py
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/perf/compiler/large-project/all.T
- testsuite/tests/perf/space_leaks/all.T
- + testsuite/tests/simplCore/should_compile/T27556.hs
- + testsuite/tests/simplCore/should_compile/T27556.script
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/warnings/should_compile/T16836a.hs
- + testsuite/tests/warnings/should_compile/T16836a.stderr
- + testsuite/tests/warnings/should_compile/T16836b.hs
- + testsuite/tests/warnings/should_compile/T16836c.hs
- + testsuite/tests/warnings/should_compile/T16836c.stderr
- + testsuite/tests/warnings/should_compile/T16836d.hs
- + testsuite/tests/warnings/should_compile/T16836d.stderr
- testsuite/tests/warnings/should_compile/all.T
- utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b38115b19b524f7c9f8277422bf41…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b38115b19b524f7c9f8277422bf41…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/andrea/gbc-backport] 20 commits: compiler: only use `Name` instead of `Id` in `SptEntry`
by Andrea Vezzosi (@trac-Saizan) 03 Sep '26
by Andrea Vezzosi (@trac-Saizan) 03 Sep '26
03 Sep '26
Andrea Vezzosi pushed to branch wip/andrea/gbc-backport at Glasgow Haskell Compiler / GHC
Commits:
270613a6 by Cheng Shao at 2026-09-03T10:37:32+02:00
compiler: only use `Name` instead of `Id` in `SptEntry`
As a part of #26298, this patch refactors `SptEntry` to only carry a
`Name` instead of `Id`: we do not care about extra information like
caffyness or type at all in any static pointer related codegen logic.
This is necessary to make `SptEntry` serializable, as a part of the
grand plan of serializable bytecode.
Co-authored-by: Codex <codex(a)openai.com>
(cherry picked from commit 39b2e3823da3ab168aa2b7365f0f27e01b1ecd0e)
- - - - -
4623b595 by Oleg Grenrus at 2026-09-03T10:37:32+02:00
Generalise thNameToGhcName by adding HasHscEnv
There were multiple single monad-specific `getHscEnv` across codebase.
HasHscEnv is modelled on HasDynFlags.
My first idea was to simply add thNameToGhcNameHsc and
thNameToGhcNameTc, but those would been exactly the same
as thNameToGhcName already.
Also add an usage example to thNameToGhcName and mention that it's
recommended way of looking up names in GHC plugins
(cherry picked from commit eb2ab1e2cadde93c330330ca7fdc64b31cd61473)
- - - - -
df10ae15 by Simon Peyton Jones at 2026-09-03T10:37:32+02:00
Refactor ForAllCo
This is a pure refactor, addressing #26389.
It arranges that the kind coercion in a ForAllCo is a MCoercion, rather
than a plain Coercion, thus removing redundancy in the common case.
See (FC8) in Note [ForAllCo]
It's a nice cleanup.
(cherry picked from commit 94b62aa7e7b40b53442161a0c4f380955fda2f14)
- - - - -
b2f45031 by Cheng Shao at 2026-09-03T10:38:16+02:00
compiler/ghci: replace the LoadDLL message with LoadDLLs
As a part of #25407, this commit changes the LoadDLL message to
LoadDLLs, which takes a list of DLL paths to load and returns the list
of remote pointer handles. The wasm dyld is refactored to take
advantage of LoadDLLs and harvest background parallelism. On other
platforms, LoadDLLs is based on a fallback codepath that does
sequential loading.
The driver is not actually emitting singular LoadDLLs message with
multiple DLLs yet, this is left in subsequent commits.
Co-authored-by: Codex <codex(a)openai.com>
(cherry picked from commit a4d664c78642438f0f178ffa243e2ffdbdf20397)
- - - - -
9c512d0e by Cheng Shao at 2026-09-03T10:38:20+02:00
driver: separate downsweep/upsweep phase in loadPackages'
This commit refactors GHC.Linker.Loader.loadPackages' to be separated
into downsweep/upsweep phases:
- The downsweep phase performs dependency analysis and generates a
list of topologically sorted packages to load
- The upsweep phase sequentially loads these packages by calling
loadPackage
This is a necessary refactoring to make it possible to make loading of
DLLs concurrent.
(cherry picked from commit c7fc4baeddcfad500126b2e91ce94d2b9391560d)
- - - - -
a8d284ea by Cheng Shao at 2026-09-03T10:38:20+02:00
driver: emit single LoadDLLs message to load multiple DLLs
This commit refactors the driver so that it emits a single LoadDLLs
message to load multiple DLLs in GHC.Linker.Loader.loadPackages'.
Closes #25407.
-------------------------
Metric Increase:
MultiLayerModulesTH_OneShot
TcPlugin_RewritePerf
-------------------------
Co-authored-by: Codex <codex(a)openai.com>
(cherry picked from commit ab180104b61a930e8a1e906f013c151669ce6fff)
- - - - -
4af2e65a by Matthew Pickering at 2026-09-03T10:38:20+02:00
driver: Load bytecode static pointer entries during linking
Previously the entries were loaded too eagerly, during upsweep, but we
should delay loading them until we know that the relevant bytecode
object is demanded.
Towards #25230
(cherry picked from commit e9445c013fbccf9318739ca3d095a3e0a2e1be8a)
- - - - -
6cf584e3 by Matthew Pickering at 2026-09-03T10:38:20+02:00
loader: Unify loadDecls and loadModuleLinkables functions
These two functions nearly did the same thing. I have refactored them so
that `loadDecls` now calls `loadModuleLinkables`.
Fixes #26459
(cherry picked from commit da9633a9009a08132b974b0407c4057cae3577f7)
- - - - -
78023870 by Matthew Pickering at 2026-09-03T10:38:20+02:00
testsuite: Use ghci_ways to set ways in PackedDataCon/UnboxedTuples/UnliftedDataTypeInterp tests
These tests reimplemented the logic from `valid_way` in order to
determine what ways to run. It's easier to use this combination of
`only_ways` and `extra_ways` to only run in GHCi ways and always run in
GHCi ways.
(cherry picked from commit 1275d3607299734228adbbc47bfb69bf8800279f)
- - - - -
7b04a1b8 by Matthew Pickering at 2026-09-03T10:38:53+02:00
Rename interpreterBackend to bytecodeBackend
This is preparation for creating bytecode files.
The "interpreter" is one way in which we can run bytecode objects. It is
more accurate to describe that the backend produces bytecode, rather
than the means by which the code will eventually run.
The "interpreterBackend" binding is left as a deprecated alias.
(cherry picked from commit c06b534bbd6dbb570b760f2e82b3e375d3956bcf)
- - - - -
7c5f98be by sheaf at 2026-09-03T10:38:57+02:00
Store SDoc context in SourceError
This commits modifies the SourceError datatype which is used for
throwing and then reporting exceptions by storing all the info we need
to be able to print the SDoc, including whether we should print with
explicit kinds, explicit runtime-reps, etc.
This is done using the new datatype:
data SourceErrorContext
= SEC
!DiagOpts
!(DiagnosticOpts GhcMessage)
Now, when we come to report an error (by handling the exception), we
have access to the full context we need.
Fixes #26387
(cherry picked from commit 129ce32d3a4f2601f5c2d1bbaeeb2fbaf8dc9ef9)
- - - - -
dbf79e13 by sheaf at 2026-09-03T10:38:57+02:00
Improvements to 'mayLookIdentical'
This commit makes significant improvements to the machinery that decides
when we should pretty-print the "invisible bits" of a type, such as:
- kind applications, e.g. '@k' in 'Proxy @k ty'
- RuntimeReps, e.g. 'TYPE r'
- multiplicities and linear arrows 'a %1 -> b'
To do this, this commit refactors 'mayLookIdentical' to return **which**
of the invisible bits don't match up, e.g. in
(a %1 -> b) ~ (a %Many -> b)
we find that the invisible bit that doesn't match up is a multiplicity,
so we should set 'sdocLinearTypes = True' when pretty-printing, and with
e.g.
Proxy @k1 ~ Proxy @k2
we find that the invisible bit that doesn't match up is an invisible
TyCon argument, so we set 'sdocPrintExplicitKinds = True'.
We leverage these changes to remove the ad-hoc treatment of linearity
of data constructors with 'dataConDisplayType' and 'dataConNonLinearType'.
This is now handled by the machinery of 'pprWithInvisibleBits'.
Fixes #26335 #26340
(cherry picked from commit 2b8baada761b13199b99268f243bebd009e6e1b5)
- - - - -
b549d9c4 by Matthew Pickering at 2026-09-03T10:38:57+02:00
Add support for generating bytecode objects
This commit adds the `-fwrite-byte-code` option which makes GHC emit a
`.gbc` file which contains a serialised representation of bytecode.
The bytecode can be loaded by the compiler to avoid having to
reinterpret a module when using the bytecode interpreter (for example,
in GHCi).
There are also the new options:
* -gbcdir=<DIR>: Specify the directory to place the gbc files
* -gbcsuf=<suffix>: Specify the suffix for gbc files
The option `-fbyte-code-and-object-code` now implies
`-fwrite-byte-code`.
These performance tests fail due to https://github.com/haskell/directory/issues/204
-------------------------
Metric Increase:
MultiComponentModules
MultiLayerModules
MultiComponentModulesRecomp
MultiLayerModulesRecomp
MultiLayerModulesTH_Make
MultiLayerModulesTH_OneShot
T13701
-------------------------
The bytecode serialisation part was implemented by Cheng Shao
Co-authored-by: Cheng Shao <terrorjack(a)type.dance>
(cherry picked from commit 6bd8155c991cfce7cca594bc63ba8f6ca6751667)
- - - - -
16e2d353 by Ben Gamari at 2026-09-03T10:38:57+02:00
rts: Eliminate uses of implicit constant arrays
Folding of `const`-sized variable-length arrays to a constant-length
array is a gnu extension which clang complains about.
Closes #26502.
(cherry picked from commit 0c00c9c3b4e9b8515d4839f2c1d7d771781dc6f4)
- - - - -
24974d92 by Matthew Pickering at 2026-09-03T10:39:10+02:00
driver: Properly handle errors during LinkNode steps
Previously we were not properly catching errors during the LinkNode step
(see T9930fail test).
This is fixed by wrapping the `LinkNode` action in `wrapAction`, the
same handler which is used for module compilation.
Fixes #26496
(cherry picked from commit 6c91582f915f80daff774db7738094bda6ab3b44)
- - - - -
198fc051 by Sylvain Henry at 2026-09-03T10:39:21+02:00
Build external interpreter program on demand (#24731)
This patch teaches GHC how to build the external interpreter program
when it is missing. As long as we have the `ghci` library, doing this is
trivial so most of this patch is refactoring for doing it sanely.
(cherry picked from commit 55eab80d337e47decacbe979c29a1b7b47d0a872)
- - - - -
74fbe765 by Matthew Pickering at 2026-09-03T10:39:29+02:00
Use 'OsPath' in getModificationTimeIfExists
This part of the compiler is quite hot during recompilation checking in
particular since the filepaths will be translated to a string. It is
better to use the 'OsPath' native function, which turns out to be easy
to do.
(cherry picked from commit ef0dc33b2034fd91e11950751264e8b2e9f03fc4)
- - - - -
425a31db by Georgios Karachalias at 2026-09-03T10:39:29+02:00
Use OsPath in PkgDbRef and UnitDatabase, not FilePath
(cherry picked from commit fa3bd0a67eea13701d1b50053636f9645e999308)
- - - - -
add2f262 by Matthew Pickering at 2026-09-03T10:39:29+02:00
Add support for building bytecode libraries
A bytecode library is a collection of bytecode files (.gbc) and a
library which combines together additional object files.
A bytecode library is created by invoking GHC with the `-bytecodelib`
flag.
A library can be created from in-memory `ModuleByteCode` linkables or
by passing `.gbc` files as arguments on the command line.
Fixes #26298
(cherry picked from commit e36a5fcbeaa33abb17707173c9d1e81730f85008)
- - - - -
d78ff1a0 by Matthew Pickering at 2026-09-03T10:39:29+02:00
Load bytecode libraries to satisfy package dependencies
This commit allows you to use a bytecode library to satisfy a package
dependency when using the interpreter.
If a user enables `-fprefer-byte-code`, then if a package provides a
bytecode library, that will be loaded and used to satisfy the
dependency.
The main change is to separate the relevant parts of the `LoaderState`
into external and home package byte code. Bytecode is loaded into either
the home package or external part (similar to HPT/EPS split), HPT
bytecode can be unloaded. External bytecode is never unloaded.
The unload function has also only been called with an empty list of
"stable linkables" for a long time. It has been modified to directly
implement a complete unloading of the home package bytecode linkables.
At the moment, the bytecode libraries are found in the "library-dirs"
field from the package description. In the future when `Cabal`
implements support for "bytecode-library-dirs" field, we can read the
bytecode libraries from there. No changes to the Cabal submodule are
necessary at the moment.
Four new tests are added in testsuite/tests/cabal, which generate fake
package descriptions and test loading the libraries into GHCi.
Fixes #26298
(cherry picked from commit 8f9ae3397dbcbb4b0bd7a574ffc6b1fbaa137b6c)
- - - - -
239 changed files:
- compiler/GHC.hs
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Linker.hs
- + compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion.hs-boot
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Multiplicity.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Reduction.hs
- compiler/GHC/Core/TyCo/Compare.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Ppr.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Data/FlatBag.hs
- compiler/GHC/Data/OsPath.hs
- compiler/GHC/Data/SmallArray.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/Backend/Internal.hs
- compiler/GHC/Driver/Backpack.hs
- + compiler/GHC/Driver/ByteCode.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Config/Finder.hs
- + compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/Config/Linker.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Messager.hs
- compiler/GHC/Driver/Monad.hs
- compiler/GHC/Driver/Phases.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy/StaticPtrTable.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- + compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Config.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Dynamic.hs
- + compiler/GHC/Linker/Executable.hs
- − compiler/GHC/Linker/ExtraObj.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/MacOS.hs
- compiler/GHC/Linker/Static.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Linker/Windows.hs
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Plugins.hs
- compiler/GHC/Runtime/Debugger.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- + compiler/GHC/Runtime/Interpreter/C.hs
- + compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Settings.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToJS/StaticPtr.hs
- compiler/GHC/SysTools/Tasks.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Utils/Unify.hs-boot
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/SourceError.hs
- compiler/GHC/Types/SptEntry.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Types/TyThing/Ppr.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Unit/Info.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Unit/Module/WholeCoreBindings.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Error.hs
- compiler/GHC/Utils/Misc.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/ghc.cabal.in
- docs/users_guide/extending_ghc.rst
- docs/users_guide/phases.rst
- docs/users_guide/separate_compilation.rst
- ghc/GHCi/UI.hs
- ghc/Main.hs
- libraries/ghc-boot/GHC/Unit/Database.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/ObjLink.hs
- libraries/ghci/GHCi/Run.hs
- rts/Printer.c
- rts/posix/OSMem.c
- testsuite/config/ghc
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/mk/boilerplate.mk
- testsuite/tests/bytecode/T24634/T24634a.stdout
- testsuite/tests/bytecode/T24634/T24634b.stdout
- + testsuite/tests/cabal/Bytecode.hs
- + testsuite/tests/cabal/BytecodeForeign.c
- + testsuite/tests/cabal/BytecodeForeign.hs
- testsuite/tests/cabal/Makefile
- testsuite/tests/cabal/all.T
- + testsuite/tests/cabal/bytecode.pkg
- + testsuite/tests/cabal/bytecode.script
- + testsuite/tests/cabal/bytecode_foreign.pkg
- + testsuite/tests/cabal/bytecode_foreign.script
- testsuite/tests/cabal/ghcpkg03.stderr
- testsuite/tests/cabal/ghcpkg03.stderr-mingw32
- testsuite/tests/cabal/ghcpkg05.stderr
- testsuite/tests/cabal/ghcpkg05.stderr-mingw32
- + testsuite/tests/cabal/pkg_bytecode.stderr
- + testsuite/tests/cabal/pkg_bytecode.stdout
- + testsuite/tests/cabal/pkg_bytecode_foreign.stderr
- + testsuite/tests/cabal/pkg_bytecode_foreign.stdout
- + testsuite/tests/cabal/pkg_bytecode_with_gbc.stderr
- + testsuite/tests/cabal/pkg_bytecode_with_gbc.stdout
- + testsuite/tests/cabal/pkg_bytecode_with_o.stderr
- + testsuite/tests/cabal/pkg_bytecode_with_o.stdout
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/cpranal/should_compile/T18174.stderr
- testsuite/tests/driver/T11429c.stderr
- testsuite/tests/driver/T21682.stderr
- + testsuite/tests/driver/T24731.hs
- testsuite/tests/driver/T5313.hs
- testsuite/tests/driver/all.T
- + testsuite/tests/driver/bytecode-object/A.hs
- + testsuite/tests/driver/bytecode-object/BytecodeForeign.c
- + testsuite/tests/driver/bytecode-object/BytecodeForeign.hs
- + testsuite/tests/driver/bytecode-object/BytecodeMain.hs
- + testsuite/tests/driver/bytecode-object/BytecodeTest.hs
- + testsuite/tests/driver/bytecode-object/Makefile
- + testsuite/tests/driver/bytecode-object/all.T
- + testsuite/tests/driver/bytecode-object/bytecode_object12.stderr
- + testsuite/tests/driver/bytecode-object/bytecode_object13.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object14.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object15.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object16.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object17.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object18.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object19.script
- + testsuite/tests/driver/bytecode-object/bytecode_object19.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object20.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object21.stderr
- + testsuite/tests/driver/bytecode-object/bytecode_object21.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object23.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object24.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object25.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object4.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object5.stdout
- + testsuite/tests/driver/bytecode-object/bytecode_object6.stdout
- testsuite/tests/driver/fat-iface/T22405/T22405.stdout
- testsuite/tests/driver/fat-iface/T22405/T22405b.stdout
- testsuite/tests/driver/fat-iface/fat011.stderr
- testsuite/tests/ghc-api/T10052/T10052.hs
- testsuite/tests/ghc-api/T10942.hs
- testsuite/tests/ghc-api/T8639_api.hs
- testsuite/tests/ghc-api/annotations-literals/literals.hs
- testsuite/tests/ghc-api/apirecomp001/myghc.hs
- testsuite/tests/ghc-e/should_fail/T9930fail.stderr
- testsuite/tests/ghc-e/should_fail/all.T
- testsuite/tests/ghci/linking/dyn/T3372.hs
- testsuite/tests/ghci/should_run/PackedDataCon/packeddatacon.T
- testsuite/tests/ghci/should_run/UnboxedTuples/unboxedtuples.T
- testsuite/tests/ghci/should_run/UnliftedDataTypeInterp/unlifteddatatypeinterp.T
- testsuite/tests/indexed-types/should_fail/T14887.stderr
- testsuite/tests/linear/should_fail/T19361.stderr
- testsuite/tests/perf/compiler/Makefile
- + testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithBytecodeFiles.script
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/roles/should_compile/Roles13.stderr
- testsuite/tests/rts/linker/T2615.hs
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- testsuite/tests/simplCore/should_compile/T17673.stderr
- testsuite/tests/simplCore/should_compile/T18078.stderr
- testsuite/tests/simplCore/should_compile/T18995.stderr
- testsuite/tests/simplCore/should_compile/T19890.stderr
- testsuite/tests/simplCore/should_compile/T21948.stderr
- testsuite/tests/simplCore/should_compile/T21960.stderr
- testsuite/tests/simplCore/should_compile/T24808.stderr
- − testsuite/tests/simplCore/should_compile/T25713.stderr
- testsuite/tests/simplCore/should_compile/T4201.stdout
- testsuite/tests/simplCore/should_compile/T8331.stderr
- testsuite/tests/simplStg/should_compile/T22840.stderr
- testsuite/tests/typecheck/no_skolem_info/T20232.stderr
- testsuite/tests/typecheck/should_fail/T11672.stderr
- testsuite/tests/typecheck/should_fail/T12373.stderr
- testsuite/tests/typecheck/should_fail/T15807.stderr
- testsuite/tests/typecheck/should_fail/T16074.stderr
- testsuite/tests/typecheck/should_fail/T18357a.stderr
- testsuite/tests/typecheck/should_fail/T19627.stderr
- testsuite/tests/typecheck/should_fail/T21530a.stderr
- testsuite/tests/typecheck/should_fail/VisFlag1.stderr
- utils/check-exact/Parsers.hs
- utils/check-exact/Preprocess.hs
- utils/ghc-pkg/Main.hs
- utils/iserv/iserv.cabal.in
- utils/jsffi/dyld.mjs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ea088334e51e9bf59f6969ac503f5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ea088334e51e9bf59f6969ac503f5…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc] Pushed new branch wip/sjakobi/T27688-bt-single-bit-tests
by Simon Jakobi (@sjakobi) 03 Sep '26
by Simon Jakobi (@sjakobi) 03 Sep '26
03 Sep '26
Simon Jakobi pushed new branch wip/sjakobi/T27688-bt-single-bit-tests at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/T27688-bt-single-bit-…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/sjakobi/T25233] X86 NCG: use btr/bts/btc for single-bit operations
by Simon Jakobi (@sjakobi) 03 Sep '26
by Simon Jakobi (@sjakobi) 03 Sep '26
03 Sep '26
Simon Jakobi pushed to branch wip/sjakobi/T25233 at Glasgow Haskell Compiler / GHC
Commits:
59676606 by Simon Jakobi at 2026-09-03T09:41:37+02:00
X86 NCG: use btr/bts/btc for single-bit operations
Previously the Cmm patterns
x & ~(1 << i)
x | (1 << i)
x ^ (1 << i)
compiled to mov/shl/not/and-style sequences of 3-4 instructions. Now
they compile to a single btr, bts or btc, matching what C compilers
produce.
When the bit index is a literal, constant folding has already collapsed
these patterns into ones with a literal mask, such as
x & 0xfffffeffffffffff for x & ~(1 << 40). Such masks are now also
compiled to a bit-test instruction when they don't fit in an imm32 and
would otherwise have to be loaded into a register first.
For a variable bit index, this applies only when the shift is unchecked
(uncheckedShiftL#, Data.Bits.unsafeShiftL): the bounds-checked shiftL
used by e.g. the default clearBit/setBit/complementBit implementations
wraps the shift in a bounds mask that this optimisation does not see
through. With a literal index, the bounds mask is constant-folded away,
so the checked operations benefit too.
See Note [Bit-test instructions] in GHC.CmmToAsm.X86.CodeGen.
Fixes #25233.
Assisted-by: Claude Fable 5
- - - - -
9 changed files:
- + changelog.d/ncg-x86-bit-test-instructions
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- + testsuite/tests/codeGen/should_gen_asm/T25233.asm
- + testsuite/tests/codeGen/should_gen_asm/T25233.hs
- + testsuite/tests/codeGen/should_gen_asm/T25233b.asm
- + testsuite/tests/codeGen/should_gen_asm/T25233b.cmm
- testsuite/tests/codeGen/should_gen_asm/all.T
Changes:
=====================================
changelog.d/ncg-x86-bit-test-instructions
=====================================
@@ -0,0 +1,20 @@
+section: compiler
+synopsis: The x86 native code generator now uses the bit-test instructions
+ ``btr``/``bts``/``btc`` to clear, set or complement a single bit
+description:
+ Cmm patterns such as ``x & ~(1 << i)``, ``x | (1 << i)`` and
+ ``x ^ (1 << i)`` now compile to a single ``btr``/``bts``/``btc``
+ instruction instead of a mov/shl/not/and-style sequence, matching what C
+ compilers produce. The same applies to the literal masks that constant
+ folding produces from these patterns when ``i`` is constant, in the cases
+ where the mask doesn't fit in an imm32 operand.
+
+ For a variable bit index this applies only when the shift is unchecked,
+ as with ``uncheckedShiftL#`` or ``Data.Bits.unsafeShiftL``. The
+ bounds-checked ``shiftL`` — used, for example, by the default
+ implementations of ``clearBit``, ``setBit`` and ``complementBit`` —
+ wraps the shift in a bounds mask that this optimisation does not see
+ through. With a literal index, the bounds mask is constant-folded away,
+ so the checked operations benefit too.
+mrs: !16311
+issues: #25233
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -1442,6 +1442,22 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
(PUNPCKLQDQ fmt (OpReg dst) dst)
)
+-- Use the bit-test instructions btr/bts/btc for clearing, setting and
+-- complementing a single bit: e.g. x .&. complement (1 `shiftL` i) is btr.
+-- See Note [Bit-test instructions].
+getRegister' platform is32Bit (CmmMachOp (MO_And w) [x, y])
+ | bitTestOpWidthOK is32Bit w
+ , Just (opnd, ix) <- clearBitArgs_maybe platform w x y
+ = genBitTestCode (intFormat w) BTR opnd ix
+getRegister' platform is32Bit (CmmMachOp (MO_Or w) [x, y])
+ | bitTestOpWidthOK is32Bit w
+ , Just (opnd, ix) <- setBitArgs_maybe platform w x y
+ = genBitTestCode (intFormat w) BTS opnd ix
+getRegister' platform is32Bit (CmmMachOp (MO_Xor w) [x, y])
+ | bitTestOpWidthOK is32Bit w
+ , Just (opnd, ix) <- setBitArgs_maybe platform w x y
+ = genBitTestCode (intFormat w) BTC opnd ix
+
getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
sse4_1 <- sse4_1Enabled
sse4_2 <- sse4_2Enabled
@@ -5883,6 +5899,138 @@ genTrivialCode rep instr a b = do
instr b_op dst
return (Any rep code)
+{- Note [Bit-test instructions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+x86 has dedicated instructions for clearing (btr), setting (bts) and
+complementing (btc) a single bit whose index is given in a register. We use
+them for Cmm patterns such as
+
+ x & ~(1 << i) ==> btr i, x (#25233)
+
+replacing a mov/shl/not/and sequence with a single instruction. The
+shift-count register operand of shl is masked modulo the operand width, and
+the bit-offset register operand of btr/bts/btc is masked the same way, so
+the replacement is faithful even for out-of-range i (where the Cmm shift is
+in any case undefined).
+
+The bit-offset operand of these instructions must be an immediate or a
+register. When the bit index is a literal, no shift reaches the NCG:
+constant folding has already turned the whole mask into a literal. If that
+mask fits in an imm32, we keep the ordinary and/or/xor with an immediate:
+it has the same latency and better throughput (more execution ports) than
+the bit-test instructions, and at worst two bytes of extra code size for bit
+indices 7..30.
+But a W64 mask touching the upper bits, e.g. ~(1 << 40), would have to be moved
+into a register first. For such masks we recognise the folded literal itself
+(exactly one bit clear resp. set) and emit btr/bts/btc with an immediate
+bit offset.
+
+We restrict the pattern to W32 and native-width W64: the instructions do not
+exist at width 8, and sub-word Cmm operations at W8/W16 are rare enough that
+they are not worth the extra care.
+-}
+
+-- | Match @1 << i@, returning @i@.
+--
+-- The returned expression is always at word width ('machOpArgReps' fixes
+-- shift amounts at 'wordWidth'). See Note [Bit-test instructions].
+singleBit_maybe :: CmmExpr -> Maybe CmmExpr
+singleBit_maybe (CmmMachOp (MO_Shl _) [CmmLit (CmmInt 1 _), i]) = Just i
+singleBit_maybe _ = Nothing
+
+-- | If exactly one bit of @m@, taken at width @w@, is set, return its index.
+--
+-- See Note [Bit-test instructions].
+setBitLit_maybe :: Width -> Integer -> Maybe Int
+setBitLit_maybe w m
+ | popCount m' == 1 = Just (countTrailingZeros m')
+ | otherwise = Nothing
+ where
+ -- w <= W64 in this X86-specific code, so a Word64 suffices.
+ m' = fromInteger (narrowU w m) :: Word64
+
+-- | If exactly one bit of @m@, taken at width @w@, is clear, return its
+-- index.
+--
+-- See Note [Bit-test instructions].
+clearBitLit_maybe :: Width -> Integer -> Maybe Int
+clearBitLit_maybe w m = setBitLit_maybe w (complement m)
+
+bitTestOpWidthOK :: Bool -> Width -> Bool
+bitTestOpWidthOK is32Bit w = w == W32 || (w == W64 && not is32Bit)
+
+-- | The bit-offset operand of a bit-test instruction (btr/bts/btc).
+data BitIndex
+ = BitIndexReg CmmExpr -- ^ variable index, computed into a register
+ | BitIndexImm Int -- ^ literal index, emitted as an immediate
+
+-- | Match the operands of a single-bit set or complement operation: one
+-- operand is a mask @1 << i@, or a literal with exactly one bit set that
+-- does not fit in an imm32. Returns the other operand and the bit index.
+--
+-- Both operand orders are matched, e.g. @x | (1 << i)@ and @(1 << i) | x@.
+--
+-- See Note [Bit-test instructions].
+setBitArgs_maybe :: Platform -> Width -> CmmExpr -> CmmExpr
+ -> Maybe (CmmExpr, BitIndex)
+setBitArgs_maybe platform w x y = go x y `mplus` go y x
+ where
+ go opnd mask
+ | Just i <- singleBit_maybe mask
+ = Just (opnd, BitIndexReg i)
+ | CmmLit lit@(CmmInt m _) <- mask
+ , Just i <- setBitLit_maybe w m
+ , not (is32BitLit platform lit)
+ = Just (opnd, BitIndexImm i)
+ | otherwise
+ = Nothing
+
+-- | As 'setBitArgs_maybe', for a single-bit clear operation: the mask is
+-- @~(1 << i)@, or a literal with exactly one bit clear.
+clearBitArgs_maybe :: Platform -> Width -> CmmExpr -> CmmExpr
+ -> Maybe (CmmExpr, BitIndex)
+clearBitArgs_maybe platform w x y = go x y `mplus` go y x
+ where
+ go opnd mask
+ | CmmMachOp (MO_Not _) [b] <- mask
+ , Just i <- singleBit_maybe b
+ = Just (opnd, BitIndexReg i)
+ | CmmLit lit@(CmmInt m _) <- mask
+ , Just i <- clearBitLit_maybe w m
+ , not (is32BitLit platform lit)
+ = Just (opnd, BitIndexImm i)
+ | otherwise
+ = Nothing
+
+-- | Generate code for @dst := x@ followed by a bit-test instruction
+-- (btr/bts/btc).
+--
+-- See Note [Bit-test instructions].
+genBitTestCode :: Format -> (Format -> Operand -> Operand -> Instr)
+ -> CmmExpr -> BitIndex -> NatM Register
+genBitTestCode rep instr x (BitIndexImm i) = do
+ x_code <- getAnyReg x
+ let code dst = x_code dst `snocOL` instr rep (OpImm (ImmInt i)) (OpReg dst)
+ return (Any rep code)
+genBitTestCode rep instr x (BitIndexReg i) = do
+ (i_reg, i_code) <- getNonClobberedReg i
+ x_code <- getAnyReg x
+ tmp <- getNewRegNat rep
+ let
+ -- As in genTrivialCode, 'i' must stay alive across the computation of
+ -- 'x' into dst, so save it in a temporary if dst holds 'i'.
+ code dst
+ | dst == i_reg =
+ i_code `appOL`
+ unitOL (MOV rep (OpReg i_reg) (OpReg tmp)) `appOL`
+ x_code dst `snocOL`
+ instr rep (OpReg tmp) (OpReg dst)
+ | otherwise =
+ i_code `appOL`
+ x_code dst `snocOL`
+ instr rep (OpReg i_reg) (OpReg dst)
+ return (Any rep code)
+
regClashesWithOp :: Reg -> Operand -> Bool
reg `regClashesWithOp` OpReg reg2 = reg == reg2
reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode)
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -193,6 +193,12 @@ data Instr
| SHLD Format Operand{-amount-} Operand Operand
| BT Format Imm Operand
+ -- | Bit test-and-reset
+ | BTR Format Operand{- ^ bit offset (imm/reg) -} Operand
+ -- | Bit set
+ | BTS Format Operand{- ^ bit offset (imm/reg) -} Operand
+ -- | Bit complement
+ | BTC Format Operand{- ^ bit offset (imm/reg) -} Operand
| NOP
@@ -496,6 +502,9 @@ regUsageOfInstr platform instr
SHLD fmt imm dst1 dst2 -> usageRMM fmt imm dst1 dst2
SHRD fmt imm dst1 dst2 -> usageRMM fmt imm dst1 dst2
BT fmt _ src -> mkRUR (use_R fmt src [])
+ BTR fmt off dst -> usageRM fmt off dst
+ BTS fmt off dst -> usageRM fmt off dst
+ BTC fmt off dst -> usageRM fmt off dst
PUSH fmt op -> mkRUR (use_R fmt op [])
POP fmt op -> mkRU [] (def_W fmt op)
@@ -830,6 +839,9 @@ patchRegsOfInstr platform instr env
SHLD fmt imm dst1 dst2 -> patch2 (SHLD fmt imm) dst1 dst2
SHRD fmt imm dst1 dst2 -> patch2 (SHRD fmt imm) dst1 dst2
BT fmt imm src -> patch1 (BT fmt imm) src
+ BTR fmt off dst -> patch2 (BTR fmt) off dst
+ BTS fmt off dst -> patch2 (BTS fmt) off dst
+ BTC fmt off dst -> patch2 (BTC fmt) off dst
TEST fmt src dst -> patch2 (TEST fmt) src dst
CMP fmt src dst -> patch2 (CMP fmt) src dst
PUSH fmt op -> patch1 (PUSH fmt) op
=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -862,6 +862,15 @@ pprInstr platform i = case i of
BT format imm src
-> pprFormatImmOp (text "bt") format imm src
+ BTR format off dst
+ -> pprFormatOpOp (text "btr") format off dst
+
+ BTS format off dst
+ -> pprFormatOpOp (text "bts") format off dst
+
+ BTC format off dst
+ -> pprFormatOpOp (text "btc") format off dst
+
CMP format src dst
| isFloatFormat format -> pprFormatOpOp (text "ucomi") format src dst -- SSE2
| otherwise -> pprFormatOpOp (text "cmp") format src dst
=====================================
testsuite/tests/codeGen/should_gen_asm/T25233.asm
=====================================
@@ -0,0 +1,9 @@
+btrq
+btsq
+btcq
+btrl
+btsl
+btcl
+btrq $40,
+btsq $40,
+btcq $40,
=====================================
testsuite/tests/codeGen/should_gen_asm/T25233.hs
=====================================
@@ -0,0 +1,39 @@
+{-# LANGUAGE MagicHash #-}
+
+-- Check that clearing/setting/complementing a single, variable bit
+-- uses the btr/bts/btc instructions (#25233).
+module T25233 where
+
+import GHC.Exts
+
+myClearBit :: Word# -> Int# -> Word#
+myClearBit x i = x `and#` not# (1## `uncheckedShiftL#` i)
+
+mySetBit :: Word# -> Int# -> Word#
+mySetBit x i = x `or#` (1## `uncheckedShiftL#` i)
+
+myComplementBit :: Word# -> Int# -> Word#
+myComplementBit x i = x `xor#` (1## `uncheckedShiftL#` i)
+
+myClearBit32 :: Word32# -> Int# -> Word32#
+myClearBit32 x i =
+ x `andWord32#` notWord32# (wordToWord32# 1## `uncheckedShiftLWord32#` i)
+
+mySetBit32 :: Word32# -> Int# -> Word32#
+mySetBit32 x i = x `orWord32#` (wordToWord32# 1## `uncheckedShiftLWord32#` i)
+
+myComplementBit32 :: Word32# -> Int# -> Word32#
+myComplementBit32 x i =
+ x `xorWord32#` (wordToWord32# 1## `uncheckedShiftLWord32#` i)
+
+-- With a constant bit index >= 32, the mask constant-folds to a literal
+-- that does not fit in an imm32, so a bit-test instruction with an
+-- immediate offset is used.
+myClearBit40 :: Word# -> Word#
+myClearBit40 x = x `and#` not# (1## `uncheckedShiftL#` 40#)
+
+mySetBit40 :: Word# -> Word#
+mySetBit40 x = x `or#` (1## `uncheckedShiftL#` 40#)
+
+myComplementBit40 :: Word# -> Word#
+myComplementBit40 x = x `xor#` (1## `uncheckedShiftL#` 40#)
=====================================
testsuite/tests/codeGen/should_gen_asm/T25233b.asm
=====================================
@@ -0,0 +1,6 @@
+btrq %
+btsq %
+btcq %
+btrq $40,
+btsq $40,
+btcq $40,
=====================================
testsuite/tests/codeGen/should_gen_asm/T25233b.cmm
=====================================
@@ -0,0 +1,27 @@
+#include "Cmm.h"
+
+// Single-bit masks written on the left of the operator (#25233).
+
+clearBitVar (W_ x, W_ i) {
+ return ((~((1 :: bits64) << i)) & x);
+}
+
+setBitVar (W_ x, W_ i) {
+ return (((1 :: bits64) << i) | x);
+}
+
+complementBitVar (W_ x, W_ i) {
+ return (((1 :: bits64) << i) ^ x);
+}
+
+clearBit40 (W_ x) {
+ return ((0xFFFFFEFFFFFFFFFF :: bits64) & x);
+}
+
+setBit40 (W_ x) {
+ return ((0x10000000000 :: bits64) | x);
+}
+
+complementBit40 (W_ x) {
+ return ((0x10000000000 :: bits64) ^ x);
+}
=====================================
testsuite/tests/codeGen/should_gen_asm/all.T
=====================================
@@ -23,6 +23,10 @@ test('avx512-int64-minmax', [unless(arch('x86_64'), skip),
when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512vl'])
test('avx512-word64-minmax', [unless(arch('x86_64'), skip),
when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512vl'])
+test('T25233', [unless(arch('x86_64'), skip),
+ when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-O'])
+test('T25233b', [unless(arch('x86_64'), skip),
+ when(unregisterised(), skip)], compile_grep_asm, ['cmm', True, ''])
is_aarch64_codegen = [
unless(arch('aarch64'), skip),
when(unregisterised(), skip),
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59676606709fb17c79926113c4b49fe…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59676606709fb17c79926113c4b49fe…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/sand-witch/27423-gadt-parens] Parentheses in prefix GADT constructors (#27423)
by Andrei Borzenkov (@sand-witch) 03 Sep '26
by Andrei Borzenkov (@sand-witch) 03 Sep '26
03 Sep '26
Andrei Borzenkov pushed to branch wip/sand-witch/27423-gadt-parens at Glasgow Haskell Compiler / GHC
Commits:
7f0908b3 by Andrei Borzenkov at 2026-09-03T10:44:47+04:00
Parentheses in prefix GADT constructors (#27423)
Updated `splitLHsGadtTy` to allow looking
through the parentheses for inner binders. General example
of a code pattern that's allowed now:
data S a where
MkS :: (forall a. S a)
That should work now with any combination of nested
foralls and parentheses.
We don't perform parenthesis unwrapping for record
GADT constructors in accordance with GHC Proposal #402.
To this end `con_inner_bndrs` no longer stores plain forall
telescopes: `[HsForAllTelescope pass]` is replaced with
`[LHsGadtTelescope pass]`, a new `HsArg`-style type whose
`HsGadtForAll` holds an inner telescope and whose `HsGadtPar`
holds a pair of parentheses. The parentheses carry no meaning
for renaming or type checking; the only reason to record them
is exact-printing.
Updated `pprConDecl` to improve the `parse == parse . ppr . parse`
property of GADT pretty-printing.
The pretty printer can now output code that's similar to this:
data T a where
MkT1 :: (forall a. T a)
MkT2 :: forall . forall a. T a
These are special cases of inner forall binders
for prefix GADT constructors, when we have either
implicit or zero explicit outer binders.
- - - - -
29 changed files:
- + changelog.d/allow-gadt-prefix-con-parens
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Type.hs
- docs/users_guide/exts/gadt_syntax.rst
- − testsuite/tests/gadt/T14320.stderr
- testsuite/tests/gadt/T18191.hs
- testsuite/tests/gadt/T18191.stderr
- + testsuite/tests/gadt/T27423a.hs
- + testsuite/tests/gadt/T27423b.hs
- + testsuite/tests/gadt/T27423b.stderr
- testsuite/tests/gadt/all.T
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/T27423c.hs
- testsuite/tests/printer/all.T
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
Changes:
=====================================
changelog.d/allow-gadt-prefix-con-parens
=====================================
@@ -0,0 +1,15 @@
+section: language
+synopsis: Allow parentheses in prefix GADT constructor declarations, as specified
+ by GHC Proposal #402 "Stable GADT constructor syntax".
+issues: #27423
+mrs: !16321
+
+description:
+ Parenthesized types are now accepted in prefix GADT constructor declarations,
+ even when they contain explicit ``forall`` quantifiers. For example:
+
+ data T where
+ MkT :: (forall a. a -> b -> T)
+
+ This is equivalent to ``MkT :: forall {b}. (forall a. a -> b -> T)``, so the
+ forall-or-nothing rule continues to be respected.
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -974,14 +974,37 @@ pprConDecl (ConDeclGADT { con_names = cons
, con_mb_cxt = mcxt, con_g_args = args
, con_res_ty = res_ty, con_modifiers = mods, con_doc = doc })
= pprMaybeWithDoc doc $ pprLHsModifiers mods <+> ppr_con_names (toList cons) <+> dcolon
- <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs
- <+> hsep (map pprHsForAllTelescope inner_bndrs)
- <+> pprLHsContext mcxt,
- sep (ppr_args args ++ [ppr res_ty]) ])
+ <+> sep [ppr_outer_bndrs, ppr_inner_bndrs (
+ sep [ pprLHsContext mcxt,
+ sep (ppr_args args ++ [ppr res_ty])])]
where
ppr_args (PrefixConGADT _ args) = map (pprHsConDeclFieldWith (\arr tyDoc -> tyDoc <+> pprHsModifiedFunArr arr)) args
ppr_args (RecConGADT _ fields) = [pprHsConDeclRecFields (unLoc fields) <+> arrow]
+ -- pprint all parentheses and foralls, so parse == parse . ppr . parse
+ ppr_inner_bndrs :: SDoc -> SDoc
+ ppr_inner_bndrs tyDoc = foldr ppr_inner_bndr (tyDoc <> close_parens) inner_bndrs
+
+ ppr_inner_bndr (L _ HsGadtPar{}) rest = lparen <> rest
+ ppr_inner_bndr (L _ (HsGadtForAll _ tele)) rest
+ | HsForAllInvis {hsf_invis_bndrs=[]} <- tele = empty_forall <+> rest
+ | otherwise = pprHsForAllTelescope tele <+> rest
+
+ -- for each open paren generate a closed one
+ close_parens = hcat [ rparen | L _ HsGadtPar{} <- inner_bndrs ]
+
+ -- pprint empty explicit outer forall as `forall.` if there are inner binders, because otherwise
+ -- `forall. forall a. ...` would become `forall a. ...` and that would parse into
+ -- different AST, thus breaking parse == parse . ppr . parse property
+ ppr_outer_bndrs
+ | HsOuterExplicit{hso_bndrs = []} <- outer_bndrs
+ , not (null inner_bndrs)
+ = empty_forall
+ | otherwise
+ = pprHsOuterSigTyVarBndrs outer_bndrs
+
+ empty_forall = forAllLit <> dot
+
ppr_con_names :: (OutputableBndr a) => [GenLocated l a] -> SDoc
ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -623,6 +623,11 @@ deriving instance Data (HsForAllTelescope GhcPs)
deriving instance Data (HsForAllTelescope GhcRn)
deriving instance Data (HsForAllTelescope GhcTc)
+-- deriving instance (DataIdLR p p) => Data (HsGadtTelescope p)
+deriving instance Data (HsGadtTelescope GhcPs)
+deriving instance Data (HsGadtTelescope GhcRn)
+deriving instance Data (HsGadtTelescope GhcTc)
+
-- deriving instance (DataIdLR p p) => Data (HsTyVarBndr p)
deriving instance (Data flag) => Data (HsTyVarBndr flag GhcPs)
deriving instance (Data flag) => Data (HsTyVarBndr flag GhcRn)
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -39,6 +39,7 @@ module GHC.Hs.Type (
HsLit(..),
HsIPName(..), hsIPNameFS,
HsArg(..), numVisibleArgs, pprHsArgsApp,
+ HsGadtTelescope(..),
LHsTypeArg, lhsTypeArgSrcSpan,
OutputableBndrFlag,
@@ -71,6 +72,7 @@ module GHC.Hs.Type (
hsLTyVarName, hsLTyVarNames,
hsForAllTelescopeBndrs,
hsForAllTelescopeNames,
+ gadtArgTelescopes, gadtTelescopeBndrs, mkHsGadtForAlls,
hsLTyVarLocName, hsExplicitLTyVarNames,
splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,
splitLHsPatSynTy,
@@ -621,6 +623,15 @@ hsForAllTelescopeNames :: HsForAllTelescope (GhcPass p) -> [IdP (GhcPass p)]
hsForAllTelescopeNames (HsForAllVis _ bndrs) = hsLTyVarNames bndrs
hsForAllTelescopeNames (HsForAllInvis _ bndrs) = hsLTyVarNames bndrs
+gadtArgTelescopes :: [LHsGadtTelescope (GhcPass p)] -> [HsForAllTelescope (GhcPass p)]
+gadtArgTelescopes args = [ tele | L _ (HsGadtForAll _ tele) <- args ]
+
+gadtTelescopeBndrs :: [LHsGadtTelescope (GhcPass p)] -> [LHsTyVarBndr ForAllTyFlag (GhcPass p)]
+gadtTelescopeBndrs = concatMap hsForAllTelescopeBndrs . gadtArgTelescopes
+
+mkHsGadtForAlls :: [HsForAllTelescope (GhcPass p)] -> [HsGadtTelescope (GhcPass p)]
+mkHsGadtForAlls = map (HsGadtForAll noExtField)
+
hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)]
-- Explicit variables only
hsExplicitLTyVarNames qtvs = hsLTyVarNames (hsQTvExplicit qtvs)
@@ -750,6 +761,14 @@ type instance XArgPar (GhcPass _) = SrcSpan
type instance XXArg (GhcPass _) = DataConCantHappen
+type instance XGadtForAll (GhcPass _) = NoExtField
+
+type instance XGadtPar GhcPs = (EpToken "(", EpToken ")")
+type instance XGadtPar GhcRn = NoExtField
+type instance XGadtPar GhcTc = NoExtField
+
+type instance XXGadtArg (GhcPass _) = DataConCantHappen
+
type instance XPrefixCon (GhcPass p) = NoExtField
type instance XInfixCon (GhcPass p) = NoExtField
type instance XRecCon (GhcPass p) = (EpToken "{", EpToken "}")
@@ -877,44 +896,55 @@ splitLHsSigmaTyInvis ty
= (tvs, ctxt, ty2)
-- | Decompose a GADT type into its constituent parts.
--- Returns @(outer_bndrs, mb_ctxt, body)@, where:
+-- Returns @(outer_bndrs, inner_bndrs, mb_ctxt, body)@, where:
--
-- * @outer_bndrs@ are 'HsOuterExplicit' if the type has explicit, outermost
-- type variable binders. Otherwise, they are 'HsOuterImplicit'.
--
+-- * @inner_bndrs@ are the remaining @forall@ telescopes, interleaved with the
+-- parentheses that enclose them.
+--
-- * @mb_ctxt@ is @Just@ the context, if it is provided.
-- Otherwise, it is @Nothing@.
--
-- * @body@ is the body of the type after the optional @forall@s and context.
--
--- This function is careful not to look through parentheses.
+-- This function does look through parentheses, but it does not discard them:
+-- they are syntactically significant, so they are recorded in @inner_bndrs@.
-- See @Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)@
--- "GHC.Hs.Decls" for why this is important.
+-- in "GHC.Hs.Decls" for why this is important.
splitLHsGadtTy ::
LHsSigType GhcPs
- -> (HsOuterSigTyVarBndrs GhcPs, [HsForAllTelescope GhcPs], Maybe (LHsContext GhcPs), LHsType GhcPs)
+ -> (HsOuterSigTyVarBndrs GhcPs, [LHsGadtTelescope GhcPs], Maybe (LHsContext GhcPs), LHsType GhcPs)
splitLHsGadtTy (L _ sig_ty)
| (outer_bndrs, sigma_ty) <- split_outer_bndrs sig_ty
, (inner_bndrs, phi_ty) <- split_inner_bndrs sigma_ty
, (mb_ctxt, rho_ty) <- splitLHsQualTy_KP phi_ty
- = case rho_ty of
- L _ (HsFunTy _ _ (L _ (XHsType HsRecTy{})) _) | not (null inner_bndrs)
+ = if is_gadt_rec_ty rho_ty && not (null inner_bndrs)
-- Bad! Record GADTs are not allowed to have inner_bndrs,
-- undo the split to get a proper error message later
- -> (outer_bndrs, [], Nothing, sigma_ty)
- _ -> (outer_bndrs, inner_bndrs, mb_ctxt, rho_ty)
+ then (outer_bndrs, [], Nothing, sigma_ty)
+ else (outer_bndrs, inner_bndrs, mb_ctxt, rho_ty)
where
split_outer_bndrs :: HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs)
split_outer_bndrs (HsSig{sig_bndrs = outer_bndrs, sig_body = body_ty}) =
(outer_bndrs, body_ty)
- split_inner_bndrs :: LHsType GhcPs -> ([HsForAllTelescope GhcPs], LHsType GhcPs)
- split_inner_bndrs (L _ HsForAllTy { hst_tele = tele
+ split_inner_bndrs ::
+ LHsType GhcPs -> ([LHsGadtTelescope GhcPs], LHsType GhcPs)
+ split_inner_bndrs (L l HsForAllTy { hst_tele = tele
, hst_body = body })
- = let ~(teles, t) = split_inner_bndrs body
- in (tele:teles, t)
+ = let ~(args, t) = split_inner_bndrs body
+ in (L l (HsGadtForAll noExtField tele) : args, t)
+ split_inner_bndrs (L l (HsParTy toks ty))
+ = let ~(args, t) = split_inner_bndrs ty
+ in (L l (HsGadtPar toks) : args, t)
split_inner_bndrs t = ([], t)
+ -- type of form {fld :: ty, ...} -> ResTy
+ is_gadt_rec_ty (L _ (HsFunTy _ _ (L _ (XHsType HsRecTy{})) _)) = True
+ is_gadt_rec_ty _ = False
+
-- | Decompose a type of the form @forall <tvs>. body@ into its constituent
-- parts. Only splits type variable binders that
-- were quantified invisibly (e.g., @forall a.@, with a dot).
@@ -1283,6 +1313,11 @@ instance OutputableBndrId p
ppr (HsForAllInvis { hsf_invis_bndrs = bndrs }) =
text "HsForAllInvis:" <+> ppr bndrs
+instance OutputableBndrId p
+ => Outputable (HsGadtTelescope (GhcPass p)) where
+ ppr (HsGadtForAll _ tele) = text "HsGadtForAll" <+> ppr tele
+ ppr (HsGadtPar _) = text "HsGadtPar"
+
instance (OutputableBndrId p, OutputableBndrFlag flag p)
=> Outputable (HsTyVarBndr flag (GhcPass p)) where
ppr = pprTyVarBndr
@@ -1611,3 +1646,5 @@ type instance Anno (HsConDeclRecField (GhcPass p)) = SrcSpanAnnA
type instance Anno (FieldOcc (GhcPass p)) = SrcSpanAnnA
type instance Anno (HsModifierOf ty (GhcPass p)) = SrcSpanAnnA
+
+type instance Anno (HsGadtTelescope (GhcPass p)) = SrcSpanAnnA
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -924,11 +924,13 @@ repC (L l (ConDeclGADT { con_names = cons
= notHandledL (locA l) ThDataConVisibleForall
where
- no_explicit_forall = nullOuterExplicit outer_bndrs && null inner_bndrs
+ inner_teles = gadtArgTelescopes inner_bndrs
+
+ no_explicit_forall = nullOuterExplicit outer_bndrs && null inner_teles
no_context = isNothing mcxt
m_invis_inner_bndrs :: Maybe [[LHsTyVarBndr Specificity GhcRn]]
- m_invis_inner_bndrs = traverse get_invis_bndrs inner_bndrs
+ m_invis_inner_bndrs = traverse get_invis_bndrs inner_teles
get_invis_bndrs :: HsForAllTelescope GhcRn -> Maybe [LHsTyVarBndr Specificity GhcRn]
get_invis_bndrs HsForAllVis{} = Nothing
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -1789,7 +1789,7 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where
HsOuterExplicit{} -> []
exp_bndrs =
[ L l (updateHsTyVarBndrFlag Invisible b) | L l b <- hsOuterExplicitBndrs outer_bndrs ]
- ++ concatMap hsForAllTelescopeBndrs inner_bndrs
+ ++ concatMap hsForAllTelescopeBndrs (gadtArgTelescopes inner_bndrs)
ConDeclH98 { con_name = name, con_ex_tvs = qvars
, con_mb_cxt = ctx, con_args = dets
, con_doc = doc} ->
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -28,8 +28,7 @@ module GHC.Rename.HsType (
checkPrecMatch, checkSectionPrec,
-- Binding related stuff
- bindHsOuterTyVarBndrs, bindHsForAllTelescope,
- bindHsForAllTelescopes,
+ bindHsOuterTyVarBndrs, bindHsForAllTelescope, bindHsGadtTelescopes,
bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..),
rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars,
FreeKiTyVars, filterInScopeM,
@@ -37,7 +36,7 @@ module GHC.Rename.HsType (
extractHsTysRdrTyVars, extractRdrKindSigVars,
extractConDeclGADTDetailsTyVars, extractDataDefnKindVars,
extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars,
- extractHsForAllTelescopes,
+ extractHsGadtTelescopes,
nubL, nubN,
-- Error helpers
@@ -1249,16 +1248,19 @@ bindHsForAllTelescope doc tele thing_inside =
checkForAllTelescopeWildcardBndrs doc bndrs'
thing_inside $ mkHsForAllInvisTele noAnn bndrs'
-bindHsForAllTelescopes :: HsDocContext
- -> [HsForAllTelescope GhcPs]
- -> ([HsForAllTelescope GhcRn] -> RnM (a, FreeNames))
- -> RnM (a, FreeNames)
-bindHsForAllTelescopes _ [] thing_inside =
+bindHsGadtTelescopes :: HsDocContext
+ -> [LHsGadtTelescope GhcPs]
+ -> ([LHsGadtTelescope GhcRn] -> RnM (a, FreeNames))
+ -> RnM (a, FreeNames)
+bindHsGadtTelescopes _ [] thing_inside =
thing_inside []
-bindHsForAllTelescopes doc (tele:teles) thing_inside =
- bindHsForAllTelescope doc tele $ \tele' ->
- bindHsForAllTelescopes doc teles $ \teles' ->
- thing_inside (tele':teles')
+bindHsGadtTelescopes doc (L l HsGadtPar{} : args) thing_inside =
+ bindHsGadtTelescopes doc args $ \args' ->
+ thing_inside (L l (HsGadtPar noExtField) : args')
+bindHsGadtTelescopes doc (L l (HsGadtForAll _ tele) : args) thing_inside =
+ bindHsForAllTelescope doc tele $ \tele' ->
+ bindHsGadtTelescopes doc args $ \args' ->
+ thing_inside (L l (HsGadtForAll noExtField tele') : args')
-- See Note [Wildcard binders in disallowed contexts] in GHC.Hs.Type
checkForAllTelescopeWildcardBndrs :: HsDocContext
@@ -2286,13 +2288,15 @@ extractHsOuterTvBndrs outer_bndrs body_fvs =
HsOuterImplicit{} -> body_fvs
HsOuterExplicit{hso_bndrs = bndrs} -> extract_hs_tv_bndrs bndrs [] body_fvs
-extractHsForAllTelescopes :: [HsForAllTelescope GhcPs]
- -> FreeKiTyVars -- Free in body
- -> FreeKiTyVars -- Free in result
-extractHsForAllTelescopes [] body_fvs = body_fvs
-extractHsForAllTelescopes (tele:teles) body_fvs =
+extractHsGadtTelescopes :: [LHsGadtTelescope GhcPs]
+ -> FreeKiTyVars -- Free in body
+ -> FreeKiTyVars -- Free in result
+extractHsGadtTelescopes [] body_fvs = body_fvs
+extractHsGadtTelescopes (L _ HsGadtPar{} : args) body_fvs =
+ extractHsGadtTelescopes args body_fvs
+extractHsGadtTelescopes (L _ (HsGadtForAll _ tele) : args) body_fvs =
extract_hs_for_all_telescope tele [] $
- extractHsForAllTelescopes teles body_fvs
+ extractHsGadtTelescopes args body_fvs
extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs]
-> FreeKiTyVars -- Accumulator
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -2644,7 +2644,7 @@ rnConDecl (ConDeclGADT { con_names = names
-- See #14808.
implicit_bndrs =
extractHsOuterTvBndrs outer_bndrs $
- extractHsForAllTelescopes inner_bndrs $
+ extractHsGadtTelescopes inner_bndrs $
extractHsTysRdrTyVars (hsConDeclTheta mcxt) $
extractConDeclGADTDetailsTyVars args $
extractHsTysRdrTyVars [res_ty] []
@@ -2652,7 +2652,7 @@ rnConDecl (ConDeclGADT { con_names = names
; let ctxt = ConDeclCtx (toList new_names)
; bindHsOuterTyVarBndrs ctxt Nothing implicit_bndrs outer_bndrs $ \outer_bndrs' ->
- bindHsForAllTelescopes ctxt inner_bndrs $ \inner_bndrs' ->
+ bindHsGadtTelescopes ctxt inner_bndrs $ \inner_bndrs' ->
do { (new_cxt, fvs1) <- rnMbContext ctxt mcxt
; (new_args, fvs2) <- rnConDeclGADTDetails (unLoc (head new_names)) ctxt args
; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -3549,12 +3549,12 @@ tcOuterTKBndrsX skol_mode skol_info outer_bndrs thing_inside
---------------
tcGadtConTyVarBndrs :: SkolemInfo
-> HsOuterSigTyVarBndrs GhcRn
- -> [HsForAllTelescope GhcRn]
+ -> [LHsGadtTelescope GhcRn]
-> TcM a -> TcM ([TcTyVarBinder], a)
tcGadtConTyVarBndrs skol_info outer inner thing_inside
= do { (outer_bndrs, (inner_tvbs, a)) <-
tcOuterTKBndrs skol_info outer $
- tcExplicitTKBndrs skol_info (concatMap hsForAllTelescopeBndrs inner) $
+ tcExplicitTKBndrs skol_info (gadtTelescopeBndrs inner) $
thing_inside
; outer_bndrs <- scopedSortOuter outer_bndrs
; let outer_tvbs = tyVarSpecToBinders (outerTyVarBndrs outer_bndrs)
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -2287,7 +2287,7 @@ kcConDecl new_or_data _tc_res_kind
bind_con_tvbs outer_bndrs inner_bndrs thing_inside
-- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs]
= discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $
- bindExplicitTKBndrs_Tv (concatMap hsForAllTelescopeBndrs inner_bndrs) $
+ bindExplicitTKBndrs_Tv (gadtTelescopeBndrs inner_bndrs) $
thing_inside
{- Note [kcConDecls: kind-checking data type decls]
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -961,8 +961,9 @@ data ConDecl pass
-- cf. HsSigType that also stores the outermost sig_bndrs separately
-- from the forall telescopes in sig_body.
-- See Note [Representing type signatures] in Language.Haskell.Syntax.Type
- , con_inner_bndrs :: [HsForAllTelescope pass]
- -- ^ The forall telescopes other than the outermost invisible forall.
+ , con_inner_bndrs :: [LHsGadtTelescope pass]
+ -- ^ The forall telescopes other than the outermost invisible forall,
+ -- interleaved with the parentheses that enclose them.
, con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any)
, con_g_args :: HsConDeclGADTDetails pass -- ^ Arguments; never infix
, con_res_ty :: LHsType pass -- ^ Result type
@@ -1074,22 +1075,21 @@ the GADT type, in precisely that order. For instance:
MkT5 :: forall a. Int -> Eq a => a -> T
-- Rejected, `Eq a` is nested
MkT6 :: (forall a. a -> T)
- -- Rejected, `forall a` is nested due to the surrounding parentheses
- MkT7 :: (Eq a => a -> t)
- -- Rejected, `Eq a` is nested due to the surrounding parentheses
+ -- OK, the parentheses are recorded in con_inner_bndrs.
+ MkT7 :: (Eq a => a -> T)
+ -- OK, ditto
For the full details, see the "Formal syntax for GADTs" section of the GHC
User's Guide. GHC enforces that GADT constructors do not have nested `forall`s
-or contexts in two parts:
+or contexts in a single place:
-1. GHC, in the process of splitting apart a GADT's type,
- extracts out the leading `forall` and context (if they are provided). To
- accomplish this splitting, the renamer uses the
- GHC.Hs.Type.splitLHsGADTPrefixTy function, which is careful not to remove
- parentheses surrounding the leading `forall` or context (as these
- parentheses can be syntactically significant). If the third result returned
- by splitLHsGADTPrefixTy contains any `forall`s or contexts, then they must
- be nested, so they will be rejected.
+ GHC, in the process of splitting apart a GADT's type,
+ extracts out the leading `forall`s and context (if they are provided). To
+ accomplish this splitting, the parser uses the GHC.Hs.Type.splitLHsGadtTy
+ function, which records the parentheses that surround the leading `forall`s
+ in con_inner_bndrs (as these parentheses are syntactically significant).
+ If the body returned by splitLHsGadtTy still contains any `forall`s or
+ contexts, then they must be nested, so they will be rejected.
Note that this step applies to both prefix and record GADTs alike, as they
both have syntax which permits `forall`s and contexts. The difference is
@@ -1098,11 +1098,6 @@ or contexts in two parts:
* For prefix GADTs, this happens in the renamer (in rnConDecl), as we cannot
split until after the type operator fixities have been resolved.
* For record GADTs, this happens in the parser (in mkGadtDecl).
-2. If the GADT type is prefix, the renamer (in the ConDeclGADTPrefixPs case of
- rnConDecl) will then check for nested `forall`s/contexts in the body of a
- prefix GADT type, after it has determined what all of the argument types are.
- This step is necessary to catch examples like MkT4 above, where the nested
- quantification occurs after a visible argument type.
-}
-- | The arguments in a Haskell98-style data constructor.
=====================================
compiler/Language/Haskell/Syntax/Type.hs
=====================================
@@ -21,6 +21,7 @@ module Language.Haskell.Syntax.Type (
isHsBndrInvisible,
isHsBndrWildCard,
HsForAllTelescope(..),
+ HsGadtTelescope(..), LHsGadtTelescope, XGadtForAll, XGadtPar, XXGadtArg,
HsTyVarBndr(..), LHsTyVarBndr,
LHsQTyVars(..),
HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
@@ -392,6 +393,42 @@ data HsForAllTelescope pass
}
| XHsForAllTelescope !(XXHsForAllTelescope pass)
+-- | A type for interleaved GADT foralls and parentheses, inspired by HsArg.
+--
+-- Here's an example:
+--
+-- data D where
+-- MkD :: forall x y. -- these go to the `con_outer_bndrs` field
+-- forall a b. ( forall c. forall d. ( forall. ...
+-- ↑ ↑ ↑ ↑ ↑ ↑
+-- 1 2 3 4 5 6
+--
+-- That would correspond to a list
+--
+-- 1 → [ HsGadtForAll
+-- 2 → , HsGadtPar
+-- 3 → , HsGadtForAll
+-- 4 → , HsGadtForAll
+-- 5 → , HsGadtPar
+-- 6 → , HsGadtForAll
+-- , ...]
+data HsGadtTelescope pass
+ = HsGadtForAll !(XGadtForAll pass) (HsForAllTelescope pass)
+ | HsGadtPar !(XGadtPar pass)
+ -- ^ `HsGadtPar` is only usefull for pretty-printing/exact-printing for recovering
+ -- parenthisis interleaved with foralls.
+ --
+ -- This approach differs from `HsPar`, which wraps the inner expression as if
+ -- surrounding it with parentheses. We can ditch the `HsPar` approach because
+ -- we know that all parentheses will be closed after the return type.
+ | XHsGadtTelescope !(XXGadtArg pass)
+
+type LHsGadtTelescope pass = XRec pass (HsGadtTelescope pass)
+
+type family XGadtForAll pass
+type family XGadtPar pass
+type family XXGadtArg pass
+
-- | Located Haskell Type Variable Binder
type LHsTyVarBndr flag pass = XRec pass (HsTyVarBndr flag pass)
-- See Note [HsType binders]
=====================================
docs/users_guide/exts/gadt_syntax.rst
=====================================
@@ -201,12 +201,12 @@ syntactically allowed. Some further various observations about this grammar:
something like ``MkS :: Int -> (forall a. a) -> S`` is allowed, since
parentheses separate the ``forall`` from the ``->``.)
-- Furthermore, GADT constructors do not permit outermost parentheses that
- surround the ``foralls`` or ``opt_ctxt``, if at least one of them are
- used. For example, ``MkU :: (forall a. a -> U)`` would be rejected, since
- it would treat the ``forall`` as being nested.
+- GADT constructors permit outermost parentheses that surround the ``foralls``
+ or ``opt_ctxt``, as well as interleaved parentheses between multiple
+ ``foralls``. For example, ``MkU :: (forall a. a -> U)`` is accepted, as is
+ ``MkW :: forall a. (forall b. a -> b -> W)``.
- Note that it is acceptable to use parentheses in a ``prefix_gadt_body``.
+ Note that it is also acceptable to use parentheses in a ``prefix_gadt_body``.
For instance, ``MkV1 :: forall a. (a) -> (V1)`` is acceptable, as is
``MkV2 :: forall a. (a -> V2)``.
=====================================
testsuite/tests/gadt/T14320.stderr deleted
=====================================
@@ -1,4 +0,0 @@
-
-T14320.hs:17:14: error: [GHC-71492]
- GADT constructor type signature cannot contain nested ‘forall’s or contexts
- In the definition of data constructor ‘TEBad’
=====================================
testsuite/tests/gadt/T18191.hs
=====================================
@@ -2,15 +2,6 @@
{-# LANGUAGE RankNTypes #-}
module T18191 where
-data T where
- MkT :: (forall a. a -> b -> T)
-
-data S a where
- MkS :: (forall a. S a)
-
-data U a where
- MkU :: (Show a => U a)
-
data Z a where
MkZ1 :: forall a. forall b. { unZ1 :: (a, b) } -> Z (a, b)
MkZ2 :: Eq a => Eq b => { unZ1 :: (a, b) } -> Z (a, b)
=====================================
testsuite/tests/gadt/T18191.stderr
=====================================
@@ -1,28 +1,16 @@
-
-T18191.hs:6:11: error: [GHC-71492]
- • GADT constructor type signature cannot contain nested ‘forall’s or contexts
- • In the definition of data constructor ‘MkT’
-
-T18191.hs:9:11: error: [GHC-71492]
- • GADT constructor type signature cannot contain nested ‘forall’s or contexts
- • In the definition of data constructor ‘MkS’
-
-T18191.hs:12:11: error: [GHC-71492]
- • GADT constructor type signature cannot contain nested ‘forall’s or contexts
- • In the definition of data constructor ‘MkU’
-
-T18191.hs:15:21: error: [GHC-71492]
+T18191.hs:6:21: error: [GHC-71492]
• GADT constructor type signature cannot contain nested ‘forall’s or contexts
• In the definition of data constructor ‘MkZ1’
-T18191.hs:15:31: error: [GHC-89246]
+T18191.hs:6:31: error: [GHC-89246]
• Record syntax is illegal here: {unZ1 :: (a, b)}
• In the definition of data constructor ‘MkZ1’
-T18191.hs:16:19: error: [GHC-71492]
+T18191.hs:7:19: error: [GHC-71492]
• GADT constructor type signature cannot contain nested ‘forall’s or contexts
• In the definition of data constructor ‘MkZ2’
-T18191.hs:16:27: error: [GHC-89246]
+T18191.hs:7:27: error: [GHC-89246]
• Record syntax is illegal here: {unZ1 :: (a, b)}
• In the definition of data constructor ‘MkZ2’
+
=====================================
testsuite/tests/gadt/T27423a.hs
=====================================
@@ -0,0 +1,46 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RequiredTypeArguments #-}
+module T27423a where
+
+data G a where
+ MkG1 :: a -> G a
+ MkG2 :: (a -> G a)
+ MkG3 :: forall a. a -> G a
+ MkG4 :: forall a. (a -> G a)
+
+-- this is equivalent to `forall {b}. (forall a. a -> b -> T)`.
+data T where
+ MkT2 :: (forall a. a -> b -> T)
+
+-- this is equivalent to `forall. (forall a. S a)`.
+data S a where
+ MkS :: (forall a. S a)
+
+-- An explicit, empty outer forall combined with a parenthesised inner one.
+data W a where
+ MkW :: forall. (forall a. W a)
+
+-- A forall and a context combined inside the same parentheses, with no
+-- outer forall at all.
+data Y a where
+ MkY :: (forall a. Show a => a -> Y a)
+
+-- Multiple, redundant nested parentheses around the whole type should
+-- be accepted.
+data H a where
+ MkH :: ((a -> H a))
+
+-- An unparenthesised outer forall together with an independent,
+-- parenthesised inner forall.
+data I a where
+ MkI :: forall a. (forall b. I (b, a))
+
+-- Visible foralls, parenthesised and not.
+data V a b where
+ MkV1 :: forall a -> forall b. (Int -> V a b)
+ MkV2 :: forall a. (forall b -> (Bool -> V a b))
+
+data P a where
+ MkP1 :: Show a => (a -> P a)
+ MkP2 :: forall a. Int -> (a -> P a)
+ MkP3 :: (forall a. Show a => (Int -> (a -> P a)))
=====================================
testsuite/tests/gadt/T27423b.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE GADTs #-}
+module T27423b where
+
+-- Record-style GADT constructors must remain unparenthesisable, per
+-- GHC Proposal #402: this is out of scope for #27423 and should
+-- continue to be rejected.
+data T1 a where
+ MkT1 :: ({ fld :: a } -> T1 a)
+
+data T2 a where
+ MkT2 :: (forall a. { fld :: a } -> T2 a)
+
+-- Without parentheses, forall-or-nothing applies to the whole type, so
+-- `b` is not implicitly quantified and this must be rejected.
+data T3 where
+ MkT3 :: forall a. a -> b -> T3
+
+-- That should gone soon, but let's check that we didn't implement it
+-- earlier than we need to
+data T4 a where
+ MkT4 :: Show a => (forall b. a -> b -> T4 a)
=====================================
testsuite/tests/gadt/T27423b.stderr
=====================================
@@ -0,0 +1,19 @@
+T27423b.hs:8:12: error: [GHC-89246]
+ • Record syntax is illegal here: {fld :: a}
+ • In the definition of data constructor ‘MkT1’
+
+T27423b.hs:11:12: error: [GHC-71492]
+ • GADT constructor type signature cannot contain nested ‘forall’s or contexts
+ • In the definition of data constructor ‘MkT2’
+
+T27423b.hs:11:22: error: [GHC-89246]
+ • Record syntax is illegal here: {fld :: a}
+ • In the definition of data constructor ‘MkT2’
+
+T27423b.hs:16:26: error: [GHC-76037]
+ Not in scope: type variable ‘b’
+
+T27423b.hs:21:22: error: [GHC-71492]
+ • GADT constructor type signature cannot contain nested ‘forall’s or contexts
+ • In the definition of data constructor ‘MkT4’
+
=====================================
testsuite/tests/gadt/all.T
=====================================
@@ -114,7 +114,7 @@ test('T7558', normal, compile, [''])
test('T9380', normal, compile_and_run, [''])
test('T12087', normal, compile_fail, [''])
test('T12468', normal, compile_fail, [''])
-test('T14320', normal, compile_fail, [''])
+test('T14320', normal, compile, [''])
test('T14719', normal, compile_fail, ['-fdiagnostics-show-caret'])
test('T14808', normal, compile, [''])
test('T15009', normal, compile, [''])
@@ -132,3 +132,6 @@ test('T19847b', normal, compile, [''])
test('T23022', normal, compile, ['-dcore-lint'])
test('T23023', normal, compile_fail, ['-O -dcore-lint']) # todo: move this test?
test('T23298', normal, compile_fail, [''])
+
+test('T27423a', normal, compile, [''])
+test('T27423b', normal, compile_fail, [''])
=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -937,3 +937,8 @@ PprQualifiedStrings:
Haddock1:
# $(CHECK_PPR) $(LIBDIR) Haddock1.hs
$(CHECK_EXACT) $(LIBDIR) Haddock1.hs
+
+.PHONY: T27423c
+T27423c:
+ $(CHECK_PPR) $(LIBDIR) T27423c.hs
+ $(CHECK_EXACT) $(LIBDIR) T27423c.hs
=====================================
testsuite/tests/printer/T27423c.hs
=====================================
@@ -0,0 +1,46 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RequiredTypeArguments #-}
+module T27423c where
+
+-- Exact-printing regression test
+-- Not every declaration there would pass renamer without errors
+data G a where
+ MkG1 :: a -> G a
+ MkG2 :: (a -> G a)
+ MkG3 :: forall a. a -> G a
+ MkG4 :: forall a. (a -> G a)
+
+data T where
+ MkT1 :: forall a. a -> b -> T
+ MkT2 :: (forall a. a -> b -> T)
+
+data S a where
+ MkS :: (forall a. S a)
+ MkS2 :: forall. (forall a. S a)
+ MkS3 :: forall. forall a. S a
+ MkS4 :: forall a. forall. forall b. forall. forall. forall c. S a
+
+data U a where
+ MkU :: (Show a => U a)
+
+data V a where
+ MkV1 :: ((a -> V a))
+ MkV2 :: forall a. (forall b. V (b, a))
+ MkV3 :: (forall a. Show a => a -> V a)
+ MkV4 :: forall a. ((forall b. (Show a => a -> (b -> V a))))
+
+data W a b where
+ MkW1 :: forall a -> forall b. (Int -> W a b)
+ MkW2 :: forall a. (forall b -> (Bool -> W a b))
+
+data P a where
+ MkP1 :: Show a => (a -> P a)
+ MkP2 :: forall a. Int -> (a -> P a)
+
+-- Comments in and around the parentheses
+data C a where
+ MkC1 :: -- comment before the parenthesis
+ (forall a. C a)
+ MkC2 :: ( -- comment after the parenthesis
+ forall a. C a)
+ MkC3 :: (forall a. {- inline comment -} C a)
=====================================
testsuite/tests/printer/all.T
=====================================
@@ -224,3 +224,4 @@ test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNa
test('PprModifiers', [ignore_stderr,req_ppr_deps], makefile_test, ['PprModifiers'])
test('PprQualifiedStrings', [ignore_stderr,req_ppr_deps], makefile_test, ['PprQualifiedStrings'])
test('Haddock1', [ignore_stderr,req_ppr_deps], makefile_test, ['Haddock1'])
+test('T27423c', [ignore_stderr,req_ppr_deps], makefile_test, ['T27423c'])
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -370,6 +370,10 @@ cua CanUpdateAnchor f = f
cua CanUpdateAnchorOnly _ = return []
cua NoCanUpdateAnchor _ = return []
+enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a
+enterAnn = enterAnnWith exact setAnnotationAnchor
+
+{-# INLINE enterAnnWith #-}
-- | "Enter" an annotation, by using the associated 'anchor' field as
-- the new reference point for calculating all DeltaPos positions.
-- This is the heart of the exact printing process.
@@ -377,14 +381,17 @@ cua NoCanUpdateAnchor _ = return []
-- This is combination of the ghc=exactprint Delta.withAST and
-- Print.exactPC functions and effectively does the delta processing
-- immediately followed by the print processing. JIT ghc-exactprint.
-enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a
-enterAnn NoEntryVal a = do
+enterAnnWith :: (Monad m, Monoid w, Typeable a, Typeable b) =>
+ (a -> EP w m b) -> -- exact
+ (b -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> b) -> -- setAnnotationAnchor
+ Entry -> a -> EP w m b
+enterAnnWith exactVia _ NoEntryVal a = do
p <- getPosP
debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a)
- r <- exact a
+ r <- exactVia a
debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a)
return r
-enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
+enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
acceptSpan <- getAcceptSpan
setAcceptSpan False
case anchor' of
@@ -495,7 +502,7 @@ enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
advance edp
debugM $ "enterAnn:exact a starting:" ++ show (showAst anchor')
- a' <- exact a
+ a' <- exactVia a
debugM $ "enterAnn:exact a done:" ++ show (showAst anchor')
-- Core recursive exactprint done, start end of Entry processing
@@ -549,8 +556,8 @@ enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do
EpaSpan s -> EpaDelta s edp []
_ -> EpaDelta noSrcSpan edp []
let r = case canUpdateAnchor of
- CanUpdateAnchor -> setAnnotationAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs)
- CanUpdateAnchorOnly -> setAnnotationAnchor a' newAnchor [] emptyComments
+ CanUpdateAnchor -> setAnnAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs)
+ CanUpdateAnchorOnly -> setAnnAnchor a' newAnchor [] emptyComments
NoCanUpdateAnchor -> a'
return r
@@ -4262,21 +4269,22 @@ instance ExactPrint (ConDecl GhcPs) where
L _ (HsOuterImplicit _) -> return outer_bndrs
_ -> markAnnotated outer_bndrs
- inner_bndrs' <- mapM markAnnotated inner_bndrs
+ (inner_bndrs', (mcxt', args', res_ty')) <- markGadtArgs inner_bndrs $ do
+ mcxt' <- markAnnotated mcxt
+ args' <-
+ case args of
+ (PrefixConGADT x args0) -> do
+ args0' <- mapM markAnnotated args0
+ return (PrefixConGADT x args0')
+ (RecConGADT (oc,cc,rarr) fields) -> do
+ oc' <- markEpToken oc
+ fields' <- markAnnotated fields
+ cc' <- markEpToken cc
+ rarr' <- markEpUniToken rarr
+ return (RecConGADT (oc',cc',rarr') fields')
+ res_ty' <- markAnnotated res_ty
+ return (mcxt', args', res_ty')
- mcxt' <- markAnnotated mcxt
- args' <-
- case args of
- (PrefixConGADT x args0) -> do
- args0' <- mapM markAnnotated args0
- return (PrefixConGADT x args0')
- (RecConGADT (oc,cc,rarr) fields) -> do
- oc' <- markEpToken oc
- fields' <- markAnnotated fields
- cc' <- markEpToken cc
- rarr' <- markEpUniToken rarr
- return (RecConGADT (oc',cc',rarr') fields')
- res_ty' <- markAnnotated res_ty
return (ConDeclGADT { con_g_ext = AnnConDeclGADT [] [] dcol'
, con_names = cons'
, con_outer_bndrs = outer_bndrs'
@@ -4285,6 +4293,44 @@ instance ExactPrint (ConDecl GhcPs) where
, con_modifiers = mods'
, con_res_ty = res_ty', con_doc = doc })
+-- | Exact print the inner binders of a GADT signature.
+--
+-- It's that complicated because we need to mark comments/trailing anns
+-- stored inside `L` and mark closing parenthesis _after_ we mark inner
+-- type:
+--
+-- data T a b where
+-- MkT ::
+-- forall a. ( -- mark inside `markGadtArgs`
+-- forall b. some type -> T a b -- mark everything there
+-- ) -- mark inside `markGadtArgs`
+--
+-- We don't have the same problem for `HsArgPar` because we ignore it
+-- during exact-print, "Does not appear in original source"
+markGadtArgs :: (Monad m, Monoid w, Typeable a)
+ => [LHsGadtTelescope GhcPs] -> EP w m a
+ -> EP w m ([LHsGadtTelescope GhcPs], a)
+markGadtArgs args inner_action = go args
+ where
+ go [] = do
+ r <- inner_action
+ return ([], r)
+ go (arg:xs) = enterAnnWith (exact_arg xs) setAnchor (entryFromLocatedA arg) arg
+
+ exact_arg xs (L l (HsGadtForAll _ tele)) = do
+ tele' <- markAnnotated tele
+ (xs', r) <- go xs
+ return (L l (HsGadtForAll noExtField tele') : xs', r)
+ exact_arg xs (L l (HsGadtPar (lp, rp))) = do
+ lp' <- markEpToken lp
+ (xs', r) <- go xs
+ rp' <- markEpToken rp
+ return (L l (HsGadtPar (lp',rp')) : xs', r)
+
+ -- The binder just entered is the head of the returned list
+ setAnchor (arg':xs', r) anc ts cs = (setAnchorAn arg' anc ts cs : xs', r)
+ setAnchor ([], r) _ _ _ = ([], r)
+
-- ---------------------------------------------------------------------
instance ExactPrint Void where
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
=====================================
@@ -350,7 +350,7 @@ ppCtor
typeSig = operator name ++ " :: " ++ outHsSigType sDocContext con_sig_ty
name = out sDocContext $ unL <$> names
con_sig_ty = HsSig noExtField outer_bndrs $
- mkForallTys inner_bndrs phi_ty
+ mkGadtArgTys inner_bndrs phi_ty
where
phi_ty = case mcxt of
Just theta -> mkQualTy theta tau_ty
@@ -367,13 +367,14 @@ ppCtor
noLocA (HsQualTy{ hst_xqual = noExtField
, hst_ctxt = ctxt, hst_body = body})
- mkForallTy :: HsForAllTelescope GhcRn -> LHsType GhcRn -> LHsType GhcRn
- mkForallTy tele body =
- noLocA (HsForAllTy { hst_xforall = noExtField
+ mkGadtArgTy :: LHsGadtTelescope GhcRn -> LHsType GhcRn -> LHsType GhcRn
+ mkGadtArgTy (L l (HsGadtForAll _ tele)) body =
+ L l (HsForAllTy { hst_xforall = noExtField
, hst_tele = tele, hst_body = body })
+ mkGadtArgTy (L l HsGadtPar{}) body = L l (HsParTy noAnn body)
- mkForallTys :: [HsForAllTelescope GhcRn] -> LHsType GhcRn -> LHsType GhcRn
- mkForallTys = flip (foldr mkForallTy)
+ mkGadtArgTys :: [LHsGadtTelescope GhcRn] -> LHsType GhcRn -> LHsType GhcRn
+ mkGadtArgTys = flip (foldr mkGadtArgTy)
ppFixity :: SDocContext -> (Name, Fixity) -> [String]
ppFixity sDocContext (name, fixity) = [out sDocContext ((FixitySig noExtField (NoNamespaceSpecifier noExtField) [noLocA name] fixity) :: FixitySig GhcRn)]
=====================================
utils/haddock/haddock-api/src/Haddock/Convert.hs
=====================================
@@ -567,7 +567,7 @@ synifyDataCon use_gadt_syntax dc =
, hso_bndrs = map synifyTyVarBndr outer_tvbs
}
- inner_bndrs = mk_telescopes inner_tvbs
+ inner_bndrs = map noLocA $ mkHsGadtForAlls (mk_telescopes inner_tvbs)
mk_telescopes bs
| (invis, other) <- split_invis_tvbs bs, not (null invis)
=====================================
utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
=====================================
@@ -229,7 +229,7 @@ getGADTConType
( HsSig
{ sig_ext = noExtField
, sig_bndrs = unLoc outer_bndrs
- , sig_body = mkForallTys inner_bndrs phi_ty
+ , sig_body = mkGadtArgTys inner_bndrs phi_ty
}
)
where
@@ -251,13 +251,14 @@ getGADTConType
noLocA (HsQualTy{ hst_xqual = noAnn
, hst_ctxt = ctxt, hst_body = body})
- mkForallTy :: HsForAllTelescope DocNameI -> LHsType DocNameI -> LHsType DocNameI
- mkForallTy tele body =
- noLocA (HsForAllTy { hst_xforall = noAnn
+ mkGadtArgTy :: LHsGadtTelescope DocNameI -> LHsType DocNameI -> LHsType DocNameI
+ mkGadtArgTy (L l (HsGadtForAll _ tele)) body =
+ L l (HsForAllTy { hst_xforall = noAnn
, hst_tele = tele, hst_body = body })
+ mkGadtArgTy (L l HsGadtPar{}) body = L l (HsParTy noAnn body)
- mkForallTys :: [HsForAllTelescope DocNameI] -> LHsType DocNameI -> LHsType DocNameI
- mkForallTys = flip (foldr mkForallTy)
+ mkGadtArgTys :: [LHsGadtTelescope DocNameI] -> LHsType DocNameI -> LHsType DocNameI
+ mkGadtArgTys = flip (foldr mkGadtArgTy)
getGADTConType (ConDeclH98{}) = panic "getGADTConType"
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
=====================================
@@ -476,6 +476,11 @@ renameHsBndrVis :: HsBndrVis GhcRn -> RnM (HsBndrVis DocNameI)
renameHsBndrVis (HsBndrRequired _) = return (HsBndrRequired noExtField)
renameHsBndrVis (HsBndrInvisible at) = return (HsBndrInvisible at)
+renameHsGadtTelescope :: LHsGadtTelescope GhcRn -> RnM (LHsGadtTelescope DocNameI)
+renameHsGadtTelescope (L l HsGadtPar{}) = pure $ L l $ HsGadtPar noExtField
+renameHsGadtTelescope (L l (HsGadtForAll _ tele)) =
+ L l . HsGadtForAll noExtField <$> renameHsForAllTelescope tele
+
renameHsForAllTelescope :: HsForAllTelescope GhcRn -> RnM (HsForAllTelescope DocNameI)
renameHsForAllTelescope tele = case tele of
HsForAllVis _ bndrs -> do
@@ -761,7 +766,7 @@ renameCon
} = do
lnames' <- mapM renameNameL lnames
outer_bndrs' <- mapM renameOuterTyVarBndrs outer_bndrs
- inner_bndrs' <- mapM renameHsForAllTelescope inner_bndrs
+ inner_bndrs' <- mapM renameHsGadtTelescope inner_bndrs
lcontext' <- traverse renameLContext lcontext
details' <- renameGADTDetails details
res_ty' <- renameLType res_ty
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -840,6 +840,7 @@ type instance Anno (CType DocNameI) = SrcSpanAnnA
type instance Anno (Header DocNameI) = SrcSpanAnnA
type instance Anno (HsModifierOf (LocatedA (HsType DocNameI)) DocNameI) = SrcSpanAnnA
type instance Anno (HsContextDetails DocNameI a) = SrcSpanAnnA
+type instance Anno (HsGadtTelescope DocNameI) = SrcSpanAnnA
type XRecCond a =
( XParTy a ~ (EpToken "(", EpToken ")")
@@ -904,6 +905,10 @@ type instance XHsForAllVis DocNameI = NoExtField
type instance XHsForAllInvis DocNameI = NoExtField
type instance XXHsForAllTelescope DocNameI = DataConCantHappen
+type instance XGadtForAll DocNameI = NoExtField
+type instance XGadtPar DocNameI = NoExtField
+type instance XXGadtArg DocNameI = DataConCantHappen
+
type instance XTyVarBndr DocNameI = NoExtField
type instance XXTyVarBndr DocNameI = DataConCantHappen
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f0908b38e005214aae32c177c5a739…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f0908b38e005214aae32c177c5a739…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
Zubin pushed new branch wip/9.14.2-rc2 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/9.14.2-rc2
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
Bodigrim pushed new branch wip/no-bitSize at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/no-bitSize
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/dcoutts/printf-warnings] FIXUP: yet more format fixes, found in CI
by Duncan Coutts (@dcoutts) 02 Sep '26
by Duncan Coutts (@dcoutts) 02 Sep '26
02 Sep '26
Duncan Coutts pushed to branch wip/dcoutts/printf-warnings at Glasgow Haskell Compiler / GHC
Commits:
13570c2f by Duncan Coutts at 2026-09-02T23:31:01+01:00
FIXUP: yet more format fixes, found in CI
- - - - -
4 changed files:
- rts/Messages.c
- rts/STM.c
- rts/posix/Poll.c
- rts/sm/GC.c
Changes:
=====================================
rts/Messages.c
=====================================
@@ -134,8 +134,8 @@ loop:
if (i == &stg_MSG_TRY_WAKEUP_info)
{
StgTSO *tso = ((MessageWakeup *)m)->tso;
- debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %"
- FMT_StgThreadID, tso->id);
+ debugTraceCap(DEBUG_sched, cap,
+ "message: try wakeup thread %" FMT_StgThreadID, tso->id);
tryWakeupThread(cap, tso);
}
else if (i == &stg_MSG_THROWTO_info)
@@ -150,8 +150,8 @@ loop:
goto loop;
}
- debugTraceCap(DEBUG_sched, cap, "message: throwTo %ld -> %ld",
- (W_)t->source->id, (W_)t->target->id);
+ debugTraceCap(DEBUG_sched, cap, "message: throwTo %" FMT_StgThreadID
+ " -> %" FMT_StgThreadID, t->source->id, t->target->id);
r = throwToMsg(cap, t);
=====================================
rts/STM.c
=====================================
@@ -781,7 +781,7 @@ static StgBool validate_and_acquire_ownership (Capability *cap,
result = false;
BREAK_FOR_EACH;
} else {
- TRACE("%p : need to check version %ld", trec, e -> num_updates);
+ TRACE("%p : need to check version %" FMT_Int, trec, e->num_updates);
}
});
}
@@ -816,7 +816,8 @@ static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
StgTVar *s;
s = e -> tvar;
if (entry_is_read_only(e)) {
- TRACE("%p : check_read_only for TVar %p, saw %ld", trec, s, e -> num_updates);
+ TRACE("%p : check_read_only for TVar %p, saw %" FMT_Int,
+ trec, s, e->num_updates);
// We must first load current_value then num_updates; this is inverse of
// the order of the stores in stmCommitTransaction.
@@ -1200,7 +1201,7 @@ of these false-positives causing actual issues.
StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec, StgBool optimistically) {
StgTRecHeader *t;
- TRACE("%p : stmValidateNestOfTransactions, %b", trec, optimistically);
+ TRACE("%p : stmValidateNestOfTransactions, %d", trec, optimistically);
ASSERT(trec != NO_TREC);
ASSERT((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_WAITING) ||
=====================================
rts/posix/Poll.c
=====================================
@@ -432,13 +432,13 @@ void pollCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
debugTrace(DEBUG_iomanager,
"ppoll(nfds = %lu, timeout.sec = 0, timeout.nsec = 0) = %d",
- nfds, res);
+ (unsigned long) nfds, res);
#else
int res = poll(poll_table, nfds, 0);
debugTrace(DEBUG_iomanager,
"poll(nfds = %lu, timeout_ms = 0) = %d",
- nfds, res);
+ (unsigned long) nfds, res);
#endif
if (res == 0) {
/* There is no I/O ready. We'll return to the scheduler. */
@@ -513,8 +513,9 @@ bool awaitCompletedTimeoutsOrIOPoll(CapIOManager *iomgr)
debugTrace(DEBUG_iomanager,
"ppoll(nfds = %lu, timeout.sec = %lu, timeout.nsec = %lu) = %d",
- nfds, timeout_ns == NULL ? -1 : timeout_ns->tv_sec,
- timeout_ns == NULL ? 0 : timeout_ns->tv_nsec,
+ (unsigned long) nfds,
+ timeout_ns == NULL ? -1 : timeout_ns->tv_sec,
+ timeout_ns == NULL ? 0 : timeout_ns->tv_nsec,
res);
#else
int res = poll(poll_table, nfds, timeout_ms);
=====================================
rts/sm/GC.c
=====================================
@@ -636,13 +636,13 @@ GarbageCollect (struct GcConfig config,
if(idle_cap[i]) { continue; }
thread = gc_threads[i];
debugTrace(DEBUG_gc,"thread %d:", i);
- debugTrace(DEBUG_gc," copied %ld",
+ debugTrace(DEBUG_gc," copied %" FMT_Word,
RELAXED_LOAD(&thread->copied) * sizeof(W_));
- debugTrace(DEBUG_gc," scanned %ld",
+ debugTrace(DEBUG_gc," scanned %" FMT_Word,
RELAXED_LOAD(&thread->scanned) * sizeof(W_));
- debugTrace(DEBUG_gc," any_work %ld",
+ debugTrace(DEBUG_gc," any_work %" FMT_Word,
RELAXED_LOAD(&thread->any_work));
- debugTrace(DEBUG_gc," scav_find_work %ld",
+ debugTrace(DEBUG_gc," scav_find_work %" FMT_Word ,
RELAXED_LOAD(&thread->scav_find_work));
any_work += RELAXED_LOAD(&thread->any_work);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13570c2f3f71d269e30b400623cb14d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/13570c2f3f71d269e30b400623cb14d…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
Simon Peyton Jones pushed to branch wip/T26543b at Glasgow Haskell Compiler / GHC
Commits:
fd273d9e by Simon Peyton Jones at 2026-09-02T23:17:05+01:00
wibble
- - - - -
1 changed file:
- compiler/GHC/Tc/Utils/Unify.hs
Changes:
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -3651,6 +3651,7 @@ simpleUnifyCheck caller given_eq_lvl lhs_tv rhs
lhs_info = metaTyVarInfo lhs_tv
lhs_tv_lvl = tcTyVarLevel lhs_tv
lhs_tv_is_concrete = isConcreteTyVar lhs_tv
+ lhs_tv_nm = tyVarName lhs_tv
forall_ok = case caller of
UC_QuickLook -> isQLInstTyVar lhs_tv
@@ -3670,7 +3671,7 @@ simpleUnifyCheck caller given_eq_lvl lhs_tv rhs
-- c.f. checkTyVar, the TEFTyVar case
| tcTyVarLevel tv `strictlyDeeperThan` lhs_tv_lvl = False
| lhs_tv_is_concrete, not (isConcreteTyVar tv) = False
- | simple_occurs_check lhs_tv tv = False
+ | simple_occurs_check lhs_tv_nm tv = False
| otherwise = True
rhs_is_ok (FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r})
@@ -4725,12 +4726,12 @@ simpleOccursCheck (OC_Check lhs_tv occ_prob) occ_tv
| simple_occurs_check lhs_tv occ_tv = TyVarCheck_Error (cteProblem occ_prob)
| otherwise = TyVarCheck_Success
-simple_occurs_check :: TcTyVar -> TcTyVar -> Bool -- True <=> occurs check
+simple_occurs_check :: Name -> TcTyVar -> Bool -- True <=> occurs check
-- Check for an occurrence of lhs_tv in occ_tv or its kind
simple_occurs_check lhs_tv occ_tv
- | lhs_tv == tyVarName occ_tcv = True
- | anyFreeVarsOfType check_fv (tyVarKind occ_tcv) = True
- | otherwise = False
+ | lhs_tv == tyVarName occ_tv = True
+ | anyFreeVarsOfType (simple_occurs_check lhs_tv) (tyVarKind occ_tv) = True
+ | otherwise = False
-------------------------
tyVarLevelCheck :: LevelCheck m -> TcTyVar -> TyVarCheckResult m
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd273d9e52242796f1d1277b8d85820…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd273d9e52242796f1d1277b8d85820…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0