September 2026 - ghc-commits

[Git][ghc/ghc][wip/az/exactprint-annotation-rationalisation] 68 commits: rts: fix ctoi_tuple_spill_words getting out of sync
by Alan Zimmerman (＠alanz) 12 Sep '26

12 Sep '26

Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC Commits: 192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00 rts: fix ctoi_tuple_spill_words getting out of sync Fix a few places that were not updating ctoi_tuple_spill_words correctly, leading to corruption/crashes when dealing with large unboxed tuples in bytecode: - captureContinuationAndAbort - findRetryFrameHelper/findAtomicallyFrameHelper - interpretBCO bci_BRK_FUN fixes #27633 - - - - - 604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00 Hadrian: don't capture the testsuite driver's output (#27780) a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the cmd' wrapper. cmd' always captures stdout and stderr, and since the caller asks for Exit, it returns without dumping what it captured. As a result the testsuite output no longer appears in CI job logs: failures, performance metrics and the summary were lost with the job. Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that commit do. Fixes #27780. Assisted-by: Claude Fable 5.1 - - - - - 06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 - - - - - f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - 430967ab by Duncan Coutts at 2026-09-09T11:07:01+01:00 Reorder cmm decls in HeapStackCheck for a better logical grouping And put more section headers in to deliniate the groups. We're about to add more here, so better to organise it first. - - - - - 344080fd by Duncan Coutts at 2026-09-09T11:07:01+01:00 Add raisePrimIOException and add it to RTS<->ghc-internal API The raisePrimIOException is a new helper function that I/O primops will use to help them report I/O errors. This is implemented in Haskell (since that's a lot easier), but has a calling convention that is easy(ish) to use from Cmm in the I/O primops. So we add it to the RTS API struct, and since we'll use it from Cmm we also need a field accessor macro for cmm (in deriveConstants). See the Note about how we cannot have nice things due to async exceptions and thunks preventing us from using catch. - - - - - cfdb3399 by Duncan Coutts at 2026-09-09T11:07:01+01:00 Add new blocking functions for I/O primops See the Note [Thread blocking for new I/O primops], and the Note [Calling convention for raisePrimIOException]. The point is, it will allow us to report synchronous exceptions from I/O primops, and do so much more flexibly. Previously the I/O managers could only report async exceptions and only nullary exceptions. This was OK historically, but no good as we add more I/O managers and expand the range of I/O operations we support. - - - - - f09c09d8 by Duncan Coutts at 2026-09-09T11:07:01+01:00 Change the encoding of results from the I/O manager to I/O primops Previously we just had async continue or heap overflow. We now extend what we can report with synchronous success, and synchronous failure with an errno. See Note [Encoding of result of I/O manager operations] We don't use these two new cases yet, but we will. In particular an epoll I/O manager needs to be able to report synchronous success or failure for waitRead#/waitWrite#. - - - - - 30f074d9 by Duncan Coutts at 2026-09-09T11:07:01+01:00 Switch waitRead/Write# to use new blocking return frames and update the I/O managers to set the result before resuming the blocked threads. This makes it possible for I/O managers to report synchronous exceptions from the I/O primops, but that will be done in a subsequent commit. - - - - - a8786ced by Duncan Coutts at 2026-09-09T11:07:01+01:00 Switch Poll and Select I/O managers to report sync exceptions rather than using raiseAsync with blockedOnBadFD_closure. This uses the new mechanism in the blocking frame return code to report synchronous exceptions. - - - - - 7a9df79a by Duncan Coutts at 2026-09-09T11:07:01+01:00 Remove now-unused blockedOnBadFD It was previously thrown by the select and poll I/O managers, but now they use raisePrimIOException (with an EBADF errno). - - - - - 6b0424e3 by Duncan Coutts at 2026-09-09T11:07:01+01:00 Improve the docs for delay# waitRead# and waitWrite# Document that the waitRead/Write# can throw exceptions (this was true before too), and that all of them are async exception cancellation points. - - - - - afeb2c30 by Duncan Coutts at 2026-09-09T20:08:58-04:00 Enable printf warnings for trace functions and fix resulting warnings Most of the existing printf-style functions are annotated with attributes to enable gcc/clang warnings for the printf format string, but several trace functions in Trace.h were missing this annotation. Enable them, and fix the resulting warnings. - - - - - 9a442c93 by Alan Zimmerman at 2026-09-09T20:09:36-04:00 EPA: Exact print ConDeclGADT without custom enterAnn !16321 brought in explicit capture of parens in a ConDeclGADT. The ExactPrint update introduced a modification of the fundamental function in exact printing, `enterAnn`, by splitting it into a version allowing injection of functionality normally handled by the ExactPrint class methods. This commit refactors that code, to restore the prior `enterAnn` version, by following the convention in ExactPrint of introducing a helper data structure with its own `ExactPrint` instance to achieve the same effect. - - - - - 4e9297ea by Simon Jakobi at 2026-09-11T08:32:45-04:00 ci: Actually pass --ignore-perf-failures to the testsuite driver 684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to RUNTEST_ARGS with bash array syntax, but the three use sites still expand RUNTEST_ARGS as a scalar, which yields only the first array element. The appended flag was therefore dropped in every job, so perf improvements kept failing Marge Bot batches and master pipelines, contrary to #19562. Append as a string instead, matching the existing --force-colors append in test_hadrian. Fixes #27563. Assisted-by: Claude Fable 5.1 - - - - - 4f78dfdf by Simon Jakobi at 2026-09-11T08:33:24-04:00 testsuite: Give T26537 a 1.5x compile timeout Its -fregs-graph compile step tends to time out in unoptimized builds (#27188, #27776). Assisted-by: Claude Fable 5.1 - - - - - 130286e3 by Alan Zimmerman at 2026-09-11T08:34:08-04:00 EPA: Remove ListBanana / ListParens from AnnListBrackets This is a step towards making AnnList only represent lists of items which can have either braces or layout. - - - - - a9827d13 by Simon Jakobi at 2026-09-11T18:53:32-04:00 Reject ~, UNPACK and multiplicity annotations on type data fields Only `!` was rejected so far. `~`, UNPACK and multiplicity annotations were silently accepted. None of them make sense at the type level, so restriction (R3) of Note [Type data declarations] now covers all of them. Fixes #27732. Assisted-by: Claude Fable 5.1 - - - - - c71d5e23 by Alan Zimmerman at 2026-09-11T18:54:11-04:00 EPA: Add a Note for the exact print main loop - - - - - 184d4c54 by Alan Zimmerman at 2026-09-12T16:50:25+01:00 EPA: More targeted HsDo exact print annotation HsDo is multi-purpose, as encoded in its HsDoFlavour field. Some of these are in a layout context (DoExpr, MDoExpr), others are not (ListComp, MonadComp). We are moving towards using AnnList only in layout contexts, so we switch the HsDo TTG annotation from holding an AnnList for this, to holding Either (EpToken "[", EpToken "]") AnnList This also allows us to trim down AnnListBrackets to only have braces or None, thereby opening the door for unification with the existing layout context data type EpLayout. - - - - - 99dc2235 by Alan Zimmerman at 2026-09-12T17:25:02+01:00 EPA: Add specific layout field to AnnList Up to now AnnList has effectively served to represent lists of things having layout, regardless of whether they do or not. In Haskell, layout is optional in many places, as there is also an alternative syntax using braces and semi-colons, which is free-form. This commit introduces AnnListLayout, a data structure capturing this distinction. It is deliberately set up similarly to EpLayout, so that these two can be merged in time. - - - - - 5017a5e9 by Alan Zimmerman at 2026-09-12T17:25:02+01:00 EPA: Use EpaLocation in EpVirtualBraces reword: 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. - - - - - c97a7cd1 by Alan Zimmerman at 2026-09-12T18:01:55+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. - - - - - abcb64e7 by Alan Zimmerman at 2026-09-12T18:18:51+01:00 EPA: AnnList clean up patch for empty where clause - - - - - a09cf2ab by Alan Zimmerman at 2026-09-12T18:18:51+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 - - - - - 14055661 by Alan Zimmerman at 2026-09-12T18:18:51+01:00 WIP annclassdecl - - - - - fc969850 by Alan Zimmerman at 2026-09-12T18:18:51+01:00 EPA: Update AnnClsInstDecl to contain AnnList It was already separately tracking the '{', '}' and leading ';' values. This aligns it with layout-introducing parser productions ('vocurly'), so the layout processing can be handled uniformly - - - - - 306aa75e by Alan Zimmerman at 2026-09-12T18:18:51+01:00 EPA: Tidy up markAnnListA' It takes an action which can modify the AnnList, but this is never used. So remove it. - - - - - c0d5dcea by Alan Zimmerman at 2026-09-12T18:18:51+01:00 EPA: Use AnnList for GADT declarations - - - - - 96f7edc7 by Alan Zimmerman at 2026-09-12T18:18:51+01:00 EPA: Use AnnList in AnnClassDecl - - - - - 0e4a0024 by Alan Zimmerman at 2026-09-12T18:18:51+01:00 MOVE EPA: Plan for Fixing AnnList Layout Properly - - - - - 1e2a6e7b by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make local binds located Use LHsLocalBinds instead of HsLocalBinds This reverses an earlier change, and brings processing of local binds into alignement with the exact printing principle that the LocatedA contents provide the location and extent of the enclosed item, together with any comments or context-specific trailing items like commas or semi colons. The internal TTG extension points only carry exact print annotations related to printing the item within its bounds. This change brings back the problem of EmptyLocalBinds, which by definition cannot have a location. These get a noSrcSpan location, which is ignored in the exact printing process. - - - - - af74d4a1 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Use AnnList in HsMultiIf It introduces layout, capture it - - - - - dff39adb by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Use AnnList in DecBrl - - - - - bdb6df32 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Replace AnnListLayout / AnnListBrackets with EpLayout - - - - - 7d1214a9 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 WIP: setLayoutBoth inside markAnnListA Current problem is it is a global one-shot, and MG has one too Check: is it needed? if so, honouring EpLayout may be needed - - - - - 5df232f9 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA some tests for layout. WIP - - - - - 54059953 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 Exactprint layout scope plan. Do not commit - - - - - a0ef48f0 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: tidy up a bit. Combine somewhere else - - - - - 62c34a32 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Introduce LayoutFrame stacks in ExactPrint state - - - - - 01869f8a by Alan Zimmerman at 2026-09-12T18:18:52+01:00 Align with ghc-exactprint - - - - - 568daed7 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Fix AnnList leading semis when layout When there is layout, anything printed triggers it, including leading semis. Add some test case examples too - - - - - 34079dc6 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 Exactprint: tidy up layout capturing - - - - - dea6e4ce by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: add makeDelta test for Test20297 The original #20297 related to comment placement for exact printing after running ExactPrint.makeDelta on ParsedSource. Add an additional test that explicitly tests this. - - - - - 86c3e786 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make ValBinds LocatedA in HsLocalBindsLR If we have items with an AnnList Annotation, as part of another, which has different content, it must be LocatedA. This is a technical requirement due to the way comment allocation happens during the makeDelta processing. Comments are queued for printing, and as soon as any non-comment is to be printed, the pending comments before that position are printed, and in makeDelta processing these attached as preceding comments to the thing just printed. The means they end up captured inside the layout region of the AnnList item. So for foo = x where -- comment x = 3 the comment ends up as a preceding comment of `x = 3`, inside the layout, and prints as foo = x where -- comment x = 3 - - - - - ad1401b8 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make IPBinds LocatedA - - - - - 579b1123 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make ClsInstDecl decls LocatedA - - - - - 0218256e by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make ClassDecls decls LocatedA - - - - - dc8c9efa by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make ClosedTypeFamily equations Located For FamilyDecl/ClosedTypeFamily - - - - - 497bb000 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make dd_cons located - - - - - 3d7d77df by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make HsMultiIf options located - - - - - e4e7df9d by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Make DecBrl contents LocatedA - - - - - 86c9a465 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Located do statements - - - - - 29141ac6 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Print RecStmt located - - - - - f9d73080 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: HsCmdDo Located - - - - - e901e0c9 by Alan Zimmerman at 2026-09-12T18:18:52+01:00 Extend Test20297 for additional occurrences - - - - - 39b57cab by Alan Zimmerman at 2026-09-12T18:18:52+01:00 EPA: Tweak PatSynBind location for comments - - - - - 0fbbcadb by Alan Zimmerman at 2026-09-12T18:42:05+01:00 EPA: WIP, add test for where ;; ValBinds - - - - - e79fc375 by Alan Zimmerman at 2026-09-12T18:42:05+01:00 EPA: Make EpVirtualBraces noSpanAnchor if no contents Otherwise the vocurly is emitted at the start of the next item parsed Check: is this needed, or just a check for empty contents? - - - - - 5ab16646 by Alan Zimmerman at 2026-09-12T18:42:47+01:00 WIP: turn of exactprint debug printing - - - - - 0c48a521 by Alan Zimmerman at 2026-09-12T18:43:04+01:00 EPA: Remove CanUpdateAnchorOnly - - - - - dcab4f1d by Alan Zimmerman at 2026-09-12T18:43:04+01:00 Plan update DO NOT COMMIT - - - - - 74ad6345 by Alan Zimmerman at 2026-09-12T18:43:04+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 - - - - - b5fb113b by Alan Zimmerman at 2026-09-12T18:43:04+01:00 EPA: HsList attempt WIP - - - - - 81185c6e by Alan Zimmerman at 2026-09-12T18:43:04+01:00 Enable ppr test for Haddock1. It currently fails - - - - - d0c53068 by Alan Zimmerman at 2026-09-12T18:43:04+01:00 WIP on removing NoEpAnn. Likely abandon - - - - - e9c53c86 by Alan Zimmerman at 2026-09-12T18:43:04+01:00 EPA: Add an overview doc for exact printing - - - - - fef90109 by Simon Peyton Jones at 2026-09-12T18:43:04+01:00 Added an intro section - - - - - 182 changed files: - .gitlab/ci.sh - + ANNLIST-LAYOUT-PLAN.md - + ExactPrint.md - + LAYOUT-SCOPE-PLAN.md - + changelog.d/27732 - + changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Builtin/primops.txt.pp - 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/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Expr.hs-boot - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Functor.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - docs/users_guide/exts/type_data.rst - ghc/GHCi/UI.hs - hadrian/src/Builder.hs - libraries/ghc-internal/include/RtsIfaceSymbols.h - libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs - libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs - rts/Capability.c - rts/Continuation.c - rts/HeapStackCheck.cmm - rts/IOManager.c - rts/IOManager.h - rts/IOManagerInternals.h - rts/Interpreter.c - rts/Messages.c - rts/Prelude.h - rts/PrimOps.cmm - rts/Printer.c - rts/STM.c - rts/Schedule.c - rts/Sparks.c - rts/StableName.c - rts/ThreadPaused.c - rts/Threads.c - rts/Trace.h - rts/include/rts/RtsToHsIface.h - rts/include/stg/MiscClosures.h - rts/posix/Poll.c - rts/posix/Poll.h - rts/posix/Select.c - rts/posix/Timeout.c - rts/sm/Compact.c - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCUtils.c - rts/sm/MBlock.c - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/sm/Storage.c - rts/sm/Sweep.c - + testsuite/tests/bytecode/T27633/Obj.hs - + testsuite/tests/bytecode/T27633/T27633a.hs - + testsuite/tests/bytecode/T27633/T27633a.stdout - + testsuite/tests/bytecode/T27633/T27633b.hs - + testsuite/tests/bytecode/T27633/T27633b.stdout - + testsuite/tests/bytecode/T27633/all.T - testsuite/tests/codeGen/should_run/all.T - 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/ghci.debugger/scripts/T27633c.hs - + testsuite/tests/ghci.debugger/scripts/T27633c.script - + testsuite/tests/ghci.debugger/scripts/T27633c.stdout - + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs - testsuite/tests/ghci.debugger/scripts/all.T - 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.hs - 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/hard_hole_fits.stderr - testsuite/tests/printer/AnnotationNoListTuplePuns.stdout - + testsuite/tests/printer/Layout.hs - testsuite/tests/printer/Makefile - testsuite/tests/printer/Ppr003.hs - testsuite/tests/printer/T18791.stderr - + testsuite/tests/printer/Test20297.expected.hs - testsuite/tests/printer/Test20297.hs - testsuite/tests/printer/Test20297.stdout - + testsuite/tests/printer/Test20297MD.stdout - testsuite/tests/printer/Test24533.stdout - testsuite/tests/printer/all.T - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T - + testsuite/tests/type-data/should_fail/T27732a.hs - + testsuite/tests/type-data/should_fail/T27732a.stderr - + testsuite/tests/type-data/should_fail/T27732b.hs - + testsuite/tests/type-data/should_fail/T27732b.stderr - + testsuite/tests/type-data/should_fail/T27732c.hs - + testsuite/tests/type-data/should_fail/T27732c.stderr - + testsuite/tests/type-data/should_fail/T27732d.hs - + testsuite/tests/type-data/should_fail/T27732d.stderr - + testsuite/tests/type-data/should_fail/T27732e.hs - + testsuite/tests/type-data/should_fail/T27732e.stderr - + testsuite/tests/type-data/should_fail/T27732f.hs - + testsuite/tests/type-data/should_fail/T27732f.stderr - testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr - testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr - testsuite/tests/type-data/should_fail/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/deriveConstants/Main.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/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.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/f23ef4db65fe072a66509d1a8311f9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f23ef4db65fe072a66509d1a8311f9… 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/epa-tidy-locatedxxx-24] EPA: More targeted HsDo exact print annotation
by Alan Zimmerman (＠alanz) 12 Sep '26

12 Sep '26

Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-24 at Glasgow Haskell Compiler / GHC Commits: 184d4c54 by Alan Zimmerman at 2026-09-12T16:50:25+01:00 EPA: More targeted HsDo exact print annotation HsDo is multi-purpose, as encoded in its HsDoFlavour field. Some of these are in a layout context (DoExpr, MDoExpr), others are not (ListComp, MonadComp). We are moving towards using AnnList only in layout contexts, so we switch the HsDo TTG annotation from holding an AnnList for this, to holding Either (EpToken "[", EpToken "]") AnnList This also allows us to trim down AnnListBrackets to only have braces or None, thereby opening the door for unification with the existing layout context data type EpLayout. - - - - - 10 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/printer/Test20297.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -290,10 +290,12 @@ 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 = DoAnn type instance XDo GhcRn = NoExtField type instance XDo GhcTc = Type +type DoAnn = (Either (EpToken "[", EpToken "]") AnnList, EpaLocation) + type instance XExplicitList GhcPs = (EpToken "[", EpToken "]") type instance XExplicitList GhcRn = NoExtField type instance XExplicitList GhcTc = Type @@ -1467,7 +1469,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 = DoAnn type instance XCmdDo GhcRn = NoExtField type instance XCmdDo GhcTc = Type ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -335,11 +335,10 @@ 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] -> DoAnn -> HsExpr GhcPs mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs - -> (AnnList, EpaLocation) +mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> DoAnn -> HsExpr GhcPs mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-" ===================================== compiler/GHC/Parser.y ===================================== @@ -3152,19 +3152,15 @@ aexp :: { ECP } return $ ECP $ $2 >>= \ $2 -> mkHsDoPV (comb2 $1 $2) - (stmtlistAnns $2) + (Right $ stmtlistAnns $2, glR $1) (fmap mkModuleNameFS (getDO $1)) - (stmtlistStmts $2) - (glR $1) - (glR $2) } + (stmtlistStmts $2) } | MDO stmtlist {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 -> fmap ecpFromExp $ amsA' (L (comb2 $1 $2) - (mkMDo (stmtlistAnns $2) - (MDoExpr $ fmap mkModuleNameFS (getMDO $1)) - (stmtlistStmts $2) - (glR $1) - (glR $2))) } + (mkHsDoAnns (MDoExpr $ fmap mkModuleNameFS (getMDO $1)) + (stmtlistStmts $2) + (Right $ stmtlistAnns $2, glR $1))) } | 'proc' aexp '->' exp {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4@cmd -> @@ -3440,7 +3436,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 (Left $ (EpTok ao, EpTok ac), noAnn)) >>= ecpFromExp' } } lexps :: { forall b. DisambECP b => PV [LocatedA b] } @@ -3658,11 +3654,13 @@ apat : aexp {% (checkPattern <=< runPV) (unECP $1) } ----------------------------------------------------------------------------- -- Statement sequences -stmtlist :: { forall b. DisambECP b => PV (LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), Located [LocatedA (Stmt GhcPs (LocatedA b))])) } +stmtlist :: { forall b. DisambECP b => PV (LocatedA (AnnList, Located [LocatedA (Stmt GhcPs (LocatedA b))])) } : '{' stmts '}' { $2 >>= \ $2 -> - amsA' (sLL $1 $> ((epTok $1, fromOL $ fst $ unLoc $2, epTok $3), sL1 $2 $ reverse $ snd $ unLoc $2))} + amsA' (sLL $1 $> (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) (ListBraces (epTok $1) (epTok $3)) (fromOL $ fst $ unLoc $2) + , sL1 $2 $ reverse $ snd $ unLoc $2))} | vocurly stmts close { $2 >>= \ $2 -> - amsA' (L (stmtsLoc $2) ((noEpTok, fromOL $ fst $ unLoc $2, noEpTok), sL1 $2 $ reverse $ snd $ unLoc $2))} + amsA' (L (stmtsLoc $2) (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) ListNone (fromOL $ fst $ unLoc $2) + , sL1 $2 $ reverse $ snd $ unLoc $2))} -- do { ;; s ; s ; ; s ;; } -- The last Stmt should be an expression, but that's hard to enforce @@ -3704,7 +3702,7 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) } stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : qual { $1 } | 'rec' stmtlist { $2 >>= \ $2 -> - amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn (epTok $1) (stmtlistAnns $2) $2) + amsA' (sLL $1 $> $ mkRecStmt (stmtlistAnns $2, epTok $1) (stmtlistStmts $2)) } qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } @@ -4724,10 +4722,6 @@ 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 rec (ob, semis, cb) (L ll _) - = (AnnList (Just $ spanAsAnchor (locA ll)) (ListBraces ob cb) semis, rec) - listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation listAsAnchorM [] = Nothing listAsAnchorM (L l _:_) = @@ -4757,8 +4751,7 @@ stmtlistStmts :: LocatedA (a, Located [LocatedA (Stmt GhcPs (LocatedA b))]) stmtlistStmts (L la (_,L l stmts)) = L ((noAnnSrcSpan l) {comments = comments la}) stmts -stmtlistAnns :: LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), a) - -> (EpToken "{", [EpToken ";"], EpToken "}") +stmtlistAnns :: LocatedA (AnnList, a) -> AnnList stmtlistAnns (L _ (an,_)) = an -- ------------------------------------- ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -519,8 +519,7 @@ data AnnList } deriving (Data,Eq) data AnnListBrackets - = ListBraces (EpToken "{") (EpToken "}") - | ListSquare (EpToken "[") (EpToken "]") + = ListBraces (EpToken "{") (EpToken "}") | ListNone deriving (Data,Eq) @@ -1093,7 +1092,6 @@ instance Outputable AnnList where instance Outputable AnnListBrackets where ppr (ListBraces o c) = text "ListBraces" <+> ppr o <+> ppr c - ppr (ListSquare o c) = text "ListSquare" <+> ppr o <+> ppr c ppr ListNone = text "ListNone" instance Outputable AnnCType where ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -12,7 +12,7 @@ module GHC.Parser.PostProcess ( mkRdrGetField, mkRdrProjection, Fbind, -- RecordDot mkHsOpApp, mkHsIntegral, mkHsFractional, mkHsIsString, - mkHsDo, mkMDo, mkSpliceDecl, + mkHsDo, mkSpliceDecl, mkRoleAnnotDecl, mkClassDecl, mkTyData, mkDataFamInst, @@ -435,10 +435,6 @@ mkRoleAnnotDecl loc tycon roles anns addFatalError $ mkPlainErrorMsgEnvelope loc_role $ (PsErrIllegalRoleName role nearby) -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) - -- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to -- binders without annotations. Only accepts specified variables, and errors if -- any of the provided binders has an 'InferredSpec' annotation. @@ -1804,12 +1800,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where -> PV (LocatedA b) -- | Disambiguate "do { ... }" (do notation) mkHsDoPV :: - SrcSpan -> - (EpToken "{", [EpToken ";"], EpToken "}") -> - Maybe ModuleName -> - LocatedA [LStmt GhcPs (LocatedA b)] -> - EpaLocation -> -- Token - EpaLocation -> -- Anchor + SrcSpan -> DoAnn -> Maybe ModuleName -> LocatedA [LStmt GhcPs (LocatedA b)] -> PV (LocatedA b) -- | Disambiguate "( ... )" (parentheses) mkHsParPV :: SrcSpan -> EpToken "(" -> LocatedA b -> EpToken ")" -> PV (LocatedA b) @@ -1959,10 +1950,10 @@ instance DisambECP (HsCmd GhcPs) where checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns) - mkHsDoPV l (ob,semis,cb) Nothing stmts tok_loc anc = do + mkHsDoPV l ann Nothing stmts = do !cs <- getCommentsFor l - 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 + return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo ann stmts) + mkHsDoPV l _ (Just m) _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m mkHsParPV l lpar c rpar = do !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdPar (lpar, rpar) c) @@ -2058,9 +2049,9 @@ instance DisambECP (HsExpr GhcPs) where checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns) - mkHsDoPV l (ob,semis,cb) mod stmts loc_tok anc = do + mkHsDoPV l ann mod stmts = 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 ann (DoExpr mod) stmts) mkHsParPV l lpar e rpar = do !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e) @@ -2156,7 +2147,7 @@ instance DisambECP (PatBuilder GhcPs) where !cs <- getCommentsFor (locA l) return $ L (addCommentsToEpAnn l cs) (PatBuilderAppType p at (mkHsTyPat t)) mkHsIfPV l _ _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrIfThenElseInPat - mkHsDoPV l _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat + mkHsDoPV l _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat mkHsParPV l lpar p rpar = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar) mkHsVarPV v@(getLoc -> l) = return $ L (l2l l) (PatBuilderVar v) mkHsLitPV lit@(L l a) = do ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -289,13 +289,12 @@ { DumpParsedAstComments.hs:14:7-8 }))])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpParsedAstComments.hs:16:3 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { DumpParsedAstComments.hs:16:3 })) + (ListNone) + [])) (EpaSpan { DumpParsedAstComments.hs:14:7-8 })) (DoExpr (Nothing)) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -331,13 +331,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) + (ListNone) + [])) (EpaSpan { DumpSemis.hs:10:7-8 })) (DoExpr (Nothing)) @@ -363,20 +362,21 @@ [])) (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 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:11:8-13 })) + (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)) @@ -625,16 +625,17 @@ [])) (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 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:(16,5)-(18,5) })) + (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)) @@ -877,16 +878,17 @@ [])) (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 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:22:12-28 })) + (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)) ===================================== testsuite/tests/printer/Test20297.stdout ===================================== @@ -394,13 +394,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { Test20297.hs:11:22-26 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { Test20297.hs:11:22-26 })) + (ListNone) + [])) (EpaSpan { Test20297.hs:11:19-20 })) (DoExpr (Nothing)) @@ -820,13 +819,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { Test20297.ppr.hs:9:20-24 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { Test20297.ppr.hs:9:20-24 })) + (ListNone) + [])) (EpaSpan { Test20297.ppr.hs:9:17-18 })) (DoExpr (Nothing)) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -980,9 +980,6 @@ markLensBracketsO' a l = ListBraces o c -> do o' <- markEpToken o return (set l (ListBraces o' c) a) - ListSquare o c -> do - o' <- markEpToken o - return (set l (ListSquare o' c) a) ListNone -> return (set l ListNone a) markLensBracketsC :: (Monad m, Monoid w) @@ -996,9 +993,6 @@ markLensBracketsC' a l = ListBraces o c -> do c' <- markEpToken c return (set l (ListBraces o c') a) - ListSquare o c -> do - c' <- markEpToken c - return (set l (ListSquare o c') a) ListNone -> return (set l ListNone a) -- ------------------------------------- @@ -1468,6 +1462,19 @@ markKwT (AddDarrowAnn tok) = AddDarrowAnn <$> markEpUniToken tok -- --------------------------------------------------------------------- +markAnnListD :: (Monad m, Monoid w) + => Either (EpToken "[", EpToken "]") AnnList + -> EP w m a + -> EP w m (Either (EpToken "[", EpToken "]") AnnList, a) +markAnnListD (Left (o,c)) action = do + o' <- markEpToken o + r <- action + c' <- markEpToken c + return (Left (o',c'), r) +markAnnListD (Right ann) action = do + (ann',r) <- markAnnList' ann action + return (Right ann',r) + markAnnList :: (Monad m, Monoid w) => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) markAnnList ann action = do @@ -3115,10 +3122,10 @@ instance ExactPrint (HsExpr GhcPs) where e' <- markAnnotated e return (HsLet (tkLet',tkIn') binds' e') - exact (HsDo (an,l) do_or_list_comp stmts) = do + exact (HsDo an do_or_list_comp stmts) = do debugM $ "HsDo" - (an',l',stmts') <- exactDo (an,l) do_or_list_comp stmts - return (HsDo (an',l') do_or_list_comp stmts') + (an',stmts') <- exactDo an do_or_list_comp stmts + return (HsDo an' do_or_list_comp stmts') exact (ExplicitList (o,c) es) = do debugM $ "ExplicitList start" @@ -3290,8 +3297,8 @@ 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) + => DoAnn -> HsDoFlavour -> LocatedAn an a + -> EP w m (DoAnn, 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" >>= @@ -3310,15 +3317,23 @@ exactMdo l (Just module_name) kw = printStringAtAA l n n = (moduleNameString module_name) ++ "." ++ kw markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a)) - => (AnnList, EpaLocation) -> LocatedAn an a -> EP w m (AnnList, EpaLocation, LocatedAn an a) + => DoAnn -> LocatedAn an a -> EP w m (DoAnn, LocatedAn an a) markMaybeDodgyStmts (an,l) stmts = if notDodgy stmts then do - (an0,stmts') <- markAnnListA' an $ \a -> do - r <- markAnnotatedWithLayout stmts - return (a, r) - return (an0, l, stmts') - else return (an, l, stmts) + (an0,stmts') <- case an of + Left (o,c) -> do + o' <- markEpToken o + r <- markAnnotated stmts + c' <- markEpToken c + return (Left (o',c'), r) + Right an' -> do + (an'',r') <- markAnnListA' an' $ \a -> do + r <- markAnnotatedWithLayout stmts + return (a, r) + return (Right an'',r') + return ((an0, l), stmts') + else return ((an, l), stmts) notDodgy :: GenLocated (EpAnn ann) a -> Bool notDodgy (L (EpAnn anc _ _) _) = notDodgyE anc @@ -3601,9 +3616,7 @@ instance ExactPrint (HsCmd GhcPs) where exact (HsCmdDo (an0,loc) es) = do debugM $ "HsCmdDo" loc' <- printStringAtAA loc "do" - (an1,es') <- markAnnList' an0 $ do - ee <- markAnnotated es - return ee + (an1,es') <- markAnnListD an0 $ do markAnnotated es return (HsCmdDo (an1,loc') es') -- --------------------------------------------------------------------- ===================================== utils/check-exact/Utils.hs ===================================== @@ -343,7 +343,6 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports annListBracketsLocs :: AnnListBrackets -> (EpaLocation,EpaLocation) annListBracketsLocs (ListBraces o c) = (getEpTokenLoc o, getEpTokenLoc c) -annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) data SplitWhere = Before | After View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/184d4c547e5864b17add6a31ad39e29… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/184d4c547e5864b17add6a31ad39e29… 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/epa-tidy-locatedxxx-24] EPA: More targeted HsDo exact print annotation
by Alan Zimmerman (＠alanz) 12 Sep '26

12 Sep '26

Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-24 at Glasgow Haskell Compiler / GHC Commits: 42eceefd by Alan Zimmerman at 2026-09-12T12:31:08+01:00 EPA: More targeted HsDo exact print annotation HsDo is multi-purpose, as encoded in its HsDoFlavour field. Some of these are in a layout context (DoExpr, MDoExpr), others are not (ListComp, MonadComp). We are moving towards using AnnList only in layout contexts, so we switch the HsDo TTG annotation from holding an AnnList for this, to holding Either (EpToken "[", EpToken "]") AnnList This also allows us to trim down AnnListBrackets to only have braces or None, thereby opening the door for unification with the existing layout context data type EpLayout. - - - - - 10 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/printer/Test20297.stdout - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -290,10 +290,12 @@ 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 = DoAnn type instance XDo GhcRn = NoExtField type instance XDo GhcTc = Type +type DoAnn = (Either (EpToken "[", EpToken "]") AnnList, EpaLocation) + type instance XExplicitList GhcPs = (EpToken "[", EpToken "]") type instance XExplicitList GhcRn = NoExtField type instance XExplicitList GhcTc = Type @@ -1467,7 +1469,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 = DoAnn type instance XCmdDo GhcRn = NoExtField type instance XCmdDo GhcTc = Type ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -335,11 +335,10 @@ 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] -> DoAnn -> HsExpr GhcPs mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs - -> (AnnList, EpaLocation) +mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> DoAnn -> HsExpr GhcPs mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-" ===================================== compiler/GHC/Parser.y ===================================== @@ -3152,19 +3152,15 @@ aexp :: { ECP } return $ ECP $ $2 >>= \ $2 -> mkHsDoPV (comb2 $1 $2) - (stmtlistAnns $2) + (Right $stmtlistAnns $2, glR $1) (fmap mkModuleNameFS (getDO $1)) - (stmtlistStmts $2) - (glR $1) - (glR $2) } + (stmtlistStmts $2) } | MDO stmtlist {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 -> fmap ecpFromExp $ amsA' (L (comb2 $1 $2) - (mkMDo (stmtlistAnns $2) - (MDoExpr $ fmap mkModuleNameFS (getMDO $1)) - (stmtlistStmts $2) - (glR $1) - (glR $2))) } + (mkHsDoAnns (MDoExpr $ fmap mkModuleNameFS (getMDO $1)) + (stmtlistStmts $2) + (Right $ stmtlistAnns $2, glR $1))) } | 'proc' aexp '->' exp {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4@cmd -> @@ -3440,7 +3436,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 (Left $ (EpTok ao, EpTok ac), noAnn)) >>= ecpFromExp' } } lexps :: { forall b. DisambECP b => PV [LocatedA b] } @@ -3658,11 +3654,13 @@ apat : aexp {% (checkPattern <=< runPV) (unECP $1) } ----------------------------------------------------------------------------- -- Statement sequences -stmtlist :: { forall b. DisambECP b => PV (LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), Located [LocatedA (Stmt GhcPs (LocatedA b))])) } +stmtlist :: { forall b. DisambECP b => PV (LocatedA (AnnList, Located [LocatedA (Stmt GhcPs (LocatedA b))])) } : '{' stmts '}' { $2 >>= \ $2 -> - amsA' (sLL $1 $> ((epTok $1, fromOL $ fst $ unLoc $2, epTok $3), sL1 $2 $ reverse $ snd $ unLoc $2))} + amsA' (sLL $1 $> (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) (ListBraces (epTok $1) (epTok $3)) (fromOL $ fst $ unLoc $2) + , sL1 $2 $ reverse $ snd $ unLoc $2))} | vocurly stmts close { $2 >>= \ $2 -> - amsA' (L (stmtsLoc $2) ((noEpTok, fromOL $ fst $ unLoc $2, noEpTok), sL1 $2 $ reverse $ snd $ unLoc $2))} + amsA' (L (stmtsLoc $2) (AnnList (Just (spanAsAnchor $ stmtsLoc $2)) ListNone (fromOL $ fst $ unLoc $2) + , sL1 $2 $ reverse $ snd $ unLoc $2))} -- do { ;; s ; s ; ; s ;; } -- The last Stmt should be an expression, but that's hard to enforce @@ -3704,7 +3702,7 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) } stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : qual { $1 } | 'rec' stmtlist { $2 >>= \ $2 -> - amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn (epTok $1) (stmtlistAnns $2) $2) + amsA' (sLL $1 $> $ mkRecStmt (stmtlistAnns $2, epTok $1) (stmtlistStmts $2)) } qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } @@ -4724,10 +4722,6 @@ 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 rec (ob, semis, cb) (L ll _) - = (AnnList (Just $ spanAsAnchor (locA ll)) (ListBraces ob cb) semis, rec) - listAsAnchorM :: [LocatedAn t a] -> Maybe EpaLocation listAsAnchorM [] = Nothing listAsAnchorM (L l _:_) = @@ -4757,8 +4751,7 @@ stmtlistStmts :: LocatedA (a, Located [LocatedA (Stmt GhcPs (LocatedA b))]) stmtlistStmts (L la (_,L l stmts)) = L ((noAnnSrcSpan l) {comments = comments la}) stmts -stmtlistAnns :: LocatedA ((EpToken "{", [EpToken ";"], EpToken "}"), a) - -> (EpToken "{", [EpToken ";"], EpToken "}") +stmtlistAnns :: LocatedA (AnnList, a) -> AnnList stmtlistAnns (L _ (an,_)) = an -- ------------------------------------- ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -519,8 +519,7 @@ data AnnList } deriving (Data,Eq) data AnnListBrackets - = ListBraces (EpToken "{") (EpToken "}") - | ListSquare (EpToken "[") (EpToken "]") + = ListBraces (EpToken "{") (EpToken "}") | ListNone deriving (Data,Eq) @@ -1093,7 +1092,6 @@ instance Outputable AnnList where instance Outputable AnnListBrackets where ppr (ListBraces o c) = text "ListBraces" <+> ppr o <+> ppr c - ppr (ListSquare o c) = text "ListSquare" <+> ppr o <+> ppr c ppr ListNone = text "ListNone" instance Outputable AnnCType where ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -12,7 +12,7 @@ module GHC.Parser.PostProcess ( mkRdrGetField, mkRdrProjection, Fbind, -- RecordDot mkHsOpApp, mkHsIntegral, mkHsFractional, mkHsIsString, - mkHsDo, mkMDo, mkSpliceDecl, + mkHsDo, mkSpliceDecl, mkRoleAnnotDecl, mkClassDecl, mkTyData, mkDataFamInst, @@ -435,10 +435,6 @@ mkRoleAnnotDecl loc tycon roles anns addFatalError $ mkPlainErrorMsgEnvelope loc_role $ (PsErrIllegalRoleName role nearby) -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) - -- | Converts a list of 'LHsTyVarBndr's annotated with their 'Specificity' to -- binders without annotations. Only accepts specified variables, and errors if -- any of the provided binders has an 'InferredSpec' annotation. @@ -1804,12 +1800,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where -> PV (LocatedA b) -- | Disambiguate "do { ... }" (do notation) mkHsDoPV :: - SrcSpan -> - (EpToken "{", [EpToken ";"], EpToken "}") -> - Maybe ModuleName -> - LocatedA [LStmt GhcPs (LocatedA b)] -> - EpaLocation -> -- Token - EpaLocation -> -- Anchor + SrcSpan -> DoAnn -> Maybe ModuleName -> LocatedA [LStmt GhcPs (LocatedA b)] -> PV (LocatedA b) -- | Disambiguate "( ... )" (parentheses) mkHsParPV :: SrcSpan -> EpToken "(" -> LocatedA b -> EpToken ")" -> PV (LocatedA b) @@ -1959,10 +1950,10 @@ instance DisambECP (HsCmd GhcPs) where checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns) - mkHsDoPV l (ob,semis,cb) Nothing stmts tok_loc anc = do + mkHsDoPV l ann Nothing stmts = do !cs <- getCommentsFor l - 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 + return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo ann stmts) + mkHsDoPV l _ (Just m) _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m mkHsParPV l lpar c rpar = do !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdPar (lpar, rpar) c) @@ -2058,9 +2049,9 @@ instance DisambECP (HsExpr GhcPs) where checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsIf c a b anns) - mkHsDoPV l (ob,semis,cb) mod stmts loc_tok anc = do + mkHsDoPV l ann mod stmts = 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 ann (DoExpr mod) stmts) mkHsParPV l lpar e rpar = do !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e) @@ -2156,7 +2147,7 @@ instance DisambECP (PatBuilder GhcPs) where !cs <- getCommentsFor (locA l) return $ L (addCommentsToEpAnn l cs) (PatBuilderAppType p at (mkHsTyPat t)) mkHsIfPV l _ _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrIfThenElseInPat - mkHsDoPV l _ _ _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat + mkHsDoPV l _ _ _ = addFatalError $ mkPlainErrorMsgEnvelope l PsErrDoNotationInPat mkHsParPV l lpar p rpar = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar) mkHsVarPV v@(getLoc -> l) = return $ L (l2l l) (PatBuilderVar v) mkHsLitPV lit@(L l a) = do ===================================== testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr ===================================== @@ -289,13 +289,12 @@ { DumpParsedAstComments.hs:14:7-8 }))])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpParsedAstComments.hs:16:3 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { DumpParsedAstComments.hs:16:3 })) + (ListNone) + [])) (EpaSpan { DumpParsedAstComments.hs:14:7-8 })) (DoExpr (Nothing)) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -331,13 +331,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:(11,3)-(12,3) })) + (ListNone) + [])) (EpaSpan { DumpSemis.hs:10:7-8 })) (DoExpr (Nothing)) @@ -363,20 +362,21 @@ [])) (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 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:11:8-13 })) + (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)) @@ -625,16 +625,17 @@ [])) (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 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:(16,5)-(18,5) })) + (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)) @@ -877,16 +878,17 @@ [])) (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 }))]) + (Right + (AnnList + (Just + (EpaSpan { DumpSemis.hs:22:12-28 })) + (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)) ===================================== testsuite/tests/printer/Test20297.stdout ===================================== @@ -394,13 +394,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { Test20297.hs:11:22-26 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { Test20297.hs:11:22-26 })) + (ListNone) + [])) (EpaSpan { Test20297.hs:11:19-20 })) (DoExpr (Nothing)) @@ -820,13 +819,12 @@ [])) (HsDo ((,) - (AnnList - (Just - (EpaSpan { Test20297.ppr.hs:9:20-24 })) - (ListBraces - (EpTok (EpaSpan { <no location info> })) - (EpTok (EpaSpan { <no location info> }))) - []) + (Right + (AnnList + (Just + (EpaSpan { Test20297.ppr.hs:9:20-24 })) + (ListNone) + [])) (EpaSpan { Test20297.ppr.hs:9:17-18 })) (DoExpr (Nothing)) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -980,9 +980,6 @@ markLensBracketsO' a l = ListBraces o c -> do o' <- markEpToken o return (set l (ListBraces o' c) a) - ListSquare o c -> do - o' <- markEpToken o - return (set l (ListSquare o' c) a) ListNone -> return (set l ListNone a) markLensBracketsC :: (Monad m, Monoid w) @@ -996,9 +993,6 @@ markLensBracketsC' a l = ListBraces o c -> do c' <- markEpToken c return (set l (ListBraces o c') a) - ListSquare o c -> do - c' <- markEpToken c - return (set l (ListSquare o c') a) ListNone -> return (set l ListNone a) -- ------------------------------------- @@ -1468,6 +1462,19 @@ markKwT (AddDarrowAnn tok) = AddDarrowAnn <$> markEpUniToken tok -- --------------------------------------------------------------------- +markAnnListD :: (Monad m, Monoid w) + => Either (EpToken "[", EpToken "]") AnnList + -> EP w m a + -> EP w m (Either (EpToken "[", EpToken "]") AnnList, a) +markAnnListD (Left (o,c)) action = do + o' <- markEpToken o + r <- action + c' <- markEpToken c + return (Left (o',c'), r) +markAnnListD (Right ann) action = do + (ann',r) <- markAnnList' ann action + return (Right ann',r) + markAnnList :: (Monad m, Monoid w) => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) markAnnList ann action = do @@ -3115,10 +3122,10 @@ instance ExactPrint (HsExpr GhcPs) where e' <- markAnnotated e return (HsLet (tkLet',tkIn') binds' e') - exact (HsDo (an,l) do_or_list_comp stmts) = do + exact (HsDo an do_or_list_comp stmts) = do debugM $ "HsDo" - (an',l',stmts') <- exactDo (an,l) do_or_list_comp stmts - return (HsDo (an',l') do_or_list_comp stmts') + (an',stmts') <- exactDo an do_or_list_comp stmts + return (HsDo an' do_or_list_comp stmts') exact (ExplicitList (o,c) es) = do debugM $ "ExplicitList start" @@ -3290,8 +3297,8 @@ 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) + => DoAnn -> HsDoFlavour -> LocatedAn an a + -> EP w m (DoAnn, 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" >>= @@ -3310,15 +3317,23 @@ exactMdo l (Just module_name) kw = printStringAtAA l n n = (moduleNameString module_name) ++ "." ++ kw markMaybeDodgyStmts :: (Monad m, Monoid w, ExactPrint (LocatedAn an a)) - => (AnnList, EpaLocation) -> LocatedAn an a -> EP w m (AnnList, EpaLocation, LocatedAn an a) + => DoAnn -> LocatedAn an a -> EP w m (DoAnn, LocatedAn an a) markMaybeDodgyStmts (an,l) stmts = if notDodgy stmts then do - (an0,stmts') <- markAnnListA' an $ \a -> do - r <- markAnnotatedWithLayout stmts - return (a, r) - return (an0, l, stmts') - else return (an, l, stmts) + (an0,stmts') <- case an of + Left (o,c) -> do + o' <- markEpToken o + r <- markAnnotated stmts + c' <- markEpToken c + return (Left (o',c'), r) + Right an' -> do + (an'',r') <- markAnnListA' an' $ \a -> do + r <- markAnnotatedWithLayout stmts + return (a, r) + return (Right an'',r') + return ((an0, l), stmts') + else return ((an, l), stmts) notDodgy :: GenLocated (EpAnn ann) a -> Bool notDodgy (L (EpAnn anc _ _) _) = notDodgyE anc @@ -3601,9 +3616,7 @@ instance ExactPrint (HsCmd GhcPs) where exact (HsCmdDo (an0,loc) es) = do debugM $ "HsCmdDo" loc' <- printStringAtAA loc "do" - (an1,es') <- markAnnList' an0 $ do - ee <- markAnnotated es - return ee + (an1,es') <- markAnnListD an0 $ do markAnnotated es return (HsCmdDo (an1,loc') es') -- --------------------------------------------------------------------- ===================================== utils/check-exact/Utils.hs ===================================== @@ -343,7 +343,6 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports annListBracketsLocs :: AnnListBrackets -> (EpaLocation,EpaLocation) annListBracketsLocs (ListBraces o c) = (getEpTokenLoc o, getEpTokenLoc c) -annListBracketsLocs (ListSquare o c) = (getEpTokenLoc o, getEpTokenLoc c) annListBracketsLocs ListNone = (noAnn, noAnn) data SplitWhere = Before | After View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42eceefd8b046f4f106310f51cb1223… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42eceefd8b046f4f106310f51cb1223… 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-24
by Alan Zimmerman (＠alanz) 12 Sep '26

12 Sep '26

Alan Zimmerman pushed new branch wip/az/epa-tidy-locatedxxx-24 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-tidy-locatedxxx-24 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/perf-test-timing
by Simon Jakobi (＠sjakobi) 12 Sep '26

12 Sep '26

Simon Jakobi pushed new branch wip/sjakobi/perf-test-timing at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/perf-test-timing 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/interpolated-strings-refactor] 9 commits: ci: Actually pass --ignore-perf-failures to the testsuite driver
by Brandon Chinn (＠brandonchinn178) 12 Sep '26

12 Sep '26

Brandon Chinn pushed to branch wip/interpolated-strings-refactor at Glasgow Haskell Compiler / GHC Commits: 4e9297ea by Simon Jakobi at 2026-09-11T08:32:45-04:00 ci: Actually pass --ignore-perf-failures to the testsuite driver 684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to RUNTEST_ARGS with bash array syntax, but the three use sites still expand RUNTEST_ARGS as a scalar, which yields only the first array element. The appended flag was therefore dropped in every job, so perf improvements kept failing Marge Bot batches and master pipelines, contrary to #19562. Append as a string instead, matching the existing --force-colors append in test_hadrian. Fixes #27563. Assisted-by: Claude Fable 5.1 - - - - - 4f78dfdf by Simon Jakobi at 2026-09-11T08:33:24-04:00 testsuite: Give T26537 a 1.5x compile timeout Its -fregs-graph compile step tends to time out in unoptimized builds (#27188, #27776). Assisted-by: Claude Fable 5.1 - - - - - 130286e3 by Alan Zimmerman at 2026-09-11T08:34:08-04:00 EPA: Remove ListBanana / ListParens from AnnListBrackets This is a step towards making AnnList only represent lists of items which can have either braces or layout. - - - - - a9827d13 by Simon Jakobi at 2026-09-11T18:53:32-04:00 Reject ~, UNPACK and multiplicity annotations on type data fields Only `!` was rejected so far. `~`, UNPACK and multiplicity annotations were silently accepted. None of them make sense at the type level, so restriction (R3) of Note [Type data declarations] now covers all of them. Fixes #27732. Assisted-by: Claude Fable 5.1 - - - - - c71d5e23 by Alan Zimmerman at 2026-09-11T18:54:11-04:00 EPA: Add a Note for the exact print main loop - - - - - 2f525215 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Reorganize processChars functions Move functions around, no code changes - - - - - 74fadf63 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Always use processCharsSingle to get StringLexError - - - - - 3783dc88 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Add pprHsStringMulti, unify string ppr functions - - - - - d8b024b3 by Brandon Chinn at 2026-09-11T23:52:58-07:00 Break out Language.Haskell.Syntax.StringMeta - - - - - 40 changed files: - .gitlab/ci.sh - + changelog.d/27732 - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Utils/Outputable.hs - + compiler/Language/Haskell/Syntax/StringMeta.hs - compiler/ghc.cabal.in - docs/users_guide/exts/type_data.rst - libraries/base/src/GHC/Show.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/type-data/should_fail/T27732a.hs - + testsuite/tests/type-data/should_fail/T27732a.stderr - + testsuite/tests/type-data/should_fail/T27732b.hs - + testsuite/tests/type-data/should_fail/T27732b.stderr - + testsuite/tests/type-data/should_fail/T27732c.hs - + testsuite/tests/type-data/should_fail/T27732c.stderr - + testsuite/tests/type-data/should_fail/T27732d.hs - + testsuite/tests/type-data/should_fail/T27732d.stderr - + testsuite/tests/type-data/should_fail/T27732e.hs - + testsuite/tests/type-data/should_fail/T27732e.stderr - + testsuite/tests/type-data/should_fail/T27732f.hs - + testsuite/tests/type-data/should_fail/T27732f.stderr - testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr - testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr - testsuite/tests/type-data/should_fail/all.T - utils/check-exact/ExactPrint.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/2a221268f0f24041f89a04f3fc5103… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a221268f0f24041f89a04f3fc5103… 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/interpolated-strings] 10 commits: ci: Actually pass --ignore-perf-failures to the testsuite driver
by Brandon Chinn (＠brandonchinn178) 12 Sep '26

12 Sep '26

Brandon Chinn pushed to branch wip/interpolated-strings at Glasgow Haskell Compiler / GHC Commits: 4e9297ea by Simon Jakobi at 2026-09-11T08:32:45-04:00 ci: Actually pass --ignore-perf-failures to the testsuite driver 684c0018d9 changed the IGNORE_PERF_FAILURES handling to append to RUNTEST_ARGS with bash array syntax, but the three use sites still expand RUNTEST_ARGS as a scalar, which yields only the first array element. The appended flag was therefore dropped in every job, so perf improvements kept failing Marge Bot batches and master pipelines, contrary to #19562. Append as a string instead, matching the existing --force-colors append in test_hadrian. Fixes #27563. Assisted-by: Claude Fable 5.1 - - - - - 4f78dfdf by Simon Jakobi at 2026-09-11T08:33:24-04:00 testsuite: Give T26537 a 1.5x compile timeout Its -fregs-graph compile step tends to time out in unoptimized builds (#27188, #27776). Assisted-by: Claude Fable 5.1 - - - - - 130286e3 by Alan Zimmerman at 2026-09-11T08:34:08-04:00 EPA: Remove ListBanana / ListParens from AnnListBrackets This is a step towards making AnnList only represent lists of items which can have either braces or layout. - - - - - a9827d13 by Simon Jakobi at 2026-09-11T18:53:32-04:00 Reject ~, UNPACK and multiplicity annotations on type data fields Only `!` was rejected so far. `~`, UNPACK and multiplicity annotations were silently accepted. None of them make sense at the type level, so restriction (R3) of Note [Type data declarations] now covers all of them. Fixes #27732. Assisted-by: Claude Fable 5.1 - - - - - c71d5e23 by Alan Zimmerman at 2026-09-11T18:54:11-04:00 EPA: Add a Note for the exact print main loop - - - - - 2f525215 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Reorganize processChars functions Move functions around, no code changes - - - - - 74fadf63 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Always use processCharsSingle to get StringLexError - - - - - 3783dc88 by Brandon Chinn at 2026-09-11T19:38:46-07:00 Add pprHsStringMulti, unify string ppr functions - - - - - d8b024b3 by Brandon Chinn at 2026-09-11T23:52:58-07:00 Break out Language.Haskell.Syntax.StringMeta - - - - - 2b7c00fc by Brandon Chinn at 2026-09-11T23:53:09-07:00 Implement interpolated strings (#27592) - - - - - 112 changed files: - .gitlab/ci.sh - + changelog.d/27732 - + changelog.d/string-interpolation - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/Lexer/String.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - + compiler/GHC/Rename/String.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - + compiler/Language/Haskell/Syntax/StringMeta.hs - compiler/ghc.cabal.in - docs/users_guide/exts/qualified_strings.rst - + docs/users_guide/exts/string_interpolation.rst - docs/users_guide/exts/type_data.rst - libraries/base/src/GHC/Essentials.hs - libraries/base/src/GHC/Show.hs - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/Data/String/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Builder/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Class/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Default/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/ShowS/Experimental.hs - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Data/String/Interpolate.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.hs - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.hs - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.hs - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInPat.hs - + testsuite/tests/parser/should_fail/StringInterpolationInPat.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInType.hs - + testsuite/tests/parser/should_fail/StringInterpolationInType.stderr - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.hs - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.hs - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_run/StringInterpolation.hs - + testsuite/tests/parser/should_run/StringInterpolation.stdout - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.hs - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.stdout - testsuite/tests/parser/should_run/all.T - + testsuite/tests/qualified-strings/should_run/Example/SQL.hs - testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.hs - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.stdout - + testsuite/tests/type-data/should_fail/T27732a.hs - + testsuite/tests/type-data/should_fail/T27732a.stderr - + testsuite/tests/type-data/should_fail/T27732b.hs - + testsuite/tests/type-data/should_fail/T27732b.stderr - + testsuite/tests/type-data/should_fail/T27732c.hs - + testsuite/tests/type-data/should_fail/T27732c.stderr - + testsuite/tests/type-data/should_fail/T27732d.hs - + testsuite/tests/type-data/should_fail/T27732d.stderr - + testsuite/tests/type-data/should_fail/T27732e.hs - + testsuite/tests/type-data/should_fail/T27732e.stderr - + testsuite/tests/type-data/should_fail/T27732f.hs - + testsuite/tests/type-data/should_fail/T27732f.stderr - testsuite/tests/type-data/should_fail/TDStrictnessGADT.stderr - testsuite/tests/type-data/should_fail/TDStrictnessH98.stderr - testsuite/tests/type-data/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/186f496c183f8c3443a242d16d75a4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/186f496c183f8c3443a242d16d75a4… 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/interpolated-strings] 3 commits: Add pprHsStringMulti, unify string ppr functions
by Brandon Chinn (＠brandonchinn178) 12 Sep '26

12 Sep '26

Brandon Chinn pushed to branch wip/interpolated-strings at Glasgow Haskell Compiler / GHC Commits: b036fbe0 by Brandon Chinn at 2026-09-11T19:37:01-07:00 Add pprHsStringMulti, unify string ppr functions - - - - - 2a221268 by Brandon Chinn at 2026-09-11T19:37:02-07:00 Break out Language.Haskell.Syntax.StringMeta - - - - - 186f496c by Brandon Chinn at 2026-09-11T19:37:16-07:00 Implement interpolated strings (#27592) - - - - - 85 changed files: - + changelog.d/string-interpolation - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/Lexer/String.x - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Expr.hs - + compiler/GHC/Rename/String.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - + compiler/Language/Haskell/Syntax/StringMeta.hs - compiler/ghc.cabal.in - docs/users_guide/exts/qualified_strings.rst - + docs/users_guide/exts/string_interpolation.rst - libraries/base/src/GHC/Essentials.hs - libraries/base/src/GHC/Show.hs - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/Data/String/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Builder/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Class/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Default/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/ShowS/Experimental.hs - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Data/String/Interpolate.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T4437.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.hs - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.hs - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.hs - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInPat.hs - + testsuite/tests/parser/should_fail/StringInterpolationInPat.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInType.hs - + testsuite/tests/parser/should_fail/StringInterpolationInType.stderr - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.hs - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.hs - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_run/StringInterpolation.hs - + testsuite/tests/parser/should_run/StringInterpolation.stdout - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.hs - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.stdout - testsuite/tests/parser/should_run/all.T - + testsuite/tests/qualified-strings/should_run/Example/SQL.hs - testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.hs - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.stdout - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d814690b133022ec94a2d0723a276f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d814690b133022ec94a2d0723a276f… 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/interpolated-strings-refactor] 2 commits: Add pprHsStringMulti, unify string ppr functions
by Brandon Chinn (＠brandonchinn178) 12 Sep '26

12 Sep '26

Brandon Chinn pushed to branch wip/interpolated-strings-refactor at Glasgow Haskell Compiler / GHC Commits: b036fbe0 by Brandon Chinn at 2026-09-11T19:37:01-07:00 Add pprHsStringMulti, unify string ppr functions - - - - - 2a221268 by Brandon Chinn at 2026-09-11T19:37:02-07:00 Break out Language.Haskell.Syntax.StringMeta - - - - - 13 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/String.hs - compiler/GHC/Utils/Outputable.hs - + compiler/Language/Haskell/Syntax/StringMeta.hs - compiler/ghc.cabal.in - libraries/base/src/GHC/Show.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -87,7 +87,6 @@ import GHC.Parser.HaddockLex import GHC.Parser.Annotation import GHC.Parser.Errors.Types import GHC.Parser.Errors.Ppr () -import GHC.Parser.String import GHC.Builtin.WiredIn.Types ( unitTyCon, unitDataCon, sumTyCon, @@ -97,6 +96,7 @@ import GHC.Builtin.WiredIn.Types unrestrictedFunTyCon ) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Language.Haskell.Syntax.StringMeta import Language.Haskell.Syntax.Text import qualified Data.Semigroup as Semi ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -141,6 +141,7 @@ import qualified GHC.Parser.Lexer.String as Lexer.String import GHC.Parser.String import Language.Haskell.Syntax.Module.Name (ModuleName(..)) +import Language.Haskell.Syntax.StringMeta import Language.Haskell.Syntax.Text } ===================================== compiler/GHC/Parser/String.hs ===================================== @@ -6,10 +6,6 @@ module GHC.Parser.String ( lexString, lexMultilineString, - -- * StringMeta - StringMeta (..), - defaultStrMeta, - -- * Unicode smart quote helpers isDoubleSmartQuote, isSingleSmartQuote, @@ -20,7 +16,6 @@ import GHC.Prelude hiding (getChar) import Control.Arrow ((>>>)) import Control.Monad (when) import Data.Char (chr, ord) -import Data.Data (Data) import qualified Data.Foldable1 as Foldable1 import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (listToMaybe, mapMaybe) @@ -37,7 +32,6 @@ import GHC.Parser.CharClass ( ) import GHC.Parser.Errors.Types (LexErr (..)) import GHC.Utils.Panic (panic) -import Language.Haskell.Syntax.Module.Name (ModuleName) type BufPos = Int data StringLexError = StringLexError LexErr BufPos @@ -288,20 +282,7 @@ isSingleSmartQuote = \case _ -> False -- ----------------------------------------------------------------------------- --- StringMeta - -data StringMeta = StringMeta - { strMetaMultiline :: Bool - , strMetaQualified :: Maybe ModuleName - } - deriving (Show, Data) - -defaultStrMeta :: StringMeta -defaultStrMeta = - StringMeta - { strMetaMultiline = False - , strMetaQualified = Nothing - } +-- QualifiedStrings {- Note [Implementation of QualifiedStrings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilyDependencies #-} @@ -61,7 +62,10 @@ module GHC.Utils.Outputable ( pprDebugAndThen, pprInfixVar, pprPrefixVar, - pprHsChar, pprHsString, pprHsBytes, + pprHsChar, + pprHsString, pprHsString', + pprHsStringMulti, pprHsStringMulti', + pprHsBytes, primFloatSuffix, primCharSuffix, primDoubleSuffix, primInt8Suffix, primWord8Suffix, @@ -165,7 +169,11 @@ import Data.Void import Control.DeepSeq (NFData(rnf)) import GHC.Fingerprint -import GHC.Show ( showMultiLineString ) +#if MIN_VERSION_base(4,23,0) +import GHC.Show (showMultiLineString') +#else +import GHC.Show (showLitString) +#endif import GHC.Utils.Exception import GHC.Exts (oneShot) @@ -1355,14 +1363,48 @@ pprHsChar :: Char -> SDoc pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32)) | otherwise = text (show c) --- | Special combinator for showing string literals. +-- | Special combinator for showing single-line string literals. pprHsString :: String -> SDoc -pprHsString fs = vcat (map text (showMultiLineString fs)) +pprHsString fs = char '"' <> pprHsString' fs <> char '"' + +-- | Like 'pprHsString' except without the outer quotes. +pprHsString' :: String -> SDoc +pprHsString' = vcat . map text . showMultiLineString' Nothing + +-- | Special combinator for showing multi-line string literals. +pprHsStringMulti :: FastString -> SDoc +pprHsStringMulti fs = text "\"\"\"" <> pprHsString' (unpackFS fs) <> text "\"\"\"" + +-- | Like 'pprHsStringMulti' except without the outer quotes. +pprHsStringMulti' :: String -> SDoc +pprHsStringMulti' = vcat . map text . showLitStringMultiline + where + showLitChars :: String -> ShowS + showLitChars [] s = s + showLitChars (c : cs) s = showLitChar c (showLitChars cs s) + + showLitStringMultiline :: String -> [String] + showLitStringMultiline = map (flip showLitChars "") . lines + +#if !MIN_VERSION_base(4,23,0) +-- Copied from GHC.Internal.Show +showMultiLineString' :: Maybe Char -> String -> [String] +showMultiLineString' delim = map ($ "") . go showDelim + where + showDelim = case delim of Just d -> showChar d; Nothing -> id + showNL = showString "\\n" + showBS = showChar '\\' + go pre s = + case break (== '\n') s of + (l, '\n':s'@(_:_)) -> (pre . showLitString l . showNL . showBS) : go showBS s' + (l, '\n':[]) -> (pre . showLitString l . showNL . showDelim) : [] + (l, _) -> (pre . showLitString l . showDelim) : [] +#endif -- | Special combinator for showing bytestring literals. pprHsBytes :: ByteString -> SDoc pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs - in vcat (map text (showMultiLineString escaped)) <> char '#' + in char '"' <> pprHsString' escaped <> text "\"#" where escape :: Word8 -> String escape w = let c = chr (fromIntegral w) in if isAscii c ===================================== compiler/Language/Haskell/Syntax/StringMeta.hs ===================================== @@ -0,0 +1,27 @@ +module Language.Haskell.Syntax.StringMeta ( + StringMeta (..), + defaultStrMeta, +) where + +import Prelude + +import Language.Haskell.Syntax.Module.Name (ModuleName) + +-- libraries: +import Data.Data (Data) + +-- ----------------------------------------------------------------------------- +-- StringMeta + +data StringMeta = StringMeta + { strMetaMultiline :: Bool + , strMetaQualified :: Maybe ModuleName + } + deriving (Show, Data) + +defaultStrMeta :: StringMeta +defaultStrMeta = + StringMeta + { strMetaMultiline = False + , strMetaQualified = Nothing + } ===================================== compiler/ghc.cabal.in ===================================== @@ -1062,6 +1062,7 @@ Library Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity + Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type ===================================== libraries/base/src/GHC/Show.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Show Show(..), ShowS, -- * Show support code - shows, showChar, showString, showMultiLineString, + shows, showChar, showString, showMultiLineString, showMultiLineString', showParen, showList__, showCommaSpace, showSpace, showLitChar, showLitString, protectEsc, intToDigit, showSignedInt, ===================================== libraries/ghc-internal/src/GHC/Internal/Show.hs ===================================== @@ -42,7 +42,8 @@ module GHC.Internal.Show -- Instances for Show: (), [], Bool, Ordering, Int, Char -- Show support code - shows, showChar, showString, showMultiLineString, + shows, showChar, showString, + showMultiLineString, showMultiLineString', showParen, showList__, showCommaSpace, showSpace, showLitChar, showLitString, protectEsc, intToDigit, showSignedInt, @@ -421,13 +422,20 @@ showMultiLineString :: String -> [String] -- * wrap the entire thing in double quotes -- Example: @showMultiLineString "hello\ngoodbye\nblah"@ -- returns @["\"hello\\n\\", "\\goodbye\n\\", "\\blah\""]@ -showMultiLineString str - = go '\"' str +showMultiLineString = showMultiLineString' (Just '\"') + +-- | Like 'showMultiLineString' except using the given delimiter +showMultiLineString' :: Maybe Char -> String -> [String] +showMultiLineString' delim = map ($ "") . go showDelim where - go ch s = case break (== '\n') s of - (l, _:s'@(_:_)) -> (ch : showLitString l "\\n\\") : go '\\' s' - (l, "\n") -> [ch : showLitString l "\\n\""] - (l, _) -> [ch : showLitString l "\""] + showDelim = case delim of Just d -> showChar d; Nothing -> id + showNL = showString "\\n" + showBS = showChar '\\' + go pre s = + case break (== '\n') s of + (l, '\n':s'@(_:_)) -> (pre . showLitString l . showNL . showBS) : go showBS s' + (l, '\n':[]) -> (pre . showLitString l . showNL . showDelim) : [] + (l, _) -> (pre . showLitString l . showDelim) : [] isDec :: Char -> Bool isDec c = c >= '0' && c <= '9' ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -28,5 +28,6 @@ Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity +Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -303,5 +303,6 @@ Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity +Language.Haskell.Syntax.StringMeta Language.Haskell.Syntax.Text Language.Haskell.Syntax.Type ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -9022,6 +9022,7 @@ module GHC.Show where showLitChar :: GHC.Internal.Types.Char -> ShowS showLitString :: GHC.Internal.Base.String -> ShowS showMultiLineString :: GHC.Internal.Base.String -> [GHC.Internal.Base.String] + showMultiLineString' :: GHC.Internal.Maybe.Maybe GHC.Internal.Types.Char -> GHC.Internal.Base.String -> [GHC.Internal.Base.String] showParen :: GHC.Internal.Types.Bool -> ShowS -> ShowS showSignedInt :: GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> ShowS showSpace :: ShowS ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -9060,6 +9060,7 @@ module GHC.Show where showLitChar :: GHC.Internal.Types.Char -> ShowS showLitString :: GHC.Internal.Base.String -> ShowS showMultiLineString :: GHC.Internal.Base.String -> [GHC.Internal.Base.String] + showMultiLineString' :: GHC.Internal.Maybe.Maybe GHC.Internal.Types.Char -> GHC.Internal.Base.String -> [GHC.Internal.Base.String] showParen :: GHC.Internal.Types.Bool -> ShowS -> ShowS showSignedInt :: GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> ShowS showSpace :: ShowS ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -9240,6 +9240,7 @@ module GHC.Show where showLitChar :: GHC.Internal.Types.Char -> ShowS showLitString :: GHC.Internal.Base.String -> ShowS showMultiLineString :: GHC.Internal.Base.String -> [GHC.Internal.Base.String] + showMultiLineString' :: GHC.Internal.Maybe.Maybe GHC.Internal.Types.Char -> GHC.Internal.Base.String -> [GHC.Internal.Base.String] showParen :: GHC.Internal.Types.Bool -> ShowS -> ShowS showSignedInt :: GHC.Internal.Types.Int -> GHC.Internal.Types.Int -> ShowS showSpace :: ShowS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51d85318eb6055a039efd1dda036da… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51d85318eb6055a039efd1dda036da… 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] EPA: Add a Note for the exact print main loop
by Marge Bot (＠marge-bot) 12 Sep '26

12 Sep '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c71d5e23 by Alan Zimmerman at 2026-09-11T18:54:11-04:00 EPA: Add a Note for the exact print main loop - - - - - 1 changed file: - utils/check-exact/ExactPrint.hs Changes: ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -140,9 +140,9 @@ defaultEPState = EPState -- | The R part of RWS. The environment. Updated via 'local' as we -- enter a new AST element, having a different anchor point. -data EPOptions m a = EPOptions - { epTokenPrint :: String -> m a - , epWhitespacePrint :: String -> m a +data EPOptions m w = EPOptions + { epTokenPrint :: String -> m w + , epWhitespacePrint :: String -> m w } -- | Helper to create a 'EPOptions' @@ -163,8 +163,7 @@ stringOptions = epOptions return return deltaOptions :: EPOptions Identity () deltaOptions = epOptions (\_ -> return ()) (\_ -> return ()) -data EPWriter a = EPWriter - { output :: !a } +data EPWriter w = EPWriter { output :: !w } instance Monoid w => Semigroup (EPWriter w) where (EPWriter a) <> (EPWriter b) = EPWriter (a <> b) @@ -239,7 +238,220 @@ setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = -- | Key entry point. Switches to an independent AST element with its -- own annotation, calculating new offsets, etc markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a -markAnnotated a = enterAnn (getAnnotationEntry a) a +markAnnotated a = enterAnn (getAnnotationEntry a) a -- See Note [Exact print main loop] + +{- +Note [Exact print main loop] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Exact printing is the process of taking the ParsedSource, or some +subtree from it, and rendering it to a string, which accurately +reflects the original source that was parsed, except detail of +whitespace (such as spaces vs tabs) is discarded. + +The ParsedSource or fragment from it must implement the ExactPrint +class, and this file does that, as well as supporting machinery to +drive the process. The ExactPrint class is described later in this +note. + +The entry point for exact printing is the exactPrint function, defined +as + + exactPrint :: ExactPrint ast => ast -> String + exactPrint ast = snd $ runIdentity (runEP stringOptions (markAnnotated ast)) + + type EP w m a = RWST (EPOptions m w) (EPWriter w) EPState m a + + runEP :: (Monad m) => EPOptions m w -> EP w m a -> m (a, w) + runEP epReader action = do + (ast, w) <- evalRWST action epReader defaultEPState + return (ast, output w) + + data EPWriter w = EPWriter { output :: !w } + + data EPOptions m w = EPOptions + { epTokenPrint :: String -> m w + , epWhitespacePrint :: String -> m w + } + +This offers some flexibility in how the output is produced, in that +the EpWriter and EPOptions work together, defining an output type and +a function to render whitespace and non-whitepace. + +In normal operation (via exactPrint) these are simply returning the +string unchanged and accumulating a larger string. But it has also been +used to render an HTML version of the source as it prints. + +The main reason exact print exists is to make it easier for tool +writers to manipulate the ParsedSource, and render this back to the +original source, except for the changed parts. One manipulation is to +simply take say a FunBind with its signature from one place in the +code to another. When doing this, the original parsed locations are no +longer useful when rendering the source back to a string. To enable +this, we have another entry point, for converting all absolute +locations to relative ones, using DeltaPos, which captures the line +and col offset relative to the prior output. + +The function to do this is + + makeDeltaAst :: ExactPrint ast => ast -> ast + makeDeltaAst ast = fst $ runIdentity (runEP deltaOptions (markAnnotated ast)) + +The implementation is practically identical for exactPrint and +makeDeltaAst, they simply return the second or first part of the same +calculation. + +This simplifies the implementation of the required ExactPrint +implmentations, in that we only need one per ast item, which encodes +how to print it, and this print process does bookkeeping to keep track +of what spacing it used when doing the print, so it can return the +updated item, with the original absolute SrcSpan's converted to +DeltaPos values instead. + +This information is captured in the XRec/Anno instances used in GHC +Hs, which are mostly LocatedA a, defined as + + GenLocated (EpAnn [TrailingAnn]) a + + data EpAnn ann + = EpAnn { entry :: !EpaLocation + , anns :: !ann + , comments :: !EpAnnComments + } + + data EpaLocation = EpaSpan !SrcSpan + | EpaDelta !SrcSpan !DeltaPos [LEpaComment] + +When parsed, the entry EpaLocation captures an EpaSpan with the parsed +absolute location. After makeDeltaAst, this instead uses EpaDelta, +including the original SrcSpan, the relative spaceing as a DeltaPos, +and any comments that may come before the item, e.g. comments before a +semicolon. + +Both exactPrint and makeDeltaAst call markAnnotated on the item to be +printed, inside the monad machinery. + + markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a + markAnnotated a = enterAnn (getAnnotationEntry a) a + +This makes use of the ExactPrint instance for the ParsedSource and +for every other part of the ParsedSource as a tree. + + class (Typeable a) => ExactPrint a where + getAnnotationEntry :: a -> Entry + exact :: (Monad m, Monoid w) => a -> EP w m a + setAnnotationAnchor :: a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a + +- getAnnotationEntry : returns the Entry information, normally derived + directly from the EpAnn in the LocatedA enclosing the item. + Entry contains + - The location of the first non-comment part of the item to be printed. + - Any [TrailingAnn] (semis, commas, etc) to follow the item. + - Any comments associated with the item, but not with enclosed items. + These comments may also precede or follow the entry location + - Some technical flags, relating to flushing remaining comments at the + last (topmost) item, and if the anchor can be updated (see below). + +- exact : Do the actual printing of the item, having been put in the right + place in terms of print location by the main loop, based on a call to + getAnnotationEntry for it. This printing normally comprises making nested + markAnnotated calls on the nested items in the current one, e.g. + + exact (HsApp an e1 e2) = do + e1' <- markAnnotated e1 + e2' <- markAnnotated e2 + return (HsApp an e1' e2') + +- setAnnotationAnchor : the main loop printing does two things: + - produce output, reflecting the items being printed + - convert all the locations in the item (each an EpaLocation) from its + EpaSpan version to an EpaDelta one, which is independent of absolute + location, being the spacing from the previous print output to this + entry point + To allow these updated locations to be captured, the item implements + the setAnnotationAnchor method, which updates the fields of the Entry + returned by getAnnotationEntry + +You will recall + + markAnnotated a = enterAnn (getAnnotationEntry a) a + enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a + +enterAnn is the part that is repeatedly called via markAnnotated, to +manage the bookkeeping around printing and calculating the updated +delta positions. + +It manages the printing state, adding the new comments from the Entry, +positioning the print head to the entry point, takes account of whether +it is an absolute span or a delta, and prints any comments that must come +before this location. + +At this print location, it calls the `exact` method on the item. This +is the only place `exact` can be called. Within `exact` implementations +the `markAnnotated` function should be used instead, to ensure the state +is managed properly for printing. + +Once the item is printed via its `exact` method, which normally +recurses via `markAnnotated` into any nested items inside it, the +`enterAnn` function prints any [TrailingAnn] from the entry and any +trailing comments. It then wraps up by calling +`setAnnotationAnchor`with the updated (now delta-based) values for the +Entry + +Printing Complicated Items +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Sometimes we need to print a sub-item which does not map cleanly onto the +ExactPrint class, usually because there are parts spread through the item +that need to be managed together while printing. + +An example is in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16321, where +ConDeclGADT needs to print its inner_bindings, but the these in turn +may have parens, e.g. + + data V a where + MkV4 :: forall a. ((forall b. (Show a => a -> (b -> V a)))) + +Here there are inner bindings for the first forall, the multiple +parens around the second forall, and the second forall, wrapping the +inner content within this. + +But the inner content `Show a => a -> (b -> V a)` had to be printed "inside" +the inner_bindings, to correctly close the nested parens. + +The approach in !16321 modified `enterAnn`, to pass in alternate versions +of the `exact` implementation. This works, but it makes an already +complicated function even more complicated. + +An ExactPrint-idiomatic approach is to create a helper data structure +to represent this nested organisation, and provide ExactPrint +instances for that. + +This is done in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16644, using + + data InnerBindings + = InnerMore (LHsGadtTelescope GhcPs) InnerBindings + | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) + +The key part of the ExactPrint instance for this is + + exact (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do + lp' <- markEpToken lp + xs' <- markAnnotated xs + rp' <- markEpToken rp + return (InnerMore (L l (HsGadtPar (lp',rp'))) xs') + +This first prints the opening paren, prints the balance of the cons list, then +prints the closing paren. + +Conversions to and from this structure populate the initial values from +the ConDeclGADT, and retrieve the updated delta-based values after +printing. + +Another use of this technique involves HsModuleImpDecls. + +-} -- | For HsModule, because we do not have a proper SrcSpan, we must -- indicate to flush trailing comments when done. @@ -377,6 +589,7 @@ 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. +-- See Note [Exact print main loop] enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a enterAnn NoEntryVal a = do p <- getPosP View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c71d5e236943abb11a45742f397344f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c71d5e236943abb11a45742f397344f… 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