[Git][ghc/ghc][wip/sand-witch/27423-gadt-parens] Parentheses in prefix GADT constructors (#27423)
by Andrei Borzenkov (＠sand-witch) 11 Aug '26
by Andrei Borzenkov (＠sand-witch) 11 Aug '26
11 Aug '26
Andrei Borzenkov pushed to branch wip/sand-witch/27423-gadt-parens at Glasgow Haskell Compiler / GHC
Commits:
e9eea6e4 by Andrei Borzenkov at 2026-08-11T10:30:39+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
`[LHsGadtArg 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.
- - - - -
31 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
- − 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/parser/should_compile/T27423d.hs
- + testsuite/tests/parser/should_compile/T27423d.stderr
- testsuite/tests/parser/should_compile/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
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9eea6e473e3695fb24e58bd3e71b8a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9eea6e473e3695fb24e58bd3e71b8a…
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] 5 commits: driver: Link object files in a deterministic order
by Marge Bot (＠marge-bot) 11 Aug '26
by Marge Bot (＠marge-bot) 11 Aug '26
11 Aug '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
e8d1a0d6 by Bernhard M. Wiedemann at 2026-08-10T21:31:23-04:00
driver: Link object files in a deterministic order
The object files handed to the linker come from the HomePackageTable,
which is ordered by the order in which modules finished compiling. With
-j1 that is the build plan order, with -jN it is whatever the scheduler
produced, so the same sources can link to different (but equivalent)
binaries.
The order reaches the output: .text and .rodata contributions are
concatenated in link order, so e.g. building the hdav executable of the
DAV package twice, once with -j1 and once with -j4, yields two binaries
that differ in ~100kB of section contents.
Sort the home modules by module before collecting their linkables,
guarded under `Opt_ObjectDeterminism` .
Fixes #27612
Signed-off-by: Bernhard M. Wiedemann <bwiedemann(a)suse.de>
- - - - -
556db2f3 by sheaf at 2026-08-10T21:32:06-04:00
Reduce SpecConstr threshold in GHC.Tc.Solver.Rewrite
As remarked in #27628, this module currently sits on a knife's edge: if
the body of 'simplifyArgsWorker' is made even a tiny bit smaller, then
SpecConstr suddenly kicks in and causes disastrous reboxing of the
LiftingContext argument.
To make this less likely to happen, this commit lowers the SpecConstr
threshold.
- - - - -
d9c3e8a6 by sheaf at 2026-08-10T22:10:21-04:00
Allow rewriting in RuntimeReps for newtype ConPats
This commit implements PHASE 2 of the FixedRuntimeRep plan described in
Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete for newtype
constructor patterns.
In short, GHC now accepts programs of the form
f (MkN x) = ...
in which the argument 'x' of the newtype constructor pattern 'MkN x'
has a representation that is not syntactically concrete, e.g. it can be
'Id IntRep' reducing to 'IntRep'. See T20363{,b,c} for examples.
There are two main parts to the implementation:
1. Typechecking, in GHC.Tc.Gen.Pat.tcDataConPat.
See Note [Typechecking newtype constructor patterns] in GHC.Tc.Gen.Pat.
2. Desugaring. We restructure the code for desugaring pattern matches
by allowing the scrutinised match variable to be casted. This allows
us to accumulate coercions and avoids creating binders at intermediate
types tha don't have a fixed RuntimeRep.
See the revamped Note [Match Ids] in GHC.HsToCore.Monad.
Fixes #20363
-------------------------
Metric Increase:
InstanceMatching
-------------------------
- - - - -
b33992b6 by Wolfgang Jeltsch at 2026-08-10T22:10:22-04:00
Add support for textual output of bytecode file content
- - - - -
35823b6f by sheaf at 2026-08-10T22:10:27-04:00
Avoid wasteful allocations in mkTyConAppCo
The idiom "traverse isReflCo_maybe" followed by "map fst" used in
'GHC.Core.Coercion.mkTyConAppCo' was allocating a lot of waste.
This commit uses 'GHC.Data.Unboxed.traverseMaybeUB' to avoid all these
unnecessary intermediate allocations.
In a quick microbenchmark for 'mkTyConAppCo', this change resulted in:
- refl case (all argument coercions are reflexive):
- -60% runtime
- -80% allocations
- non-refl case:
- from 0% to -12% runtime (depending on which argument is non-refl)
- from 0% to -70% allocations ( -- '' -- )
Fixes #27648
-------------------------
Metric Decrease:
FamAppCachePerf
SimplCastPerf
T12425
T15703
T26426
T3064
T9872b_defer
T9872d
T5321Fun
T9020
T9630
-------------------------
- - - - -
54 changed files:
- + changelog.d/T20363
- + changelog.d/link-deterministic-order
- + changelog.d/show-byte-code
- compiler/GHC/ByteCode/Serialize.hs
- + compiler/GHC/ByteCode/Show.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Data/Unboxed.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match.hs-boot
- compiler/GHC/HsToCore/Match/Constructor.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/ghc.cabal.in
- docs/users_guide/using.rst
- ghc/GHC/Driver/Session/Mode.hs
- ghc/Main.hs
- testsuite/tests/corelint/T21115b.stderr
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/dmdanal/should_compile/T23398.stderr
- testsuite/tests/numeric/should_compile/T23907.stderr
- testsuite/tests/rep-poly/RepPolyRecordPattern.hs
- testsuite/tests/rep-poly/RepPolyRecordPattern.stderr
- testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
- testsuite/tests/rep-poly/T20113.stderr
- − testsuite/tests/rep-poly/T20363.stderr
- − testsuite/tests/rep-poly/T20363_show_co.hs
- − testsuite/tests/rep-poly/T20363_show_co.stderr
- − testsuite/tests/rep-poly/T20363b.stderr
- + testsuite/tests/rep-poly/T20363c.hs
- testsuite/tests/rep-poly/all.T
- + testsuite/tests/show-bytecode/Example.hs
- + testsuite/tests/show-bytecode/Makefile
- + testsuite/tests/show-bytecode/all.T
- + testsuite/tests/show-bytecode/normalize
- + testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout
- + testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout-javascript-unknown-ghcjs
- + testsuite/tests/show-bytecode/show-bytecode-hpc.stdout
- + testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout
- + testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout-javascript-unknown-ghcjs
- testsuite/tests/simplCore/should_compile/T24229a.stderr
- testsuite/tests/simplCore/should_compile/T24229b.stderr
- testsuite/tests/simplCore/should_compile/T3717.stderr
- testsuite/tests/simplCore/should_compile/T3772.stdout
- testsuite/tests/simplCore/should_compile/T4081.stderr
- testsuite/tests/simplCore/should_compile/T4908.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1fd18fe5a6ab6b8ea45905a129310e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1fd18fe5a6ab6b8ea45905a129310e…
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][master] Reduce SpecConstr threshold in GHC.Tc.Solver.Rewrite
by Marge Bot (＠marge-bot) 11 Aug '26
by Marge Bot (＠marge-bot) 11 Aug '26
11 Aug '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
556db2f3 by sheaf at 2026-08-10T21:32:06-04:00
Reduce SpecConstr threshold in GHC.Tc.Solver.Rewrite
As remarked in #27628, this module currently sits on a knife's edge: if
the body of 'simplifyArgsWorker' is made even a tiny bit smaller, then
SpecConstr suddenly kicks in and causes disastrous reboxing of the
LiftingContext argument.
To make this less likely to happen, this commit lowers the SpecConstr
threshold.
- - - - -
1 changed file:
- compiler/GHC/Tc/Solver/Rewrite.hs
Changes:
=====================================
compiler/GHC/Tc/Solver/Rewrite.hs
=====================================
@@ -1,3 +1,13 @@
+{-# OPTIONS_GHC -fspec-constr-threshold=1200 #-}
+ -- This threshold (smaller than the default 2000) avoids SpecConstr from firing
+ -- on the inner loop of GHC.Core.Reduction.simplifyArgsWorker (inlined into
+ -- this module) based on a 'LiftingContext' argument, as this causes
+ -- significant reboxing (regressing compile-time allocations in T9872d by ~4%),
+ -- as per #27628.
+ --
+ -- The 1200 threshold was chosen to avoid this issue while still allowing
+ -- beneficial SpecConstr to fire in the rest of the module.
+
module GHC.Tc.Solver.Rewrite(
rewrite, rewriteForErrors, rewriteArgsNom,
rewriteType
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/556db2f32f59ec2d3b1c225d24d677c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/556db2f32f59ec2d3b1c225d24d677c…
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][master] driver: Link object files in a deterministic order
by Marge Bot (＠marge-bot) 11 Aug '26
by Marge Bot (＠marge-bot) 11 Aug '26
11 Aug '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
e8d1a0d6 by Bernhard M. Wiedemann at 2026-08-10T21:31:23-04:00
driver: Link object files in a deterministic order
The object files handed to the linker come from the HomePackageTable,
which is ordered by the order in which modules finished compiling. With
-j1 that is the build plan order, with -jN it is whatever the scheduler
produced, so the same sources can link to different (but equivalent)
binaries.
The order reaches the output: .text and .rodata contributions are
concatenated in link order, so e.g. building the hdav executable of the
DAV package twice, once with -j1 and once with -j4, yields two binaries
that differ in ~100kB of section contents.
Sort the home modules by module before collecting their linkables,
guarded under `Opt_ObjectDeterminism` .
Fixes #27612
Signed-off-by: Bernhard M. Wiedemann <bwiedemann(a)suse.de>
- - - - -
2 changed files:
- + changelog.d/link-deterministic-order
- compiler/GHC/Driver/Pipeline.hs
Changes:
=====================================
changelog.d/link-deterministic-order
=====================================
@@ -0,0 +1,5 @@
+section: compiler
+synopsis: -fobject-determinism sorts the list of object files to be linked for reproducible builds
+issues: #27612
+mrs: !16457
+
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -410,8 +410,14 @@ link' hsc_env batch_attempt_linking mHscMessager hpt
-- know which packages are actually needed at the runtime stage.
pkg_deps <- map snd . Set.toList <$> hptCollectDependencies hpt
- -- the linkables to link
- home_mods <- hptCollectHomeModInfo hpt
+ -- the linkables to link; under -fobject-determinism sorted, because
+ -- the HPT holds modules in the order in which they finished compiling,
+ -- which varies with -j
+ let det_sort
+ | gopt Opt_ObjectDeterminism dflags
+ = sortWith (mi_module . hm_iface)
+ | otherwise = id
+ home_mods <- det_sort <$> hptCollectHomeModInfo hpt
let home_modules = map (mi_module . hm_iface) home_mods
debugTraceMsg logger 3 (text "link: hmi ..." $$ vcat (map ppr home_modules))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8d1a0d68067ba344fdff816f6b84f0…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8d1a0d68067ba344fdff816f6b84f0…
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/az/exactprint-annotation-rationalisation] 30 commits: Word64Map: add compareSize
by Alan Zimmerman (＠alanz) 10 Aug '26
by Alan Zimmerman (＠alanz) 10 Aug '26
10 Aug '26
Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC
Commits:
3a552476 by Simon Jakobi at 2026-08-09T15:20:06-04:00
Word64Map: add compareSize
compareSize m c compares the size of a map to an Int, but unlike
compare (size m) c it stops traversing the map once the outcome is
determined.
Based on https://github.com/haskell/containers/pull/1139
Assisted-by: Claude Opus 5
- - - - -
6e2c99d8 by Simon Jakobi at 2026-08-09T15:20:06-04:00
Use a pigeonhole sort for deterministic UniqDFM iteration
Deterministic UniqDFM iteration used a list mergesort, allocating O(n
log n) cons cells and contributing significantly to compiler allocations
(#27459).
Use a pigeonhole sort where appropriate, while retaining the mergesort
fallback. See Note [Sorting a UDFM] and Note [Cost of deterministic
iteration].
The peak_megabytes_allocated increase for LinkableUsage02 is probably
due to GC timing noise. See #27613.
-------------------------
Metric Decrease:
InstanceMatching
InstanceMatching1
ManyAlternatives
T12707
T13379
T13719
T24471
T27336
T5321FD
T5321Fun
T783
Metric Increase 'peak_megabytes_allocated':
LinkableUsage02
-------------------------
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
a938ab12 by sheaf at 2026-08-09T15:20:48-04:00
Testsuite: don't measure max residency for T27336
We really care more about total allocations for this test, so this commit
removes the maximum residency measurement.
- - - - -
7d94bb78 by Alan Zimmerman at 2026-08-09T15:21:29-04:00
EPA: Remove LocatedE, replace with LocatedA
This gets rid of one more LocatedXXX occurrence
- - - - -
9df24b7e by sheaf at 2026-08-10T14:28:30-04:00
hie.yaml: use a polyglot shell/batch script
This commit merges hie-bios and hie-bios.bat into a single polyglot
script. This avoids Windows users having to manually update hie.yaml
in order to be able to use HLS.
- - - - -
7f75c588 by Alan Zimmerman at 2026-08-10T14:29:11-04:00
EPA: Remove type parameter from AnnList
This is a step towards cutting AnnList down to its core for formatting
lists only
- - - - -
84444a21 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Remove al_trailing from AnnList
It was not being used
- - - - -
23dc0224 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
TTG: Add extension points to BooleanFormula
They are currently unused, but will be used for exact print annotations next
- - - - -
8c1b3063 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Remove LocatedBC / SrcSpanBF
- - - - -
5f7bbc73 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: remove unused addTrailingAnnToL. Squash appropriately
- - - - -
0a659cac by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPS: Remove NoEpTok/NoEpUniTok, using an unhelpful SrcSpan instead
Also introduce helper functions noEpTok and noEpUniTok to serve
as simple replacements in code inserting an token annotation without
location information.
- - - - -
b5268d98 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Some haddock processing tweaks
- - - - -
4b1b0986 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
Some haddock exactprint tests
- - - - -
d0826b33 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: When adding comments honour trailing anns
- - - - -
a8d7d6ee by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Uses Parsers.parseModule for exactprint tests
This is the advertised way to parse for use for exact printing in the
ghc-exactprint library, make sure we test using it.
- - - - -
993d16bc by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA Fix HsCmdDo exact print with comments
TODO: add test based on proc-do-complex-four-out.hs
- - - - -
6a88694e by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Add comments about remaining Anno SrcSpan instances
- - - - -
44184341 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Plan for Fixing AnnList Layout Properly
- - - - -
dc78930b by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Add specific layout field to AnnList
- - - - -
2b598ffe by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA Use vocurly as basis for AnnListLayout
For the existing cases that populate AnnList.
This also shows up AnnList usages that can never capture layout.
- - - - -
22ab0bfa by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: AnnList clean up patch for empty where clause
- - - - -
67338120 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Add TTG fields to FamilyInfo
This commit is a simple add, with unused extension fields.
It lays the groundwork for using them for exact print annotations
- - - - -
25b7872c by Alan Zimmerman at 2026-08-10T20:55:22+01:00
WIP annclassdecl
- - - - -
b881d5e1 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: Remove al_trailing from AnnList
It was not being used
- - - - -
57339a22 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: First pass implementation of HsList, for ClassDecls
Just as a straight list replacement to start with, no payload.
This shows the scope and invasiveness of the initial change
- - - - -
338dcbff by Alan Zimmerman at 2026-08-10T20:55:22+01:00
EPA: HsList attempt WIP
- - - - -
64c2441e by Alan Zimmerman at 2026-08-10T20:55:22+01:00
Enable ppr test for Haddock1. It currently fails
- - - - -
57c4d829 by Alan Zimmerman at 2026-08-10T20:55:22+01:00
WIP on removing NoEpAnn. Likely abandon
- - - - -
61e2cb4a by Alan Zimmerman at 2026-08-10T20:55:23+01:00
EPA: Add an overview doc for exact printing
- - - - -
8b82cc94 by Simon Peyton Jones at 2026-08-10T20:55:23+01:00
Added an intro section
- - - - -
93 changed files:
- + ANNLIST-LAYOUT-PLAN.md
- + ExactPrint.md
- compiler/GHC/Core/Class.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Data/BooleanFormula.hs
- compiler/GHC/Data/Word64Map/Internal.hs
- compiler/GHC/Data/Word64Map/Lazy.hs
- compiler/GHC/Data/Word64Map/Strict.hs
- compiler/GHC/Data/Word64Map/Strict/Internal.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Main/Interactive.hs
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension/Pass.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Stats.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Unique/DFM.hs
- compiler/GHC/Unit/Module/Warnings.hs
- compiler/Language/Haskell/Syntax.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/BooleanFormula.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- ghc/GHCi/UI.hs
- − hadrian/hie-bios
- hadrian/hie-bios.bat
- hie.yaml
- testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/parser/should_compile/T15279.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20718b.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/parser/should_compile/T23315/T23315.stderr
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
- + testsuite/tests/printer/Haddock1.hs
- testsuite/tests/printer/Makefile
- testsuite/tests/printer/T18791.stderr
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- testsuite/tests/printer/all.T
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9d725e4f0572b0800a97141577e8f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9d725e4f0572b0800a97141577e8f…
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/az/epa-tidy-locatedxxx-16
by Alan Zimmerman (＠alanz) 10 Aug '26
by Alan Zimmerman (＠alanz) 10 Aug '26
10 Aug '26
Alan Zimmerman pushed new branch wip/az/epa-tidy-locatedxxx-16 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-tidy-locatedxxx-16
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] 4 commits: hie.yaml: use a polyglot shell/batch script
by Marge Bot (＠marge-bot) 10 Aug '26
by Marge Bot (＠marge-bot) 10 Aug '26
10 Aug '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
9df24b7e by sheaf at 2026-08-10T14:28:30-04:00
hie.yaml: use a polyglot shell/batch script
This commit merges hie-bios and hie-bios.bat into a single polyglot
script. This avoids Windows users having to manually update hie.yaml
in order to be able to use HLS.
- - - - -
7f75c588 by Alan Zimmerman at 2026-08-10T14:29:11-04:00
EPA: Remove type parameter from AnnList
This is a step towards cutting AnnList down to its core for formatting
lists only
- - - - -
531c45b1 by Bernhard M. Wiedemann at 2026-08-10T15:00:56-04:00
driver: Link object files in a deterministic order
The object files handed to the linker come from the HomePackageTable,
which is ordered by the order in which modules finished compiling. With
-j1 that is the build plan order, with -jN it is whatever the scheduler
produced, so the same sources can link to different (but equivalent)
binaries.
The order reaches the output: .text and .rodata contributions are
concatenated in link order, so e.g. building the hdav executable of the
DAV package twice, once with -j1 and once with -j4, yields two binaries
that differ in ~100kB of section contents.
Sort the home modules by module before collecting their linkables,
guarded under `Opt_ObjectDeterminism` .
Fixes #27612
Signed-off-by: Bernhard M. Wiedemann <bwiedemann(a)suse.de>
- - - - -
1fd18fe5 by sheaf at 2026-08-10T15:00:57-04:00
Reduce SpecConstr threshold in GHC.Tc.Solver.Rewrite
As remarked in #27628, this module currently sits on a knife's edge: if
the body of 'simplifyArgsWorker' is made even a tiny bit smaller, then
SpecConstr suddenly kicks in and causes disastrous reboxing of the
LiftingContext argument.
To make this less likely to happen, this commit lowers the SpecConstr
threshold.
- - - - -
32 changed files:
- + changelog.d/link-deterministic-order
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- − hadrian/hie-bios
- hadrian/hie-bios.bat
- hie.yaml
- testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T15279.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a86da2c669bdb3c8586f6b4c15212…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a86da2c669bdb3c8586f6b4c15212…
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/jeltsch/ghc-9-14-building-base] Add missing newline escaping
by Wolfgang Jeltsch (＠jeltsch) 10 Aug '26
by Wolfgang Jeltsch (＠jeltsch) 10 Aug '26
10 Aug '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/ghc-9-14-building-base at Glasgow Haskell Compiler / GHC
Commits:
59aebe52 by Wolfgang Jeltsch at 2026-08-10T21:46:44+03:00
Add missing newline escaping
- - - - -
1 changed file:
- .gitlab/base-ci.sh
Changes:
=====================================
.gitlab/base-ci.sh
=====================================
@@ -53,7 +53,7 @@ do
# Build `base` with the installed GHC
cd libraries/base
- cabal build
+ cabal build \
--with-compiler "${project_root}/other-ghcs/opt/${ghc_version}/bin/ghc" \
--allow-boot-library-installs \
-O0
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59aebe52c0e532e7cf387f551ea6188…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59aebe52c0e532e7cf387f551ea6188…
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
10 Aug '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
7f75c588 by Alan Zimmerman at 2026-08-10T14:29:11-04:00
EPA: Remove type parameter from AnnList
This is a step towards cutting AnnList down to its core for formatting
lists only
- - - - -
26 changed files:
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T15279.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
Changes:
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -72,8 +72,8 @@ Global bindings (where clauses)
-- the ...LR datatypes are parameterized by two id types,
-- one for the left and one for the right.
-type instance XHsValBinds (GhcPass pL) (GhcPass pR) = EpAnn (AnnList (EpToken "where"))
-type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = EpAnn (AnnList (EpToken "where"))
+type instance XHsValBinds (GhcPass pL) (GhcPass pR) = (EpAnn AnnList, EpToken "where")
+type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = (EpAnn AnnList, EpToken "where")
type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField
type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = DataConCantHappen
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -67,11 +67,8 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
`extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan
`extQ` annotationModule
`extQ` annotationGrhsAnn
+ `extQ` annotationAnnListEpAnn
`extQ` annotationAnnList
- `extQ` annotationEpAnnListWhere
- `extQ` annotationAnnListUnit
- `extQ` annotationAnnListCommas
- `extQ` annotationAnnListEpaLocation
`extQ` annotationNoEpAnns
`extQ` annotationExprBracket
`extQ` annotationTypedBracket
@@ -372,27 +369,15 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc
annotationGrhsAnn = annotation' (text "EpAnn GrhsAnn")
- annotationAnnList :: EpAnn (AnnList ()) -> SDoc
- annotationAnnList = annotation' (text "EpAnn (AnnList ())")
+ annotationAnnListEpAnn :: EpAnn AnnList -> SDoc
+ annotationAnnListEpAnn = annotation' (text "EpAnn AnnList")
- annotationEpAnnListWhere :: EpAnn (AnnList (EpToken "where")) -> SDoc
- annotationEpAnnListWhere = annotation' (text "EpAnn (AnnList (EpToken \"where\"))")
-
- annotationAnnListCommas :: EpAnn (AnnList [EpToken ","]) -> SDoc
- annotationAnnListCommas = annotation' (text "EpAnn (AnnList [EpToken \",\"])")
-
- annotationAnnListUnit :: AnnList () -> SDoc
- annotationAnnListUnit anns = case ba of
+ annotationAnnList :: AnnList -> SDoc
+ annotationAnnList anns = case ba of
BlankEpAnnotations -> parens (text "blanked:" <+> text "AnnList ()")
NoBlankEpAnnotations -> parens $ text (showConstr (toConstr anns))
$$ vcat (gmapQ showAstData' anns)
- annotationAnnListEpaLocation :: AnnList EpaLocation -> SDoc
- annotationAnnListEpaLocation anns = case ba of
- BlankEpAnnotations -> parens (text "blanked:" <+> text "AnnList EpaLocation")
- NoBlankEpAnnotations -> parens $ text (showConstr (toConstr anns))
- $$ vcat (gmapQ showAstData' anns)
-
annotationNoEpAnns :: EpAnn NoEpAnns -> SDoc
annotationNoEpAnns = annotation' (text "EpAnn NoEpAnns")
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -289,11 +289,11 @@ type instance XLet GhcPs = (EpToken "let", EpToken "in")
type instance XLet GhcRn = NoExtField
type instance XLet GhcTc = NoExtField
-type instance XDo GhcPs = AnnList EpaLocation
+type instance XDo GhcPs = (AnnList, EpaLocation)
type instance XDo GhcRn = NoExtField
type instance XDo GhcTc = Type
-type instance XExplicitList GhcPs = AnnList ()
+type instance XExplicitList GhcPs = AnnList
type instance XExplicitList GhcRn = NoExtField
type instance XExplicitList GhcTc = Type
-- GhcPs: ExplicitList includes all source-level
@@ -1437,7 +1437,7 @@ type instance XCmdArrApp GhcPs = (IsUnicodeSyntax, EpaLocation)
type instance XCmdArrApp GhcRn = NoExtField
type instance XCmdArrApp GhcTc = Type
-type instance XCmdArrForm GhcPs = AnnList ()
+type instance XCmdArrForm GhcPs = AnnList
-- | fixity (filled in by the renamer), for forms that were converted from
-- OpApp's by the renamer
type instance XCmdArrForm GhcRn = Maybe Fixity
@@ -1464,7 +1464,7 @@ type instance XCmdLet GhcPs = (EpToken "let", EpToken "in")
type instance XCmdLet GhcRn = NoExtField
type instance XCmdLet GhcTc = NoExtField
-type instance XCmdDo GhcPs = AnnList EpaLocation
+type instance XCmdDo GhcPs = (AnnList, EpaLocation)
type instance XCmdDo GhcRn = NoExtField
type instance XCmdDo GhcTc = Type
@@ -1657,7 +1657,7 @@ type instance XMG GhcRn b = (Origin, -- See Note [Generated code and pat
MatchGroupAnn)
type instance XMG GhcTc b = MatchGroupTc
-type MatchGroupAnn = AnnList ()
+type MatchGroupAnn = AnnList
data MatchGroupTc
= MatchGroupTc
@@ -1892,7 +1892,7 @@ type instance XTransStmt (GhcPass _) GhcPs b = AnnTransStmt
type instance XTransStmt (GhcPass _) GhcRn b = NoExtField
type instance XTransStmt (GhcPass _) GhcTc b = Type
-type instance XRecStmt (GhcPass _) GhcPs b = AnnList (EpToken "rec")
+type instance XRecStmt (GhcPass _) GhcPs b = (AnnList, EpToken "rec")
type instance XRecStmt (GhcPass _) GhcRn b = NoExtField
type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -104,7 +104,7 @@ type instance XBangPat GhcPs = EpToken "!"
type instance XBangPat GhcRn = NoExtField
type instance XBangPat GhcTc = NoExtField
-type instance XListPat GhcPs = AnnList ()
+type instance XListPat GhcPs = AnnList
-- After parsing, ListPat can refer to a built-in Haskell list pattern
-- or an overloaded list pattern.
type instance XListPat GhcRn = NoExtField
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -326,11 +326,11 @@ mkHsIntegral :: IntegralLit GhcPs -> HsOverLit GhcPs
mkHsFractional :: FractionalLit GhcPs -> HsOverLit GhcPs
mkHsIsString :: SourceText -> HText -> HsOverLit GhcPs
mkHsDo :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> HsExpr GhcPs
-mkHsDoAnns :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> AnnList EpaLocation -> HsExpr GhcPs
+mkHsDoAnns :: HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> (AnnList, EpaLocation) -> HsExpr GhcPs
mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> HsExpr GhcPs
mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
- -> AnnList EpaLocation
+ -> (AnnList, EpaLocation)
-> HsExpr GhcPs
mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-"
@@ -368,7 +368,7 @@ mkRecStmt :: forall (idL :: Pass) bodyR.
(Anno (StmtLR (GhcPass idL) GhcPs bodyR))
(StmtLR (GhcPass idL) GhcPs bodyR)]
~ SrcSpanAnnA)
- => AnnList (EpToken "rec")
+ => (AnnList, EpToken "rec")
-> LocatedA [LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
mkRecStmt anns stmts = (emptyRecStmt' anns :: StmtLR (GhcPass idL) GhcPs bodyR)
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1791,13 +1791,13 @@ cvars1 :: { [RecordPatSynField GhcPs] }
| var ',' cvars1 {% do { h <- addTrailingCommaN $1 (gl $2)
; return ((RecordPatSynField (mkFieldOcc h) h) : $3 )}}
-where_decls :: { LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList ()) }
+where_decls :: { LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList) }
: 'where' '{' decls '}' {% amsA' (sLL $1 $> (thdOf3 $ unLoc $3,
epTok $1,
- AnnList (Just (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3) () [])) }
+ AnnList (Just (fstOf3 $ unLoc $3)) (ListBraces (epTok $2) (epTok $4)) (sndOf3 $ unLoc $3) [])) }
| 'where' vocurly decls close {% amsA' (sLL $1 $3 (thdOf3 $ unLoc $3,
epTok $1,
- AnnList (Just (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3) () [])) }
+ AnnList (Just (fstOf3 $ unLoc $3)) ListNone (sndOf3 $ unLoc $3) [])) }
pattern_synonym_sig :: { LSig GhcPs }
: 'pattern' con_list '::' sigtype
@@ -1932,10 +1932,10 @@ decls :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) }
| decl { sL1 $1 (glR $1, [], unitOL $1) }
| {- empty -} { noLoc (noAnn, [],nilOL) }
-decllist :: { Located (AnnList (),Located (OrdList (LHsDecl GhcPs))) }
- : '{' decls '}' { sLL $1 $> (AnnList (Just (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) noAnn []
+decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) }
+ : '{' decls '}' { sLL $1 $> (AnnList (Just (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) []
,sL1 $2 $ thdOf3 $ unLoc $2) }
- | vocurly decls close { sL1 $2 (AnnList (Just (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) noAnn []
+ | vocurly decls close { sL1 $2 (AnnList (Just (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) []
,sL1 $2 $ thdOf3 $ unLoc $2) }
-- Binding groups other than those of class and instance declarations
@@ -1943,16 +1943,16 @@ decllist :: { Located (AnnList (),Located (OrdList (LHsDecl GhcPs))) }
binds :: { Located (HsLocalBinds GhcPs) }
-- May have implicit parameters
-- No type declarations
- : decllist {% do { let { (AnnList anc p s _ t, decls) = unLoc $1 }
+ : decllist {% do { let { (AnnList anc p s t, decls) = unLoc $1 }
; val_binds <- cvBindGroup (unLoc $ decls)
; !cs <- getCommentsFor (gl $1)
- ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList anc p s noAnn t) cs) val_binds)} }
+ ; return (sL1 $1 $ HsValBinds (EpAnn (glR $1) (AnnList anc p s t) cs, NoEpTok) val_binds)} }
| '{' dbinds '}' {% acs (comb3 $1 $2 $3) (\loc cs -> (L loc
- $ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (Just$ glR $2) (ListBraces (epTok $1) (epTok $3)) [] noAnn []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }
+ $ HsIPBinds (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) (AnnList (Just$ glR $2) (ListBraces (epTok $1) (epTok $3)) [] []) cs, NoEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) }
| vocurly dbinds close {% acs (gl $2) (\loc cs -> (L loc
- $ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) ListNone [] noAnn []) cs) (IPBinds noExtField (reverse $ unLoc $2)))) }
+ $ HsIPBinds (EpAnn (glR $1) (AnnList (Just $ glR $2) ListNone [] []) cs, NoEpTok) (IPBinds noExtField (reverse $ unLoc $2)))) }
wherebinds :: { Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments )) }
@@ -3280,7 +3280,7 @@ aexp2 :: { ECP }
-- arrow notation extension
| '(|' aexp cmdargs '|)' {% runPV (unECP $2) >>= \ $2 ->
fmap ecpFromCmd $
- amsA' (sLL $1 $> $ HsCmdArrForm (AnnList (glRM $1) (ListBanana (epUniTok $1) (epUniTok $4)) [] noAnn []) $2 Prefix
+ amsA' (sLL $1 $> $ HsCmdArrForm (AnnList (glRM $1) (ListBanana (epUniTok $1) (epUniTok $4)) [] []) $2 Prefix
(reverse $3)) }
projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) }
@@ -3412,9 +3412,9 @@ tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)] }
-- Never empty.
list :: { forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b) }
: texp { \loc (ao,ac) -> unECP $1 >>= \ $1 ->
- mkHsExplicitListPV loc [$1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []) }
+ mkHsExplicitListPV loc [$1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] []) }
| lexps { \loc (ao,ac) -> $1 >>= \ $1 ->
- mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []) }
+ mkHsExplicitListPV loc (reverse $1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] []) }
| texp '..' { \loc (ao,ac) -> unECP $1 >>= \ $1 ->
amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok $2) (EpTok ac)) Nothing (From $1))
>>= ecpFromExp' }
@@ -3438,7 +3438,7 @@ list :: { forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (
{ \loc (ao,ac) ->
checkMonadComp >>= \ ctxt ->
unECP $1 >>= \ $1 -> do { t <- addTrailingVbarA $1 (epTok $2)
- ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc $3) t (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []))
+ ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc $3) t (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] [], noAnn))
>>= ecpFromExp' } }
lexps :: { forall b. DisambECP b => PV [LocatedA b] }
@@ -3541,14 +3541,14 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
-----------------------------------------------------------------------------
-- Case alternatives
-altslist(PATS) :: { forall b. DisambECP b => PV (LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ())) }
+altslist(PATS) :: { forall b. DisambECP b => PV (LocatedA ([LMatch GhcPs (LocatedA b)], AnnList)) }
: '{' alts(PATS) '}' { $2 >>= \ $2 -> amsA'
(sLL $1 $> (reverse (snd $ unLoc $2),
- (AnnList (Just $ glR $2) (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2) noAnn []))) }
+ (AnnList (Just $ glR $2) (ListBraces (epTok $1) (epTok $3)) (fst $ unLoc $2) []))) }
| vocurly alts(PATS) close { $2 >>= \ $2 -> amsA'
(L (getLoc $2) (reverse (snd $ unLoc $2),
- (AnnList (Just $ glR $2) ListNone (fst $ unLoc $2) noAnn []))) }
- | '{' '}' { amsA' (sLL $1 $> ([], (AnnList Nothing (ListBraces (epTok $1) (epTok $2)) [] noAnn []))) }
+ (AnnList (Just $ glR $2) ListNone (fst $ unLoc $2) []))) }
+ | '{' '}' { amsA' (sLL $1 $> ([], (AnnList Nothing (ListBraces (epTok $1) (epTok $2)) [] []))) }
| vocurly close { return $ noLocA ([], noAnn) }
alts(PATS) :: { forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)])) }
@@ -4723,9 +4723,9 @@ commentsPA la@(L l a) = do
!cs <- getPriorCommentsFor (getLocA la)
return (L (addCommentsToEpAnn l cs) a)
-hsDoAnn :: EpToken "rec" -> (EpToken "{", [EpToken ";"], EpToken "}") -> LocatedAn t b -> AnnList (EpToken "rec")
+hsDoAnn :: EpToken "rec" -> (EpToken "{", [EpToken ";"], EpToken "}") -> LocatedAn t b -> (AnnList, EpToken "rec")
hsDoAnn rec (ob, semis, cb) (L ll _)
- = AnnList (Just $ spanAsAnchor (locA ll)) (ListBraces ob cb) semis rec []
+ = (AnnList (Just $ spanAsAnchor (locA ll)) (ListBraces ob cb) semis [], rec)
listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation
listAsAnchorM [] = Nothing
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -515,12 +515,11 @@ instance Outputable TrailingAnn where
-- keywords such as 'where'.
-- AZ: goal: only used when there is layout, so vertical alignment matters
-data AnnList a
+data AnnList
= AnnList {
al_anchor :: !(Maybe EpaLocation), -- ^ start point of a list having layout
al_brackets :: !AnnListBrackets,
al_semis :: [EpToken ";"], -- decls
- al_rest :: !a,
al_trailing :: ![TrailingAnn] -- ^ items appearing after the
-- list, such as '=>' for a
-- context
@@ -666,7 +665,7 @@ data AnnPragSCC
-- | Helper function used in the parser to add a 'TrailingAnn' items
-- to an existing annotation.
addTrailingAnnToL :: TrailingAnn -> EpAnnComments
- -> EpAnn (AnnList a) -> EpAnn (AnnList a)
+ -> EpAnn AnnList -> EpAnn AnnList
addTrailingAnnToL t cs n = n { anns = addTrailing (anns n)
, comments = comments n <> cs }
where
@@ -1037,8 +1036,8 @@ instance NoAnn NoEpAnns where
instance NoAnn AnnBooleanFormula where
noAnn = AnnBooleanFormula noAnn noAnn []
-instance NoAnn a => NoAnn (AnnList a) where
- noAnn = AnnList Nothing ListNone noAnn noAnn []
+instance NoAnn AnnList where
+ noAnn = AnnList Nothing ListNone noAnn []
instance NoAnn NameAnn where
noAnn = NameAnnTrailing []
@@ -1131,9 +1130,9 @@ instance Outputable NameAnn where
ppr (NameAnnTrailing t)
= text "NameAnnTrailing" <+> ppr t
-instance (Outputable a) => Outputable (AnnList a) where
- ppr (AnnList anc p s a t)
- = text "AnnList" <+> ppr anc <+> ppr p <+> ppr s <+> ppr a <+> ppr t
+instance Outputable AnnList where
+ ppr (AnnList anc p s t)
+ = text "AnnList" <+> ppr anc <+> ppr p <+> ppr s <+> ppr t
instance Outputable AnnListBrackets where
ppr (ListParens o c) = text "ListParens" <+> ppr o <+> ppr c
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -437,7 +437,7 @@ mkRoleAnnotDecl loc tycon roles anns
mkMDo :: (EpToken "{", [EpToken ";"], EpToken "}") -> HsDoFlavour -> LocatedA [ExprLStmt GhcPs] -> EpaLocation -> EpaLocation -> HsExpr GhcPs
mkMDo (ob, semis, cb) ctxt stmts tok loc
- = mkHsDoAnns ctxt stmts (AnnList (Just loc) (ListBraces ob cb) semis tok [])
+ = mkHsDoAnns ctxt stmts (AnnList (Just loc) (ListBraces ob cb) semis [], tok)
-- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to
-- binders without annotations. Only accepts specified variables, and errors if
@@ -459,19 +459,19 @@ fromSpecTyVarBndr (L loc (HsTvb xtv flag idp k)) = do
-- | Add the annotation for a 'where' keyword to existing @HsLocalBinds@
annBinds :: EpToken "where" -> EpAnnComments -> HsLocalBinds GhcPs
-> (HsLocalBinds GhcPs, Maybe EpAnnComments)
-annBinds w cs (HsValBinds an bs) = (HsValBinds (add_where w an cs) bs, Nothing)
-annBinds w cs (HsIPBinds an bs) = (HsIPBinds (add_where w an cs) bs, Nothing)
+annBinds w cs (HsValBinds an bs) = (HsValBinds (add_where w (fst an) cs) bs, Nothing)
+annBinds w cs (HsIPBinds an bs) = (HsIPBinds (add_where w (fst an) cs) bs, Nothing)
annBinds _ cs (EmptyLocalBinds x) = (EmptyLocalBinds x, Just cs)
-add_where :: EpToken "where" -> EpAnn (AnnList (EpToken "where")) -> EpAnnComments -> EpAnn (AnnList (EpToken "where"))
+add_where :: EpToken "where" -> EpAnn AnnList -> EpAnnComments
+ -> (EpAnn AnnList, EpToken "where")
add_where w@(EpTok (EpaSpan (RealSrcSpan rs _))) (EpAnn a al cs) cs2
| valid_anchor a
- = EpAnn (widenAnchorT a w) (al { al_rest = w}) (cs Semi.<> cs2)
+ = (EpAnn (widenAnchorT a w) al (cs Semi.<> cs2), w)
| otherwise
- = EpAnn (patch_anchor rs a)
- (al { al_anchor = (fmap (patch_anchor rs) (al_anchor al))
- , al_rest = w})
- (cs Semi.<> cs2)
+ = (EpAnn (patch_anchor rs a)
+ (al { al_anchor = (fmap (patch_anchor rs) (al_anchor al))})
+ (cs Semi.<> cs2), w)
add_where _ _ _ = panic "add_where"
-- EpaDelta should only be used for transformations
@@ -728,7 +728,7 @@ tyConToDataCon (L loc tc)
occ = rdrNameOcc tc
mkPatSynMatchGroup :: LocatedN RdrName
- -> LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList ())
+ -> LocatedA (OrdList (LHsDecl GhcPs), EpToken "where", AnnList)
-> P (MatchGroup GhcPs (LHsExpr GhcPs))
mkPatSynMatchGroup (L loc patsyn_name) (L ld (decls, _, ann)) =
do { matches <- mapM fromDecl (fromOL decls)
@@ -1777,11 +1777,11 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
-> PV (LocatedA b)
-- | Disambiguate "case ... of ..."
mkHsCasePV :: SrcSpan -> LHsExpr GhcPs
- -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ())
+ -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList)
-> EpAnnHsCase -> PV (LocatedA b)
-- | Disambiguate "\... -> ..." (lambda), "\case" and "\cases"
mkHsLamPV :: SrcSpan -> HsLamVariant
- -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList ())
+ -> LocatedA ([LMatch GhcPs (LocatedA b)], AnnList)
-> EpAnnLam
-> PV (LocatedA b)
-- | Function argument representation
@@ -1827,7 +1827,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
mkHsTySigPV
:: SrcSpanAnnA -> LocatedA b -> LHsType GhcPs -> TokDcolon -> PV (LocatedA b)
-- | Disambiguate "[a,b,c]" (list syntax)
- mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList () -> PV (LocatedA b)
+ mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b)
-- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices)
mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (LocatedA b)
-- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates)
@@ -1961,7 +1961,7 @@ instance DisambECP (HsCmd GhcPs) where
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns)
mkHsDoPV l (ob,semis,cb) Nothing stmts tok_loc anc = do
!cs <- getCommentsFor l
- return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo (AnnList (Just anc) (ListBraces ob cb) semis tok_loc []) stmts)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo (AnnList (Just anc) (ListBraces ob cb) semis [], tok_loc) stmts)
mkHsDoPV l _ (Just m) _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m
mkHsParPV l lpar c rpar = do
!cs <- getCommentsFor l
@@ -2060,7 +2060,7 @@ instance DisambECP (HsExpr GhcPs) where
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns)
mkHsDoPV l (ob,semis,cb) mod stmts loc_tok anc = do
!cs <- getCommentsFor l
- return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo (AnnList (Just anc) (ListBraces ob cb) semis loc_tok []) (DoExpr mod) stmts)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsDo (AnnList (Just anc) (ListBraces ob cb) semis [], loc_tok) (DoExpr mod) stmts)
mkHsParPV l lpar e rpar = do
!cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e)
=====================================
testsuite/tests/ghc-api/T25121_status.stdout
=====================================
@@ -15,7 +15,7 @@ X(FunArr) match = NoExtField
X(ExprWithTySig) match = EpUniToken "::" "\8759"
X(UntypedSplice) match = NoExtField
X(ExplicitList) mismatch
- >>> AnnList ()
+ >>> AnnList
<<< ((EpToken "'"),(EpToken "["),(EpToken "]"))
X(ExplicitTuple) mismatch
>>> AnnParen
=====================================
testsuite/tests/ghc-api/exactprint/T22919.stderr
=====================================
@@ -72,7 +72,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
=====================================
@@ -84,7 +84,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/module/mod185.stderr
=====================================
@@ -96,7 +96,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -2124,7 +2124,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -92,7 +92,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -216,7 +215,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -289,15 +287,16 @@
"-- normal comment")
{ DumpParsedAstComments.hs:14:7-8 }))]))
(HsDo
- (AnnList
- (Just
- (EpaSpan { DumpParsedAstComments.hs:16:3 }))
- (ListBraces
- (NoEpTok)
- (NoEpTok))
- []
- (EpaSpan { DumpParsedAstComments.hs:14:7-8 })
- [])
+ ((,)
+ (AnnList
+ (Just
+ (EpaSpan { DumpParsedAstComments.hs:16:3 }))
+ (ListBraces
+ (NoEpTok)
+ (NoEpTok))
+ []
+ [])
+ (EpaSpan { DumpParsedAstComments.hs:14:7-8 }))
(DoExpr
(Nothing))
(L
@@ -366,7 +365,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -33,7 +33,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -260,7 +260,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -327,15 +326,16 @@
(EpaComments
[]))
(HsDo
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:(11,3)-(12,3) }))
- (ListBraces
- (NoEpTok)
- (NoEpTok))
- []
- (EpaSpan { DumpSemis.hs:10:7-8 })
- [])
+ ((,)
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:(11,3)-(12,3) }))
+ (ListBraces
+ (NoEpTok)
+ (NoEpTok))
+ []
+ [])
+ (EpaSpan { DumpSemis.hs:10:7-8 }))
(DoExpr
(Nothing))
(L
@@ -359,22 +359,23 @@
(EpaComments
[]))
(HsDo
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:11:6-15 }))
- (ListBraces
- (EpTok (EpaSpan { DumpSemis.hs:11:6 }))
- (EpTok (EpaSpan { DumpSemis.hs:11:15 })))
- [(EpTok
- (EpaSpan { DumpSemis.hs:11:8 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:11:9 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:11:10 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:11:11 }))]
- (EpaSpan { DumpSemis.hs:11:3-4 })
- [])
+ ((,)
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:11:6-15 }))
+ (ListBraces
+ (EpTok (EpaSpan { DumpSemis.hs:11:6 }))
+ (EpTok (EpaSpan { DumpSemis.hs:11:15 })))
+ [(EpTok
+ (EpaSpan { DumpSemis.hs:11:8 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:11:9 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:11:10 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:11:11 }))]
+ [])
+ (EpaSpan { DumpSemis.hs:11:3-4 }))
(DoExpr
(Nothing))
(L
@@ -554,7 +555,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -621,18 +621,19 @@
(EpaComments
[]))
(HsDo
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:(16,3)-(19,3) }))
- (ListBraces
- (EpTok (EpaSpan { DumpSemis.hs:16:3 }))
- (EpTok (EpaSpan { DumpSemis.hs:19:3 })))
- [(EpTok
- (EpaSpan { DumpSemis.hs:16:5 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:16:8 }))]
- (EpaSpan { DumpSemis.hs:15:7-8 })
- [])
+ ((,)
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:(16,3)-(19,3) }))
+ (ListBraces
+ (EpTok (EpaSpan { DumpSemis.hs:16:3 }))
+ (EpTok (EpaSpan { DumpSemis.hs:19:3 })))
+ [(EpTok
+ (EpaSpan { DumpSemis.hs:16:5 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:16:8 }))]
+ [])
+ (EpaSpan { DumpSemis.hs:15:7-8 }))
(DoExpr
(Nothing))
(L
@@ -806,7 +807,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -873,18 +873,19 @@
(EpaComments
[]))
(HsDo
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:22:10-30 }))
- (ListBraces
- (EpTok (EpaSpan { DumpSemis.hs:22:10 }))
- (EpTok (EpaSpan { DumpSemis.hs:22:30 })))
- [(EpTok
- (EpaSpan { DumpSemis.hs:22:12 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:22:13 }))]
- (EpaSpan { DumpSemis.hs:22:7-8 })
- [])
+ ((,)
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:22:10-30 }))
+ (ListBraces
+ (EpTok (EpaSpan { DumpSemis.hs:22:10 }))
+ (EpTok (EpaSpan { DumpSemis.hs:22:30 })))
+ [(EpTok
+ (EpaSpan { DumpSemis.hs:22:12 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:22:13 }))]
+ [])
+ (EpaSpan { DumpSemis.hs:22:7-8 }))
(DoExpr
(Nothing))
(L
@@ -1015,7 +1016,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -1121,7 +1121,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -1229,7 +1228,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -1721,7 +1719,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -1848,7 +1845,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -1921,28 +1917,29 @@
(EpTok
(EpaSpan { DumpSemis.hs:34:32-33 })))
(HsValBinds
- (EpAnn
- (EpaSpan { DumpSemis.hs:34:13-31 })
- (AnnList
- (Just
- (EpaSpan { DumpSemis.hs:34:18-30 }))
- (ListBraces
- (EpTok (EpaSpan { DumpSemis.hs:34:13 }))
- (EpTok (EpaSpan { DumpSemis.hs:34:31 })))
- [(EpTok
- (EpaSpan { DumpSemis.hs:34:14 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:34:15 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:34:16 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:34:17 }))
- ,(EpTok
- (EpaSpan { DumpSemis.hs:34:18 }))]
- (NoEpTok)
- [])
- (EpaComments
- []))
+ ((,)
+ (EpAnn
+ (EpaSpan { DumpSemis.hs:34:13-31 })
+ (AnnList
+ (Just
+ (EpaSpan { DumpSemis.hs:34:18-30 }))
+ (ListBraces
+ (EpTok (EpaSpan { DumpSemis.hs:34:13 }))
+ (EpTok (EpaSpan { DumpSemis.hs:34:31 })))
+ [(EpTok
+ (EpaSpan { DumpSemis.hs:34:14 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:34:15 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:34:16 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:34:17 }))
+ ,(EpTok
+ (EpaSpan { DumpSemis.hs:34:18 }))]
+ [])
+ (EpaComments
+ []))
+ (NoEpTok))
(ValBinds
(NoExtField)
[(VbBind
@@ -1975,7 +1972,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -2089,7 +2085,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -2215,7 +2210,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -2335,7 +2329,6 @@
(EpaSpan { DumpSemis.hs:38:7 }))
,(EpTok
(EpaSpan { DumpSemis.hs:38:8 }))]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -965,7 +965,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -1665,7 +1664,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/T15279.stderr
=====================================
@@ -34,8 +34,7 @@
(L
(EpAnn
(EpaSpan { T15279.hs:3:8-13 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
{ModuleName: T15279}))
@@ -44,8 +43,7 @@
[(L
(EpAnn
(EpaSpan { T15279.hs:5:1-19 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(SigD
@@ -72,8 +70,7 @@
(L
(EpAnn
(EpaSpan { T15279.hs:5:8-19 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(HsSig
@@ -83,8 +80,7 @@
(L
(EpAnn
(EpaSpan { T15279.hs:5:8-19 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(HsFunTy
@@ -100,8 +96,7 @@
(L
(EpAnn
(EpaSpan { T15279.hs:5:8-11 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(HsTyVar
@@ -119,8 +114,7 @@
(L
(EpAnn
(EpaSpan { T15279.hs:5:16-19 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(HsTyVar
@@ -138,8 +132,7 @@
,(L
(EpAnn
(EpaSpan { <combineSrcSpans: files differ> })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(ValD
@@ -162,20 +155,17 @@
(Nothing)
(ListNone)
[]
- (NoEpTok)
[]))
(L
(EpAnn
(EpaSpan { <combineSrcSpans: files differ> })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
[(L
(EpAnn
(EpaSpan { T15279.hs-incl:1:1-13 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(Match
@@ -197,12 +187,15 @@
[]
[]))
(L
- (EpaSpan { T15279.hs-incl:1:5-7 })
+ (EpAnn
+ (EpaSpan { T15279.hs-incl:1:5-7 })
+ []
+ (EpaComments
+ []))
[(L
(EpAnn
(EpaSpan { T15279.hs-incl:1:5-7 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(LitPat
@@ -234,8 +227,7 @@
(L
(EpAnn
(EpaSpan { T15279.hs-incl:1:11-13 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(HsLit
@@ -249,8 +241,7 @@
,(L
(EpAnn
(EpaSpan { T15279.hs-incl:2:1-13 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(Match
@@ -272,12 +263,15 @@
[]
[]))
(L
- (EpaSpan { T15279.hs-incl:2:5-7 })
+ (EpAnn
+ (EpaSpan { T15279.hs-incl:2:5-7 })
+ []
+ (EpaComments
+ []))
[(L
(EpAnn
(EpaSpan { T15279.hs-incl:2:5-7 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(LitPat
@@ -309,8 +303,7 @@
(L
(EpAnn
(EpaSpan { T15279.hs-incl:2:11-13 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(HsLit
@@ -324,8 +317,7 @@
,(L
(EpAnn
(EpaSpan { T15279.hs:7:1-11 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(Match
@@ -347,12 +339,15 @@
[]
[]))
(L
- (EpaSpan { T15279.hs:7:5 })
+ (EpAnn
+ (EpaSpan { T15279.hs:7:5 })
+ []
+ (EpaComments
+ []))
[(L
(EpAnn
(EpaSpan { T15279.hs:7:5 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(WildPat
@@ -381,8 +376,7 @@
(L
(EpAnn
(EpaSpan { T15279.hs:7:9-11 })
- (AnnListItem
- [])
+ []
(EpaComments
[]))
(HsLit
=====================================
testsuite/tests/parser/should_compile/T20718.stderr
=====================================
@@ -106,7 +106,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -96,7 +96,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -72,7 +72,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -157,18 +156,19 @@
{OccName: x}))))))
[])
(HsValBinds
- (EpAnn
- (EpaSpan { <no location info> })
- (AnnList
- (Just
- (EpaSpan { Test20297.hs:7:3-7 }))
- (ListNone)
- []
- (EpTok
- (EpaSpan { Test20297.hs:7:3-7 }))
- [])
- (EpaComments
- []))
+ ((,)
+ (EpAnn
+ (EpaSpan { <no location info> })
+ (AnnList
+ (Just
+ (EpaSpan { Test20297.hs:7:3-7 }))
+ (ListNone)
+ []
+ [])
+ (EpaComments
+ []))
+ (EpTok
+ (EpaSpan { Test20297.hs:7:3-7 })))
(ValBinds
(NoExtField)
[])))))])))))
@@ -204,7 +204,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -283,24 +282,25 @@
{OccName: x}))))))
[])
(HsValBinds
- (EpAnn
- (EpaSpan { Test20297.hs:(10,3)-(11,26) })
- (AnnList
- (Just
- (EpaSpan { Test20297.hs:11:9-26 }))
- (ListNone)
- []
- (EpTok
- (EpaSpan { Test20297.hs:10:3-7 }))
- [])
- (EpaComments
- [(L
- (EpaSpan
- { Test20297.hs:10:9-19 })
- (EpaComment
- (EpaLineComment
- "-- comment2")
- { Test20297.hs:10:3-7 }))]))
+ ((,)
+ (EpAnn
+ (EpaSpan { Test20297.hs:(10,3)-(11,26) })
+ (AnnList
+ (Just
+ (EpaSpan { Test20297.hs:11:9-26 }))
+ (ListNone)
+ []
+ [])
+ (EpaComments
+ [(L
+ (EpaSpan
+ { Test20297.hs:10:9-19 })
+ (EpaComment
+ (EpaLineComment
+ "-- comment2")
+ { Test20297.hs:10:3-7 }))]))
+ (EpTok
+ (EpaSpan { Test20297.hs:10:3-7 })))
(ValBinds
(NoExtField)
[(VbBind
@@ -328,7 +328,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -395,15 +394,16 @@
(EpaComments
[]))
(HsDo
- (AnnList
- (Just
- (EpaSpan { Test20297.hs:11:22-26 }))
- (ListBraces
- (NoEpTok)
- (NoEpTok))
- []
- (EpaSpan { Test20297.hs:11:19-20 })
- [])
+ ((,)
+ (AnnList
+ (Just
+ (EpaSpan { Test20297.hs:11:22-26 }))
+ (ListBraces
+ (NoEpTok)
+ (NoEpTok))
+ []
+ [])
+ (EpaSpan { Test20297.hs:11:19-20 }))
(DoExpr
(Nothing))
(L
@@ -518,7 +518,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -597,18 +596,19 @@
{OccName: x}))))))
[])
(HsValBinds
- (EpAnn
- (EpaSpan { <no location info> })
- (AnnList
- (Just
- (EpaSpan { Test20297.ppr.hs:5:3-7 }))
- (ListNone)
- []
- (EpTok
- (EpaSpan { Test20297.ppr.hs:5:3-7 }))
- [])
- (EpaComments
- []))
+ ((,)
+ (EpAnn
+ (EpaSpan { <no location info> })
+ (AnnList
+ (Just
+ (EpaSpan { Test20297.ppr.hs:5:3-7 }))
+ (ListNone)
+ []
+ [])
+ (EpaComments
+ []))
+ (EpTok
+ (EpaSpan { Test20297.ppr.hs:5:3-7 })))
(ValBinds
(NoExtField)
[])))))])))))
@@ -638,7 +638,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -717,18 +716,19 @@
{OccName: x}))))))
[])
(HsValBinds
- (EpAnn
- (EpaSpan { Test20297.ppr.hs:(8,3)-(9,24) })
- (AnnList
- (Just
- (EpaSpan { Test20297.ppr.hs:9:7-24 }))
- (ListNone)
- []
- (EpTok
- (EpaSpan { Test20297.ppr.hs:8:3-7 }))
- [])
- (EpaComments
- []))
+ ((,)
+ (EpAnn
+ (EpaSpan { Test20297.ppr.hs:(8,3)-(9,24) })
+ (AnnList
+ (Just
+ (EpaSpan { Test20297.ppr.hs:9:7-24 }))
+ (ListNone)
+ []
+ [])
+ (EpaComments
+ []))
+ (EpTok
+ (EpaSpan { Test20297.ppr.hs:8:3-7 })))
(ValBinds
(NoExtField)
[(VbBind
@@ -756,7 +756,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -823,15 +822,16 @@
(EpaComments
[]))
(HsDo
- (AnnList
- (Just
- (EpaSpan { Test20297.ppr.hs:9:20-24 }))
- (ListBraces
- (NoEpTok)
- (NoEpTok))
- []
- (EpaSpan { Test20297.ppr.hs:9:17-18 })
- [])
+ ((,)
+ (AnnList
+ (Just
+ (EpaSpan { Test20297.ppr.hs:9:20-24 }))
+ (ListBraces
+ (NoEpTok)
+ (NoEpTok))
+ []
+ [])
+ (EpaSpan { Test20297.ppr.hs:9:17-18 }))
(DoExpr
(Nothing))
(L
=====================================
testsuite/tests/printer/Test24533.stdout
=====================================
@@ -522,7 +522,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
@@ -1095,7 +1094,6 @@
(Nothing)
(ListNone)
[]
- (())
[]))
(L
(EpAnn
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -231,7 +231,7 @@ setAnchorAn :: (HasTrailing an)
setAnchorAn (L (EpAnn _ an _) a) anc ts cs = (L (EpAnn anc (setTrailing an ts) cs) a)
-- `debug` ("setAnchorAn: anc=" ++ showAst anc)
-setAnchorEpaL :: EpAnn (AnnList l) -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn (AnnList l)
+setAnchorEpaL :: EpAnn AnnList -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> EpAnn AnnList
setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = Nothing}) ts) cs
-- ---------------------------------------------------------------------
@@ -280,7 +280,7 @@ instance HasTrailing EpAnnSumPat where
trailing _ = []
setTrailing a _ = a
-instance HasTrailing (AnnList a) where
+instance HasTrailing AnnList where
trailing a = al_trailing a
setTrailing a ts = a { al_trailing = ts }
@@ -976,24 +976,19 @@ limportDeclAnnPackage k annImp = fmap (\new -> annImp { importDeclAnnPackage = n
-- al_anchor :: Maybe Anchor, -- ^ start point of a list having layout
-- al_brackets :: !AnnListBrackets,
-- al_semis :: [EpToken ";"], -- decls
--- al_rest :: !a,
-- al_trailing :: [TrailingAnn] -- ^ items appearing after the
-- -- list, such as '=>' for a
-- -- context
-- } deriving (Data,Eq)
-lal_brackets :: Lens (AnnList l) AnnListBrackets
+lal_brackets :: Lens AnnList AnnListBrackets
lal_brackets k parent = fmap (\new -> parent { al_brackets = new })
(k (al_brackets parent))
-lal_semis :: Lens (AnnList l) [EpToken ";"]
+lal_semis :: Lens AnnList [EpToken ";"]
lal_semis k parent = fmap (\new -> parent { al_semis = new })
(k (al_semis parent))
-lal_rest :: Lens (AnnList l) l
-lal_rest k parent = fmap (\new -> parent { al_rest = new })
- (k (al_rest parent))
-
-- -------------------------------------
lfst :: Lens (a,b) a
@@ -1281,23 +1276,23 @@ markKwT (AddDarrowAnn tok) = AddDarrowAnn <$> markEpUniToken tok
-- ---------------------------------------------------------------------
markAnnList :: (Monad m, Monoid w)
- => EpAnn (AnnList l) -> EP w m a -> EP w m (EpAnn (AnnList l), a)
+ => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
markAnnList ann action = do
markAnnListA ann $ \a -> do
r <- action
return (a,r)
markAnnList' :: (Monad m, Monoid w)
- => AnnList l -> EP w m a -> EP w m (AnnList l, a)
+ => AnnList -> EP w m a -> EP w m (AnnList, a)
markAnnList' ann action = do
markAnnListA' ann $ \a -> do
r <- action
return (a,r)
markAnnListA :: (Monad m, Monoid w)
- => EpAnn (AnnList l)
- -> (EpAnn (AnnList l) -> EP w m (EpAnn (AnnList l), a))
- -> EP w m (EpAnn (AnnList l), a)
+ => EpAnn AnnList
+ -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
+ -> EP w m (EpAnn AnnList, a)
markAnnListA an action = do
an0 <- markLensBracketsO an lal_brackets
an1 <- markEpAnnAllLT an0 lal_semis
@@ -1306,9 +1301,9 @@ markAnnListA an action = do
return (an3, r)
markAnnListA' :: (Monad m, Monoid w)
- => AnnList l
- -> (AnnList l -> EP w m (AnnList l, a))
- -> EP w m (AnnList l , a)
+ => AnnList
+ -> (AnnList -> EP w m (AnnList, a))
+ -> EP w m (AnnList, a)
markAnnListA' an action = do
an0 <- markLensBracketsO' an lal_brackets
an1 <- markEpAnnAllLT' an0 lal_semis
@@ -2467,17 +2462,17 @@ instance ExactPrint (GRHSs GhcPs (LocatedA (HsCmd GhcPs))) where
-- ---------------------------------------------------------------------
instance ExactPrint (HsLocalBinds GhcPs) where
- getAnnotationEntry (HsValBinds an _) = fromAnn an
+ getAnnotationEntry (HsValBinds (an,_) _) = fromAnn an
getAnnotationEntry (HsIPBinds{}) = NoEntryVal
getAnnotationEntry (EmptyLocalBinds{}) = NoEntryVal
- setAnnotationAnchor (HsValBinds an a) anc ts cs = HsValBinds (setAnchorEpaL an anc ts cs) a
+ setAnnotationAnchor (HsValBinds (an,w) a) anc ts cs = HsValBinds (setAnchorEpaL an anc ts cs, w) a
setAnnotationAnchor a _ _ _ = a
- exact (HsValBinds an valbinds) = do
- an0 <- markLensFun' an lal_rest markEpToken -- 'where'
+ exact (HsValBinds (an0, w) valbinds) = do
+ w' <- markEpToken w -- 'where'
- case al_anchor $ anns an of
+ case al_anchor $ anns an0 of
Just anc -> do
when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc)
_ -> return ()
@@ -2490,14 +2485,14 @@ instance ExactPrint (HsLocalBinds GhcPs) where
Just (ss,dp) -> do
setExtraDPReturn Nothing
return $ an1 { anns = (anns an1) { al_anchor = Just (EpaDelta ss dp []) }}
- return (HsValBinds an2 valbinds')
+ return (HsValBinds (an2, w') valbinds')
- exact (HsIPBinds an bs) = do
+ exact (HsIPBinds (an,w) bs) = do
+ w' <- markEpToken w
(an2,bs') <- markAnnListA an $ \an0 -> do
- an1 <- markLensFun' an0 lal_rest markEpToken
bs' <- markAnnotated bs
- return (an1, bs')
- return (HsIPBinds an2 bs')
+ return (an0, bs')
+ return (HsIPBinds (an2,w') bs')
exact b@(EmptyLocalBinds _) = return b
@@ -2925,10 +2920,10 @@ instance ExactPrint (HsExpr GhcPs) where
e' <- markAnnotated e
return (HsLet (tkLet',tkIn') binds' e')
- exact (HsDo an do_or_list_comp stmts) = do
+ exact (HsDo (an,l) do_or_list_comp stmts) = do
debugM $ "HsDo"
- (an',stmts') <- exactDo an do_or_list_comp stmts
- return (HsDo an' do_or_list_comp stmts')
+ (an',l',stmts') <- exactDo (an,l) do_or_list_comp stmts
+ return (HsDo (an',l') do_or_list_comp stmts')
exact (ExplicitList an es) = do
debugM $ "ExplicitList start"
@@ -3100,33 +3095,35 @@ instance ExactPrint (HsExpr GhcPs) where
-- ---------------------------------------------------------------------
exactDo :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
- => AnnList EpaLocation -> HsDoFlavour -> LocatedAn an a
- -> EP w m (AnnList EpaLocation, LocatedAn an a)
-exactDo an (DoExpr m) stmts = exactMdo an m "do" >>=
- \an0 -> markMaybeDodgyStmts an0 stmts
-exactDo an GhciStmtCtxt stmts = markLensFun an lal_rest (\l -> printStringAtAA l "do") >>=
- \an0 -> markMaybeDodgyStmts an0 stmts
-exactDo an (MDoExpr m) stmts = exactMdo an m "mdo" >>=
- \an0 -> markMaybeDodgyStmts an0 stmts
-exactDo an ListComp stmts = markMaybeDodgyStmts an stmts
-exactDo an MonadComp stmts = markMaybeDodgyStmts an stmts
+ => (AnnList, EpaLocation) -> HsDoFlavour -> LocatedAn an a
+ -> EP w m (AnnList, EpaLocation, LocatedAn an a)
+exactDo (an,l) (DoExpr m) stmts = exactMdo l m "do" >>=
+ \l0 -> markMaybeDodgyStmts (an,l0) stmts
+exactDo (an,l) GhciStmtCtxt stmts = printStringAtAA l "do" >>=
+ \l0 -> markMaybeDodgyStmts (an,l0) stmts
+exactDo (an,l) (MDoExpr m) stmts = exactMdo l m "mdo" >>=
+ \l0 -> markMaybeDodgyStmts (an,l0) stmts
+exactDo (an,l) ListComp stmts = markMaybeDodgyStmts (an,l) stmts
+exactDo (an,l) MonadComp stmts = markMaybeDodgyStmts (an,l) stmts
exactMdo :: (Monad m, Monoid w)
- => AnnList EpaLocation -> Maybe ModuleName -> String -> EP w m (AnnList EpaLocation)
-exactMdo an Nothing kw = markLensFun an lal_rest (\l -> printStringAtAA l kw)
-exactMdo an (Just module_name) kw = markLensFun an lal_rest (\l -> printStringAtAA l n)
+ => EpaLocation -> Maybe ModuleName -> String -> EP w m EpaLocation
+-- exactMdo an Nothing kw = markLensFun an lal_rest (\l -> printStringAtAA l kw)
+exactMdo l Nothing kw = printStringAtAA l kw
+exactMdo l (Just module_name) kw = printStringAtAA l n
where
n = (moduleNameString module_name) ++ "." ++ kw
markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a))
- => AnnList l -> LocatedAn an a -> EP w m (AnnList l, LocatedAn an a)
-markMaybeDodgyStmts an stmts =
+ => (AnnList, EpaLocation) -> LocatedAn an a -> EP w m (AnnList, EpaLocation, LocatedAn an a)
+markMaybeDodgyStmts (an,l) stmts =
if notDodgy stmts
then do
- markAnnListA' an $ \a -> do
+ (an0,stmts') <- markAnnListA' an $ \a -> do
r <- markAnnotatedWithLayout stmts
return (a, r)
- else return (an, stmts)
+ return (an0, l, stmts')
+ else return (an, l, stmts)
notDodgy :: GenLocated (EpAnn ann) a -> Bool
notDodgy (L (EpAnn anc _ _) _) = notDodgyE anc
@@ -3406,13 +3403,13 @@ instance ExactPrint (HsCmd GhcPs) where
e' <- markAnnotated e
return (HsCmdLet (tkLet', tkIn') binds' e')
- exact (HsCmdDo an (L l es)) = do
+ exact (HsCmdDo (an0,loc) (L l es)) = do
debugM $ "HsCmdDo"
- an0 <- markLensFun an lal_rest (\ll -> printStringAtAA ll "do")
+ loc' <- printStringAtAA loc "do"
(an1,es') <- markAnnList' an0 $ do
ee <- mapM markAnnotated es
return ee
- return (HsCmdDo an1 (L l es'))
+ return (HsCmdDo (an1,loc') (L l es'))
-- ---------------------------------------------------------------------
@@ -3459,11 +3456,11 @@ instance (
(an', by', using') <- exactTransStmt an by using form
return (TransStmt an' form stmts' b using' by' c d e)
- exact (RecStmt an stmts a b c d e) = do
+ exact (RecStmt (an,r) stmts a b c d e) = do
debugM $ "RecStmt"
- an0 <- markLensFun an lal_rest markEpToken
- (an1, stmts') <- markAnnList' an0 (markAnnotated stmts)
- return (RecStmt an1 stmts' a b c d e)
+ r' <- markEpToken r
+ (an1, stmts') <- markAnnList' an (markAnnotated stmts)
+ return (RecStmt (an1,r') stmts' a b c d e)
-- ---------------------------------------------------------------------
=====================================
utils/check-exact/Main.hs
=====================================
@@ -518,15 +518,15 @@ changeLocalDecls libdir (L l p) = do
doAddLocal = everywhereM (mkM replaceLocalBinds) p
replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)
-> Transform (LMatch GhcPs (LHsExpr GhcPs))
- replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds van (ValBinds _ bs))))) = do
+ replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds (van,w) (ValBinds _ bs))))) = do
let (oldDecls) = map unWrapValBind bs
-- let decls = s:d:oldDecls
let oldDecls' = captureLineSpacing oldDecls
let (VbSig o:oldBinds) = map wrapValBind oldDecls'
o' = setEntryDP o (DifferentLine 2 0)
- let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van
- let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b c dd) cs)
- let binds' = (HsValBinds van'
+ let (EpAnn anc (AnnList (Just _) a b dd) cs) = van
+ let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b dd) cs)
+ let binds' = (HsValBinds (van',w)
(ValBinds noExtField (VbSig sig':VbBind decl':VbSig o':oldBinds)))
return (L lm (Match an mln pats (GRHSs emptyComments rhs binds')))
`debug` ("oldDecls=" ++ showAst oldDecls)
@@ -550,12 +550,11 @@ changeLocalDecls2 libdir (L l p) = do
replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do
let anc = (EpaDelta noSrcSpan (DifferentLine 1 2) [])
let anc2 = (EpaDelta noSrcSpan (DifferentLine 1 4) [])
- let an = EpAnn anc
+ let an = (EpAnn anc
(AnnList (Just anc2) ListNone
[]
- (EpTok (EpaDelta noSrcSpan (SameLine 0) []))
[])
- emptyComments
+ emptyComments, EpTok (EpaDelta noSrcSpan (SameLine 0) []))
let decls = [VbSig sig', VbBind decl']
let binds = (HsValBinds an (ValBinds noExtField decls))
return (L lm (Match ma mln pats (GRHSs emptyComments rhs binds)))
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -499,7 +499,7 @@ balanceCommentsMatch (L l (Match am mctxt pats (GRHSs xg grhss binds)))
pushTrailingComments :: WithWhere -> EpAnnComments -> HsLocalBinds GhcPs -> (Bool, HsLocalBinds GhcPs)
pushTrailingComments _ _cs b@EmptyLocalBinds{} = (False, b)
pushTrailingComments _ _cs (HsIPBinds _ _) = error "TODO: pushTrailingComments:HsIPBinds"
-pushTrailingComments w cs lb@(HsValBinds an _) = (True, HsValBinds an' vb)
+pushTrailingComments w cs lb@(HsValBinds (an,wt) _) = (True, HsValBinds (an',wt) vb)
where
decls = hsDeclsLocalBinds lb
(an', decls') = case reverse decls of
@@ -1090,13 +1090,13 @@ replaceDeclsValbinds w (EmptyLocalBinds _) new
= let an = newWhereAnnotation w
in (HsValBinds an (ValBinds noExtField (map wrapValBind new)))
-oldWhereAnnotation :: EpAnn (AnnList (EpToken "where"))
- -> WithWhere -> RealSrcSpan -> (EpAnn (AnnList (EpToken "where")))
-oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = an'
+oldWhereAnnotation :: (EpAnn AnnList, EpToken "where")
+ -> WithWhere -> RealSrcSpan -> (EpAnn AnnList, EpToken "where")
+oldWhereAnnotation (EpAnn anc an cs, _w) ww _oldSpan = an'
-- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation,
-- change the AnnList anchor to have the correct DP too
where
- (AnnList ancl p s _r t) = an
+ (AnnList ancl p s t) = an
w = case ww of
WithWhere -> EpTok (EpaDelta noSrcSpan (SameLine 0) [])
WithoutWhere -> NoEpTok
@@ -1104,12 +1104,12 @@ oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = an'
case ww of
WithWhere -> (anc, ancl)
WithoutWhere -> (anc, ancl)
- an' = EpAnn anc'
- (AnnList ancl' p s w t)
- cs
+ an' = (EpAnn anc'
+ (AnnList ancl' p s t)
+ cs, w)
-newWhereAnnotation :: WithWhere -> (EpAnn (AnnList (EpToken "where")))
-newWhereAnnotation ww = an
+newWhereAnnotation :: WithWhere -> (EpAnn AnnList, EpToken "where")
+newWhereAnnotation ww = (an, w)
where
anc = EpaDelta noSrcSpan (DifferentLine 1 2) []
anc2 = EpaDelta noSrcSpan (DifferentLine 1 4) []
@@ -1117,7 +1117,7 @@ newWhereAnnotation ww = an
WithWhere -> EpTok (EpaDelta noSrcSpan (SameLine 0) [])
WithoutWhere -> NoEpTok
an = EpAnn anc
- (AnnList (Just anc2) ListNone [] w [])
+ (AnnList (Just anc2) ListNone [] [])
emptyComments
-- ---------------------------------------------------------------------
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -230,7 +230,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining
addCommentsListItem :: EpAnn [TrailingAnn] -> State [LEpaComment] (EpAnn [TrailingAnn])
addCommentsListItem = addComments
- addCommentsList :: EpAnn (AnnList ()) -> State [LEpaComment] (EpAnn (AnnList ()))
+ addCommentsList :: EpAnn AnnList -> State [LEpaComment] (EpAnn AnnList)
addCommentsList = addComments
addCommentsGrhs :: EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f75c58844bbcff94e386c24012130d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f75c58844bbcff94e386c24012130d…
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][master] hie.yaml: use a polyglot shell/batch script
by Marge Bot (＠marge-bot) 10 Aug '26
by Marge Bot (＠marge-bot) 10 Aug '26
10 Aug '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
9df24b7e by sheaf at 2026-08-10T14:28:30-04:00
hie.yaml: use a polyglot shell/batch script
This commit merges hie-bios and hie-bios.bat into a single polyglot
script. This avoids Windows users having to manually update hie.yaml
in order to be able to use HLS.
- - - - -
3 changed files:
- − hadrian/hie-bios
- hadrian/hie-bios.bat
- hie.yaml
Changes:
=====================================
hadrian/hie-bios deleted
=====================================
@@ -1,6 +0,0 @@
-#! /usr/bin/env bash
-
-# When run, this program will output a list of arguments which are necessary to
-# load the GHC library component into GHCi. The program is used by `ghcide` in
-# order to automatically set up the correct GHC API session for a project.
-TERM=dumb CABFLAGS=-v0 TOOL_OUTPUT=$HIE_BIOS_OUTPUT $PWD/hadrian/build-cabal tool:$1 -q --build-root=.hie-bios --flavour=ghc-in-ghci -j
=====================================
hadrian/hie-bios.bat
=====================================
@@ -1,4 +1,31 @@
+#!/usr/bin/env bash
+
+:;# When run, this program will output a list of arguments which are necessary to
+:;# load the GHC library component into GHCi. The program is used by `ghcide` in
+:;# order to automatically set up the correct GHC API session for a project.
+
+:;# This is a POSIX shell/Windows batch polyglot script, which allows hie-bios
+:;# to use a single hie.yaml file for both platforms.
+:;#
+:;# 1. The file extension is '.bat', because Windows requires this.
+:;# On POSIX, the extension doesn't matter, because the #! is what makes
+:;# the script runnable. On Windows, this shebang makes cmd.exe complain on
+:;# stderr, but this doesn't break anything; we add 'Please ignore the #! error'
+:;# to stderr as a courtesy.
+:;# 2. On Windows, cmd.exe interprets lines starting with ':' as (goto) labels,
+:;# essentially ignoring them (for our purposes).
+:;# On POSIX, ':' is the no-op command, which we terminate with ';'.
+:;# As '#' is used for shell comment syntax, ':;#' behaves like a comment
+:;# marker in the polyglot language.
+:;# 3. The line endings are LF-only, to make this POSIX-compliant.
+
+:;# The POSIX part. Ignored on Windows as it starts with ':'.
+:; TERM=dumb CABFLAGS=-v0 TOOL_OUTPUT=$HIE_BIOS_OUTPUT exec "$PWD/hadrian/build-cabal" tool:"$1" -q --build-root=.hie-bios --flavour=ghc-in-ghci -j
+
+:;# The Windows part. Ignored on POSIX, because the above command execs.
+@echo off
+>&2 echo Please ignore the above error that '#!' is not recognised.
set TERM=dumb
set CABFLAGS=-v0
set TOOL_OUTPUT=%HIE_BIOS_OUTPUT%
-%CD%\hadrian\build-cabal.bat tool:%1 --build-root=.hie-bios --flavour=ghc-in-ghci -j
+%CD%\hadrian\build-cabal.bat tool:%1 -q --build-root=.hie-bios --flavour=ghc-in-ghci -j
=====================================
hie.yaml
=====================================
@@ -1,8 +1,7 @@
# This is a IDE configuration file which tells IDEs such as `ghcide` how
# to set up a GHC API session for this project.
#
-# To use it in windows systems replace the config with
-# cradle: {bios: {program: "./hadrian/hie-bios.bat"}}
-#
# The format is documented here - https://github.com/mpickering/hie-bios
-cradle: {bios: {program: "./hadrian/hie-bios"}}
+cradle: {bios: {program: "./hadrian/hie-bios.bat"}}
+ # NB: hadrian/hie-bios.bat is a shell/batch polyglot script which runs
+ # on all platforms.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9df24b7e5fa8e76c01270ce1e708ab4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9df24b7e5fa8e76c01270ce1e708ab4…
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