- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/romes/ast-ohne-faststring] ttg: Using Text over FastString in the AST
by Rodrigo Mesquita (＠alt-romes) 01 Jul '26

01 Jul '26

Rodrigo Mesquita pushed to branch wip/romes/ast-ohne-faststring at Glasgow Haskell Compiler / GHC Commits: 225fc61a by Rodrigo Mesquita at 2026-07-01T10:45:41+01:00 ttg: Using Text over FastString in the AST To make the AST independent of GHC, this commit replaces usages of `FastString` with `HText` in the AST, killing the last edge from Language.Haskell.* to GHC.* modules. Even though we /do/ want to use FastStrings in general -- critically in Names or Ids -- there is no particular reason for the FastStrings that occur in the AST proper to be FastStrings. Strings in the AST are typically unique and don't benefit particularly from being interned FastStrings with Uniques for fast comparison. `HText` is a newtype string wrapper around `Text` which uses GHC's Modified UTF-8 encoding exclusively. It is an opaque type, to ensure it is only modified and converted in ways which preserve the Modified UTF-8 encoding in a way that roundtrips (as opposed to losing information, which would happen if using bare `Text`). Modified UTF-8 must be used to represent the Haskell AST because the Haskell Report allows surrogate code points. `Text` operations use UTF-8 proper and replaces surrogates with a placeholder value, thus is unsuitable for the AST directly. See the `Language.Haskell.Syntax.Text` module header for more details. Final progress towards #21592 - - - - - 94 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Data/StringBuffer.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Foreign.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Types/PkgQual.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Module/Name.hs - + compiler/Language/Haskell/Syntax/Text.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - 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/DumpTypecheckedAst.stderr - + testsuite/tests/parser/should_run/StringStartsWithNull.hs - + testsuite/tests/parser/should_run/StringStartsWithNull.stdout - testsuite/tests/parser/should_run/all.T - testsuite/tests/perf/compiler/hard_hole_fits.stderr - utils/check-exact/ExactPrint.hs - utils/check-exact/check-exact.cabal - utils/haddock/haddock-api/haddock-api.cabal - utils/haddock/haddock-api/src/Haddock.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/225fc61af5a7d2a9b997189ac6a1c3c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/225fc61af5a7d2a9b997189ac6a1c3c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 38 commits: Decoupling 'L.H.S' from 'GHC.Types.SourceText'
by Marge Bot (＠marge-bot) 01 Jul '26

01 Jul '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d7cfea49 by Recursion Ninja at 2026-06-30T21:37:12-04:00 Decoupling 'L.H.S' from 'GHC.Types.SourceText' * Migrated 'IntegralLit' to 'L.H.S.Lit'. * Migrated 'FractionalLit' to 'L.H.S.Lit'. * Migrated 'StringLiteral' to 'L.H.S.Lit'. * Added TTG extension points to the types above. * Added nice export list to 'GHC.Hs.Lit'. * Added 'rnOverLitVal' and 'tcOverLitVal' functions to 'GHC.Hs.Lit'. * Added instance 'Anno (StringLiteral (GhcPass p)) = SrcSpanAnnN' * Moved [Notes] about 'SourceText' from 'L.H.S.*' to 'GHC.*'. * Removed all references to 'SourceText' from 'L.H.S'. * Removed the trailing comma record field from 'StringLiteral' * Renamed exported functions for nomenclature consistency. * Deprecated the renamed functions Fixes #26953 - - - - - a1f2558b by Recursion Ninja at 2026-06-30T21:37:12-04:00 Monomorphising GHC pass parameters where appropriate - - - - - 7bf9e3c5 by Teo Camarasu at 2026-06-30T21:38:03-04:00 Make Q abstract This patch aims to clearly demarcate the internal and external interfaces of Q. In the past the `Quasi` typeclass was both part of the external, public-facing interface, and was used to give the implementation of `Q`. Now we separate out these two distinct roles. `Quasi` continues to exist in the public interface, but we introduce a new `MetaHandlers` type, which is equivalent to `Dict Quasi`. `Q a` is now defined to be `MetaHandlers -> IO a`, and, crucially, the constructor and the new `MetaHandlers` type are not exposed from the public interface. This gives us the ability to vary the interface on the GHC side without forcing a breaking change on the `template-haskell` side. Similarly `template-haskell` has more freedom to change the `Quasi` typeclass without needing any changes in `lib:ghc`. Implements https://github.com/ghc-proposals/ghc-proposals/pull/700 Resolves #27341 - - - - - 4262af36 by L0neGamer at 2026-06-30T21:38:56-04:00 generically defines mconcat in terms of internal type's Semigroup instance add changelog entry use simpler definition for mconcat `nonEmpty` isn't available yet; inline branches in case add test case fixup generically defines mconcat in terms of internal type's Semigroup instance add comment on Generically and deriving mishaps swap mconcat to foldr version add some strictness testing for mconcat add to `base` changelog entry - - - - - e22ad997 by Cheng Shao at 2026-06-30T21:39:43-04:00 hadrian/rts: fix unregisterised build for gcc 15+ This patch fixes unregisterised build for gcc 15+: - Pass -optc-Wno-error in hadrian when +werror enables -optc-Werror, see added comment for details. - For RTS functions that the codegen would emit calls, ensure their real prototype is hidden when the header is included in .hc fies (IN_STG_CODE), and the dummy prototype is provided to match the EFF_ convention. In the future we should get rid of EFF_ (#14647) and remove these hacks, but for now this patch makes unregisterised work again on newer toolchains. Fixes #27404. Co-authored-by: Codex <codex(a)openai.com> - - - - - 3f00f234 by Cheng Shao at 2026-06-30T21:40:32-04:00 compiler: fix missing handling of CmmUnsafeForeignCall node in LayoutStack This patch fixes missing handling of `CmmUnsafeForeignCall` middle node in the `LayoutStack` pass. Before proc-points splitting, this pass computes liveliness of local registers, and spills those alive across a Cmm native call onto the stack. It need to traverse all middle nodes in each block and check whether a local register is an assignee, if so then the previous mapping in `sm_regs` is invalidated and needs to be dropped. However, it didn't handle `CmmUnsafeForeignCall` node which may also assign to a local register. When proc-points splitting is enabled, this can produce an invalid basic block that doesn't properly backup the updated local register to the stack before doing a Cmm call, resulting in completely invalid runtime behavior. The patch also adds a `T27447` regression test. With no-TNTC or with LLVM backend, without the fix the test case would output a stale 0x1111111111111111 value, instead of the expected 0x2222222222222222 output. Fixes #27447. Co-authored-by: Codex <codex(a)openai.com> - - - - - a0368d70 by Ben Gamari at 2026-07-01T05:33:14-04:00 gitlab-ci: Drop vestigial references to make build system - - - - - 54a29915 by Ben Gamari at 2026-07-01T05:33:14-04:00 gitlab-ci: Add support for running specifying a job's testsuite ways - - - - - c98033d8 by Ben Gamari at 2026-07-01T05:33:14-04:00 gitlab-ci: Run llvm testsuite ways in llvm jobs Addresses #25762. - - - - - 982aa058 by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Add normalise_ddump_deriv setup function Some tests check the result of -ddump-deriv, which may contain INLINE pragmas depending on optimization flags. With normalise_ddump_deriv setup function, INLINE pragmas are stripped off. - - - - - f08d5e59 by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Use -dsuppress-idinfo to make tests more robust Previously, T18052a and T21755 were failing on 'optasm' and 'optllvm' ways because of visibility of unfoldings. - - - - - 6328e646 by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Use a trick to keep large objects alive Previously, T17574 and T19381 were failing on 'optasm' and 'optllvm' ways because of compiler optimizations. Change them to use NOINLINE to prevent unwanted optimizations. - - - - - 4c016975 by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Only run T24224 in 'normal' way This test is a frontend-only one and breaks if optimizations are enabled. - - - - - 7b3884ab by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Ignore T18118's stderr When optimizations are enabled, the compiler emits a warning (You cannot SPECIALISE ...). The message is not important, so ignore it. - - - - - e79152be by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Mark T816 and tc216 broken with optimizations These tests are about type checking, so we should not care too much if they are broken with optimizations. See #26952 - - - - - ac59308c by Ben Gamari at 2026-07-01T05:33:14-04:00 testsuite: ds014 is not longer broken It now appears to pass in the ways it was marked as broken in. Closes #14901. - - - - - adb8d44a by Ben Gamari at 2026-07-01T05:33:14-04:00 testsuite: Only run stack cloning tests in the normal way These are too dependent upon code generation specifics to pass in most other ways. - - - - - 302e23db by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Update options_ghc_fbyte-code The `-fbyte-code` option used to be overriden by `-fllvm` but it is no longer true since !14872 was merged. I updated the test to accept the new behavior. Closes #27049 - - - - - 10baed70 by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Only run T22744 in 'normal' way This test takes a long time on optimized ways. - - - - - 5e19bfe5 by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Disable tests that use -finfo-table-map on llvm ways Currently, -finfo-table-map does not work with -fllvm. See #26435 - - - - - 01cfbbf0 by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Don't run T24726 on optimized ways If optimizations are enabled, the rewrite rule just fires and -drule-check will report nothing. - - - - - b11d685b by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Use -fno-unoptimized-core-for-interpreter when running LinkableUsage01/02 Optimizations for the bytecode interpreter are considered experimental, and need a flag to be enabled. - - - - - 33775ef6 by ARATA Mizuki at 2026-07-01T05:33:14-04:00 testsuite: Suppress unwanted optimizations on T25284 - - - - - 8a672574 by ARATA Mizuki at 2026-07-01T05:33:15-04:00 testsuite: Don't run stack_big_ret with optimizations Stack layout may change with optimizations enabled. - - - - - 92cf2ea1 by ARATA Mizuki at 2026-07-01T05:33:15-04:00 testsuite: Mark memo001 broken on optimized ways See #27396 - - - - - 4212a271 by ARATA Mizuki at 2026-07-01T05:33:15-04:00 testsuite: Mark syn-perf broken on optimized ways See #27398 - - - - - cb641dde by Duncan Coutts at 2026-07-01T05:33:17-04:00 Add a test for thread scheduler fairness It also tests that the interval timer and context switching works. We also test that fairness is lost when the context switching interval is too coarse for the duration of the test. We add this test before doing surgery on the interval timer, so we have decent coverage. - - - - - 560dec4b by Duncan Coutts at 2026-07-01T05:33:17-04:00 Make exported stop/startTimer no-ops, and rename internal functions Specifically, internally rename: stop/startTimer to pause/unpauseTimer stop/startTicker to pause/unpauseTicker and keep stop/startTimer as exported functions, but now as no-ops. In the past the stop/startTicker actions were used incorrectly as if they were synchronous, which they are not. See issue #27105. We now document pause/unpackTicker as being async and not to be used for the purpose of concurrency safety. The existing stop/startTimer (note Timer not Ticker, the Timer calls the Ticker!) are also exported from the RTS as a public API. This was historically because the ticker used signals and it was important to suspend the timer signel over a process fork. So these functions were exported to be used by the process and unix libraries. We cannot just remove the RTS exports, but we now make them no-ops, and they can be removed from the process and unix library later. This was already documented in a changelog.d entry no-more-timer-signal but due to changes during the MR process the change to make stop/startTicker into no-ops didn't make it into the earlier MR. - - - - - b447aae5 by Duncan Coutts at 2026-07-01T05:33:17-04:00 Make exitTicker/exitTimer unconditionally synchronous We never use them asynchronously, and we should never need to do so. And update some related comments. - - - - - 789e8286 by Duncan Coutts at 2026-07-01T05:33:17-04:00 posix ticker: update and improve comments on (un)pause and exit Clarify what is async vs sync. - - - - - bae0c84e by Duncan Coutts at 2026-07-01T05:33:17-04:00 posix ticker: split out ppoll/select helper functions Move the #ifdefs out of the main code body by introducing local helper functions and types, which themselves have two implementations (with a common API) based on ppoll or select. This helps improve clarity/readability. - - - - - c2678268 by Duncan Coutts at 2026-07-01T05:33:17-04:00 posix ticker: improve the implementation The existing implementation supported pausing and exiting, with the implementation of pausing reling on a mutex and condition variable. It needed to check the pause and stop shared variables on every iteration. It relies on ppoll or select, to wait on the timeout and also wait on an interrupt fd. The interrupt fd was only used for prompt exit/shutdown, and not for pausing or other notification. The pause only needed a lock and a memory operation, but the pause was not prompt. The resume used a lock, and signaling a cond var. The new implementation uses a somewhat more regular design: every notification is done by setting a shared variable and interrupting/notifying the ticker via the fd. The ticker thread does not need to check any shared variables on normal timer expiry, only when it recevies notification. This may be a micro-optimisation, but the tick occurs 100 times a second by default so any improvements in the hot path are amplified. When the ticker thread does receive notification it can check the various shared variables and update its local state. The blocking relies on using ppoll/select but without a timeout. This avoids the condition var and also allows further notifications when paused (also used for unpausing). This design can be extended with further notification types if needed by using and checking further shared vars (or making existing shared vars an enum or counter). This may be used in future for additional notifications to the ticker thread. This will likely be used to proxy wakeUpRts from a single handler context for example. And this approach, avoiding mutexes, is compatible with use from signal handlers. So overall, it's: * slightly simpler / more regular; * easier to extend with additional notifications; * probably slightly more efficient (but a micro-optimisation); * and supports calling notification from signal handlers - - - - - 8f62440c by Duncan Coutts at 2026-07-01T05:33:17-04:00 posix ticker: further minor local renaming for code clarity Improve the clarity with better choice of names for several local vars and function. - - - - - 4e4ed71f by Duncan Coutts at 2026-07-01T05:33:17-04:00 win32 ticker: split out local helper functions - - - - - fd094e93 by Duncan Coutts at 2026-07-01T05:33:17-04:00 win32 ticker: provide guarantee about concurrency and idempotency Use a lock to ensure pause/unpause can be used concurrently. Use a paused variable, protected by the lock, to ensure that pause and unpause are both idempotent. This is what the portable API expects. - - - - - 67df9d1f by Duncan Coutts at 2026-07-01T05:33:17-04:00 win32 ticker: make the initial tick be after one wait interval There is no need to tick immediately. This is consistent with the posix implementation. - - - - - 3050872d by Duncan Coutts at 2026-07-01T05:33:17-04:00 ticker: remove now-unnecessary layer of enable/disable There was an atomic variable used to block *part* of the actions of the tick handler. This still did not make stopTimer synchronous, even for the part of the the handle_tick actions it covered. It also added a more expensive (sequentuially consistent) atomic operation in the hot path for the handle_tick action, whereas our new design requires no atomic ops at all. Now that we have eliminate the need for synchronous stop/startTicker, we don't need this not-quite-working-anyway atomic protocol. The new pause/unpauseTicker is explicitly asynchronous and idempotent. - - - - - c17d42ef by Duncan Coutts at 2026-07-01T05:33:17-04:00 ticker: add TODOs about issue #27250: too much being done from handle_tick The handle_tick should not perform I/O, block, perform long-running operations or call arbitrary user code. Unfortunately, everything to do with the eventlog (at the moment) falls into all those categories. - - - - - 124 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - + changelog.d/AbstractQ - + changelog.d/fix-layout-stack-fcall - + changelog.d/fix-unreg - + changelog.d/generically-mconcat - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Gen/Splice.hs-boot - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/PkgQual.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - hadrian/src/Flavour.hs - libraries/base/changelog.md - libraries/base/tests/all.T - libraries/ghc-heap/tests/all.T - libraries/ghc-internal/src/GHC/Internal/Generics.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - libraries/ghci/GHCi/TH.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - rts/RtsStartup.c - rts/Schedule.c - rts/Ticker.h - rts/Timer.c - rts/Timer.h - rts/include/rts/NonMoving.h - rts/include/rts/Timer.h - rts/include/stg/MiscClosures.h - rts/posix/Ticker.c - rts/win32/Ticker.c - testsuite/driver/testlib.py - testsuite/tests/arityanal/should_compile/T21755.stderr - testsuite/tests/arityanal/should_compile/all.T - testsuite/tests/bytecode/TLinkable/all.T - testsuite/tests/cmm/should_compile/all.T - + testsuite/tests/cmm/should_run/T27447.hs - + testsuite/tests/cmm/should_run/T27447.stdout - + testsuite/tests/cmm/should_run/T27447_cmm.cmm - testsuite/tests/cmm/should_run/all.T - + testsuite/tests/concurrent/should_run/T27105.hs - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/core-to-stg/T25284/Cls.hs - testsuite/tests/deSugar/should_fail/all.T - testsuite/tests/deSugar/should_run/all.T - testsuite/tests/deriving/should_compile/all.T - testsuite/tests/driver/options_ghc/Mod_fbyte_code.hs - testsuite/tests/driver/options_ghc/all.T - testsuite/tests/driver/options_ghc/options_ghc_fbyte-code.stderr - testsuite/tests/generics/GenDerivOutput.hs - testsuite/tests/generics/GenDerivOutput1_0.hs - testsuite/tests/generics/GenDerivOutput1_1.hs - testsuite/tests/generics/T10604/T10604_deriving.hs - testsuite/tests/generics/T10604/all.T - + testsuite/tests/generics/T27245.hs - + testsuite/tests/generics/T27245.stdout - testsuite/tests/generics/all.T - testsuite/tests/ghc-api/annotations-literals/literals.stdout - testsuite/tests/ghc-api/annotations-literals/parsed.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/template-haskell-exports.stdout - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/printer/all.T - testsuite/tests/profiling/perf/T23103/all.T - testsuite/tests/profiling/should_run/all.T - testsuite/tests/rts/T17574.hs - testsuite/tests/rts/T19381.hs - testsuite/tests/rts/all.T - testsuite/tests/rts/ipe/T24005/all.T - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/typecheck/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.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/095432f6ed2ce99d986a31e1e23ec0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/095432f6ed2ce99d986a31e1e23ec0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/ast-ohne-faststring] ttg: Using Text over FastString in the AST
by Rodrigo Mesquita (＠alt-romes) 01 Jul '26

01 Jul '26

Rodrigo Mesquita pushed to branch wip/romes/ast-ohne-faststring at Glasgow Haskell Compiler / GHC Commits: 789bdc71 by Rodrigo Mesquita at 2026-07-01T10:24:46+01:00 ttg: Using Text over FastString in the AST To make the AST independent of GHC, this commit replaces usages of `FastString` with `HText` in the AST, killing the last edge from Language.Haskell.* to GHC.* modules. Even though we /do/ want to use FastStrings in general -- critically in Names or Ids -- there is no particular reason for the FastStrings that occur in the AST proper to be FastStrings. Strings in the AST are typically unique and don't benefit particularly from being interned FastStrings with Uniques for fast comparison. `HText` is a newtype string wrapper around `Text` which uses GHC's Modified UTF-8 encoding exclusively. It is an opaque type, to ensure it is only modified and converted in ways which preserve the Modified UTF-8 encoding in a way that roundtrips (as opposed to losing information, which would happen if using bare `Text`). Modified UTF-8 must be used to represent the Haskell AST because the Haskell Report allows surrogate code points. `Text` operations use UTF-8 proper and replaces surrogates with a placeholder value, thus is unsuitable for the AST directly. See the `Language.Haskell.Syntax.Text` module header for more details. Final progress towards #21592 - - - - - 97 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Data/StringBuffer.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Foreign.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Types/PkgQual.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Module/Name.hs - + compiler/Language/Haskell/Syntax/Text.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - 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/DumpTypecheckedAst.stderr - + testsuite/tests/parser/should_run/StringStartsWithNull.hs - + testsuite/tests/parser/should_run/StringStartsWithNull.stdout - testsuite/tests/parser/should_run/all.T - testsuite/tests/perf/compiler/hard_hole_fits.stderr - utils/check-exact/ExactPrint.hs - utils/check-exact/check-exact.cabal - utils/haddock/haddock-api/haddock-api.cabal - utils/haddock/haddock-api/src/Haddock.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Names.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/789bdc71ea884f174d85d9ce3846472… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/789bdc71ea884f174d85d9ce3846472… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/davide/windows-dlls] rts/include: annotate all public symbols with RTS_EXPORT
by David Eichmann (＠DavidEichmann) 01 Jul '26

01 Jul '26

David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC Commits: e6bc007e by David Eichmann at 2026-07-01T09:35:53+01:00 rts/include: annotate all public symbols with RTS_EXPORT Add RTS_EXPORT macro (expands to __attribute__((dllexport)) on mingw32, empty elsewhere) to all public function and global data declarations across every header under rts/include/. The macro is defined in Stg.h. Each header that uses it also carries a fallback #ifndef RTS_EXPORT guard so it can be analysed in isolation. Declarations inside #if IN_STG_CODE blocks (raw StgWord/W_ types for Cmm/STG code), INLINE_HEADER/EXTERN_INLINE inline definitions, and RTS_PRIVATE symbols are intentionally left unannotated. AI-generated by Claude Sonnet 4.6 per prompt: "annotate all global data/functions under rts/include with __attribute__((dllexport)) unless explicitly marked as private" Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com> - - - - - 51 changed files: - rts/include/HsFFI.h - rts/include/Rts.h - rts/include/RtsAPI.h - rts/include/Stg.h - rts/include/rts/Adjustor.h - rts/include/rts/BlockSignals.h - rts/include/rts/EventLogWriter.h - rts/include/rts/ExecPage.h - rts/include/rts/FileLock.h - rts/include/rts/Flags.h - rts/include/rts/ForeignExports.h - rts/include/rts/GetTime.h - rts/include/rts/Globals.h - rts/include/rts/Hpc.h - rts/include/rts/IOInterface.h - rts/include/rts/IPE.h - rts/include/rts/Libdw.h - rts/include/rts/LibdwPool.h - rts/include/rts/Linker.h - rts/include/rts/Messages.h - rts/include/rts/NonMoving.h - rts/include/rts/OSThreads.h - rts/include/rts/Parallel.h - rts/include/rts/PrimFloat.h - rts/include/rts/Profiling.h - rts/include/rts/RtsToHsIface.h - rts/include/rts/SpinLock.h - rts/include/rts/StableName.h - rts/include/rts/StablePtr.h - rts/include/rts/StaticPtrTable.h - rts/include/rts/TSANUtils.h - rts/include/rts/TTY.h - rts/include/rts/Threads.h - rts/include/rts/Ticky.h - rts/include/rts/Time.h - rts/include/rts/Timer.h - rts/include/rts/Utils.h - rts/include/rts/prof/CCS.h - rts/include/rts/prof/Heap.h - rts/include/rts/storage/Block.h - rts/include/rts/storage/ClosureMacros.h - rts/include/rts/storage/GC.h - rts/include/rts/storage/Heap.h - rts/include/rts/storage/HeapAlloc.h - rts/include/rts/storage/InfoTables.h - rts/include/rts/storage/MBlock.h - rts/include/rts/storage/TSO.h - rts/include/stg/MiscClosures.h - rts/include/stg/Prim.h - rts/include/stg/SMP.h - rts/include/stg/Ticky.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6bc007eb624a7b029a4aaa0172f2d3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6bc007eb624a7b029a4aaa0172f2d3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/no-code-output-constr] Add failing test for `-finfo-table-map` and bytecode backend
by Hannes Siebenhandl (＠fendor) 01 Jul '26

01 Jul '26

Hannes Siebenhandl pushed to branch wip/fendor/no-code-output-constr at Glasgow Haskell Compiler / GHC Commits: be6a65cb by fendor at 2026-07-01T09:14:31+02:00 Add failing test for `-finfo-table-map` and bytecode backend If you compile a module using the bytecode backend, with -finfo-table-map, then the info table map doesn't get populated for the module. This is because the -finfo-table-map code path is implemented mostly in the StgToCmm phase which isn't run when creating bytecode. Ticket #27039 - - - - - 5 changed files: - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/ghci/scripts/bytecodeIPE.hs - + testsuite/tests/ghci/scripts/bytecodeIPE.script - + testsuite/tests/ghci/scripts/bytecodeIPE.stderr - + testsuite/tests/ghci/scripts/bytecodeIPE.stdout Changes: ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -385,6 +385,14 @@ test('ListTuplePunsPpr', normal, ghci_script, ['ListTuplePunsPpr.script']) test('ListTuplePunsPprNoAbbrevTuple', [limit_stdout_lines(14)], ghci_script, ['ListTuplePunsPprNoAbbrevTuple.script']) test('T24459', normal, ghci_script, ['T24459.script']) test('T24632', normal, ghci_script, ['T24632.script']) +# bytecode backend doesn't support '-finfo-table-map' (#27039) +test('bytecodeIPE', + [ extra_hc_opts('-finfo-table-map') + , extra_files(['bytecodeIPE.hs']) + , req_rts_linker + , when(arch('wasm32') or arch('javascript'), skip) + ], + ghci_script, ['bytecodeIPE.script']) # Test package renaming in GHCi session test('GhciPackageRename', ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.hs ===================================== @@ -0,0 +1,12 @@ +module BytecodeIPE where + +import Data.Maybe (isJust) +import GHC.InfoProv (whereFrom) + +marker :: String +marker = id "bytecode-stub-init" +{-# NOINLINE marker #-} + +-- `whereFrom` only succeeds if the module's IPE initializer ran. +probe :: IO Bool +probe = isJust <$> whereFrom marker ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.script ===================================== @@ -0,0 +1,2 @@ +:load bytecodeIPE.hs +probe ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.stderr ===================================== @@ -0,0 +1,2 @@ +when making flags consistent: warning: [GHC-74335] [-Winconsistent-flags (in -Wdefault)] + -finfo-table-map is incompatible with -fbyte-code and is disabled ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.stdout ===================================== @@ -0,0 +1 @@ +False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be6a65cbad150c3138b20969ef255f0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be6a65cbad150c3138b20969ef255f0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] compiler: fix missing handling of CmmUnsafeForeignCall node in LayoutStack
by Marge Bot (＠marge-bot) 01 Jul '26

01 Jul '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3f00f234 by Cheng Shao at 2026-06-30T21:40:32-04:00 compiler: fix missing handling of CmmUnsafeForeignCall node in LayoutStack This patch fixes missing handling of `CmmUnsafeForeignCall` middle node in the `LayoutStack` pass. Before proc-points splitting, this pass computes liveliness of local registers, and spills those alive across a Cmm native call onto the stack. It need to traverse all middle nodes in each block and check whether a local register is an assignee, if so then the previous mapping in `sm_regs` is invalidated and needs to be dropped. However, it didn't handle `CmmUnsafeForeignCall` node which may also assign to a local register. When proc-points splitting is enabled, this can produce an invalid basic block that doesn't properly backup the updated local register to the stack before doing a Cmm call, resulting in completely invalid runtime behavior. The patch also adds a `T27447` regression test. With no-TNTC or with LLVM backend, without the fix the test case would output a stale 0x1111111111111111 value, instead of the expected 0x2222222222222222 output. Fixes #27447. Co-authored-by: Codex <codex(a)openai.com> - - - - - 6 changed files: - + changelog.d/fix-layout-stack-fcall - compiler/GHC/Cmm/LayoutStack.hs - + testsuite/tests/cmm/should_run/T27447.hs - + testsuite/tests/cmm/should_run/T27447.stdout - + testsuite/tests/cmm/should_run/T27447_cmm.cmm - testsuite/tests/cmm/should_run/all.T Changes: ===================================== changelog.d/fix-layout-stack-fcall ===================================== @@ -0,0 +1,4 @@ +section: compiler +synopsis: Fix invalid cmm basic block output when proc-point splitting is enabled (wasm/llvm/unregisterised) +issues: #27447 +mrs: !16271 ===================================== compiler/GHC/Cmm/LayoutStack.hs ===================================== @@ -408,6 +408,8 @@ procMiddle stackmaps node sm where loc = getStackLoc area off stackmaps CmmAssign (CmmLocal r) _other -> sm { sm_regs = delFromUFM (sm_regs sm) r } + CmmUnsafeForeignCall _ results _ + -> sm { sm_regs = delListFromUFM (sm_regs sm) results } _other -> sm ===================================== testsuite/tests/cmm/should_run/T27447.hs ===================================== @@ -0,0 +1,40 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} + +import Foreign +import GHC.Exts +import GHC.IO +import GHC.Word +import Text.Printf + +foreign import prim "t27447_repro" + t27447_repro# :: Addr# -> State# RealWorld -> (# State# RealWorld, Word64# #) + +expected :: Word64 +expected = 0x2222222222222222 + +stale :: Word64 +stale = 0x1111111111111111 + +runCmm :: Ptr a -> IO Word64 +runCmm (Ptr p#) = IO $ \s -> + case t27447_repro# p# s of + (# s', w# #) -> (# s', W64# w# #) + +main :: IO () +main = allocaBytesAligned 48 8 $ \raw -> do + let node0 = raw + node1 = raw `plusPtr` 24 + + pokeByteOff node0 0 (1 :: Word64) + pokeByteOff node0 8 node1 + pokeByteOff node0 16 stale + + pokeByteOff node1 0 (0 :: Word64) + pokeByteOff node1 8 node1 + pokeByteOff node1 16 expected + + got <- runCmm node0 + printf "0x%016x\n" got ===================================== testsuite/tests/cmm/should_run/T27447.stdout ===================================== @@ -0,0 +1 @@ +0x2222222222222222 ===================================== testsuite/tests/cmm/should_run/T27447_cmm.cmm ===================================== @@ -0,0 +1,24 @@ +#include "Cmm.h" + +t27447_repro (W_ x) { + I64 ty; + W_ old; + +again: + ty = I64[x]; + switch [0 .. 2] (ty) { + case 0: { + return (I64[x + 16]); + } + case 1: { + old = x; + x = %acquire W_[x + 8]; + I64[old] = 0; + goto again; + } + case 2: { + STK_CHK_GEN(); + goto again; + } + } +} ===================================== testsuite/tests/cmm/should_run/all.T ===================================== @@ -33,7 +33,7 @@ test('T22871', test('JumpTableNoStackDealloc', [ extra_run_opts('"' + config.libdir + '"') - , req_cmm + , req_cmm , when(arch('wasm32'), skip) # wasm32 doesn't support the printf() calls , when(arch('i386'), skip) # i386 doesn't support `MO_U_Rem W64` (`_c1::I64 % 10 :: W64`) ], @@ -52,3 +52,11 @@ test('T25601', [req_cmm], multi_compile_and_run, ['T25601', [('T25601a.cmm', '')], '']) + +test('T27447', + [ req_cmm + , extra_ways(['optasm']) + , when(have_llvm(), extra_ways(['optasm', 'optllvm'])) + ], + multi_compile_and_run, + ['T27447', [('T27447_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f00f234d0d5b3b3b2a23a5dc70ce37… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f00f234d0d5b3b3b2a23a5dc70ce37… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] hadrian/rts: fix unregisterised build for gcc 15+
by Marge Bot (＠marge-bot) 01 Jul '26

01 Jul '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e22ad997 by Cheng Shao at 2026-06-30T21:39:43-04:00 hadrian/rts: fix unregisterised build for gcc 15+ This patch fixes unregisterised build for gcc 15+: - Pass -optc-Wno-error in hadrian when +werror enables -optc-Werror, see added comment for details. - For RTS functions that the codegen would emit calls, ensure their real prototype is hidden when the header is included in .hc fies (IN_STG_CODE), and the dummy prototype is provided to match the EFF_ convention. In the future we should get rid of EFF_ (#14647) and remove these hacks, but for now this patch makes unregisterised work again on newer toolchains. Fixes #27404. Co-authored-by: Codex <codex(a)openai.com> - - - - - 4 changed files: - + changelog.d/fix-unreg - hadrian/src/Flavour.hs - rts/include/rts/NonMoving.h - rts/include/stg/MiscClosures.h Changes: ===================================== changelog.d/fix-unreg ===================================== @@ -0,0 +1,4 @@ +section: packaging +synopsis: Fix unregisterised build for gcc 15+ +issues: #27404 +mrs: !16264 ===================================== hadrian/src/Flavour.hs ===================================== @@ -35,7 +35,9 @@ import Data.Either import Data.Map (Map) import qualified Data.Map as M import qualified Data.Set as Set +import GHC.Toolchain.Target import Oracles.Flag +import Oracles.Setting import Packages import Flavour.Type import Settings.Parser @@ -140,8 +142,9 @@ addArgs args' fl = fl { extraArgs = extraArgs fl <> args' } -- in unix and/or hsc2hs to make cross-compiling unix completely free -- from warnings. werror :: Flavour -> Flavour -werror = - addArgs $ mconcat +werror = addArgs $ do + stage <- getStage + mconcat [ builder Ghc ? notStage0 ? mconcat @@ -159,6 +162,15 @@ werror = , arg "-optc-Wno-error=unknown-pragmas" -- rejected inlinings are highly dependent upon toolchain and way , arg "-optc-Wno-error=inline" + -- when building unregisterised, gcc 15+ complains "error: + -- function called through a non-compatible type" with + -- -Werror (#27404). no corresponding -Wno-foo for it so + -- -Wno-error is needed. + -- + -- TODO: get rid of EFF_ altogether (#14647) and make sure + -- unregisterised backend emits clean C without needing + -- these hacks. + , queryTargetTarget stage tgtUnregisterised ? arg "-optc-Wno-error" ] -- N.B. We currently don't build the boot libraries' C sources with -Werror -- as this tends to be a portability nightmare. ===================================== rts/include/rts/NonMoving.h ===================================== @@ -18,6 +18,14 @@ struct StgClosure_; struct StgThunk_; struct Capability_; +#if IN_STG_CODE + +EFF_(updateRemembSetPushClosure_); + +EFF_(updateRemembSetPushThunk_); + +#else + /* This is called by the code generator */ extern void updateRemembSetPushClosure_(StgRegTable *reg, struct StgClosure_ *p); @@ -25,6 +33,8 @@ void updateRemembSetPushClosure_(StgRegTable *reg, struct StgClosure_ *p); extern void updateRemembSetPushThunk_(StgRegTable *reg, struct StgThunk_ *p); +#endif + // Forward declaration for unregisterised backend. EF_(stg_copyArray_barrier); ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -617,7 +617,11 @@ extern StgWord CCS_SYSTEM[]; // 'GHC.StgToCmm.Prof' // as opposed to real prototype declared in // 'rts/include/rts/prof/CCS.h' +#if IN_STG_CODE +EFF_(enterFunCCS); +#else void enterFunCCS (void *reg, void *ccsfn); +#endif void * pushCostCentre (void *ccs, void *cc); // Capability.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e22ad9972091e29ae56ed77686d3c8f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e22ad9972091e29ae56ed77686d3c8f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] generically defines mconcat in terms of internal type's Semigroup instance
by Marge Bot (＠marge-bot) 01 Jul '26

01 Jul '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4262af36 by L0neGamer at 2026-06-30T21:38:56-04:00 generically defines mconcat in terms of internal type's Semigroup instance add changelog entry use simpler definition for mconcat `nonEmpty` isn't available yet; inline branches in case add test case fixup generically defines mconcat in terms of internal type's Semigroup instance add comment on Generically and deriving mishaps swap mconcat to foldr version add some strictness testing for mconcat add to `base` changelog entry - - - - - 9 changed files: - + changelog.d/generically-mconcat - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Generics.hs - + testsuite/tests/generics/T27245.hs - + testsuite/tests/generics/T27245.stdout - testsuite/tests/generics/all.T - 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: ===================================== changelog.d/generically-mconcat ===================================== @@ -0,0 +1,4 @@ +section: base +synopsis: Add definition for Generically's `mconcat` in terms of the type variable's Semigroup instance instead of using the generically derived version. +issues: #27245 +mrs: !16011 ===================================== libraries/base/changelog.md ===================================== @@ -6,6 +6,7 @@ * Add `Data.List.NonEmpty.{zip{3..7},zipWith{3..7},unzip{3..7}}` ([CLC proposal #409)(https://github.com/haskell/core-libraries-committee/issues/409)) * Ensure that `Data.List.elem` and `notElem` can be specialized even when no list fusion happens. ([CLC proposal #412)(https://github.com/haskell/core-libraries-committee/issues/412)) * Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378)) + * Change `Generically a`'s `Monoid` definition to require a `Semigroup` constraint, and define its `mconcat` using `(<>)` from that constraint. ([CLC proposal #413](https://github.com/haskell/core-libraries-committee/issues/413)) ## 4.23.0.0 *TBA* * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370)) ===================================== libraries/ghc-internal/src/GHC/Internal/Generics.hs ===================================== @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-} - {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} @@ -744,7 +742,7 @@ import GHC.Internal.Types hiding (Any) -- clashes with the Semigroup import GHC.Internal.Ix ( Ix ) import GHC.Internal.Base ( Alternative(..), Applicative(..), Functor(..) , Monad(..), MonadPlus(..), NonEmpty(..), String - , Semigroup(..), Void ) + , Semigroup(..), Void) import GHC.Internal.Err (errorWithoutStackTrace) import GHC.Internal.Classes ( Eq(..), Ord(..) ) import GHC.Internal.Enum ( Bounded, Enum ) @@ -1437,6 +1435,10 @@ class Generic1 (f :: k -> Type) where -- type/ like 'Generically' decouples the instance from the type -- class. -- +-- Note that if you don't generate parent and child instances using the same +-- method, the result may be incongruous; for example, in previous versions +-- `mconcat` didn't use the correct `(<>)`, instead preferring a Generic version. +-- -- @since base-4.17.0.0 newtype Generically a = Generically a @@ -1446,12 +1448,14 @@ instance (Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where Generically a <> Generically b = Generically (to (from a <> from b :: Rep a ())) -- | @since base-4.17.0.0 -instance (Generic a, Monoid (Rep a ())) => Monoid (Generically a) where +instance (Generic a, Semigroup a, Monoid (Rep a ())) => Monoid (Generically a) where mempty :: Generically a mempty = Generically (to (mempty :: Rep a ())) - mappend :: Generically a -> Generically a -> Generically a - mappend = (<>) + -- https://github.com/haskell/core-libraries-committee/issues/324 + mconcat :: [Generically a] -> Generically a + mconcat = foldr (coerce @(a -> a -> a) (<>)) mempty + {-# INLINE mconcat #-} -- | A type whose instances are defined generically, using the -- 'Generic1' representation. 'Generically1' is a higher-kinded ===================================== testsuite/tests/generics/T27245.hs ===================================== @@ -0,0 +1,87 @@ + +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import GHC.Generics +import Data.Coerce +import Data.Semigroup +import Data.List.NonEmpty qualified as NE +import Control.Exception + +main :: IO () +main = do + let l1 = L [1] + l2 = L [2] + -- check append functions; this is a regression test for later down the line + print ("sappend", l1 <> l2) + print ("mappend", l1 `mappend` l2) + print ("gappend", l1 `gappend` l2) + -- when `mappend` is removed from `Monoid`, `mappend`'s definition will be + -- `mappend = (<>)` at the top level, removing the above `mappend = gappend` issue + + -- check concat functions + -- We have the defined method functions, the generic variants, and the + -- default implementations written out again + let ls = [l1, l2] + lsNE = l1 NE.:| [l2] + print ("sconcat", sconcat lsNE) + print ("mconcat", mconcat ls) + print ("gsconcat", gsconcat lsNE) + print ("gmconcat", gmconcat ls) + print ("dsconcat", dsconcat lsNE) + print ("dmconcatMappend", dmconcatMappend ls) -- uses `mappend` which is incorrect, see above + print ("dmconcatSappend", dmconcatSappend ls) + print ("dmconcatUsingSconcat", dmconcatUsingSconcat ls) + + let undefinedList = l1 : undefined + fOn s f = print ("strictness " <> s, f undefinedList) + (fOn "mconcat" mconcat `finally` -- derived instance is fine, shows + fOn "gmconcat" gmconcat `finally` -- this is too strict - using mappend on lists needs all lists + fOn "dmconcatMappend" dmconcatMappend `finally` -- also too strict for the above + fOn "dmconcatSappend" dmconcatSappend `finally` -- correct strictness, shows + fOn "dmconcatUsingSconcat" dmconcatUsingSconcat -- sconcat is too strict as well + ) `catch` \(_ :: SomeException) -> pure () + +newtype L a = L [a] + deriving (Generic, Show, Eq) + deriving Monoid via (Generically (L a)) + +-- semigroup instance not derived with Generically, so it could be mis-aligned +-- with generic monoid definition +instance Semigroup (L a) where + L [] <> l = l + l <> _ = l + +-- generic (<>) +gappend :: forall a . (Generic a, Semigroup (Rep a ())) => a -> a -> a +gappend a b = to (from a <> from b :: Rep a ()) + +-- generic sconcat +gsconcat :: forall a . (Generic a, Semigroup (Rep a ())) => NE.NonEmpty a -> a +gsconcat = to . sconcat @(Rep a ()) . fmap from + +-- generic mconcat +gmconcat :: forall a . (Generic a, Monoid (Rep a ())) => [a] -> a +gmconcat = to . mconcat @(Rep a ()) . fmap from + +-- default sconcat +dsconcat :: forall a . Semigroup a => NE.NonEmpty a -> a +dsconcat (a NE.:| as) = go a as where + go b (c:cs) = b <> go c cs + go b [] = b + +-- default mconcat using mappend +dmconcatMappend :: Monoid a => [a] -> a +dmconcatMappend = foldr mappend mempty + +-- default mconcat using (<>), also the new generically impl +dmconcatSappend :: Monoid a => [a] -> a +dmconcatSappend = foldr (<>) mempty + +-- incorrect impl, too strict in the spine +dmconcatUsingSconcat :: Monoid a => [a] -> a +dmconcatUsingSconcat as = case as of + [] -> mempty + x : xs -> sconcat (x NE.:| xs) ===================================== testsuite/tests/generics/T27245.stdout ===================================== @@ -0,0 +1,13 @@ +("sappend",L [1]) +("mappend",L [1,2]) +("gappend",L [1,2]) +("sconcat",L [1]) +("mconcat",L [1]) +("gsconcat",L [1,2]) +("gmconcat",L [1,2]) +("dsconcat",L [1]) +("dmconcatMappend",L [1,2]) +("dmconcatSappend",L [1]) +("dmconcatUsingSconcat",L [1]) +("strictness mconcat",L [1]) +("strictness dmconcatSappend",L [1]) ===================================== testsuite/tests/generics/all.T ===================================== @@ -50,3 +50,4 @@ test('T19819', normal, compile_and_run, ['']) test('T21185', normal, compile, ['']) test('T25148a', normal, compile, ['']) test('T25148b', normal, compile, ['']) +test('T27245', normal, compile_and_run, ['']) ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -11056,7 +11056,7 @@ instance GHC.Internal.Base.Monoid ghc-internal-10.100.0:GHC.Internal.Event.Inter instance GHC.Internal.Base.Monoid ghc-internal-10.100.0:GHC.Internal.Event.Internal.Types.Lifetime -- Defined in ‘ghc-internal-10.100.0:GHC.Internal.Event.Internal.Types’ instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ -instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ +instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ instance forall k c i (p :: k). GHC.Internal.Base.Monoid c => GHC.Internal.Base.Monoid (GHC.Internal.Generics.K1 i c p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (p :: k) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monoid (f p) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.M1 i c f p) -- Defined in ‘GHC.Internal.Generics’ instance forall p. GHC.Internal.Base.Monoid p => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Generics’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -11091,7 +11091,7 @@ instance forall m. GHC.Internal.Base.Monoid m => GHC.Internal.Base.Monoid (Data. instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.STM.STM a) -- Defined in ‘GHC.Internal.STM’ instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ -instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ +instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ instance forall k c i (p :: k). GHC.Internal.Base.Monoid c => GHC.Internal.Base.Monoid (GHC.Internal.Generics.K1 i c p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (p :: k) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monoid (f p) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.M1 i c f p) -- Defined in ‘GHC.Internal.Generics’ instance forall p. GHC.Internal.Base.Monoid p => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Generics’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -11316,7 +11316,7 @@ instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.I instance GHC.Internal.Base.Monoid GHC.Internal.Event.Windows.EventData -- Defined in ‘GHC.Internal.Event.Windows’ instance forall k (f :: k -> *) (p :: k) (g :: k -> *). (GHC.Internal.Base.Monoid (f p), GHC.Internal.Base.Monoid (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:*:) f g p) -- Defined in ‘GHC.Internal.Generics’ instance forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1). GHC.Internal.Base.Monoid (f (g p)) => GHC.Internal.Base.Monoid ((GHC.Internal.Generics.:.:) f g p) -- Defined in ‘GHC.Internal.Generics’ -instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ +instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’ instance forall k c i (p :: k). GHC.Internal.Base.Monoid c => GHC.Internal.Base.Monoid (GHC.Internal.Generics.K1 i c p) -- Defined in ‘GHC.Internal.Generics’ instance forall k (f :: k -> *) (p :: k) i (c :: GHC.Internal.Generics.Meta). GHC.Internal.Base.Monoid (f p) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.M1 i c f p) -- Defined in ‘GHC.Internal.Generics’ instance forall p. GHC.Internal.Base.Monoid p => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Par1 p) -- Defined in ‘GHC.Internal.Generics’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4262af3664e29b681753276203dc447… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4262af3664e29b681753276203dc447… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Make Q abstract
by Marge Bot (＠marge-bot) 01 Jul '26

01 Jul '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7bf9e3c5 by Teo Camarasu at 2026-06-30T21:38:03-04:00 Make Q abstract This patch aims to clearly demarcate the internal and external interfaces of Q. In the past the `Quasi` typeclass was both part of the external, public-facing interface, and was used to give the implementation of `Q`. Now we separate out these two distinct roles. `Quasi` continues to exist in the public interface, but we introduce a new `MetaHandlers` type, which is equivalent to `Dict Quasi`. `Q a` is now defined to be `MetaHandlers -> IO a`, and, crucially, the constructor and the new `MetaHandlers` type are not exposed from the public interface. This gives us the ability to vary the interface on the GHC side without forcing a breaking change on the `template-haskell` side. Similarly `template-haskell` has more freedom to change the `Quasi` typeclass without needing any changes in `lib:ghc`. Implements https://github.com/ghc-proposals/ghc-proposals/pull/700 Resolves #27341 - - - - - 9 changed files: - + changelog.d/AbstractQ - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Gen/Splice.hs-boot - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - libraries/ghci/GHCi/TH.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/interface-stability/template-haskell-exports.stdout Changes: ===================================== changelog.d/AbstractQ ===================================== @@ -0,0 +1,9 @@ +section: template-haskell +synopsis: Hide the implementation of Q +description: The constructor of Q is now hidden. + This is done to improve the stability of ``template-haskell``. + To minimize breakage, we have added a new ``qRunQ`` operation to ``Quasi``. + The ``Quasi TcM`` instance is no longer exposed from the ``ghc`` API. + See the `GHC proposal <https://github.com/ghc-proposals/ghc-proposals/pull/700>`_ for more details. +mrs: !15696 +issues: #27341 ===================================== compiler/GHC/Data/IOEnv.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Data.IOEnv ( IOEnvFailure(..), -- Getting at the environment - getEnv, setEnv, updEnv, updEnvIO, + getEnv, setEnv, updEnv, updEnvIO, withRunInIO, runIOEnv, unsafeInterleaveM, uninterruptibleMaskM_, tryM, tryAllM, tryMostM, fixM, @@ -258,3 +258,12 @@ updEnv upd (IOEnv m) = IOEnv (\ env -> m (upd env)) updEnvIO :: (env -> IO env') -> IOEnv env' a -> IOEnv env a {-# INLINE updEnvIO #-} updEnvIO upd (IOEnv m) = IOEnv (\ env -> m =<< upd env) + +-- | 'withRunInIO' specialised to `IOEnv`. +-- See https://hackage.haskell.org/package/unliftio-core/docs/Control-Monad-IO-Unl… for an explanation. +withRunInIO:: forall env b. ((forall a. IOEnv env a -> IO a) -> IO b) -> IOEnv env b +withRunInIO k = IOEnv $ \env -> + let + unlift :: forall a. IOEnv env a -> IO a + unlift (IOEnv m) = m env + in k unlift ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -25,7 +25,7 @@ module GHC.Tc.Gen.Splice( tcTypedSplice, tcTypedBracket, tcUntypedBracket, runAnnotation, getUntypedSpliceBody, - runMetaE, runMetaP, runMetaT, runMetaD, runQuasi, + runMetaE, runMetaP, runMetaT, runMetaD, runQinTcM, tcTopSpliceExpr, lookupThName_maybe, defaultRunMeta, runMeta', runRemoteModFinalizers, finishTH, runTopSplice @@ -138,6 +138,7 @@ import qualified GHC.LanguageExtensions as LangExt -- THSyntax gives access to internal functions and data types import qualified GHC.Boot.TH.Syntax as TH import qualified GHC.Boot.TH.Monad as TH +import GHC.Boot.TH.Monad (MetaHandlers(..)) import qualified GHC.Boot.TH.Ppr as TH #if defined(HAVE_INTERNAL_INTERPRETER) @@ -1138,8 +1139,8 @@ convertAnnotationWrapper fhv = do ************************************************************************ -} -runQuasi :: TH.Q a -> TcM a -runQuasi act = TH.runQ act +runQinTcM :: TH.Q a -> TcM a +runQinTcM (TH.Q act) = withRunInIO $ \runInIO -> act (metaHandlersTcM runInIO) runRemoteModFinalizers :: ThModFinalizers -> TcM () runRemoteModFinalizers (ThModFinalizers finRefs) = do @@ -1152,7 +1153,7 @@ runRemoteModFinalizers (ThModFinalizers finRefs) = do #if defined(HAVE_INTERNAL_INTERPRETER) InternalInterp -> do qs <- liftIO (withForeignRefs finRefs $ mapM localRef) - runQuasi $ sequence_ qs + runQinTcM $ sequence_ qs #endif ExternalInterp ext -> withExtInterp ext $ \inst -> do @@ -1466,70 +1467,14 @@ when showing an error message. To call runQ in the Tc monad, we need to make TcM an instance of Quasi: -} -instance TH.Quasi TcM where - qNewName s = do { u <- newUnique - ; let i = toInteger (getKey u) - ; return (TH.mkNameU s i) } +-- 'msg' is forced to ensure exceptions don't escape, +-- see Note [Exceptions in TH] +report :: Bool -> [Char] -> TcM () +report True msg = seqList msg $ addErr $ TcRnTHError $ ReportCustomQuasiError True msg +report False msg = seqList msg $ addDiagnostic $ TcRnTHError $ ReportCustomQuasiError False msg - -- 'msg' is forced to ensure exceptions don't escape, - -- see Note [Exceptions in TH] - qReport True msg = seqList msg $ addErr $ TcRnTHError $ ReportCustomQuasiError True msg - qReport False msg = seqList msg $ addDiagnostic $ TcRnTHError $ ReportCustomQuasiError False msg - - qLocation :: TcM TH.Loc - qLocation = do { m <- getModule - ; l <- getSrcSpanM - ; r <- case l of - RealSrcSpan s _ -> return s - GeneratedSrcSpan{} -> pprPanic "qLocation: generatedSrcSpan" - (pprGeneratedSrcSpanDetails) - UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location" - (ppr l) - ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r) - , TH.loc_module = moduleNameString (moduleName m) - , TH.loc_package = unitString (moduleUnit m) - , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r) - , TH.loc_end = (srcSpanEndLine r, srcSpanEndCol r) }) } - - qLookupName = lookupName - qReify = reify - qReifyFixity nm = lookupThName nm >>= reifyFixity - qReifyType = reifyTypeOfThing - qReifyInstances = reifyInstances - qReifyRoles = reifyRoles - qReifyAnnotations = reifyAnnotations - qReifyModule = reifyModule - qReifyConStrictness nm = do { nm' <- lookupThName nm - ; dc <- tcLookupDataCon nm' - ; let bangs = dataConImplBangs dc - ; return (map reifyDecidedStrictness bangs) } - - -- For qRecover, discard error messages if - -- the recovery action is chosen. Otherwise - -- we'll only fail higher up. - qRecover recover main = tryTcDiscardingErrs recover main - - qGetPackageRoot = do - dflags <- getDynFlags - return $ fromMaybe "." (workingDirectory dflags) - - qAddDependentFile fp = do - ref <- fmap tcg_dependent_files getGblEnv - dep_files <- readTcRef ref - writeTcRef ref (fp:dep_files) - - qAddDependentDirectory dp = do - ref <- fmap tcg_dependent_dirs getGblEnv - dep_dirs <- readTcRef ref - writeTcRef ref (dp:dep_dirs) - - qAddTempFile suffix = do - dflags <- getDynFlags - logger <- getLogger - tmpfs <- hsc_tmpfs <$> getTopEnv - liftIO $ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession suffix - - qAddTopDecls thds = do +addTopDecls :: [TH.Dec] -> TcM () +addTopDecls thds = do exts <- fmap extensionFlags getDynFlags l <- getSrcSpanM th_origin <- getThSpliceOrigin @@ -1557,52 +1502,13 @@ instance TH.Quasi TcM where bindName :: RdrName -> TcM () bindName (Exact n) = do { th_topnames_var <- fmap tcg_th_topnames getGblEnv - ; updTcRef th_topnames_var (\ns -> extendNameSet ns n) - } + ; updTcRef th_topnames_var (\ns -> extendNameSet ns n) + } bindName name = addErr $ TcRnTHError $ THNameError $ NonExactName name - qAddForeignFilePath lang fp = do - var <- fmap tcg_th_foreign_files getGblEnv - updTcRef var ((lang, fp) :) - - qAddModFinalizer fin = do - r <- liftIO $ mkRemoteRef fin - fref <- liftIO $ mkForeignRef r (freeRemoteRef r) - addModFinalizerRef fref - - qAddCorePlugin plugin = do - hsc_env <- getTopEnv - let fc = hsc_FC hsc_env - let home_unit = hsc_home_unit hsc_env - let dflags = hsc_dflags hsc_env - let fopts = initFinderOpts dflags - r <- liftIO $ findHomeModule fc fopts home_unit (mkModuleName plugin) - let err = TcRnTHError $ AddInvalidCorePlugin plugin - case r of - Found {} -> addErr err - FoundMultiple {} -> addErr err - _ -> return () - th_coreplugins_var <- tcg_th_coreplugins <$> getGblEnv - updTcRef th_coreplugins_var (plugin:) - - qGetQ :: forall a. Typeable a => TcM (Maybe a) - qGetQ = do - th_state_var <- fmap tcg_th_state getGblEnv - th_state <- readTcRef th_state_var - -- See #10596 for why we use a scoped type variable here. - return (Map.lookup (typeRep (Proxy :: Proxy a)) th_state >>= fromDynamic) - - qPutQ x = do - th_state_var <- fmap tcg_th_state getGblEnv - updTcRef th_state_var (\m -> Map.insert (typeOf x) (toDyn x) m) - - qIsExtEnabled = xoptM - - qExtsEnabled = - EnumSet.toList . extensionFlags . hsc_dflags <$> getTopEnv - - qPutDoc doc_loc s = do +putDoc :: TH.DocLoc -> String -> TcM () +putDoc doc_loc s = do th_doc_var <- tcg_th_docs <$> getGblEnv resolved_doc_loc <- resolve_loc doc_loc is_local <- checkLocalName resolved_doc_loc @@ -1624,15 +1530,131 @@ instance TH.Quasi TcM where checkLocalName (InstDoc n) = nameIsLocalOrFrom <$> getModule <*> pure n checkLocalName ModuleDoc = pure True - - qGetDoc (TH.DeclDoc n) = lookupThName n >>= lookupDeclDoc - qGetDoc (TH.InstDoc t) = lookupThInstName t >>= lookupDeclDoc - qGetDoc (TH.ArgDoc n i) = lookupThName n >>= lookupArgDoc i - qGetDoc TH.ModuleDoc = do +getDoc :: TH.DocLoc -> TcM (Maybe String) +getDoc (TH.DeclDoc n) = lookupThName n >>= lookupDeclDoc +getDoc (TH.InstDoc t) = lookupThInstName t >>= lookupDeclDoc +getDoc (TH.ArgDoc n i) = lookupThName n >>= lookupArgDoc i +getDoc TH.ModuleDoc = do df <- getDynFlags docs <- getGblEnv >>= extractDocs df return (renderHsDocString . hsDocString <$> (docs_mod_hdr =<< docs)) +getQ :: forall a. Typeable a => TcM (Maybe a) +getQ = do + th_state_var <- fmap tcg_th_state getGblEnv + th_state <- readTcRef th_state_var + -- See #10596 for why we use a scoped type variable here. + return (Map.lookup (typeRep (Proxy :: Proxy a)) th_state >>= fromDynamic) + +location :: TcM TH.Loc +location = do { m <- getModule + ; l <- getSrcSpanM + ; r <- case l of + RealSrcSpan s _ -> return s + GeneratedSrcSpan{} -> pprPanic "qLocation: generatedSrcSpan" + (pprGeneratedSrcSpanDetails) + UnhelpfulSpan _ -> pprPanic "qLocation: Unhelpful location" + (ppr l) + ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r) + , TH.loc_module = moduleNameString (moduleName m) + , TH.loc_package = unitString (moduleUnit m) + , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r) + , TH.loc_end = (srcSpanEndLine r, srcSpanEndCol r) }) } + +metaHandlersTcM :: (forall x. TcM x -> IO x) -> TH.MetaHandlers +metaHandlersTcM runInIO = TH.MetaHandlers { + mLiftIO = id + -- We are careful to use the TcM instance not the one for IO, since that would lead to a different error. + , mFail = \s -> runInIO $ fail @TcM s + , mNewName = \s -> runInIO $ do { u <- newUnique + ; let i = toInteger (getKey u) + ; return (TH.mkNameU s i) } + + , mReport = fmap runInIO . report + + , mLocation = runInIO location + + , mLookupName = fmap runInIO . lookupName + , mReify = runInIO . reify + , mReifyFixity = \nm -> runInIO $ lookupThName nm >>= reifyFixity + , mReifyType = runInIO . reifyTypeOfThing + , mReifyInstances = fmap runInIO . reifyInstances + , mReifyRoles = runInIO . reifyRoles + , mReifyAnnotations = runInIO . reifyAnnotations + , mReifyModule = runInIO . reifyModule + , mReifyConStrictness = \nm -> runInIO $ do + { nm' <- lookupThName nm + ; dc <- tcLookupDataCon nm' + ; let bangs = dataConImplBangs dc + ; return (map reifyDecidedStrictness bangs) } + + -- For qRecover, discard error messages if + -- the recovery action is chosen. Otherwise + -- we'll only fail higher up. + , mRecover = \recover main -> runInIO $ tryTcDiscardingErrs (runQinTcM recover) (runQinTcM main) + + , mGetPackageRoot = runInIO $ do + dflags <- getDynFlags + return $ fromMaybe "." (workingDirectory dflags) + + , mAddDependentFile = \fp -> runInIO $ do + ref <- fmap tcg_dependent_files getGblEnv + dep_files <- readTcRef ref + writeTcRef ref (fp:dep_files) + + , mAddDependentDirectory = \dp -> runInIO $ do + ref <- fmap tcg_dependent_dirs getGblEnv + dep_dirs <- readTcRef ref + writeTcRef ref (dp:dep_dirs) + + , mAddTempFile = \suffix -> runInIO $ do + dflags <- getDynFlags + logger <- getLogger + tmpfs <- hsc_tmpfs <$> getTopEnv + liftIO $ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession suffix + + , mAddTopDecls = runInIO . addTopDecls + + , mAddForeignFilePath = \lang fp -> runInIO $ do + var <- fmap tcg_th_foreign_files getGblEnv + updTcRef var ((lang, fp) :) + + , mAddModFinalizer = \fin -> runInIO $ do + r <- liftIO $ mkRemoteRef fin + fref <- liftIO $ mkForeignRef r (freeRemoteRef r) + addModFinalizerRef fref + + , mAddCorePlugin = \plugin -> runInIO $ do + hsc_env <- getTopEnv + let fc = hsc_FC hsc_env + let home_unit = hsc_home_unit hsc_env + let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags + r <- liftIO $ findHomeModule fc fopts home_unit (mkModuleName plugin) + let err = TcRnTHError $ AddInvalidCorePlugin plugin + case r of + Found {} -> addErr err + FoundMultiple {} -> addErr err + _ -> return () + th_coreplugins_var <- tcg_th_coreplugins <$> getGblEnv + updTcRef th_coreplugins_var (plugin:) + + , mGetQ = runInIO getQ + + , mPutQ = \x -> runInIO $ do + th_state_var <- fmap tcg_th_state getGblEnv + updTcRef th_state_var (\m -> Map.insert (typeOf x) (toDyn x) m) + + , mIsExtEnabled = runInIO . xoptM + + , mExtsEnabled = runInIO $ + EnumSet.toList . extensionFlags . hsc_dflags <$> getTopEnv + + , mPutDoc = fmap runInIO . putDoc + + , mGetDoc = runInIO . getDoc + } + -- | Looks up documentation for a declaration in first the current module, -- otherwise tries to find it in another module via 'hscGetModuleInterface'. lookupDeclDoc :: Name -> TcM (Maybe String) @@ -1788,7 +1810,7 @@ runTH ty fhv = do InternalInterp -> do -- Run it in the local TcM hv <- liftIO $ wormhole interp fhv - r <- runQuasi (unsafeCoerce hv :: TH.Q a) + r <- runQinTcM (unsafeCoerce hv :: TH.Q a) return r #endif @@ -1797,7 +1819,7 @@ runTH ty fhv = do -- Remote GHCi, see Note [Remote Template Haskell] in -- libraries/ghci/GHCi/TH.hs. rstate <- getTHState inst - loc <- TH.qLocation + loc <- location -- run a remote TH request r <- liftIO $ withForeignRef rstate $ \state_hv -> @@ -1913,32 +1935,32 @@ wrapTHResult tcm = do handleTHMessage :: THMessage a -> TcM a handleTHMessage msg = case msg of - NewName a -> wrapTHResult $ TH.qNewName a - Report b str -> wrapTHResult $ TH.qReport b str - LookupName b str -> wrapTHResult $ TH.qLookupName b str - Reify n -> wrapTHResult $ TH.qReify n - ReifyFixity n -> wrapTHResult $ TH.qReifyFixity n - ReifyType n -> wrapTHResult $ TH.qReifyType n - ReifyInstances n ts -> wrapTHResult $ TH.qReifyInstances n ts - ReifyRoles n -> wrapTHResult $ TH.qReifyRoles n + NewName a -> wrapTHResult $ runQinTcM $ TH.newName a + Report b str -> wrapTHResult $ runQinTcM $ TH.report b str + LookupName b str -> wrapTHResult $ runQinTcM $ TH.lookupName b str + Reify n -> wrapTHResult $ runQinTcM $ TH.reify n + ReifyFixity n -> wrapTHResult $ runQinTcM $ TH.reifyFixity n + ReifyType n -> wrapTHResult $ runQinTcM $ TH.reifyType n + ReifyInstances n ts -> wrapTHResult $ runQinTcM $ TH.reifyInstances n ts + ReifyRoles n -> wrapTHResult $ runQinTcM $ TH.reifyRoles n ReifyAnnotations lookup tyrep -> wrapTHResult $ (map B.pack <$> getAnnotationsByTypeRep lookup tyrep) - ReifyModule m -> wrapTHResult $ TH.qReifyModule m - ReifyConStrictness nm -> wrapTHResult $ TH.qReifyConStrictness nm - GetPackageRoot -> wrapTHResult $ TH.qGetPackageRoot - AddDependentFile f -> wrapTHResult $ TH.qAddDependentFile f - AddDependentDirectory d -> wrapTHResult $ TH.qAddDependentDirectory d - AddTempFile s -> wrapTHResult $ TH.qAddTempFile s + ReifyModule m -> wrapTHResult $ runQinTcM $ TH.reifyModule m + ReifyConStrictness nm -> wrapTHResult $ runQinTcM $ TH.reifyConStrictness nm + GetPackageRoot -> wrapTHResult $ runQinTcM $ TH.getPackageRoot + AddDependentFile f -> wrapTHResult $ runQinTcM $ TH.addDependentFile f + AddDependentDirectory d -> wrapTHResult $ runQinTcM $ TH.addDependentDirectory d + AddTempFile s -> wrapTHResult $ runQinTcM $ TH.addTempFile s AddModFinalizer r -> do interp <- hscInterp <$> getTopEnv wrapTHResult $ liftIO (mkFinalizedHValue interp r) >>= addModFinalizerRef - AddCorePlugin str -> wrapTHResult $ TH.qAddCorePlugin str - AddTopDecls decs -> wrapTHResult $ TH.qAddTopDecls decs - AddForeignFilePath lang str -> wrapTHResult $ TH.qAddForeignFilePath lang str - IsExtEnabled ext -> wrapTHResult $ TH.qIsExtEnabled ext - ExtsEnabled -> wrapTHResult $ TH.qExtsEnabled - PutDoc l s -> wrapTHResult $ TH.qPutDoc l s - GetDoc l -> wrapTHResult $ TH.qGetDoc l + AddCorePlugin str -> wrapTHResult $ runQinTcM $ TH.addCorePlugin str + AddTopDecls decs -> wrapTHResult $ runQinTcM $ TH.addTopDecls decs + AddForeignFilePath lang str -> wrapTHResult $ runQinTcM $ TH.addForeignFilePath lang str + IsExtEnabled ext -> wrapTHResult $ runQinTcM $ TH.isExtEnabled ext + ExtsEnabled -> wrapTHResult $ runQinTcM $ TH.extsEnabled + PutDoc l s -> wrapTHResult $ runQinTcM $ TH.putDoc l s + GetDoc l -> wrapTHResult $ runQinTcM $ TH.getDoc l FailIfErrs -> wrapTHResult failIfErrsM _ -> panic ("handleTHMessage: unexpected message " ++ show msg) ===================================== compiler/GHC/Tc/Gen/Splice.hs-boot ===================================== @@ -42,6 +42,6 @@ runMetaT :: LHsExpr GhcTc -> TcM (LHsType GhcPs) runMetaD :: LHsExpr GhcTc -> TcM [LHsDecl GhcPs] lookupThName_maybe :: TH.Name -> TcM (Maybe Name) -runQuasi :: TH.Q a -> TcM a +runQinTcM :: TH.Q a -> TcM a runRemoteModFinalizers :: ThModFinalizers -> TcM () finishTH :: TcM () ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs ===================================== @@ -1079,7 +1079,7 @@ withDecDoc :: String -> Q Dec -> Q Dec withDecDoc doc dec = do dec' <- dec case doc_loc dec' of - Just loc -> qAddModFinalizer $ qPutDoc loc doc + Just loc -> addModFinalizer $ putDoc loc doc Nothing -> pure () pure dec' where @@ -1128,7 +1128,7 @@ funD_doc :: Name -> [Q Clause] -> [Maybe String] -- ^ Documentation to attach to arguments -> Q Dec funD_doc nm cs mfun_doc arg_docs = do - qAddModFinalizer $ sequence_ + addModFinalizer $ sequence_ [putDoc (ArgDoc nm i) s | (i, Just s) <- zip [0..] arg_docs] let dec = funD nm cs case mfun_doc of @@ -1145,7 +1145,7 @@ dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -- ^ Documentation to attach to the data declaration -> Q Dec dataD_doc ctxt tc tvs ksig cons_with_docs derivs mdoc = do - qAddModFinalizer $ mapM_ docCons cons_with_docs + addModFinalizer $ mapM_ docCons cons_with_docs let dec = dataD ctxt tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs) derivs maybe dec (flip withDecDoc dec) mdoc @@ -1159,7 +1159,7 @@ newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -- ^ Documentation to attach to the newtype declaration -> Q Dec newtypeD_doc ctxt tc tvs ksig con_with_docs@(con, _, _) derivs mdoc = do - qAddModFinalizer $ docCons con_with_docs + addModFinalizer $ docCons con_with_docs let dec = newtypeD ctxt tc tvs ksig con derivs maybe dec (flip withDecDoc dec) mdoc @@ -1172,7 +1172,7 @@ typeDataD_doc :: Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -- ^ Documentation to attach to the data declaration -> Q Dec typeDataD_doc tc tvs ksig cons_with_docs mdoc = do - qAddModFinalizer $ mapM_ docCons cons_with_docs + addModFinalizer $ mapM_ docCons cons_with_docs let dec = typeDataD tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs) maybe dec (flip withDecDoc dec) mdoc @@ -1186,7 +1186,7 @@ dataInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type -> Maybe (Q Kind) -- ^ Documentation to attach to the instance declaration -> Q Dec dataInstD_doc ctxt mb_bndrs ty ksig cons_with_docs derivs mdoc = do - qAddModFinalizer $ mapM_ docCons cons_with_docs + addModFinalizer $ mapM_ docCons cons_with_docs let dec = dataInstD ctxt mb_bndrs ty ksig (map (\(con, _, _) -> con) cons_with_docs) derivs maybe dec (flip withDecDoc dec) mdoc @@ -1202,7 +1202,7 @@ newtypeInstD_doc :: Q Cxt -> (Maybe [Q (TyVarBndr ())]) -> Q Type -- ^ Documentation to attach to the instance declaration -> Q Dec newtypeInstD_doc ctxt mb_bndrs ty ksig con_with_docs@(con, _, _) derivs mdoc = do - qAddModFinalizer $ docCons con_with_docs + addModFinalizer $ docCons con_with_docs let dec = newtypeInstD ctxt mb_bndrs ty ksig con derivs maybe dec (flip withDecDoc dec) mdoc @@ -1212,7 +1212,7 @@ patSynD_doc :: Name -> Q PatSynArgs -> Q PatSynDir -> Q Pat -> [Maybe String] -- ^ Documentation to attach to the pattern arguments -> Q Dec patSynD_doc name args dir pat mdoc arg_docs = do - qAddModFinalizer $ sequence_ + addModFinalizer $ sequence_ [putDoc (ArgDoc name i) s | (i, Just s) <- zip [0..] arg_docs] let dec = patSynD name args dir pat maybe dec (flip withDecDoc dec) mdoc ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs ===================================== @@ -29,13 +29,13 @@ import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe (unsafePerformIO) import Control.Monad.IO.Class (MonadIO (..)) -import System.IO (FilePath, hPutStrLn, stderr) +import System.IO (hPutStrLn, stderr) import qualified Data.Kind as Kind (Type) import GHC.Types (TYPE, RuntimeRep(..)) #else import GHC.Internal.Base ( Applicative(..), Functor(..), Monad(..), Monoid(..), Semigroup(..), String, - flip, id, (.), (++), + flip, id, (.), (++), ($), ) import GHC.Internal.Classes (not) import GHC.Internal.Data.Data hiding (Fixity(..)) @@ -59,145 +59,150 @@ import GHC.Internal.ForeignSrcLang import GHC.Internal.LanguageExtensions import GHC.Internal.TH.Syntax ------------------------------------------------------ --- --- The Quasi class --- ------------------------------------------------------ - -class (MonadIO m, MonadFail m) => Quasi m where - -- | Fresh names. See 'newName'. - qNewName :: String -> m Name - - ------- Error reporting and recovery ------- - -- | Report an error (True) or warning (False) - -- ...but carry on; use 'fail' to stop. See 'report'. - qReport :: Bool -> String -> m () - - -- | See 'recover'. - qRecover :: m a -- ^ the error handler - -> m a -- ^ action which may fail - -> m a -- ^ Recover from the monadic 'fail' - - ------- Inspect the type-checker's environment ------- - -- | True <=> type namespace, False <=> value namespace. See 'lookupName'. - qLookupName :: Bool -> String -> m (Maybe Name) - -- | See 'reify'. - qReify :: Name -> m Info - -- | See 'reifyFixity'. - qReifyFixity :: Name -> m (Maybe Fixity) - -- | See 'reifyType'. - qReifyType :: Name -> m Type - -- | Is (n tys) an instance? Returns list of matching instance Decs (with - -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'. - qReifyInstances :: Name -> [Type] -> m [Dec] - -- | See 'reifyRoles'. - qReifyRoles :: Name -> m [Role] - -- | See 'reifyAnnotations'. - qReifyAnnotations :: Data a => AnnLookup -> m [a] - -- | See 'reifyModule'. - qReifyModule :: Module -> m ModuleInfo - -- | See 'reifyConStrictness'. - qReifyConStrictness :: Name -> m [DecidedStrictness] - - -- | See 'location'. - qLocation :: m Loc - - -- | Input/output (dangerous). See 'runIO'. - qRunIO :: IO a -> m a - qRunIO = liftIO - -- | See 'getPackageRoot'. - qGetPackageRoot :: m FilePath - - -- | See 'addDependentFile'. - qAddDependentFile :: FilePath -> m () - - -- | See 'addDependentDirectory'. - qAddDependentDirectory :: FilePath -> m () - - -- | See 'addTempFile'. - qAddTempFile :: String -> m FilePath - - -- | See 'addTopDecls'. - qAddTopDecls :: [Dec] -> m () - - -- | See 'addForeignFilePath'. - qAddForeignFilePath :: ForeignSrcLang -> String -> m () - - -- | See 'addModFinalizer'. - qAddModFinalizer :: Q () -> m () - - -- | See 'addCorePlugin'. - qAddCorePlugin :: String -> m () - - -- | See 'getQ'. - qGetQ :: Typeable a => m (Maybe a) - - -- | See 'putQ'. - qPutQ :: Typeable a => a -> m () - - -- | See 'isExtEnabled'. - qIsExtEnabled :: Extension -> m Bool - -- | See 'extsEnabled'. - qExtsEnabled :: m [Extension] - - -- | See 'putDoc'. - qPutDoc :: DocLoc -> String -> m () - -- | See 'getDoc'. - qGetDoc :: DocLoc -> m (Maybe String) +-- | 'MetaHandlers' defines the interface between GHC and TH splices. +-- This is an internal interface between two parts of the compiler, +-- and should never be directly exposed to users. +-- +-- It mirrors the 'Quasi' typeclass, which is part of the public facing interface of TH. +-- With time the two interfaces may drift apart. +-- +-- This type is defined in `ghc-internal` rather than `lib:ghc` to avoid +-- `template-haskell` having to depend on GHC, ie, it implements dependency inversion. +-- +-- For more information about the historical design of this interface, +-- see: https://github.com/ghc-proposals/ghc-proposals/pull/700 +data MetaHandlers = MetaHandlers { + -- | We have an explicit handler for liftIO to allow users to forbid lifting into 'IO' + mLiftIO :: forall a. IO a -> IO a + , mFail :: forall a. String -> IO a + -- | Fresh names. See 'newName'. + , mNewName :: String -> IO Name + + ------- Error reporting and recovery ------- + -- | Report an error (True) or warning (False) + -- ...but carry on; use 'fail' to stop. See 'report'. + , mReport :: Bool -> String -> IO () + + -- | See 'recover'. + , mRecover :: forall a. Q a -- ^ the error handler + -> Q a -- ^ action which may fail + -> IO a -- ^ Recover from the monadic 'fail' + + ------- Inspect the type-checker's environment ------- + -- | True <=> type namespace, False <=> value namespace. See 'lookupName'. + , mLookupName :: Bool -> String -> IO (Maybe Name) + -- | See 'reify'. + , mReify :: Name -> IO Info + -- | See 'reifyFixity'. + , mReifyFixity :: Name -> IO (Maybe Fixity) + -- | See 'reifyType'. + , mReifyType :: Name -> IO Type + -- | Is (n tys) an instance? Returns list of matching instance Decs (with + -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'. + , mReifyInstances :: Name -> [Type] -> IO [Dec] + -- | See 'reifyRoles'. + , mReifyRoles :: Name -> IO [Role] + -- | See 'reifyAnnotations'. + , mReifyAnnotations :: forall a. Data a => AnnLookup -> IO [a] + -- | See 'reifyModule'. + , mReifyModule :: Module -> IO ModuleInfo + -- | See 'reifyConStrictness'. + , mReifyConStrictness :: Name -> IO [DecidedStrictness] + + -- | See 'location'. + , mLocation :: IO Loc + + -- | See 'getPackageRoot'. + , mGetPackageRoot :: IO FilePath + + -- | See 'addDependentFile'. + , mAddDependentFile :: FilePath -> IO () + + -- | See 'addDependentDirectory'. + , mAddDependentDirectory :: FilePath -> IO () + + -- | See 'addTempFile'. + , mAddTempFile :: String -> IO FilePath + + -- | See 'addTopDecls'. + , mAddTopDecls :: [Dec] -> IO () + + -- | See 'addForeignFilePath'. + , mAddForeignFilePath :: ForeignSrcLang -> String -> IO () + + -- | See 'addModFinalizer'. + , mAddModFinalizer :: Q () -> IO () + + -- | See 'addCorePlugin'. + , mAddCorePlugin :: String -> IO () + + -- | See 'getQ'. + , mGetQ :: forall a. Typeable a => IO (Maybe a) + + -- | See 'putQ'. + , mPutQ :: forall a. Typeable a => a -> IO () + + -- | See 'isExtEnabled'. + , mIsExtEnabled :: Extension -> IO Bool + -- | See 'extsEnabled'. + , mExtsEnabled :: IO [Extension] + + -- | See 'putDoc'. + , mPutDoc :: DocLoc -> String -> IO () + -- | See 'getDoc'. + , mGetDoc :: DocLoc -> IO (Maybe String) + } ------------------------------------------------------ --- The IO instance of Quasi ------------------------------------------------------ +badIO :: String -> IO a +badIO op = do { hPutStrLn stderr ("Can't do `" ++ op ++ "' in the IO monad") + ; fail "Template Haskell failure" } --- | This instance is used only when running a Q --- computation in the IO monad, usually just to --- print the result. There is no interesting --- type environment, so reification isn't going to --- work. -instance Quasi IO where - qNewName = newNameIO - - qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) - qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) - - qLookupName _ _ = badIO "lookupName" - qReify _ = badIO "reify" - qReifyFixity _ = badIO "reifyFixity" - qReifyType _ = badIO "reifyFixity" - qReifyInstances _ _ = badIO "reifyInstances" - qReifyRoles _ = badIO "reifyRoles" - qReifyAnnotations _ = badIO "reifyAnnotations" - qReifyModule _ = badIO "reifyModule" - qReifyConStrictness _ = badIO "reifyConStrictness" - qLocation = badIO "currentLocation" - qRecover _ _ = badIO "recover" -- Maybe we could fix this? - qGetPackageRoot = badIO "getProjectRoot" - qAddDependentFile _ = badIO "addDependentFile" - qAddTempFile _ = badIO "addTempFile" - qAddTopDecls _ = badIO "addTopDecls" - qAddForeignFilePath _ _ = badIO "addForeignFilePath" - qAddModFinalizer _ = badIO "addModFinalizer" - qAddCorePlugin _ = badIO "addCorePlugin" - qGetQ = badIO "getQ" - qPutQ _ = badIO "putQ" - qIsExtEnabled _ = badIO "isExtEnabled" - qExtsEnabled = badIO "extsEnabled" - qPutDoc _ _ = badIO "putDoc" - qGetDoc _ = badIO "getDoc" - qAddDependentDirectory _ = badIO "AddDependentDirectory" +metaHandlersIO :: MetaHandlers +metaHandlersIO = MetaHandlers { + mLiftIO = id + , mFail = fail + , mNewName = newNameIO + , mReport = \b msg -> + if b then + hPutStrLn stderr ("Template Haskell error: " ++ msg) + else + hPutStrLn stderr ("Template Haskell error: " ++ msg) -- TODO: should this be different from above? + , mLookupName = \ _ _ -> badIO "lookupName" + , mReify = \_ -> badIO "reify" + , mReifyFixity = \_ -> badIO "reifyFixity" + , mReifyType = \_ -> badIO "reifyFixity" + , mReifyInstances = \_ _ -> badIO "reifyInstances" + , mReifyRoles = \_ -> badIO "reifyRoles" + , mReifyAnnotations = \_ -> badIO "reifyAnnotations" + , mReifyModule = \_ -> badIO "reifyModule" + , mReifyConStrictness = \_ -> badIO "reifyConStrictness" + , mLocation = badIO "currentLocation" + , mRecover = \_ _ -> badIO "recover" -- Maybe we could fix this? + , mGetPackageRoot = badIO "getProjectRoot" + , mAddDependentFile = \_ -> badIO "addDependentFile" + , mAddTempFile = \_ -> badIO "addTempFile" + , mAddTopDecls = \_ -> badIO "addTopDecls" + , mAddForeignFilePath = \_ _ -> badIO "addForeignFilePath" + , mAddModFinalizer = \_ -> badIO "addModFinalizer" + , mAddCorePlugin = \_ -> badIO "addCorePlugin" + , mGetQ = badIO "getQ" + , mPutQ = \_ -> badIO "putQ" + , mIsExtEnabled = \_ -> badIO "isExtEnabled" + , mExtsEnabled = badIO "extsEnabled" + , mPutDoc = \_ _ -> badIO "putDoc" + , mGetDoc = \_ -> badIO "getDoc" + , mAddDependentDirectory = \_ -> badIO "AddDependentDirectory" + } instance Quote IO where newName = newNameIO + + newNameIO :: String -> IO Name newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x)) ; pure (mkNameU s n) } -badIO :: String -> IO a -badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad") - ; fail "Template Haskell failure" } - -- Global variable to generate unique symbols counter :: IORef Uniq {-# NOINLINE counter #-} @@ -210,46 +215,24 @@ counter = unsafePerformIO (newIORef 0) -- ----------------------------------------------------- --- | In short, 'Q' provides the 'Quasi' operations in one neat monad for the --- user. --- --- The longer story, is that 'Q' wraps an arbitrary 'Quasi'-able monad. --- The perceptive reader notices that 'Quasi' has only two instances, 'Q' --- itself and 'IO', neither of which have concrete implementations.'Q' plays --- the trick of [dependency --- inversion](https://en.wikipedia.org/wiki/Dependency_inversion_principle), --- providing an abstract interface for the user which is later concretely --- fufilled by an concrete 'Quasi' instance, internal to GHC. -newtype Q a = Q { unQ :: forall m. Quasi m => m a } - --- | \"Runs\" the 'Q' monad. Normal users of Template Haskell --- should not need this function, as the splice brackets @$( ... )@ --- are the usual way of running a 'Q' computation. --- --- This function is primarily used in GHC internals, and for debugging --- splices by running them in 'IO'. --- --- Note that many functions in 'Q', such as 'reify' and other compiler --- queries, are not supported when running 'Q' in 'IO'; these operations --- simply fail at runtime. Indeed, the only operations guaranteed to succeed --- are 'newName', 'runIO', 'reportError' and 'reportWarning'. -runQ :: Quasi m => Q a -> m a -runQ (Q m) = m +-- | 'Q' is the base 'Monad' for TemplateHaskell splices, +-- similar to how 'IO' is the base 'Monad' for normal Haskell programs. +newtype Q a = Q { unQ :: MetaHandlers -> IO a } instance Monad Q where - Q m >>= k = Q (m >>= \x -> unQ (k x)) + Q m >>= k = Q $ \h -> (m h >>= \x -> unQ (k x) h) (>>) = (*>) instance MonadFail Q where - fail s = report True s >> Q (fail "Q monad failure") + fail s = report True s >> Q (\h -> mFail h "Q monad failure") instance Functor Q where - fmap f (Q x) = Q (fmap f x) + fmap f (Q x) = Q $ \h -> fmap f (x h) instance Applicative Q where - pure x = Q (pure x) - Q f <*> Q x = Q (f <*> x) - Q m *> Q n = Q (m *> n) + pure x = Q $ \_ -> pure x + Q f <*> Q x = Q $ \h -> (f h <*> x h) + Q m *> Q n = Q $ \h -> (m h *> n h) -- | @since 2.17.0.0 instance Semigroup a => Semigroup (Q a) where @@ -319,7 +302,7 @@ class Monad m => Quote m where newName :: String -> m Name instance Quote Q where - newName s = Q (qNewName s) + newName s = Q $ \h -> mNewName h s ----------------------------------------------------- -- @@ -517,35 +500,26 @@ joinCode = flip bindCode id -- | Report an error (True) or warning (False), -- but carry on; use 'fail' to stop. report :: Bool -> String -> Q () -report b s = Q (qReport b s) -{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6 - --- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'. -reportError :: String -> Q () -reportError = report True - --- | Report a warning to the user, and carry on. -reportWarning :: String -> Q () -reportWarning = report False +report b s = Q $ \h -> mReport h b s -- | Recover from errors raised by 'reportError' or 'fail'. recover :: Q a -- ^ handler to invoke on failure -> Q a -- ^ computation to run -> Q a -recover (Q r) (Q m) = Q (qRecover r m) +recover rec main = Q $ \h -> mRecover h rec main -- We don't export lookupName; the Bool isn't a great API -- Instead we export lookupTypeName, lookupValueName lookupName :: Bool -> String -> Q (Maybe Name) -lookupName ns s = Q (qLookupName ns s) +lookupName ns s = Q $ \h -> mLookupName h ns s -- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details. lookupTypeName :: String -> Q (Maybe Name) -lookupTypeName s = Q (qLookupName True s) +lookupTypeName s = Q $ \h -> mLookupName h True s -- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details. lookupValueName :: String -> Q (Maybe Name) -lookupValueName s = Q (qLookupName False s) +lookupValueName s = Q $ \h -> mLookupName h False s {- Note [Name lookup] @@ -620,7 +594,7 @@ To ensure we get information about @D@-the-value, use 'lookupValueName': and to get information about @D@-the-type, use 'lookupTypeName'. -} reify :: Name -> Q Info -reify v = Q (qReify v) +reify v = Q $ \h -> mReify h v {- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then @@ -629,7 +603,7 @@ example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then 'Nothing', so you may assume @bar@ has 'defaultFixity'. -} reifyFixity :: Name -> Q (Maybe Fixity) -reifyFixity nm = Q (qReifyFixity nm) +reifyFixity nm = Q $ \h -> mReifyFixity h nm {- | @reifyType nm@ attempts to find the type or kind of @nm@. For example, @reifyType 'not@ returns @Bool -> Bool@, and @@ -637,7 +611,7 @@ reifyFixity nm = Q (qReifyFixity nm) This works even if there's no explicit signature and the type or kind is inferred. -} reifyType :: Name -> Q Type -reifyType nm = Q (qReifyType nm) +reifyType nm = Q $ \h -> mReifyType h nm {- | Template Haskell is capable of reifying information about types and terms defined in previous declaration groups. Top-level declaration splices break up @@ -729,7 +703,7 @@ has some discussion around this. -} reifyInstances :: Name -> [Type] -> Q [InstanceDec] -reifyInstances cls tys = Q (qReifyInstances cls tys) +reifyInstances cls tys = Q $ \h -> mReifyInstances h cls tys {- | @reifyRoles nm@ returns the list of roles associated with the parameters (both visible and invisible) of @@ -748,20 +722,20 @@ and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' i the role of the invisible @k@ parameter. Kind parameters are always nominal. -} reifyRoles :: Name -> Q [Role] -reifyRoles nm = Q (qReifyRoles nm) +reifyRoles nm = Q $ \h -> mReifyRoles h nm -- | @reifyAnnotations target@ returns the list of annotations -- associated with @target@. Only the annotations that are -- appropriately typed is returned. So if you have @Int@ and @String@ -- annotations for the same target, you have to call this function twice. reifyAnnotations :: Data a => AnnLookup -> Q [a] -reifyAnnotations an = Q (qReifyAnnotations an) +reifyAnnotations an = Q $ \h -> mReifyAnnotations h an -- | @reifyModule mod@ looks up information about module @mod@. To -- look up the current module, call this function with the return -- value of 'Language.Haskell.TH.Lib.thisModule'. reifyModule :: Module -> Q ModuleInfo -reifyModule m = Q (qReifyModule m) +reifyModule m = Q $ \h -> mReifyModule h m -- | @reifyConStrictness nm@ looks up the strictness information for the fields -- of the constructor with the name @nm@. Note that the strictness information @@ -776,7 +750,7 @@ reifyModule m = Q (qReifyModule m) -- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the -- @-XStrictData@ language extension was enabled. reifyConStrictness :: Name -> Q [DecidedStrictness] -reifyConStrictness n = Q (qReifyConStrictness n) +reifyConStrictness n = Q $ \h -> mReifyConStrictness h n -- | Is the list of instances returned by 'reifyInstances' nonempty? -- @@ -789,7 +763,7 @@ isInstance nm tys = do { decs <- reifyInstances nm tys -- | The location at which this computation is spliced. location :: Q Loc -location = Q qLocation +location = Q mLocation -- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad. -- Take care: you are guaranteed the ordering of calls to 'runIO' within @@ -799,7 +773,7 @@ location = Q qLocation -- necessarily flushed when the compiler finishes running, so you should -- flush them yourself. runIO :: IO a -> Q a -runIO m = Q (qRunIO m) +runIO m = Q $ \h -> mLiftIO h m -- | Get the package root for the current package which is being compiled. -- This can be set explicitly with the -package-root flag but is normally @@ -811,7 +785,7 @@ runIO m = Q (qRunIO m) -- change directory when compiling files but instead set the -package-root flag -- appropriately. getPackageRoot :: Q FilePath -getPackageRoot = Q qGetPackageRoot +getPackageRoot = Q mGetPackageRoot -- | Record external directories that runIO is using (dependent upon). -- The compiler can then recognize that it should re-compile the Haskell file @@ -830,7 +804,7 @@ getPackageRoot = Q qGetPackageRoot -- * The state of the directory is read at the interface generation time, -- not at the time of the function call. addDependentDirectory :: FilePath -> Q () -addDependentDirectory dp = Q (qAddDependentDirectory dp) +addDependentDirectory dp = Q $ \h -> mAddDependentDirectory h dp -- | Record external files that runIO is using (dependent upon). -- The compiler can then recognize that it should re-compile the Haskell file @@ -844,17 +818,17 @@ addDependentDirectory dp = Q (qAddDependentDirectory dp) -- -- * The dependency is based on file content, not a modification time addDependentFile :: FilePath -> Q () -addDependentFile fp = Q (qAddDependentFile fp) +addDependentFile fp = Q $ \h -> mAddDependentFile h fp -- | Obtain a temporary file path with the given suffix. The compiler will -- delete this file after compilation. addTempFile :: String -> Q FilePath -addTempFile suffix = Q (qAddTempFile suffix) +addTempFile suffix = Q $ \h -> mAddTempFile h suffix -- | Add additional top-level declarations. The added declarations will be type -- checked along with the current declaration group. addTopDecls :: [Dec] -> Q () -addTopDecls ds = Q (qAddTopDecls ds) +addTopDecls ds = Q $ \h -> mAddTopDecls h ds -- | Same as 'addForeignSource', but expects to receive a path pointing to the -- foreign file instead of a 'String' of its contents. Consider using this in @@ -863,7 +837,7 @@ addTopDecls ds = Q (qAddTopDecls ds) -- This is a good alternative to 'addForeignSource' when you are trying to -- directly link in an object file. addForeignFilePath :: ForeignSrcLang -> FilePath -> Q () -addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp) +addForeignFilePath lang fp = Q $ \h -> mAddForeignFilePath h lang fp -- | Add a finalizer that will run in the Q monad after the current module has -- been type checked. This only makes sense when run within a top-level splice. @@ -872,7 +846,7 @@ addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp) -- 'reify' is able to find the local definitions when executed inside the -- finalizer. addModFinalizer :: Q () -> Q () -addModFinalizer act = Q (qAddModFinalizer (unQ act)) +addModFinalizer act = Q $ \h -> mAddModFinalizer h act -- | Adds a core plugin to the compilation pipeline. -- @@ -882,7 +856,7 @@ addModFinalizer act = Q (qAddModFinalizer (unQ act)) -- to tell the compiler that we needed to compile first a plugin module in the -- current package. addCorePlugin :: String -> Q () -addCorePlugin plugin = Q (qAddCorePlugin plugin) +addCorePlugin plugin = Q $ \h -> mAddCorePlugin h plugin -- | Get state from the 'Q' monad. The state maintained by 'Q' is isomorphic to -- a type-indexed finite map. That is, @@ -896,20 +870,20 @@ addCorePlugin plugin = Q (qAddCorePlugin plugin) -- Note that the state is local to the Haskell module in which the Template -- Haskell expression is executed. getQ :: Typeable a => Q (Maybe a) -getQ = Q qGetQ +getQ = Q mGetQ -- | Replace the state in the 'Q' monad. Note that the state is local to the -- Haskell module in which the Template Haskell expression is executed. putQ :: Typeable a => a -> Q () -putQ x = Q (qPutQ x) +putQ x = Q $ \h -> mPutQ h x -- | Determine whether the given language extension is enabled in the 'Q' monad. isExtEnabled :: Extension -> Q Bool -isExtEnabled ext = Q (qIsExtEnabled ext) +isExtEnabled ext = Q $ \h -> mIsExtEnabled h ext -- | List all enabled language extensions. extsEnabled :: Q [Extension] -extsEnabled = Q qExtsEnabled +extsEnabled = Q mExtsEnabled -- | Add Haddock documentation to the specified location. This will overwrite -- any documentation at the location if it already exists. This will reify the @@ -928,48 +902,18 @@ extsEnabled = Q qExtsEnabled -- Adding documentation to anything outside of the current module will cause an -- error. putDoc :: DocLoc -> String -> Q () -putDoc t s = Q (qPutDoc t s) +putDoc t s = Q $ \h -> mPutDoc h t s -- | Retrieves the Haddock documentation at the specified location, if one -- exists. -- It can be used to read documentation on things defined outside of the current -- module, provided that those modules were compiled with the @-haddock@ flag. getDoc :: DocLoc -> Q (Maybe String) -getDoc n = Q (qGetDoc n) +getDoc n = Q $ \h -> mGetDoc h n instance MonadIO Q where liftIO = runIO -instance Quasi Q where - qNewName = newName - qReport = report - qRecover = recover - qReify = reify - qReifyFixity = reifyFixity - qReifyType = reifyType - qReifyInstances = reifyInstances - qReifyRoles = reifyRoles - qReifyAnnotations = reifyAnnotations - qReifyModule = reifyModule - qReifyConStrictness = reifyConStrictness - qLookupName = lookupName - qLocation = location - qGetPackageRoot = getPackageRoot - qAddDependentFile = addDependentFile - qAddDependentDirectory = addDependentDirectory - qAddTempFile = addTempFile - qAddTopDecls = addTopDecls - qAddForeignFilePath = addForeignFilePath - qAddModFinalizer = addModFinalizer - qAddCorePlugin = addCorePlugin - qGetQ = getQ - qPutQ = putQ - qIsExtEnabled = isExtEnabled - qExtsEnabled = extsEnabled - qPutDoc = putDoc - qGetDoc = getDoc - - ---------------------------------------------------- -- The following operations are used solely in GHC.HsToCore.Quote when -- desugaring brackets. They are not necessary for the user, who can use ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, DeriveGeneric, - TupleSections, RecordWildCards, InstanceSigs, CPP #-} + TupleSections, RecordWildCards, InstanceSigs, CPP, RankNTypes #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | @@ -164,58 +164,70 @@ ghcCmd m = GHCiQ $ \sRef -> do instance MonadIO GHCiQ where liftIO m = GHCiQ $ \_ -> m -instance TH.Quasi GHCiQ where - qNewName str = ghcCmd (NewName str) - qReport isError msg = ghcCmd (Report isError msg) - - -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice - qRecover (GHCiQ h) a = GHCiQ $ \sRef -> mask $ \unmask -> do - s <- readIORef sRef - remoteTHCall (qsPipe s) StartRecover - e <- try $ unmask $ runGHCiQ (a <* ghcCmd FailIfErrs) sRef - remoteTHCall (qsPipe s) (EndRecover (isLeft e)) - case e of - Left GHCiQException{} -> h sRef - Right r -> return r - qLookupName isType occ = ghcCmd (LookupName isType occ) - qReify name = ghcCmd (Reify name) - qReifyFixity name = ghcCmd (ReifyFixity name) - qReifyType name = ghcCmd (ReifyType name) - qReifyInstances name tys = ghcCmd (ReifyInstances name tys) - qReifyRoles name = ghcCmd (ReifyRoles name) - -- To reify annotations, we send GHC the AnnLookup and also the -- TypeRep of the thing we're looking for, to avoid needing to -- serialize irrelevant annotations. - qReifyAnnotations :: forall a . Data a => TH.AnnLookup -> GHCiQ [a] - qReifyAnnotations lookup = +reifyAnnotations :: forall a . Data a => TH.AnnLookup -> GHCiQ [a] +reifyAnnotations lookup = map (deserializeWithData . B.unpack) <$> ghcCmd (ReifyAnnotations lookup typerep) where typerep = typeOf (undefined :: a) - qReifyModule m = ghcCmd (ReifyModule m) - qReifyConStrictness name = ghcCmd (ReifyConStrictness name) - qLocation = fromMaybe noLoc . qsLocation <$> getState - qGetPackageRoot = ghcCmd GetPackageRoot - qAddDependentFile file = ghcCmd (AddDependentFile file) - qAddDependentDirectory dir = ghcCmd (AddDependentDirectory dir) - qAddTempFile suffix = ghcCmd (AddTempFile suffix) - qAddTopDecls decls = ghcCmd (AddTopDecls decls) - qAddForeignFilePath lang fp = ghcCmd (AddForeignFilePath lang fp) - qAddModFinalizer fin = GHCiQ (\_ -> mkRemoteRef fin) >>= +runQinGHCiQ :: TH.Q a -> GHCiQ a +runQinGHCiQ (TH.Q m) = GHCiQ $ \sRef -> m (metaHandlersGHCiQ (runInIO sRef)) + where + runInIO :: IORef QState -> GHCiQ a -> IO a + runInIO sRef (GHCiQ m) = m sRef + +metaHandlersGHCiQ :: (forall x. GHCiQ x -> IO x) -> TH.MetaHandlers +metaHandlersGHCiQ runInIO = TH.MetaHandlers { + mLiftIO = id + , mFail = runInIO . fail + , mNewName = \str -> runInIO $ ghcCmd (NewName str) + , mReport = \isError msg -> runInIO $ ghcCmd (Report isError msg) + + -- See Note [TH recover with -fexternal-interpreter] in GHC.Tc.Gen.Splice + , mRecover = \h a -> runInIO $ GHCiQ $ \sRef -> mask $ \unmask -> do + s <- readIORef sRef + remoteTHCall (qsPipe s) StartRecover + e <- try $ unmask $ runGHCiQ (runQinGHCiQ a <* ghcCmd FailIfErrs) sRef + remoteTHCall (qsPipe s) (EndRecover (isLeft e)) + case e of + Left GHCiQException{} -> + runGHCiQ (runQinGHCiQ h) sRef + Right r -> return r + , mLookupName = \isType occ -> runInIO $ ghcCmd (LookupName isType occ) + , mReify = \name ->runInIO $ ghcCmd (Reify name) + , mReifyFixity = \name ->runInIO $ ghcCmd (ReifyFixity name) + , mReifyType = \name -> runInIO $ ghcCmd (ReifyType name) + , mReifyInstances = \name tys -> runInIO $ ghcCmd (ReifyInstances name tys) + , mReifyRoles = \name -> runInIO $ ghcCmd (ReifyRoles name) + + , mReifyAnnotations = runInIO . reifyAnnotations + , mReifyModule = \m -> runInIO $ ghcCmd (ReifyModule m) + , mReifyConStrictness = \name -> runInIO $ ghcCmd (ReifyConStrictness name) + , mLocation = runInIO $ fromMaybe noLoc . qsLocation <$> getState + , mGetPackageRoot = runInIO $ ghcCmd GetPackageRoot + , mAddDependentFile = \file -> runInIO $ ghcCmd (AddDependentFile file) + , mAddDependentDirectory = \dir -> runInIO $ ghcCmd (AddDependentDirectory dir) + , mAddTempFile = \suffix -> runInIO $ ghcCmd (AddTempFile suffix) + , mAddTopDecls = \decls -> runInIO $ ghcCmd (AddTopDecls decls) + , mAddForeignFilePath = \lang fp -> runInIO $ ghcCmd (AddForeignFilePath lang fp) + , mAddModFinalizer = \fin -> runInIO $ GHCiQ (\_ -> mkRemoteRef fin) >>= ghcCmd . AddModFinalizer - qAddCorePlugin str = ghcCmd (AddCorePlugin str) - qGetQ = do + , mAddCorePlugin = \str -> runInIO $ ghcCmd (AddCorePlugin str) + , mGetQ = runInIO $ do s <- getState let lookup :: forall a. Typeable a => Map TypeRep Dynamic -> Maybe a lookup m = fromDynamic =<< M.lookup (typeOf (undefined::a)) m return $ lookup (qsMap s) - qPutQ k = GHCiQ $ \sRef -> - modifyIORef' sRef (\s -> s { qsMap = M.insert (typeOf k) (toDyn k) (qsMap s) }) - qIsExtEnabled x = ghcCmd (IsExtEnabled x) - qExtsEnabled = ghcCmd ExtsEnabled - qPutDoc l s = ghcCmd (PutDoc l s) - qGetDoc l = ghcCmd (GetDoc l) + , mPutQ = \k -> runInIO $ GHCiQ $ \sRef -> + modifyIORef' sRef (\s -> s { qsMap = M.insert (typeOf k) (toDyn k) (qsMap s) }) + , mIsExtEnabled = \x -> runInIO $ ghcCmd (IsExtEnabled x) + , mExtsEnabled = runInIO $ ghcCmd ExtsEnabled + , mPutDoc = \l s -> runInIO $ ghcCmd (PutDoc l s) + , mGetDoc = \l -> runInIO $ ghcCmd (GetDoc l) +} -- | The implementation of the 'StartTH' message: create -- a new IORef QState, and return a RemoteRef to it. @@ -235,7 +247,7 @@ runModFinalizerRefs pipe rstate qrefs = do qstateref <- localRef rstate qstate <- readIORef qstateref qstate' <- newIORef $ qstate { qsPipe = pipe } - _ <- runGHCiQ (TH.runQ $ sequence_ qs) qstate' + _ <- runGHCiQ (runQinGHCiQ $ sequence_ qs) qstate' return () -- | The implementation of the 'RunTH' message @@ -272,5 +284,5 @@ runTHQ runTHQ pipe rstate mb_loc ghciq = do qstateref <- localRef rstate modifyIORef' qstateref (\qstate -> qstate { qsLocation = mb_loc, qsPipe = pipe }) - r <- runGHCiQ (TH.runQ ghciq) qstateref + r <- runGHCiQ (runQinGHCiQ ghciq) qstateref return $! LB.toStrict (runPut (put r)) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -5,13 +5,17 @@ {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE UnboxedTuples #-} +-- Don't warn for using 'report' from ghc-internal +{-# OPTIONS_GHC -Wno-warnings-deprecations #-} module Language.Haskell.TH.Syntax ( Quote (..), Exp (..), Match (..), Clause (..), - Q (..), + Q, + -- backwards compatibility + Language.Haskell.TH.Syntax.unQ, Pat (..), Stmt (..), Con (..), @@ -202,11 +206,14 @@ where import GHC.Boot.TH.Lift import GHC.Boot.TH.Syntax -import GHC.Boot.TH.Monad +import GHC.Boot.TH.Monad hiding (report) +import qualified GHC.Boot.TH.Monad as Internal import System.FilePath import Data.Data hiding (Fixity(..)) import Data.List.NonEmpty (NonEmpty(..)) import GHC.Lexeme ( startsVarSym, startsVarId ) +import Control.Monad.IO.Class (MonadIO, liftIO) +import System.IO (hPutStrLn, stderr) -- This module completely re-exports 'GHC.Boot.TH.Syntax', -- and exports additionally functions that depend on @filepath@ or @System.IO@. @@ -499,3 +506,172 @@ reassociate the tree as necessary. -- Subsumed by the more general 'SpecialiseEP' constructor. pattern SpecialiseP :: Name -> Type -> (Maybe Inline) -> Phases -> Pragma pattern SpecialiseP nm ty inl phases = SpecialiseEP Nothing [] (SigE (VarE nm) ty) inl phases + +unQ :: Q a -> (forall m. Quasi m => m a) +unQ m = runQ m + +----------------------------------------------------- +-- +-- The Quasi class +-- +----------------------------------------------------- + +-- | The 'Quasi' typeclass used to provide an exhaustive list of the effects exposed by the 'Q' monad. +-- This invariant no longer holds, and it is encouraged to use 'Q' or 'Quote' instead. +class (MonadIO m, MonadFail m) => Quasi m where + qRunQ :: Q a -> m a + -- | Fresh names. See 'newName'. + qNewName :: String -> m Name + qNewName = qRunQ . newName + + ------- Error reporting and recovery ------- + -- | Report an error (True) or warning (False) + -- ...but carry on; use 'fail' to stop. See 'report'. + qReport :: Bool -> String -> m () + qReport b s = qRunQ $ report b s + + -- | See 'recover'. + qRecover :: m a -- ^ the error handler + -> m a -- ^ action which may fail + -> m a -- ^ Recover from the monadic 'fail' + + ------- Inspect the type-checker's environment ------- + -- | True <=> type namespace, False <=> value namespace. See 'lookupName'. + qLookupName :: Bool -> String -> m (Maybe Name) + qLookupName ns s = qRunQ $ lookupName ns s + -- | See 'reify'. + qReify :: Name -> m Info + qReify v = qRunQ $ reify v + -- | See 'reifyFixity'. + qReifyFixity :: Name -> m (Maybe Fixity) + qReifyFixity v = qRunQ $ reifyFixity v + -- | See 'reifyType'. + qReifyType :: Name -> m Type + qReifyType v = qRunQ $ reifyType v + -- | Is (n tys) an instance? Returns list of matching instance Decs (with + -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'. + qReifyInstances :: Name -> [Type] -> m [Dec] + qReifyInstances cls tys = qRunQ $ reifyInstances cls tys + -- | See 'reifyRoles'. + qReifyRoles :: Name -> m [Role] + qReifyRoles nm = qRunQ $ reifyRoles nm + -- | See 'reifyAnnotations'. + qReifyAnnotations :: Data a => AnnLookup -> m [a] + qReifyAnnotations an = qRunQ $ reifyAnnotations an + -- | See 'reifyModule'. + qReifyModule :: Module -> m ModuleInfo + qReifyModule m = qRunQ $ reifyModule m + -- | See 'reifyConStrictness'. + qReifyConStrictness :: Name -> m [DecidedStrictness] + qReifyConStrictness nm = qRunQ $ reifyConStrictness nm + + -- | See 'location'. + qLocation :: m Loc + qLocation = qRunQ location + + -- | Input/output (dangerous). See 'runIO'. + qRunIO :: IO a -> m a + qRunIO = liftIO + -- | See 'getPackageRoot'. + qGetPackageRoot :: m FilePath + qGetPackageRoot = qRunQ getPackageRoot + + -- | See 'addDependentFile'. + qAddDependentFile :: FilePath -> m () + qAddDependentFile p = qRunQ $ addDependentFile p + + -- | See 'addDependentDirectory'. + qAddDependentDirectory :: FilePath -> m () + qAddDependentDirectory p = qRunQ $ addDependentDirectory p + + -- | See 'addTempFile'. + qAddTempFile :: String -> m FilePath + qAddTempFile p = qRunQ $ addTempFile p + + -- | See 'addTopDecls'. + qAddTopDecls :: [Dec] -> m () + qAddTopDecls decls = qRunQ $ addTopDecls decls + + -- | See 'addForeignFilePath'. + qAddForeignFilePath :: ForeignSrcLang -> String -> m () + qAddForeignFilePath lang fp = qRunQ $ addForeignFilePath lang fp + + -- | See 'addModFinalizer'. + qAddModFinalizer :: Q () -> m () + qAddModFinalizer fin = qRunQ $ addModFinalizer fin + + -- | See 'addCorePlugin'. + qAddCorePlugin :: String -> m () + qAddCorePlugin nm = qRunQ $ addCorePlugin nm + + -- | See 'getQ'. + qGetQ :: Typeable a => m (Maybe a) + qGetQ = qRunQ getQ + + -- | See 'putQ'. + qPutQ :: Typeable a => a -> m () + qPutQ x = qRunQ $ putQ x + + -- | See 'isExtEnabled'. + qIsExtEnabled :: Extension -> m Bool + qIsExtEnabled ext = qRunQ $ isExtEnabled ext + -- | See 'extsEnabled'. + qExtsEnabled :: m [Extension] + qExtsEnabled = qRunQ extsEnabled + + -- | See 'putDoc'. + qPutDoc :: DocLoc -> String -> m () + qPutDoc l s = qRunQ $ putDoc l s + -- | See 'getDoc'. + qGetDoc :: DocLoc -> m (Maybe String) + qGetDoc l = qRunQ $ getDoc l + +-- | \"Runs\" the 'Q' monad. Normal users of Template Haskell +-- should not need this function, as the splice brackets @$( ... )@ +-- are the usual way of running a 'Q' computation. +-- +-- This function is primarily used in GHC internals, and for debugging +-- splices by running them in 'IO'. +-- +-- Note that many functions in 'Q', such as 'reify' and other compiler +-- queries, are not supported when running 'Q' in 'IO'; these operations +-- simply fail at runtime. Indeed, the only operations guaranteed to succeed +-- are 'newName', 'runIO', 'reportError' and 'reportWarning'. +runQ :: Quasi m => Q a -> m a +runQ = qRunQ + +----------------------------------------------------- +-- The IO instance of Quasi +----------------------------------------------------- + +-- | This instance is used only when running a Q +-- computation in the IO monad, usually just to +-- print the result. There is no interesting +-- type environment, so reification isn't going to +-- work. Please use 'Quote' instead, which is much safer. +instance Quasi IO where + qRunQ (Q m) = m metaHandlersIO + qNewName = newNameIO + + qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) + qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) + qRecover _ _ = badIO "recover" -- Maybe we could fix this? + +instance Quasi Q where + qRunQ = id + qRecover = recover + + +-- | Report an error (True) or warning (False), +-- but carry on; use 'fail' to stop. +report :: Bool -> String -> Q () +report = Internal.report +{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6 + +-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'. +reportError :: String -> Q () +reportError = report True + +-- | Report a warning to the user, and carry on. +reportWarning :: String -> Q () +reportWarning = report False ===================================== testsuite/tests/interface-stability/template-haskell-exports.stdout ===================================== @@ -354,7 +354,6 @@ module Language.Haskell.TH where type Pred = Type type PredQ :: * type PredQ = Q Pred - type role Q nominal type Q :: * -> * newtype Q a = ... type Quote :: (* -> *) -> Constraint @@ -655,7 +654,7 @@ module Language.Haskell.TH where roleAnnotD :: forall (m :: * -> *). Quote m => Name -> [GHC.Internal.TH.Lib.Role] -> m Dec ruleVar :: forall (m :: * -> *). Quote m => Name -> m RuleBndr runIO :: forall a. GHC.Internal.Types.IO a -> Q a - runQ :: forall (m :: * -> *) a. GHC.Internal.TH.Monad.Quasi m => Q a -> m a + runQ :: forall (m :: * -> *) a. Language.Haskell.TH.Syntax.Quasi m => Q a -> m a safe :: Safety sectionL :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp sectionR :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp @@ -1703,11 +1702,11 @@ module Language.Haskell.TH.Syntax where data Pragma = InlineP Name Inline RuleMatch Phases | OpaqueP Name | SpecialiseEP (GHC.Internal.Maybe.Maybe [TyVarBndr ()]) [RuleBndr] Exp (GHC.Internal.Maybe.Maybe Inline) Phases | SpecialiseInstP Type | RuleP GHC.Internal.Base.String (GHC.Internal.Maybe.Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases | AnnP AnnTarget Exp | LineP GHC.Internal.Types.Int GHC.Internal.Base.String | CompleteP [Name] (GHC.Internal.Maybe.Maybe Name) | SCCP Name (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String) type Pred :: * type Pred = Type - type role Q nominal type Q :: * -> * - newtype Q a = Q {unQ :: forall (m :: * -> *). Quasi m => m a} + newtype Q a = ... type Quasi :: (* -> *) -> Constraint class (GHC.Internal.Control.Monad.IO.Class.MonadIO m, GHC.Internal.Control.Monad.Fail.MonadFail m) => Quasi m where + qRunQ :: forall a. Q a -> m a qNewName :: GHC.Internal.Base.String -> m Name qReport :: GHC.Internal.Types.Bool -> GHC.Internal.Base.String -> m () qRecover :: forall a. m a -> m a -> m a @@ -1730,13 +1729,13 @@ module Language.Haskell.TH.Syntax where qAddForeignFilePath :: ForeignSrcLang -> GHC.Internal.Base.String -> m () qAddModFinalizer :: Q () -> m () qAddCorePlugin :: GHC.Internal.Base.String -> m () - qGetQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => m (GHC.Internal.Maybe.Maybe a) - qPutQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> m () + qGetQ :: forall a. ghc-internal-10.100.0:GHC.Internal.Data.Typeable.Internal.Typeable a => m (GHC.Internal.Maybe.Maybe a) + qPutQ :: forall a. ghc-internal-10.100.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> m () qIsExtEnabled :: Extension -> m GHC.Internal.Types.Bool qExtsEnabled :: m [Extension] qPutDoc :: DocLoc -> GHC.Internal.Base.String -> m () qGetDoc :: DocLoc -> m (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String) - {-# MINIMAL qNewName, qReport, qRecover, qLookupName, qReify, qReifyFixity, qReifyType, qReifyInstances, qReifyRoles, qReifyAnnotations, qReifyModule, qReifyConStrictness, qLocation, qGetPackageRoot, qAddDependentFile, qAddDependentDirectory, qAddTempFile, qAddTopDecls, qAddForeignFilePath, qAddModFinalizer, qAddCorePlugin, qGetQ, qPutQ, qIsExtEnabled, qExtsEnabled, qPutDoc, qGetDoc #-} + {-# MINIMAL qRunQ, qRecover #-} type Quote :: (* -> *) -> Constraint class GHC.Internal.Base.Monad m => Quote m where newName :: GHC.Internal.Base.String -> m Name @@ -1814,7 +1813,7 @@ module Language.Haskell.TH.Syntax where falseName :: Name getDoc :: DocLoc -> Q (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String) getPackageRoot :: Q GHC.Internal.IO.FilePath - getQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => Q (GHC.Internal.Maybe.Maybe a) + getQ :: forall a. ghc-internal-10.100.0:GHC.Internal.Data.Typeable.Internal.Typeable a => Q (GHC.Internal.Maybe.Maybe a) get_cons_names :: Con -> [Name] hoistCode :: forall (m :: * -> *) (n :: * -> *) (r :: GHC.Internal.Types.RuntimeRep) (a :: TYPE r). GHC.Internal.Base.Monad m => (forall x. m x -> n x) -> Code m a -> Code n a isExtEnabled :: Extension -> Q GHC.Internal.Types.Bool @@ -1861,7 +1860,7 @@ module Language.Haskell.TH.Syntax where oneName :: Name pkgString :: PkgName -> GHC.Internal.Base.String putDoc :: DocLoc -> GHC.Internal.Base.String -> Q () - putQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> Q () + putQ :: forall a. ghc-internal-10.100.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> Q () recover :: forall a. Q a -> Q a -> Q a reify :: Name -> Q Info reifyAnnotations :: forall a. GHC.Internal.Data.Data.Data a => AnnLookup -> Q [a] @@ -1884,6 +1883,7 @@ module Language.Haskell.TH.Syntax where trueName :: Name tupleDataName :: GHC.Internal.Types.Int -> Name tupleTypeName :: GHC.Internal.Types.Int -> Name + unQ :: forall a. Q a -> forall (m :: * -> *). Quasi m => m a unTypeCode :: forall (r :: GHC.Internal.Types.RuntimeRep) (a :: TYPE r) (m :: * -> *). Quote m => Code m a -> m Exp unTypeQ :: forall (r :: GHC.Internal.Types.RuntimeRep) (a :: TYPE r) (m :: * -> *). Quote m => m (TExp a) -> m Exp unboxedSumDataName :: SumAlt -> SumArity -> Name @@ -2289,10 +2289,10 @@ instance forall a b c d e f g. (GHC.Internal.TH.Lift.Lift a, GHC.Internal.TH.Lif instance GHC.Internal.TH.Lift.Lift (# #) -- Defined in ‘GHC.Internal.TH.Lift’ instance GHC.Internal.TH.Lift.Lift GHC.Internal.Prim.Char# -- Defined in ‘GHC.Internal.TH.Lift’ instance GHC.Internal.TH.Lift.Lift GHC.Internal.Prim.Word# -- Defined in ‘GHC.Internal.TH.Lift’ -instance GHC.Internal.TH.Monad.Quasi GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.TH.Monad’ -instance GHC.Internal.TH.Monad.Quasi GHC.Internal.TH.Monad.Q -- Defined in ‘GHC.Internal.TH.Monad’ instance GHC.Internal.TH.Monad.Quote GHC.Internal.Types.IO -- Defined in ‘GHC.Internal.TH.Monad’ instance GHC.Internal.TH.Monad.Quote GHC.Internal.TH.Monad.Q -- Defined in ‘GHC.Internal.TH.Monad’ instance [safe] Language.Haskell.TH.Lib.DefaultBndrFlag GHC.Internal.TH.Syntax.BndrVis -- Defined in ‘Language.Haskell.TH.Lib’ instance [safe] Language.Haskell.TH.Lib.DefaultBndrFlag GHC.Internal.TH.Syntax.Specificity -- Defined in ‘Language.Haskell.TH.Lib’ instance [safe] Language.Haskell.TH.Lib.DefaultBndrFlag () -- Defined in ‘Language.Haskell.TH.Lib’ +instance Language.Haskell.TH.Syntax.Quasi GHC.Internal.Types.IO -- Defined in ‘Language.Haskell.TH.Syntax’ +instance Language.Haskell.TH.Syntax.Quasi GHC.Internal.TH.Monad.Q -- Defined in ‘Language.Haskell.TH.Syntax’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bf9e3c51c668f2d5fd6951f57356e8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bf9e3c51c668f2d5fd6951f57356e8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: Decoupling 'L.H.S' from 'GHC.Types.SourceText'
by Marge Bot (＠marge-bot) 01 Jul '26

01 Jul '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d7cfea49 by Recursion Ninja at 2026-06-30T21:37:12-04:00 Decoupling 'L.H.S' from 'GHC.Types.SourceText' * Migrated 'IntegralLit' to 'L.H.S.Lit'. * Migrated 'FractionalLit' to 'L.H.S.Lit'. * Migrated 'StringLiteral' to 'L.H.S.Lit'. * Added TTG extension points to the types above. * Added nice export list to 'GHC.Hs.Lit'. * Added 'rnOverLitVal' and 'tcOverLitVal' functions to 'GHC.Hs.Lit'. * Added instance 'Anno (StringLiteral (GhcPass p)) = SrcSpanAnnN' * Moved [Notes] about 'SourceText' from 'L.H.S.*' to 'GHC.*'. * Removed all references to 'SourceText' from 'L.H.S'. * Removed the trailing comma record field from 'StringLiteral' * Renamed exported functions for nomenclature consistency. * Deprecated the renamed functions Fixes #26953 - - - - - a1f2558b by Recursion Ninja at 2026-06-30T21:37:12-04:00 Monomorphising GHC pass parameters where appropriate - - - - - 53 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Warnings.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/PkgQual.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Binds/InlinePragma.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - testsuite/tests/ghc-api/annotations-literals/literals.stdout - testsuite/tests/ghc-api/annotations-literals/parsed.hs - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.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/bf7b5ce65f470f21eee29007f3d6a1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf7b5ce65f470f21eee29007f3d6a1… You're receiving this email because of your account on gitlab.haskell.org.

1 0