- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new branch wip/andrea/with-signal-handlers
by Andrea Vezzosi (＠trac-Saizan) 07 Oct '26

07 Oct '26

Andrea Vezzosi pushed new branch wip/andrea/with-signal-handlers at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andrea/with-signal-handlers You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/T27828] 26 commits: Improve the `mhu-closure` makefile
by Simon Peyton Jones (＠simonpj) 07 Oct '26

07 Oct '26

Simon Peyton Jones pushed to branch wip/T27828 at Glasgow Haskell Compiler / GHC Commits: 1abef1ef by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Improve the `mhu-closure` makefile - - - - - a79a68ea by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Make `ghci-multi` hide all unneeded packages - - - - - d6e72450 by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Improve the definition of the home unit closure property - - - - - c9a2766d by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Re-implement the home unit closure check Compared to the previous implementation, the new one has the following advantages: * It is correct. - It distinguishes between units that have the same unit ID but different ABI hashes. - When `-hide-all-packages` is not used, it considers as home unit dependencies also units that are made implicitly available because they are in the package database. * It seems to be faster in usual settings. - In particular, it does not have a preparation phase in which it merges the dependency information from all home units, so that its running time does not grow linearly with the size of the package database in normal Cabal scenarios. * It is (hopefully) clearer. * It is better documented. - - - - - fa96acf8 by Wolfgang Jeltsch at 2026-09-25T17:02:07-04:00 Remove erroneous GHC flag in `hadrian-multi` The flag was `-Werror=-Wno-error=incomplete-record-selectors`. Its purpose was to permit incomplete record selectors, but because of the illegal combination of `-Werror=` and `-Wno-error` it was ignored, without any negative consequences. - - - - - 9f48a5b9 by Alan Zimmerman at 2026-09-25T17:02:50-04:00 EPA: Add specific layout field to AnnList Up to now AnnList has effectively served to represent lists of things having layout, regardless of whether they do or not. In Haskell, layout is optional in many places, as there is also an alternative syntax using braces and semi-colons, which is free-form. This commit introduces AnnListLayout, a data structure capturing this distinction. It is deliberately set up similarly to EpLayout, so that these two can be merged in time. The transition is done mechanically, where AnnListBraces is not used yet, the original Nothing case maps to AnnListNoLayout, and the Just case to AnnListLayout. Later commits will fine tune these against the actual parser layout. - - - - - 234bab08 by Vladislav Zavialov at 2026-09-29T17:22:54-04:00 Add regression test for #7803 Commit 2effe18ab5, first shipped with GHC 8.2.1, fixed #7803 "Superclass methods are left unspecialized". This change turns the example from the ticket description into a regression test, checking that foo1 is fully specialised at Double, with no calls to the overloaded exp5Tail. Closes #7803 Assisted-by: Claude Opus 5 - - - - - c406135c by Andreas Klebinger at 2026-10-01T06:57:28-04:00 RTS: Update flag parsing/handling: Using 0 as argument to any of these flags now resets the flags setting to default: - ``-n0`` disables nursery chunking. - ``-K0`` (or a bare ``-K``) removes the stack size limit. - ``-M0`` removes the heap size limit. - ``-H0`` resets the suggested heap size, including the nursery scaling set by ``-H``. - ``-AL0`` makes the large object allocation limit follow ``-A`` again. GC Generations are now limited to 64. -n larger than -A now emits a warning and disables chunking. Fixes #27830 #27829 - - - - - 984ee82b by Andreas Klebinger at 2026-10-01T06:58:10-04:00 Fix MultiLayerModules timeout multiplier. We accidentally used the compile multiplier for ghci commands which use the run timeout setting to set the timeout. Fixes #26263 and #27796. - - - - - 50a9cf26 by Andreas Klebinger at 2026-10-01T06:58:10-04:00 testsuite: Include runtime in JUnit report. - - - - - e358619f by Alan Zimmerman at 2026-10-01T06:59:01-04:00 EPA: Use EpaLocation in EpVirtualBraces Haddock processing uses EpLayout.EpVirtualBraces to record the current layout column, for allocating haddock comments correctly. For exact printing, we need the line as well as the col, so we know how many lines to skip when the indented code block starts. This commit updates EpLayout.EpVirtualBraces so that it carries an EpaLocation instead of just the Int column, to allow it to be used for both purposes. It is a simple mechanical change, with no other impact, but it allows us to use EpLayout instead of AnnListLayout in AnnList, in the next commit in this series. - - - - - 1d2a26ee by Andrew Lelechenko at 2026-10-01T20:22:04-04:00 Remove bitSize from MINIMAL pragma of class Bits Cf. https://github.com/haskell/core-libraries-committee/issues/441 The function is deprecated for 12 years and has a default implementation, yet it was never removed from the MINIMAL pragma, putting library authors in a very awkward position. Let's finally remove bitSize from MINIMAL. - - - - - 3cc21e4c by Hannes Siebenhandl at 2026-10-01T20:22:59-04:00 Add regression test for #27641 - - - - - c35096f5 by Hannes Siebenhandl at 2026-10-01T20:23:00-04:00 Don't `:add` modules the loader will reject Only home modules can be actually added to the loader context, thus we only accept the module if it belongs to a home unit. - - - - - a563cb27 by Simon Jakobi at 2026-10-02T17:37:36-04:00 ci: accept modified changelog.d entries in lint-changelog The changelog guide says to extend an existing entry rather than add a new one when the feature is already documented. lint_changelog only counted added files, so such MRs failed before the validator ran. Fixes #27779. Assisted-by: Claude Fable 5.1 - - - - - 03082cd4 by Simon Jakobi at 2026-10-02T17:38:17-04:00 changelog.d: Fix warning flag name in the semaphore-v2 entry The entry refers to -Wsemaphore-version-mismatch, which does not exist. The warning GHC emits when it cannot use a -jsem semaphore, including on a protocol version mismatch, is -Wsemaphore-open-failure. Context: !15729, #25087 Assisted-by: Claude Fable 5.1 - - - - - a93705ee by Simon Jakobi at 2026-10-02T17:38:17-04:00 changelog.d: Fix the CLC proposal link in the T27455 entry The entry used the Sphinx :ref: role with a URL as its target. :ref: resolves only internal labels, so the generated release notes would show the proposal name without a link. Use the plain hyperlink form like the other entries. Context: !16274, #27455 Assisted-by: Claude Fable 5.1 - - - - - 54381079 by Hannes Siebenhandl at 2026-10-02T17:39:01-04:00 Extend the `TrustOverlay` for wired-in units The TrustOverlay only contained the `UnitId` of all on-disk units. However, wired-in units are referred to by their wired-in unit id, which is not the same as the on-disk unit id. Thus, trust checks for wired-in units failed because the lookup was using the wired-in unit, which wasn't present in the `TrustOverlay`. We fix #27834, by copying the trust info for wired-in unit ids. - - - - - f8cfb1a5 by Hécate Kleidukos at 2026-10-04T19:36:39+02:00 [CLC 341] Strict variants of mutable types This commit is the implementation of CLC Proposal 341 https://github.com/haskell/core-libraries-committee/issues/341 - - - - - 575c4bc6 by Rodrigo Mesquita at 2026-10-05T12:32:02-04:00 ttg: HsModuleName in the AST, ModuleName in GHC This commit makes the AST fully independent from GHC by parsing a "module name" as an `HsModuleName (= HText)` rather than constructing an `ModuleName (= FastString)` straight away. In the GHC side, everything remains as a `ModuleName`. We turn AST `HsModuleName`s into fast strings with the cheap `mkFastStringShortText` when we process the AST for manipulation within the compiler. There are no performance regressions introduced by this approach. This is the final piece of #21592 Alternative plans were discussed in gitlab.haskell.org/ghc/ghc/-/merge_requests/16546#note_694647, but the Simon suggested one won in simplicity and performance when compared against my attempt at implementing my original plan of having a family `ModuleNameP`. - - - - - b3b89d32 by mangoiv at 2026-10-05T22:03:32-04:00 hadrian: Persist the used flavour name in the build root (#20650) This executes the idea proposed in #20650, teaching Hadrian to persist the flavour used to build a build root. This both makes use of multiple build roots more ergonomic (as the user no longer needs to repeat themselves) and avoids a tiresome foot-gun (forgetting to specify a flavour, often wholly invalidating a build root). Closes #20650. Co-authored-by: Sylvain Henry <sylvain(a)haskus.fr> - - - - - f977837b by mangoiv at 2026-10-05T22:04:21-04:00 configure: fix sed script and subst tooldir script Fixes #27672 Adds sanity checking for SUBST_TOOLDIR Metric Decrease: LinkableUsage01 MultiLayerModulesTH_OneShot T10547 T12234 T12425 T13035 T13820 T18140 T18730 T18923 T9198 TcPlugin_RewritePerf mhu-perf - - - - - f1cb08be by Hannes Siebenhandl at 2026-10-05T22:05:03-04:00 Prepend in-memory unit database for backpack The packageDbFlags are stored in reverse order. Thus, prepending will ensure that the in-memory unit database is the last item on the unit database stack. Further, the in-memory unit database needs to be able to shadow units from earlier unit databases in the unit database stack. Moreover, a `-clear-package-db` would remove the in-memory database if it weren't the last item on the stack. Closes #27835 - - - - - 8d49ed42 by Kazu Yamamoto at 2026-10-06T19:37:25-04:00 Do not leave standard file descriptors free at startup (#24450) A process may be started with stdout closed -- `prog >&-` from a shell does exactly that. Nothing then reserves descriptor 1, and open(), pipe() and socket() hand out the lowest free descriptor, so the next descriptor the runtime creates for itself takes it: the ticker's pipe, or a capability's IO manager control pipe. 'GHC.Internal.IO.StdHandles.stdout' is a CAF, built the first time the program writes to stdout, which is long after that has happened. It builds a 'Handle' over descriptor 1, which now belongs to the runtime, and nothing reports an error because the descriptor is perfectly good. The program then writes its output into the runtime's own plumbing. What that looks like from the outside is a hang. The descriptor the Handle has taken over is the read end of a pipe, so poll() for POLLOUT on it never says yes and epoll_ctl() accepts a registration for it; the thread waiting to write blocks for ever. Closing the Handle at exit closes the runtime's descriptor, which is worse: the ticker then fails on every tick. 'hs_init_ghc' now opens /dev/null onto whichever of descriptors 0, 1 and 2 are closed, before the runtime creates any descriptor of its own. Each is opened for the access that descriptor would normally have, read-only for 0 and write-only for 1 and 2, so that writing to 'stdin' or reading from 'stdout' still fails rather than quietly succeeding against /dev/null. See Note [Standard file descriptors must be open]. Moving only the descriptors the runtime opens would not do: the first file the program itself opened would land on the free number instead. The fix has to leave no free number. A program run this way therefore finds stdout connected to /dev/null rather than failing with EBADF on the first write, which is what such a program would get from most other language runtimes. Co-Authored-By: Claude Opus 5 (1M context) <noreply(a)anthropic.com> - - - - - 65bcf9e9 by Simon Jakobi at 2026-10-06T19:38:09-04:00 changelog: Repair the sentence describing #27477 The description read "programs using could crash", the object of "using" having been lost. The synopsis already says which programs are affected, so drop the dangling word. Assisted-by: Claude Fable 5.1 - - - - - 8fffaa01 by Simon Peyton Jones at 2026-10-07T12:07:16+01:00 Refactor fundeps again This MR fixes #27828; there was a bad scoping error in `trim_qtvs`. The main changes are * Refactor `trim_qtvs` completely to eliminate the bug. * Remove a redundant `apartnessCheck` from `mkTopOpenFamEqFDs`. * Lots of improvements to the Notes in FunDeps.hs I also did a couple of pure refactors: * I realised that we were carefully caching `cab_incomps` in each `CoAxBranch`, to make it more efficient to reduce a type family application, but we were not doing the same thing when computing relevance for functional dependencies; see Note [Relevance] in GHC.Tc.Solver.FunDeps. So I added `cab_overlaps`, which is now used in `noEarlierMatch`. * Use a proper data types, `AmIUnifying` and `OuterKindsFlag`, for two previously-Boolean arguments to `tc_unify_tys`. This is a pure refactor. - - - - - 178 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + changelog.d/24450 - + changelog.d/27641 - changelog.d/T27455 - + changelog.d/T27828 - + changelog.d/T27830-rts-flag-bounds - + changelog.d/clc-341-strict-mutable-data-types - changelog.d/fix-parallel-gc-selector-race-27477 - + changelog.d/hadrian-persist-flavour - changelog.d/semaphore-v2 - changelog.d/unit-index - compiler/GHC.hs - compiler/GHC/Builtin/Modules.hs - compiler/GHC/Builtin/WiredIn/Types/Box.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Show.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Errors/Ppr.hs - compiler/GHC/Driver/Errors/Types.hs - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Driver/Pipeline.hs-boot - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/Tc/Deriv/Generics.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/FunDeps.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/UnresolvedImport.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/External/Wired.hs - compiler/GHC/Unit/Home.hs - compiler/GHC/Unit/Module.hs - compiler/GHC/Unit/Module/Env.hs - + compiler/GHC/Unit/Module/Name.hs - compiler/GHC/Unit/Parser.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - compiler/GHC/Unit/Types.hs-boot - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Module/Name.hs - compiler/Language/Haskell/Syntax/Text.hs - compiler/ghc.cabal.in - distrib/configure.ac.in - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - hadrian/doc/flavours.md - hadrian/ghci-multi-cabal.in - hadrian/src/Rules.hs - hadrian/src/Settings.hs - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Control/Concurrent/Chan.hs - + libraries/base/src/Control/Concurrent/Chan/Strict.hs - libraries/base/src/Control/Concurrent/MVar.hs - + libraries/base/src/Control/Concurrent/MVar/Strict.hs - libraries/base/src/Data/IORef.hs - + libraries/base/src/Data/IORef/Strict.hs - libraries/ghc-internal/src/GHC/Internal/Bits.hs - linters/lint-codes/LintCodes/Static.hs - m4/subst_tooldir.m4 - rts/RtsFlags.c - rts/RtsStartup.c - rts/include/rts/Flags.h - rts/include/rts/storage/GC.h - rts/sm/GC.c - rts/sm/Storage.c - testsuite/driver/junit.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - + testsuite/tests/backpack/should_compile/T27835.bkp - + testsuite/tests/backpack/should_compile/T27835.stderr - testsuite/tests/backpack/should_compile/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/multipleHomeUnits/mhu-closure/Makefile - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stderr - testsuite/tests/driver/multipleHomeUnits/mhu-closure/mhu-closure.stdout - testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.hs - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - + testsuite/tests/ghci/scripts/T27641.script - + testsuite/tests/ghci/scripts/T27641.stderr - + testsuite/tests/ghci/scripts/T27641.stdout - + testsuite/tests/ghci/scripts/T27834.hs - + testsuite/tests/ghci/scripts/T27834.script - + testsuite/tests/ghci/scripts/T27834.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr - testsuite/tests/hiefile/should_run/T24544.hs - + testsuite/tests/indexed-types/should_compile/T27828.hs - + testsuite/tests/indexed-types/should_compile/T27828a.hs - + testsuite/tests/indexed-types/should_compile/T27828b.hs - testsuite/tests/indexed-types/should_compile/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 - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_compile/T15279.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20718b.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_compile/T23315/T23315.stderr - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/AnnotationNoListTuplePuns.stdout - testsuite/tests/printer/T18791.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - testsuite/tests/profiling/should_run/caller-cc/CallerCcParser.hs - + testsuite/tests/rts/T24450.hs - + testsuite/tests/rts/T24450.stderr - testsuite/tests/rts/all.T - testsuite/tests/rts/rtsflags001.stderr-ws-32 - testsuite/tests/rts/rtsflags001.stderr-ws-64 - + testsuite/tests/simplCore/should_compile/T7803.hs - + testsuite/tests/simplCore/should_compile/T7803.stderr - + testsuite/tests/simplCore/should_compile/T7803a.hs - testsuite/tests/simplCore/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cac84324f535b94e941767f4250fb7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cac84324f535b94e941767f4250fb7… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/substitution-via-mapper] 3 commits: Do not leave standard file descriptors free at startup (#24450)
by Simon Peyton Jones (＠simonpj) 07 Oct '26

07 Oct '26

Simon Peyton Jones pushed to branch wip/substitution-via-mapper at Glasgow Haskell Compiler / GHC Commits: 8d49ed42 by Kazu Yamamoto at 2026-10-06T19:37:25-04:00 Do not leave standard file descriptors free at startup (#24450) A process may be started with stdout closed -- `prog >&-` from a shell does exactly that. Nothing then reserves descriptor 1, and open(), pipe() and socket() hand out the lowest free descriptor, so the next descriptor the runtime creates for itself takes it: the ticker's pipe, or a capability's IO manager control pipe. 'GHC.Internal.IO.StdHandles.stdout' is a CAF, built the first time the program writes to stdout, which is long after that has happened. It builds a 'Handle' over descriptor 1, which now belongs to the runtime, and nothing reports an error because the descriptor is perfectly good. The program then writes its output into the runtime's own plumbing. What that looks like from the outside is a hang. The descriptor the Handle has taken over is the read end of a pipe, so poll() for POLLOUT on it never says yes and epoll_ctl() accepts a registration for it; the thread waiting to write blocks for ever. Closing the Handle at exit closes the runtime's descriptor, which is worse: the ticker then fails on every tick. 'hs_init_ghc' now opens /dev/null onto whichever of descriptors 0, 1 and 2 are closed, before the runtime creates any descriptor of its own. Each is opened for the access that descriptor would normally have, read-only for 0 and write-only for 1 and 2, so that writing to 'stdin' or reading from 'stdout' still fails rather than quietly succeeding against /dev/null. See Note [Standard file descriptors must be open]. Moving only the descriptors the runtime opens would not do: the first file the program itself opened would land on the free number instead. The fix has to leave no free number. A program run this way therefore finds stdout connected to /dev/null rather than failing with EBADF on the first write, which is what such a program would get from most other language runtimes. Co-Authored-By: Claude Opus 5 (1M context) <noreply(a)anthropic.com> - - - - - 65bcf9e9 by Simon Jakobi at 2026-10-06T19:38:09-04:00 changelog: Repair the sentence describing #27477 The description read "programs using could crash", the object of "using" having been lost. The synopsis already says which programs are affected, so drop the dangling word. Assisted-by: Claude Fable 5.1 - - - - - f9ef0775 by Simon Peyton Jones at 2026-10-07T11:00:15+01:00 Refactor type and coercion substitution This MR refactors type and coercion substitution so that they use TyCoMapper, rather than hand-rolled code. Fundamentally it's a simple idea, but I had to do quite a bit of refactoring to make it fly. I got Claude to help me this this refactoring, but I paid careful attention to every line of code. Main changes: * New module GHC.Core.TyCo.Make which defines TyCoMapper, and a bunch of other simple "smart constructors" for types and coercions. See GHC.Core.TyCo.Rep Note [The Type-related module hierarchy], esp (TRM1) * The new TyCoMapper has new fields `tcm_tcapp_ty` and `tcm_tcapp_co` to handle type-constructor applications. These replace `tcm_tycon`. * Rewrite GHC.Core.TyCo.Subst to use TyCoMapper * Rewrite GHC.Core.Type.expandTypeSynonyms to use TyCoMapper. * Implement `seqType` and `seqCo` with TyCoFolder. To to this I had to add a `tcf_lit` field to TyCoFolder. * A new module GHC.Utils.StrictIdentity to define a strict identity monad, which itself is used for substTyCoMapper :: TyCoMapper Subst StrictIdentity Refactoring `seq` functions * In GHC.Core.Seq, redefine `seqOneShot`, `seqRuleInfo`, and friends to return `SeqResult`, a new type defined in GHC.Types.Baseic, rather than `()`. We can define a Monoid instance for `SeqResult` that does the right thing. * This has knock-on effects across the compiler. Refactoring ForAllTyFlag In Note [Comparing visibility] in GHC.Core.TyCo.Compare we read that "we always compare ForAllTyFlags with `eqForAllVis` or `cmpForAllVis`" But alas there was an Eq and Ord instance for ForAllTyFlag, which made it impossible to check this claim. So I made these changes: * Move the definition of ForAllTyFlag and its related functions from L.H.S.Specificity (where it did not belong, since L.H.S didn't use it) into GHC.Types.Var. * Remove the Eq and Ord instances for ForAllTyFlag * Deal with the fallout, by using `eqForAllVis` or related functions. * In interface files we use IfaceType as a key for a de-deduplication map See Note [Deduplication during iface binary serialisation] in GHC.Iface.Binary. For this we need /exact/ comparison, so we use a newtype wrapper for IfaceForAllTyFlag, and give use `cmpForAllTyFlagExactly` to implement its Ord instance. Tiresome but easy. * Rename `toIfaceForAllBndrs` to `toIfaceForAllTyBndrs` - - - - - 64 changed files: - + changelog.d/24450 - changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - + compiler/GHC/Core/TyCo/Make.hs - + compiler/GHC/Core/TyCo/Make.hs-boot - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToIface.hs-boot - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Iface/Type.hs-boot - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/EnforceEpt/TagSig.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Cpr.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Map.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Types/Var.hs-boot - compiler/GHC/Types/Var/Set.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - + compiler/GHC/Utils/StrictIdentity.hs - compiler/Language/Haskell/Syntax/Specificity.hs - compiler/ghc.cabal.in - rts/RtsStartup.c - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/rts/T24450.hs - + testsuite/tests/rts/T24450.stderr - testsuite/tests/rts/all.T - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f47443d93c46d8ebb20897a2c944c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f47443d93c46d8ebb20897a2c944c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/27817] ci: make lint-adjacent jobs into platform independent
by Magnus (＠MangoIV) 07 Oct '26

07 Oct '26

Magnus pushed to branch wip/mangoiv/27817 at Glasgow Haskell Compiler / GHC Commits: 5732ce7e by mangoiv at 2026-10-07T11:32:32+02:00 ci: make lint-adjacent jobs into platform independent - move lint jobs into lint-anyarch tag - unify lint jobs under the same platform independent container - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -137,15 +137,37 @@ workflow: .lint: stage: tool-lint tags: - - lint - before_script: - # Allow Git to read from the runner-owned checkout. This is needed - # for example by the lint-author job. - - git config --global --add safe.directory "$CI_PROJECT_DIR" + - lint-anyarch + image: debian:13 rules: - *drafts-can-fail-lint - when: always +.install-ghc-toolchain: &install-ghc-toolchain + - apt update + - apt install -qy build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses6 libtinfo6 pkg-config python3 cmake git happy alex autoconf automake python3 libgmp-dev libnuma-dev libncurses-dev + - curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 sh + - source /root/.ghcup/env + - ghcup --no-verbose install ghc --set --install-targets 'install_bin install_lib update_package_db' '9.10' + - ghcup --no-verbose install cabal --set + - ghc --info + - cabal --version + +# linting but we need a boot toolchain +.lint-ghc-toolchain: + extends: .lint + before_script: + - *install-ghc-toolchain + - git config --global --add safe.directory "$CI_PROJECT_DIR" + +# linting but we need python +.lint-python: + extends: .lint + before_script: + - apt update + - apt install -qy python3 mypy shellcheck git + - git config --global --add safe.directory "$CI_PROJECT_DIR" + .nightly: &nightly variables: XZ_OPT: "-9" @@ -217,11 +239,11 @@ not-interruptible: stage: not-interruptible script: "true" interruptible: false - image: "debian:13" + image: debian:13 variables: GIT_STRATEGY: none tags: - - lint + - lint-anyarch rules: # - if: '$CI_COMMIT_BRANCH == "master"' # when: always @@ -242,7 +264,6 @@ include: '.gitlab/jobs.yaml' ghc-linters: stage: tool-lint - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" extends: .lint-params variables: BUILD_FLAVOUR: default @@ -258,16 +279,11 @@ ghc-linters: # Skipped if the MR has the ~"no-changelog" label. lint-changelog: stage: tool-lint - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" - extends: .lint + extends: .lint-ghc-toolchain variables: CHANGELOG_EXPECT_MR: "$CI_MERGE_REQUEST_IID" GIT_DEPTH: 1 GIT_SUBMODULE_STRATEGY: none - before_script: - - export PATH="/opt/toolchain/bin:$PATH" - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - .gitlab/ci.sh lint_changelog dependencies: [] @@ -279,42 +295,30 @@ lint-changelog: # Run mypy Python typechecker on linter scripts. lint-linters: - image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" - extends: .lint + extends: .lint-python variables: GIT_DEPTH: 1 GIT_SUBMODULE_STRATEGY: none - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - mypy testsuite/tests/linters/regex-linters/*.py dependencies: [] # Check that .T files all parse by listing broken tests. lint-testsuite: - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" - extends: .lint + extends: .lint-ghc-toolchain variables: GIT_DEPTH: 1 GIT_SUBMODULE_STRATEGY: none - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - - make -Ctestsuite list_broken TEST_HC=$GHC + - make -Ctestsuite list_broken TEST_HC=$(which ghc) dependencies: [] # Run mypy Python typechecker on testsuite driver typecheck-testsuite: - image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" - extends: .lint + extends: .lint-python variables: GIT_DEPTH: 1 GIT_SUBMODULE_STRATEGY: none - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - mypy testsuite/driver/runtests.py dependencies: [] @@ -323,7 +327,6 @@ typecheck-testsuite: # accommodate, e.g., haddock changes not yet upstream) but not on `master` or # Marge jobs. .lint-submods: - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" extends: .lint-params variables: BUILD_FLAVOUR: default @@ -341,13 +344,9 @@ typecheck-testsuite: # Check that commits in an MR were not authored with the identity that CI uses # when it needs to create commits itself. This only needs Git history. lint-author: - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" - extends: .lint + extends: .lint-python variables: GIT_SUBMODULE_STRATEGY: none - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . script: - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" @@ -425,12 +424,9 @@ lint-submods-branch: .lint-params: needs: [] - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" extends: .lint before_script: - - export PATH="/opt/toolchain/bin:$PATH" - # workaround for docker permissions - - sudo chown ghc:ghc -R . + - *install-ghc-toolchain - .gitlab/ci.sh setup after_script: - .gitlab/ci.sh save_cache @@ -448,18 +444,13 @@ lint-submods-branch: hadrian-ghc-in-ghci: stage: quick-build + extends: .lint-ghc-toolchain needs: - job: lint-linters - job: lint-submods optional: true - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" - before_script: - # workaround for docker permissions - - sudo chown ghc:ghc -R . variables: GHC_FLAGS: -Werror -Wwarn=unused-imports - tags: - - lint script: - git clean -xdf && git submodule foreach git clean -xdf - . .gitlab/ci.sh setup @@ -549,6 +540,7 @@ stack-hadrian-build: extends: hadrian-ghc-in-ghci stage: quick-build script: + - ghcup --no-verbose install stack --set - . .gitlab/ci.sh setup - . .gitlab/ci.sh configure - hadrian/build-stack --version View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5732ce7e46db2c947435c35c73c3d46… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5732ce7e46db2c947435c35c73c3d46… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/fendor/dep-json] Testsuite changes
by Hannes Siebenhandl (＠fendor) 07 Oct '26

07 Oct '26

Hannes Siebenhandl pushed to branch wip/fendor/dep-json at Glasgow Haskell Compiler / GHC Commits: da92068a by fendor at 2026-10-07T09:16:23+02:00 Testsuite changes - - - - - 51 changed files: - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/driver/mkdepend/Makefile - testsuite/tests/driver/mkdepend/A.hs → testsuite/tests/driver/mkdepend/T24384/A.hs - testsuite/tests/driver/mkdepend/C.hs → testsuite/tests/driver/mkdepend/T24384/C.hs - testsuite/tests/driver/mkdepend/C.hs-boot → testsuite/tests/driver/mkdepend/T24384/C.hs-boot - testsuite/tests/driver/mkdepend/D.hs → testsuite/tests/driver/mkdepend/T24384/D.hs - testsuite/tests/driver/mkdepend/E.hs → testsuite/tests/driver/mkdepend/T24384/E.hs - testsuite/tests/driver/mkdepend/dep-internal/DepInternal.hs → testsuite/tests/driver/mkdepend/T24384/dep-internal/DepInternal.hs - testsuite/tests/driver/mkdepend/dep-internal/dep-internal.pkg → testsuite/tests/driver/mkdepend/T24384/dep-internal/dep-internal.pkg - testsuite/tests/driver/mkdepend/dep-public/DepPublic.hs → testsuite/tests/driver/mkdepend/T24384/dep-public/DepPublic.hs - testsuite/tests/driver/mkdepend/dep-public/dep-public.pkg → testsuite/tests/driver/mkdepend/T24384/dep-public/dep-public.pkg - testsuite/tests/driver/mkdepend/dep/Dep.hs → testsuite/tests/driver/mkdepend/T24384/dep/Dep.hs - testsuite/tests/driver/mkdepend/dep/dep.pkg → testsuite/tests/driver/mkdepend/T24384/dep/dep.pkg - testsuite/tests/driver/mkdepend/foo.h → testsuite/tests/driver/mkdepend/T24384/foo.h - testsuite/tests/driver/mkdepend/lib/B.hs → testsuite/tests/driver/mkdepend/T24384/lib/B.hs - + testsuite/tests/driver/mkdepend/T24384/lib/B.hs-boot - testsuite/tests/driver/mkdepend/preproc.sh → testsuite/tests/driver/mkdepend/T24384/preproc.sh - testsuite/tests/driver/mkdepend/T24384a.stdout - + testsuite/tests/driver/mkdepend/T24384b.stdout - + testsuite/tests/driver/mkdepend/T24384c.stdout - testsuite/tests/driver/mkdepend/all.T - + testsuite/tests/driver/mkdepend/format_json.sh - + testsuite/tests/driver/mkdepend/format_makefile.sh - + testsuite/tests/driver/mkdepend/mhu01/a/A/Base.hs - + testsuite/tests/driver/mkdepend/mhu01/a/A/Base.hs-boot - + testsuite/tests/driver/mkdepend/mhu01/a/A/TH.hs - + testsuite/tests/driver/mkdepend/mhu01/a/Util.hs - + testsuite/tests/driver/mkdepend/mhu01/b/B/Normal.hs - + testsuite/tests/driver/mkdepend/mhu01/b/B/Splice.hs - + testsuite/tests/driver/mkdepend/mhu01/b/Util.hs - + testsuite/tests/driver/mkdepend/mhu01/c/C.hs - + testsuite/tests/driver/mkdepend/mhu01/unitA - + testsuite/tests/driver/mkdepend/mhu01/unitB - + testsuite/tests/driver/mkdepend/mhu01/unitC - + testsuite/tests/driver/mkdepend/mhu02/A.hs - + testsuite/tests/driver/mkdepend/mhu02/B.hs - + testsuite/tests/driver/mkdepend/mhu02/pp.sh - + testsuite/tests/driver/mkdepend/mhu02/unitA - + testsuite/tests/driver/mkdepend/mhu02/unitB - + testsuite/tests/driver/mkdepend/mhu03/pkg/A.hs - + testsuite/tests/driver/mkdepend/mhu03/pkg/pp.sh - + testsuite/tests/driver/mkdepend/mhu03/unitA - + testsuite/tests/driver/mkdepend/mkdepend01.dep-json - + testsuite/tests/driver/mkdepend/mkdepend01.dep-makefile - + testsuite/tests/driver/mkdepend/mkdepend01/A.hs - + testsuite/tests/driver/mkdepend/mkdepend_mhu01.dep-json - + testsuite/tests/driver/mkdepend/mkdepend_mhu01.dep-makefile - + testsuite/tests/driver/mkdepend/mkdepend_mhu02.dep-json - + testsuite/tests/driver/mkdepend/mkdepend_mhu03.dep-json - testsuite/tests/perf/compiler/large-project/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da92068af7157a0e0f9290d9ae7775d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da92068af7157a0e0f9290d9ae7775d… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][master] Do not leave standard file descriptors free at startup (#24450)
by Marge Bot (＠marge-bot) 06 Oct '26

06 Oct '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8d49ed42 by Kazu Yamamoto at 2026-10-06T19:37:25-04:00 Do not leave standard file descriptors free at startup (#24450) A process may be started with stdout closed -- `prog >&-` from a shell does exactly that. Nothing then reserves descriptor 1, and open(), pipe() and socket() hand out the lowest free descriptor, so the next descriptor the runtime creates for itself takes it: the ticker's pipe, or a capability's IO manager control pipe. 'GHC.Internal.IO.StdHandles.stdout' is a CAF, built the first time the program writes to stdout, which is long after that has happened. It builds a 'Handle' over descriptor 1, which now belongs to the runtime, and nothing reports an error because the descriptor is perfectly good. The program then writes its output into the runtime's own plumbing. What that looks like from the outside is a hang. The descriptor the Handle has taken over is the read end of a pipe, so poll() for POLLOUT on it never says yes and epoll_ctl() accepts a registration for it; the thread waiting to write blocks for ever. Closing the Handle at exit closes the runtime's descriptor, which is worse: the ticker then fails on every tick. 'hs_init_ghc' now opens /dev/null onto whichever of descriptors 0, 1 and 2 are closed, before the runtime creates any descriptor of its own. Each is opened for the access that descriptor would normally have, read-only for 0 and write-only for 1 and 2, so that writing to 'stdin' or reading from 'stdout' still fails rather than quietly succeeding against /dev/null. See Note [Standard file descriptors must be open]. Moving only the descriptors the runtime opens would not do: the first file the program itself opened would land on the free number instead. The fix has to leave no free number. A program run this way therefore finds stdout connected to /dev/null rather than failing with EBADF on the first write, which is what such a program would get from most other language runtimes. Co-Authored-By: Claude Opus 5 (1M context) <noreply(a)anthropic.com> - - - - - 5 changed files: - + changelog.d/24450 - rts/RtsStartup.c - + testsuite/tests/rts/T24450.hs - + testsuite/tests/rts/T24450.stderr - testsuite/tests/rts/all.T Changes: ===================================== changelog.d/24450 ===================================== @@ -0,0 +1,14 @@ +section: rts +synopsis: + Fix a hang when a program is started with a standard file descriptor closed +description: + A process started with stdout or stderr closed -- ``prog >&-`` from a shell + does exactly that -- left that descriptor number free for the runtime to + take for its own use. The ``Handle`` for the stream, built later when the + program first wrote to it, then took over a descriptor belonging to the + runtime: the program wrote its output into the runtime's own plumbing and + hung, with no error reported anywhere. The runtime now opens ``/dev/null`` + onto whichever of the descriptors 0, 1 and 2 are closed when it starts, so + such a stream is connected to ``/dev/null`` instead. +mrs: !16710 +issues: #24450 ===================================== rts/RtsStartup.c ===================================== @@ -69,6 +69,10 @@ #if defined(HAVE_LOCALE_H) #include <locale.h> #endif +#if !defined(mingw32_HOST_OS) +#include <errno.h> +#include <fcntl.h> +#endif // Count of how many outstanding hs_init()s there have been. static StgWord hs_init_count = 0; @@ -81,6 +85,10 @@ static int64_t __codePage = -1; static void flushStdHandles(void); +#if !defined(mingw32_HOST_OS) +static void sanitiseStandardFds(void); +#endif + /* ----------------------------------------------------------------------------- Initialise floating point unit on x86 (currently disabled; See Note [x86 Floating point precision] in compiler/GHC/CmmToAsm/X86/Instr.hs) @@ -238,6 +246,82 @@ hs_init_with_rtsopts(int *argc, char **argv[]) void init_ghc_hs_iface(void); +#if !defined(mingw32_HOST_OS) +/* See Note [Standard file descriptors must be open]. */ +static void sanitiseStandardFds(void) +{ + // The access mode each descriptor would have had, had the process been + // started with it open. + static const int access_mode[3] = { O_RDONLY, O_WRONLY, O_WRONLY }; + + for (int fd = 0; fd <= 2; fd++) { + if (fcntl(fd, F_GETFD) != -1 || errno != EBADF) { + continue; // already open + } + + int nullfd; + do { + nullfd = open("/dev/null", access_mode[fd]); + } while (nullfd == -1 && errno == EINTR); + + if (nullfd == -1) { + // No /dev/null to be had. There is nothing better to do than + // carry on; the hazard the Note describes is then still there, + // but refusing to start would be worse. + return; + } + if (nullfd != fd) { + // open() hands out the lowest free descriptor, so this cannot + // happen unless something in this process is opening descriptors + // concurrently. Do not shuffle its descriptor around. + close(nullfd); + return; + } + } +} + +/* + * Note [Standard file descriptors must be open] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * A process may be started with any of file descriptors 0, 1 and 2 closed -- + * from a shell, `prog >&-` does exactly that. Nothing then reserves those + * numbers, and open(), pipe() and socket() hand out the lowest free + * descriptor, so the next descriptor the runtime creates for itself takes one + * of them: the ticker's pipe, or a capability's IO manager control pipe. + * + * Nothing warns anybody. 'GHC.Internal.IO.StdHandles.stdout' is a CAF, so it + * is built the first time the program writes to stdout, which is long after + * that has happened, and it builds a 'Handle' over descriptor 1 -- which now + * belongs to the runtime. The program then writes its output into the + * runtime's own plumbing, and at exit closes it. + * + * What this looks like from the outside is a hang, because the descriptor the + * Handle has taken over is the read end of a pipe. It is a perfectly good + * descriptor, so nothing reports an error: poll() for POLLOUT on it simply + * never says yes, epoll_ctl() accepts a registration for it, and the thread + * waiting to write blocks for ever. See #24450, where this is `prog >&-` + * hanging after main has finished. + * + * Closing those descriptors is legal, so the runtime cannot refuse them; and + * moving only the descriptors the runtime opens would not help, since the + * first file the program itself opens would land on the free number instead. + * The fix is to leave no free number: open /dev/null onto whichever of 0, 1 + * and 2 are closed, before the runtime creates any descriptor of its own. + * Other runtimes do the same, and for the same reason. + * + * A program run this way therefore finds stdout connected to /dev/null rather + * than failing with EBADF on the first write. That is the price of the fix, + * and it is the behaviour such a program would get from most other language + * runtimes. + * + * Each substitute is opened for the access the descriptor would normally have: + * read-only for 0, write-only for 1 and 2. Opening all three for both would + * make the substitute something a real stdin or stdout is not, and writing to + * 'stdin' or reading from 'stdout' would then quietly succeed instead of + * failing with EBADF. + */ +#endif + void hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) { @@ -252,6 +336,12 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) stg_exit(1); } +#if !defined(mingw32_HOST_OS) + /* Before anything here opens a file descriptor of its own. + See Note [Standard file descriptors must be open]. */ + sanitiseStandardFds(); +#endif + #if defined(wasm32_HOST_ARCH) char *pwd = getenv("PWD"); if (pwd != NULL) { ===================================== testsuite/tests/rts/T24450.hs ===================================== @@ -0,0 +1,41 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- A process may be started with stdout closed -- `prog >&-` from a shell does +-- exactly that. Nothing then reserves descriptor 1, so the next descriptor +-- the runtime opens for itself takes it, and the 'Handle' for stdout, built +-- later when the program first writes, takes over a descriptor belonging to +-- the runtime. The write then goes into the runtime's own plumbing, and what +-- this looks like from the outside is a hang. See #24450 and +-- Note [Standard file descriptors must be open] in rts/RtsStartup.c. +-- +-- This test is run with its stdin and stdout closed, so what it has to say +-- goes to stderr. The four writes are the reproducer from the ticket and must +-- simply finish. The lines after them are what tell the two outcomes apart: +-- the descriptors the runtime opens for itself are pipes, so finding a pipe on +-- descriptor 0 or 1 means it was handed to the runtime. +module Main (main) where + +import Control.Exception (IOException, try) +import System.IO +import System.Posix.Files (getFdStatus, isCharacterDevice, isNamedPipe) +import System.Posix.Types (Fd (..)) + +main :: IO () +main = do + hPutChar stderr 'A' -- unbuffered + hPutChar stdout 'X' -- buffered; this is the one that used to hang + hPutChar stderr 'Z' -- unbuffered + hPutChar stderr '\n' -- unbuffered + mapM_ (\fd -> hPutStrLn stderr =<< describeFd fd) [0, 1] + +describeFd :: Fd -> IO String +describeFd fd = do + r <- try (getFdStatus fd) + return $ "fd " ++ show fd ++ ": " ++ case r of + Left (_ :: IOException) -> "closed" + Right st + -- What the fix arranges: /dev/null, opened onto the free number + -- before the runtime could take it. + | isCharacterDevice st -> "character device" + -- What #24450 is: the runtime's ticker or control pipe. + | isNamedPipe st -> "pipe" + | otherwise -> "something else" ===================================== testsuite/tests/rts/T24450.stderr ===================================== @@ -0,0 +1,3 @@ +AZ +fd 0: character device +fd 1: character device ===================================== testsuite/tests/rts/all.T ===================================== @@ -408,6 +408,18 @@ test('T10590', [ ignore_stderr , req_process ], compile_and_run, ['']) +# Run with stdin and stdout closed -- that is what leaves those descriptors +# free for the runtime to take, which is the whole of #24450. What the test +# has to say therefore goes to stderr and is checked against T24450.stderr. +test('T24450', + [ when(opsys('mingw32'), skip) # POSIX only + , js_skip # JS backend has its own runtime + # The wrapper below would close the stdout of the wasm runtime rather + # than that of the program running under it, which tests nothing. + , when(arch('wasm32'), skip) + , cmd_wrapper(lambda c: c + ' <&- >&-') + ], compile_and_run, ['']) + # 20000 was easily enough to trigger the bug with 7.10 test('T10904', [ extra_run_opts('20000'), req_c ], compile_and_run, ['T10904lib.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8d49ed42d8ec1ad92737fa338571aad… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8d49ed42d8ec1ad92737fa338571aad… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][master] changelog: Repair the sentence describing #27477
by Marge Bot (＠marge-bot) 06 Oct '26

06 Oct '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 65bcf9e9 by Simon Jakobi at 2026-10-06T19:38:09-04:00 changelog: Repair the sentence describing #27477 The description read "programs using could crash", the object of "using" having been lost. The synopsis already says which programs are affected, so drop the dangling word. Assisted-by: Claude Fable 5.1 - - - - - 1 changed file: - changelog.d/fix-parallel-gc-selector-race-27477 Changes: ===================================== changelog.d/fix-parallel-gc-selector-race-27477 ===================================== @@ -1,7 +1,7 @@ section: rts synopsis: Fix a parallel GC race on weakly-ordered architectures (AArch64) that could crash or silently corrupt the heap description: - On weakly-ordered architectures such as AArch64 programs using + On weakly-ordered architectures such as AArch64, programs could crash during parallel garbage collection (segmentation fault or ``internal error: eval_thunk_selector: strange selectee <n>``) or continue running with silently corrupted heap data, due to a missing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65bcf9e9116c3a8170d3a7e568f2a35… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65bcf9e9116c3a8170d3a7e568f2a35… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/substitution-via-mapper] Refactor type and coercion substitution
by Simon Peyton Jones (＠simonpj) 06 Oct '26

06 Oct '26

Simon Peyton Jones pushed to branch wip/substitution-via-mapper at Glasgow Haskell Compiler / GHC Commits: 7f47443d by Simon Peyton Jones at 2026-10-07T00:33:37+01:00 Refactor type and coercion substitution This MR refactors type and coercion substitution so that they use TyCoMapper, rather than hand-rolled code. Fundamentally it's a simple idea, but I had to do quite a bit of refactoring to make it fly. I got Claude to help me this this refactoring, but I paid careful attention to every line of code. Main changes: * New module GHC.Core.TyCo.Make which defines TyCoMapper, and a bunch of other simple "smart constructors" for types and coercions. See GHC.Core.TyCo.Rep Note [The Type-related module hierarchy], esp (TRM1) * The new TyCoMapper has new fields `tcm_tcapp_ty` and `tcm_tcapp_co` to handle type-constructor applications. These replace `tcm_tycon`. * Rewrite GHC.Core.TyCo.Subst to use TyCoMapper * Rewrite GHC.Core.Type.expandTypeSynonyms to use TyCoMapper. * Implement `seqType` and `seqCo` with TyCoFolder. To to this I had to add a `tcf_lit` field to TyCoFolder. * A new module GHC.Utils.StrictIdentity to define a strict identity monad, which itself is used for substTyCoMapper :: TyCoMapper Subst StrictIdentity Refactoring `seq` functions * In GHC.Core.Seq, redefine `seqOneShot`, `seqRuleInfo`, and friends to return `SeqResult`, a new type defined in GHC.Types.Baseic, rather than `()`. We can define a Monoid instance for `SeqResult` that does the right thing. * This has knock-on effects across the compiler. Refactoring ForAllTyFlag In Note [Comparing visibility] in GHC.Core.TyCo.Compare we read that "we always compare ForAllTyFlags with `eqForAllVis` or `cmpForAllVis`" But alas there was an Eq and Ord instance for ForAllTyFlag, which made it impossible to check this claim. So I made these changes: * Move the definition of ForAllTyFlag and its related functions from L.H.S.Specificity (where it did not belong, since L.H.S didn't use it) into GHC.Types.Var. * Remove the Eq and Ord instances for ForAllTyFlag * Deal with the fallout, by using `eqForAllVis` or related functions. * In interface files we use IfaceType as a key for a de-deduplication map See Note [Deduplication during iface binary serialisation] in GHC.Iface.Binary. For this we need /exact/ comparison, so we use a newtype wrapper for IfaceForAllTyFlag, and give use `cmpForAllTyFlagExactly` to implement its Ord instance. Tiresome but easy. * Rename `toIfaceForAllBndrs` to `toIfaceForAllTyBndrs` - - - - - 57 changed files: - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - + compiler/GHC/Core/TyCo/Make.hs - + compiler/GHC/Core/TyCo/Make.hs-boot - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToIface.hs-boot - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Iface/Type.hs-boot - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/EnforceEpt/TagSig.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Cpr.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Map.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Types/Var.hs-boot - compiler/GHC/Types/Var/Set.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - + compiler/GHC/Utils/StrictIdentity.hs - compiler/Language/Haskell/Syntax/Specificity.hs - compiler/ghc.cabal.in - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f47443d93c46d8ebb20897a2c944c7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f47443d93c46d8ebb20897a2c944c7… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Do not leave standard file descriptors free at startup (#24450)
by Marge Bot (＠marge-bot) 06 Oct '26

06 Oct '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cbfbecb6 by Kazu Yamamoto at 2026-10-06T15:16:47-04:00 Do not leave standard file descriptors free at startup (#24450) A process may be started with stdout closed -- `prog >&-` from a shell does exactly that. Nothing then reserves descriptor 1, and open(), pipe() and socket() hand out the lowest free descriptor, so the next descriptor the runtime creates for itself takes it: the ticker's pipe, or a capability's IO manager control pipe. 'GHC.Internal.IO.StdHandles.stdout' is a CAF, built the first time the program writes to stdout, which is long after that has happened. It builds a 'Handle' over descriptor 1, which now belongs to the runtime, and nothing reports an error because the descriptor is perfectly good. The program then writes its output into the runtime's own plumbing. What that looks like from the outside is a hang. The descriptor the Handle has taken over is the read end of a pipe, so poll() for POLLOUT on it never says yes and epoll_ctl() accepts a registration for it; the thread waiting to write blocks for ever. Closing the Handle at exit closes the runtime's descriptor, which is worse: the ticker then fails on every tick. 'hs_init_ghc' now opens /dev/null onto whichever of descriptors 0, 1 and 2 are closed, before the runtime creates any descriptor of its own. Each is opened for the access that descriptor would normally have, read-only for 0 and write-only for 1 and 2, so that writing to 'stdin' or reading from 'stdout' still fails rather than quietly succeeding against /dev/null. See Note [Standard file descriptors must be open]. Moving only the descriptors the runtime opens would not do: the first file the program itself opened would land on the free number instead. The fix has to leave no free number. A program run this way therefore finds stdout connected to /dev/null rather than failing with EBADF on the first write, which is what such a program would get from most other language runtimes. Co-Authored-By: Claude Opus 5 (1M context) <noreply(a)anthropic.com> - - - - - f20e7d94 by Simon Jakobi at 2026-10-06T15:16:48-04:00 changelog: Repair the sentence describing #27477 The description read "programs using could crash", the object of "using" having been lost. The synopsis already says which programs are affected, so drop the dangling word. Assisted-by: Claude Fable 5.1 - - - - - 6 changed files: - + changelog.d/24450 - changelog.d/fix-parallel-gc-selector-race-27477 - rts/RtsStartup.c - + testsuite/tests/rts/T24450.hs - + testsuite/tests/rts/T24450.stderr - testsuite/tests/rts/all.T Changes: ===================================== changelog.d/24450 ===================================== @@ -0,0 +1,14 @@ +section: rts +synopsis: + Fix a hang when a program is started with a standard file descriptor closed +description: + A process started with stdout or stderr closed -- ``prog >&-`` from a shell + does exactly that -- left that descriptor number free for the runtime to + take for its own use. The ``Handle`` for the stream, built later when the + program first wrote to it, then took over a descriptor belonging to the + runtime: the program wrote its output into the runtime's own plumbing and + hung, with no error reported anywhere. The runtime now opens ``/dev/null`` + onto whichever of the descriptors 0, 1 and 2 are closed when it starts, so + such a stream is connected to ``/dev/null`` instead. +mrs: !16710 +issues: #24450 ===================================== changelog.d/fix-parallel-gc-selector-race-27477 ===================================== @@ -1,7 +1,7 @@ section: rts synopsis: Fix a parallel GC race on weakly-ordered architectures (AArch64) that could crash or silently corrupt the heap description: - On weakly-ordered architectures such as AArch64 programs using + On weakly-ordered architectures such as AArch64, programs could crash during parallel garbage collection (segmentation fault or ``internal error: eval_thunk_selector: strange selectee <n>``) or continue running with silently corrupted heap data, due to a missing ===================================== rts/RtsStartup.c ===================================== @@ -69,6 +69,10 @@ #if defined(HAVE_LOCALE_H) #include <locale.h> #endif +#if !defined(mingw32_HOST_OS) +#include <errno.h> +#include <fcntl.h> +#endif // Count of how many outstanding hs_init()s there have been. static StgWord hs_init_count = 0; @@ -81,6 +85,10 @@ static int64_t __codePage = -1; static void flushStdHandles(void); +#if !defined(mingw32_HOST_OS) +static void sanitiseStandardFds(void); +#endif + /* ----------------------------------------------------------------------------- Initialise floating point unit on x86 (currently disabled; See Note [x86 Floating point precision] in compiler/GHC/CmmToAsm/X86/Instr.hs) @@ -238,6 +246,82 @@ hs_init_with_rtsopts(int *argc, char **argv[]) void init_ghc_hs_iface(void); +#if !defined(mingw32_HOST_OS) +/* See Note [Standard file descriptors must be open]. */ +static void sanitiseStandardFds(void) +{ + // The access mode each descriptor would have had, had the process been + // started with it open. + static const int access_mode[3] = { O_RDONLY, O_WRONLY, O_WRONLY }; + + for (int fd = 0; fd <= 2; fd++) { + if (fcntl(fd, F_GETFD) != -1 || errno != EBADF) { + continue; // already open + } + + int nullfd; + do { + nullfd = open("/dev/null", access_mode[fd]); + } while (nullfd == -1 && errno == EINTR); + + if (nullfd == -1) { + // No /dev/null to be had. There is nothing better to do than + // carry on; the hazard the Note describes is then still there, + // but refusing to start would be worse. + return; + } + if (nullfd != fd) { + // open() hands out the lowest free descriptor, so this cannot + // happen unless something in this process is opening descriptors + // concurrently. Do not shuffle its descriptor around. + close(nullfd); + return; + } + } +} + +/* + * Note [Standard file descriptors must be open] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * A process may be started with any of file descriptors 0, 1 and 2 closed -- + * from a shell, `prog >&-` does exactly that. Nothing then reserves those + * numbers, and open(), pipe() and socket() hand out the lowest free + * descriptor, so the next descriptor the runtime creates for itself takes one + * of them: the ticker's pipe, or a capability's IO manager control pipe. + * + * Nothing warns anybody. 'GHC.Internal.IO.StdHandles.stdout' is a CAF, so it + * is built the first time the program writes to stdout, which is long after + * that has happened, and it builds a 'Handle' over descriptor 1 -- which now + * belongs to the runtime. The program then writes its output into the + * runtime's own plumbing, and at exit closes it. + * + * What this looks like from the outside is a hang, because the descriptor the + * Handle has taken over is the read end of a pipe. It is a perfectly good + * descriptor, so nothing reports an error: poll() for POLLOUT on it simply + * never says yes, epoll_ctl() accepts a registration for it, and the thread + * waiting to write blocks for ever. See #24450, where this is `prog >&-` + * hanging after main has finished. + * + * Closing those descriptors is legal, so the runtime cannot refuse them; and + * moving only the descriptors the runtime opens would not help, since the + * first file the program itself opens would land on the free number instead. + * The fix is to leave no free number: open /dev/null onto whichever of 0, 1 + * and 2 are closed, before the runtime creates any descriptor of its own. + * Other runtimes do the same, and for the same reason. + * + * A program run this way therefore finds stdout connected to /dev/null rather + * than failing with EBADF on the first write. That is the price of the fix, + * and it is the behaviour such a program would get from most other language + * runtimes. + * + * Each substitute is opened for the access the descriptor would normally have: + * read-only for 0, write-only for 1 and 2. Opening all three for both would + * make the substitute something a real stdin or stdout is not, and writing to + * 'stdin' or reading from 'stdout' would then quietly succeed instead of + * failing with EBADF. + */ +#endif + void hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) { @@ -252,6 +336,12 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) stg_exit(1); } +#if !defined(mingw32_HOST_OS) + /* Before anything here opens a file descriptor of its own. + See Note [Standard file descriptors must be open]. */ + sanitiseStandardFds(); +#endif + #if defined(wasm32_HOST_ARCH) char *pwd = getenv("PWD"); if (pwd != NULL) { ===================================== testsuite/tests/rts/T24450.hs ===================================== @@ -0,0 +1,41 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- A process may be started with stdout closed -- `prog >&-` from a shell does +-- exactly that. Nothing then reserves descriptor 1, so the next descriptor +-- the runtime opens for itself takes it, and the 'Handle' for stdout, built +-- later when the program first writes, takes over a descriptor belonging to +-- the runtime. The write then goes into the runtime's own plumbing, and what +-- this looks like from the outside is a hang. See #24450 and +-- Note [Standard file descriptors must be open] in rts/RtsStartup.c. +-- +-- This test is run with its stdin and stdout closed, so what it has to say +-- goes to stderr. The four writes are the reproducer from the ticket and must +-- simply finish. The lines after them are what tell the two outcomes apart: +-- the descriptors the runtime opens for itself are pipes, so finding a pipe on +-- descriptor 0 or 1 means it was handed to the runtime. +module Main (main) where + +import Control.Exception (IOException, try) +import System.IO +import System.Posix.Files (getFdStatus, isCharacterDevice, isNamedPipe) +import System.Posix.Types (Fd (..)) + +main :: IO () +main = do + hPutChar stderr 'A' -- unbuffered + hPutChar stdout 'X' -- buffered; this is the one that used to hang + hPutChar stderr 'Z' -- unbuffered + hPutChar stderr '\n' -- unbuffered + mapM_ (\fd -> hPutStrLn stderr =<< describeFd fd) [0, 1] + +describeFd :: Fd -> IO String +describeFd fd = do + r <- try (getFdStatus fd) + return $ "fd " ++ show fd ++ ": " ++ case r of + Left (_ :: IOException) -> "closed" + Right st + -- What the fix arranges: /dev/null, opened onto the free number + -- before the runtime could take it. + | isCharacterDevice st -> "character device" + -- What #24450 is: the runtime's ticker or control pipe. + | isNamedPipe st -> "pipe" + | otherwise -> "something else" ===================================== testsuite/tests/rts/T24450.stderr ===================================== @@ -0,0 +1,3 @@ +AZ +fd 0: character device +fd 1: character device ===================================== testsuite/tests/rts/all.T ===================================== @@ -408,6 +408,18 @@ test('T10590', [ ignore_stderr , req_process ], compile_and_run, ['']) +# Run with stdin and stdout closed -- that is what leaves those descriptors +# free for the runtime to take, which is the whole of #24450. What the test +# has to say therefore goes to stderr and is checked against T24450.stderr. +test('T24450', + [ when(opsys('mingw32'), skip) # POSIX only + , js_skip # JS backend has its own runtime + # The wrapper below would close the stdout of the wasm runtime rather + # than that of the program running under it, which tests nothing. + , when(arch('wasm32'), skip) + , cmd_wrapper(lambda c: c + ' <&- >&-') + ], compile_and_run, ['']) + # 20000 was easily enough to trigger the bug with 7.10 test('T10904', [ extra_run_opts('20000'), req_c ], compile_and_run, ['T10904lib.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03383bf1c43812511c0fb888d4660b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03383bf1c43812511c0fb888d4660b… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/romes/multi-threaded-debugger] 3 commits: Asynchronous RPC with external interpreter
by Rodrigo Mesquita (＠alt-romes) 06 Oct '26

06 Oct '26

Rodrigo Mesquita pushed to branch wip/romes/multi-threaded-debugger at Glasgow Haskell Compiler / GHC Commits: 5f600346 by Rodrigo Mesquita at 2026-10-06T17:45:16+01:00 Asynchronous RPC with external interpreter - Kill InterpProcess.interpLock to Pipe.pipeLock - - - - - 1c15fcb9 by Rodrigo Mesquita at 2026-10-06T19:27:25+01:00 Async more work - - - - - 2540e67a by Rodrigo Mesquita at 2026-10-06T19:28:18+01:00 WIP: Asynchronous eval/resume - - - - - 9 changed files: - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/JS.hs - compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs - compiler/GHC/Runtime/Interpreter/Wasm.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/GHCi/Server.hs Changes: ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -188,12 +188,13 @@ execOptions = ExecOptions -- by default we just care about breakpoints hit in this eval thread } --- | Run a statement in the current interactive context. +-- | Run a statement in the current interactive context, as a new thread in the interpreter. +-- Returns an action which blocks waiting for the execution to finish and yield a result. execStmt :: GhcMonad m => String -- ^ a statement (bind or expression) -> ExecOptions - -> m ExecResult + -> m (m ExecResult) execStmt input exec_opts@ExecOptions{..} = do hsc_env <- getSession @@ -204,13 +205,15 @@ execStmt input exec_opts@ExecOptions{..} = do case mb_stmt of -- empty statement / comment - Nothing -> return (ExecComplete (Right []) 0) + Nothing -> pure (pure (ExecComplete (Right []) 0)) Just stmt -> execStmt' stmt input exec_opts -- | Like `execStmt`, but takes a parsed statement as argument. Useful when -- doing preprocessing on the AST before execution, e.g. in GHCi (see -- GHCi.UI.runStmt). -execStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult +-- +-- Returns an action which blocks waiting for the execution to finish and yield a result. +execStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m (m ExecResult) execStmt' stmt stmt_text ExecOptions{..} = do hsc_env <- getSession let interp = hscInterp hsc_env @@ -226,21 +229,22 @@ execStmt' stmt stmt_text ExecOptions{..} = do case r of Nothing -> -- empty statement / comment - return (ExecComplete (Right []) 0) + pure (pure (ExecComplete (Right []) 0)) Just (ids, hval, fix_env) -> do updateFixityEnv fix_env let eval_opts = initEvalOpts idflags' (enableGhcStepMode execSingleStep) (enableIsolateThreadBreaks execIsolateMode) - status <- liftIO $ evalStmt interp eval_opts (execWrap hval) + rtid <- liftIO $ evalStmt interp eval_opts (execWrap hval) let ic = hsc_IC hsc_env bindings = (ic_tythings ic, ic_gre_cache ic) size = ghciHistSize idflags' - - handleRunStatus execSingleStep eval_opts stmt_text bindings ids - status (emptyHistory size) + pure $ do + status <- liftIO (waitThreadResult interp rtid) + handleRunStatus execSingleStep eval_opts stmt_text bindings ids + status (emptyHistory size) runDecls :: GhcMonad m => String -> m [TyThing] runDecls = runDeclsWithLocation "<interactive>" 1 @@ -326,16 +330,16 @@ handleRunStatus step eval_opts expr bindings final_ids status history0 = do return (ExecComplete (Left (fromSerializableException e)) alloc) -- Nothing case: we stopped when an exception was raised, not at a breakpoint. - EvalBreak apStack_ref Nothing resume_ctxt ccs -> do - resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt - apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref + EvalBreak apStack_ref Nothing resume_tid ccs -> do + resume_tid_fhv <- liftIO $ mkFinalizedHValue interp resume_tid + apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref let span = mkGeneralSrcSpan (fsLit "<unknown>") (hsc_env1, break_ids) <- liftIO $ bindLocalsAtBreakpoint hsc_env apStack_fhv span Nothing let resume = Resume { resumeStmt = expr - , resumeContext = resume_ctxt_fhv + , resumeContext = resume_tid_fhv , resumeBindings = bindings , resumeFinalIds = final_ids , resumeApStack = apStack_fhv @@ -356,7 +360,7 @@ handleRunStatus step eval_opts expr bindings final_ids status history0 = do -- The interpreter yields on a breakpoint if: -- - the breakpoint was explicitly enabled (in @BreakArray@) -- - or one of the stepping options in @EvalOpts@ caused us to stop at one - EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do + EvalBreak apStack_ref (Just eval_break) resume_tid ccs -> do let ibi = evalBreakpointToId eval_break let hug = hsc_HUG hsc_env info_brks <- liftIO $ readIModBreaks hug ibi @@ -368,8 +372,8 @@ handleRunStatus step eval_opts expr bindings final_ids status history0 = do breakArray <- getBreakArray interp ibi info_brks breakpointStatus interp breakArray (ibi_info_index ibi) - apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref - resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt + apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref + resume_tid_fhv <- liftIO $ mkFinalizedHValue interp resume_tid -- This breakpoint is enabled or we mean to break here; -- we want to stop instead of just logging it. @@ -382,7 +386,7 @@ handleRunStatus step eval_opts expr bindings final_ids status history0 = do let resume = Resume { resumeStmt = expr - , resumeContext = resume_ctxt_fhv + , resumeContext = resume_tid_fhv , resumeBindings = bindings , resumeFinalIds = final_ids , resumeApStack = apStack_fhv @@ -398,7 +402,9 @@ handleRunStatus step eval_opts expr bindings final_ids status history0 = do return (ExecBreak break_ids (Just ibi) resume) else do -- resume with the same step type - status <- liftIO $ GHCi.resumeStmt interp eval_opts resume_ctxt_fhv + status <- liftIO $ do + GHCi.resumeStmt interp eval_opts resume_tid_fhv + GHCi.waitThreadResult interp resume_tid_fhv history <- if not tracing then pure history0 else do history1 <- liftIO $ mkHistory hug apStack_fhv ibi let !history' = history1 `consBL` history0 @@ -414,7 +420,9 @@ resumeExec :: GhcMonad m -> ThreadBreaksIsolationMode -> Maybe Int -> Resume - -> m ExecResult + -> m (m ExecResult) + -- ^ Returns an action which blocks waiting for the resumed thread + -- to break again or yield a result resumeExec step isolateMode mbCnt r = do hsc_env <- getSession let ic = hsc_IC hsc_env @@ -438,7 +446,7 @@ resumeExec step isolateMode mbCnt r = do case r of Resume { resumeStmt = expr - , resumeContext = fhv + , resumeContext = rtid , resumeBindings = bindings , resumeFinalIds = final_ids , resumeApStack = apStack @@ -454,17 +462,19 @@ resumeExec step isolateMode mbCnt r = do let eval_opts = initEvalOpts dflags (enableGhcStepMode step) (enableIsolateThreadBreaks isolateMode) - status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv - let prevHistoryLst = fromListBL 50 hist - hug = hsc_HUG hsc_env - hist' = case mb_brkpt of - Nothing -> pure prevHistoryLst - Just bi - | breakHere False step span -> do - hist1 <- liftIO (mkHistory hug apStack bi) - return $ hist1 `consBL` fromListBL 50 hist - | otherwise -> pure prevHistoryLst - handleRunStatus step eval_opts expr bindings final_ids status =<< hist' + liftIO $ GHCi.resumeStmt interp eval_opts rtid + pure $ do + status <- liftIO $ GHCi.waitThreadResult interp rtid + let prevHistoryLst = fromListBL 50 hist + hug = hsc_HUG hsc_env + hist' = case mb_brkpt of + Nothing -> pure prevHistoryLst + Just bi + | breakHere False step span -> do + hist1 <- liftIO (mkHistory hug apStack bi) + return $ hist1 `consBL` fromListBL 50 hist + | otherwise -> pure prevHistoryLst + handleRunStatus step eval_opts expr bindings final_ids status =<< hist' setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157 setupBreakpoint interp ibi cnt = do @@ -1275,7 +1285,9 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do updateFixityEnv fix_env let eval_opts = initEvalOpts dflags EvalStepNone True - status <- liftIO $ evalStmt interp eval_opts (EvalThis hvals_io) + status <- liftIO $ do + rtid <- evalStmt interp eval_opts (EvalThis hvals_io) + waitThreadResult interp rtid case status of EvalComplete _ (EvalSuccess [hval]) -> return hval EvalComplete _ (EvalException e) -> ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -11,6 +11,7 @@ module GHC.Runtime.Interpreter , evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..) , resumeStmt , abandonStmt + , waitThreadResult , evalIO , evalString , evalStringToIOString @@ -286,11 +287,11 @@ evalStmt :: Interp -> EvalOpts -> EvalExpr ForeignHValue - -> IO (EvalStatus_ [ForeignHValue] [HValueRef]) + -> IO (ForeignRef ThreadId) evalStmt interp opts foreign_expr = do - status <- withExpr foreign_expr $ \expr -> + r <- withExpr foreign_expr $ \expr -> interpCmd interp (EvalStmt opts expr) - handleEvalStatus interp status + mkFinalizedHValue interp r where withExpr :: EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a withExpr (EvalThis fhv) cont = @@ -304,17 +305,25 @@ resumeStmt :: Interp -> EvalOpts -> ForeignRef ThreadId - -> IO (EvalStatus_ [ForeignHValue] [HValueRef]) + -> IO () resumeStmt interp opts resume_tid = do - status <- withForeignRef resume_tid $ \rhv -> + withForeignRef resume_tid $ \rhv -> interpCmd interp (ResumeStmt opts rhv) - handleEvalStatus interp status abandonStmt :: Interp -> ForeignRef ThreadId -> IO () abandonStmt interp resume_tid = withForeignRef resume_tid $ \rhv -> interpCmd interp (AbandonStmt rhv) +waitThreadResult + :: Interp + -> ForeignRef ThreadId + -> IO (EvalStatus_ [ForeignHValue] [HValueRef]) +waitThreadResult interp tid = do + status <- withForeignRef tid $ \rhv -> do + interpCmd interp (WaitThreadResult rhv) + handleEvalStatus interp status + handleEvalStatus :: Interp -> EvalStatus [HValueRef] @@ -417,8 +426,9 @@ whereFrom interp ref = seqHValue :: Interp -> UnitEnv -> Logger -> ForeignHValue -> IO (EvalResult ()) seqHValue interp unit_env logger ref = withForeignRef ref $ \hval -> do - status <- interpCmd interp (Seq hval) - handleSeqHValueStatus interp unit_env logger status + rtid <- interpCmd interp (Seq hval) + status <- interpCmd interp (WaitThreadResult rtid) + handleSeqHValueStatus interp unit_env logger (clearEvalStatus status) evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId evalBreakpointToId eval_break = @@ -460,9 +470,10 @@ handleSeqHValueStatus interp unit_env logger eval_status = Just modbreaks -> put =<< getBreakLoc (readIModModBreaks hug) ibi modbreaks -- resume the seq (:force) processing in the iserv process - withForeignRef resume_ctxt_fhv $ \hval -> do - status <- interpCmd interp (ResumeSeq hval) - handleSeqHValueStatus interp unit_env logger status + withForeignRef resume_ctxt_fhv $ \rtid -> do + interpCmd interp (ResumeSeq rtid) + status <- interpCmd interp (WaitThreadResult rtid) + handleSeqHValueStatus interp unit_env logger (clearEvalStatus status) (EvalComplete _ r) -> return r @@ -626,11 +637,9 @@ spawnIServ conf = do [] (iservConfOpts conf) interpPipe <- mkPipeFromHandles rh wh - lock <- newMVar () let process = InterpProcess { interpHandle = ph , interpPipe - , interpLock = lock } pending_frees <- newMVar [] @@ -771,3 +780,9 @@ readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaks fromEvalResult :: EvalResult a -> IO a fromEvalResult (EvalException e) = throwIO (fromSerializableException e) fromEvalResult (EvalSuccess a) = return a + +clearEvalStatus :: EvalStatus a -> EvalStatus () +clearEvalStatus = \case + EvalComplete w (EvalException se) -> EvalComplete w (EvalException se) + EvalComplete w (EvalSuccess _) -> EvalComplete w (EvalSuccess ()) + EvalBreak ap mb rt rccs -> EvalBreak ap mb rt rccs ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -127,11 +127,9 @@ startTHRunnerProcess interp_js settings = do std_in <- readIORef interp_in interpPipe <- mkPipeFromHandles rh wh - lock <- newMVar () let proc = InterpProcess { interpHandle = hdl , interpPipe - , interpLock = lock } pure (std_in, proc) @@ -382,7 +380,7 @@ jsLinkPlan logger tmpfs tmp_dir ar_cache link_cfg cfg inst link_plan = do -- Haskell server. server_started <- jsServerStarted <$> readMVar (instJSState (instExtra inst)) if server_started - then sendMessageNoResponse inst $ LoadObj all_js + then sendMessage inst $ LoadObj all_js else jsLoadFile inst all_js ---------------------------------------------------------------- ===================================== compiler/GHC/Runtime/Interpreter/Process.hs ===================================== @@ -2,16 +2,7 @@ module GHC.Runtime.Interpreter.Process ( -- * Message API Message(..) - , DelayedResponse (..) - -- * Top-level message API (these acquire/release a lock) , sendMessage - , sendMessageNoResponse - , sendMessageDelayedResponse - , receiveDelayedResponse - -- * Nested message API (these require the interpreter to already be locked) - , sendAnyValue - , receiveAnyValue - , receiveTHMessage ) where @@ -27,79 +18,13 @@ import GHC.Utils.Exception as Ex import Data.Binary import System.Exit import System.Process -import Control.Concurrent.MVar (MVar, withMVar, takeMVar, putMVar, isEmptyMVar) - -data DelayedResponse a = DelayedResponse -- ----------------------------------------------------------------------------- -- Top-level Message API --- | Send a message to the interpreter process that doesn't expect a response --- (locks the interpreter while sending) -sendMessageNoResponse :: ExtInterpInstance d -> Message () -> IO () -sendMessageNoResponse i m = - withLock i $ writeInterpProcess (instProcess i) (putMessage m) - --- | Send a message to the interpreter that expects a response --- (locks the interpreter while until the response is received) +-- | Send a message to the interpreter and expect a response, blocking until it arrives. sendMessage :: Binary a => ExtInterpInstance d -> Message a -> IO a -sendMessage i m = withLock i $ callInterpProcess (instProcess i) m - --- | Send a message to the interpreter process whose response is expected later --- --- This is useful to avoid forgetting to receive the value and to ensure that --- the type of the response isn't lost. Use receiveDelayedResponse to read it. --- (locks the interpreter until the response is received using --- `receiveDelayedResponse`) -sendMessageDelayedResponse :: ExtInterpInstance d -> Message a -> IO (DelayedResponse a) -sendMessageDelayedResponse i m = do - lock i - writeInterpProcess (instProcess i) (putMessage m) - pure DelayedResponse - --- | Expect a delayed result to be received now -receiveDelayedResponse :: Binary a => ExtInterpInstance d -> DelayedResponse a -> IO a -receiveDelayedResponse i DelayedResponse = do - ensureLocked i - r <- readInterpProcess (instProcess i) get - unlock i - pure r - --- ----------------------------------------------------------------------------- --- Nested Message API - --- | Send any value (requires locked interpreter) -sendAnyValue :: Binary a => ExtInterpInstance d -> a -> IO () -sendAnyValue i m = ensureLocked i >> writeInterpProcess (instProcess i) (put m) - --- | Expect a value to be received (requires locked interpreter) -receiveAnyValue :: ExtInterpInstance d -> Get a -> IO a -receiveAnyValue i get = ensureLocked i >> readInterpProcess (instProcess i) get - --- | Wait for a Template Haskell message (requires locked interpreter) -receiveTHMessage :: ExtInterpInstance d -> IO THMsg -receiveTHMessage i = ensureLocked i >> receiveAnyValue i getTHMessage - --- ----------------------------------------------------------------------------- - -getLock :: ExtInterpInstance d -> MVar () -getLock = interpLock . instProcess - -withLock :: ExtInterpInstance d -> IO a -> IO a -withLock i f = withMVar (getLock i) (const f) - -lock :: ExtInterpInstance d -> IO () -lock i = takeMVar (getLock i) - -unlock :: ExtInterpInstance d -> IO () -unlock i = putMVar (getLock i) () - -ensureLocked :: ExtInterpInstance d -> IO () -ensureLocked i = - isEmptyMVar (getLock i) >>= \case - False -> panic "ensureLocked: external interpreter not locked" - _ -> pure () - +sendMessage i m = callInterpProcess (instProcess i) m -- | Send a 'Message' and receive the response from the interpreter process callInterpProcess :: Binary a => InterpProcess -> Message a -> IO a @@ -107,18 +32,6 @@ callInterpProcess i msg = remoteCall (interpPipe i) msg `catchException` \(e :: SomeException) -> handleInterpProcessFailure i e --- | Read a value from the interpreter process -readInterpProcess :: InterpProcess -> Get a -> IO a -readInterpProcess i get = - readPipe (interpPipe i) get - `catchException` \(e :: SomeException) -> handleInterpProcessFailure i e - --- | Send a value to the interpreter process -writeInterpProcess :: InterpProcess -> Put -> IO () -writeInterpProcess i put = - writePipe (interpPipe i) put - `catchException` \(e :: SomeException) -> handleInterpProcessFailure i e - handleInterpProcessFailure :: InterpProcess -> SomeException -> IO a handleInterpProcessFailure i e = do let hdl = interpHandle i ===================================== compiler/GHC/Runtime/Interpreter/Types.hs ===================================== @@ -111,7 +111,6 @@ type WasmInterp = ExtInterpState WasmInterpConfig () data InterpProcess = InterpProcess { interpPipe :: !Pipe -- ^ Pipe to communicate with the server , interpHandle :: !ProcessHandle -- ^ Process handle of the server - , interpLock :: !(MVar ()) -- ^ Lock to prevent concurrent access to the stream } -- | Status of an external interpreter ===================================== compiler/GHC/Runtime/Interpreter/Wasm.hs ===================================== @@ -73,14 +73,12 @@ spawnWasmInterp WasmInterpConfig {..} = do hSetBuffering rh NoBuffering interpPipe <- mkPipeFromHandles rh wh pending_frees <- newMVar [] - lock <- newMVar () pure $ ExtInterpInstance { instProcess = InterpProcess { interpHandle = ph, - interpPipe, - interpLock = lock + interpPipe }, instPendingFrees = pending_frees, instExtra = () ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -12,7 +12,7 @@ module GHCi.Message ( Message(..), Msg(..) , ConInfoTable(..) - , THMessage(..), THMsg(..) + , THMessage(..) -- , THMsg(..) , QResult(..) , EvalStatus_(..,EvalBreak), EvalStatus, EvalResult(..), EvalOpts(..), EvalExpr(..) , EvalBreak(..), EvalBreakpoint (..) @@ -20,7 +20,7 @@ module GHCi.Message , toSerializableException, fromSerializableException , THResult(..), THResultType(..) , QState(..) - , getMessage, putMessage, getTHMessage, putTHMessage + , getMessage, putMessage, {- getTHMessage, -} putTHMessage , Pipe, mkPipeFromHandles, mkPipeFromContinuations, remoteCall, remoteTHCall, readPipe, writePipe , BreakModule , BreakUnitId @@ -62,6 +62,8 @@ import Data.Dynamic import Data.Typeable (TypeRep) import Data.IORef import Data.Map (Map) +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap import Foreign import GHC.Generics import GHC.Stack.CCS @@ -70,6 +72,7 @@ import qualified GHC.Boot.TH.Monad as TH import System.Exit import System.IO import System.IO.Error +import Control.Monad -- ----------------------------------------------------------------------------- -- The RPC protocol between GHC and the interactive server @@ -132,13 +135,13 @@ data Message a where EvalStmt :: EvalOpts -> EvalExpr HValueRef {- IO [a] -} - -> Message (EvalStatus [HValueRef]) {- [a] -} + -> Message (RemoteRef ThreadId) {- [a] -} -- | Resume evaluation of a statement after a breakpoint ResumeStmt :: EvalOpts -> RemoteRef ThreadId - -> Message (EvalStatus [HValueRef]) + -> Message () -- | Abandon evaluation of a statement after a breakpoint AbandonStmt @@ -240,12 +243,23 @@ data Message a where -- | Evaluate something. This is used to support :force in GHCi. Seq :: HValueRef - -> Message (EvalStatus ()) + -> Message (RemoteRef ThreadId) -- | Resume forcing a free variable in a breakpoint (#2950) ResumeSeq :: RemoteRef ThreadId - -> Message (EvalStatus ()) + -> Message () + + WaitThreadResult + :: RemoteRef ThreadId + -> Message (EvalStatus [HValueRef]) + + WaitAnyThreadBreak + :: Message EvalBreak + + WaitThreadResultOrAnyThreadBreak + :: RemoteRef ThreadId + -> Message (EvalStatus [HValueRef]) -- | User-defined request encoded as a tag/payload pair. This is left -- uninterpreted by GHC and is meant for GHC API applications to be able to supply @@ -323,40 +337,40 @@ data THMessage a where deriving instance Show (THMessage a) -data THMsg = forall a . (Binary a, Show a) => THMsg (THMessage a) - -getTHMessage :: Get THMsg -getTHMessage = do - b <- getWord8 - case b of - 0 -> THMsg <$> NewName <$> get - 1 -> THMsg <$> (Report <$> get <*> get) - 2 -> THMsg <$> (LookupName <$> get <*> get) - 3 -> THMsg <$> Reify <$> get - 4 -> THMsg <$> ReifyFixity <$> get - 5 -> THMsg <$> (ReifyInstances <$> get <*> get) - 6 -> THMsg <$> ReifyRoles <$> get - 7 -> THMsg <$> (ReifyAnnotations <$> get <*> get) - 8 -> THMsg <$> ReifyModule <$> get - 9 -> THMsg <$> ReifyConStrictness <$> get - 10 -> THMsg <$> AddDependentFile <$> get - 11 -> THMsg <$> AddTempFile <$> get - 12 -> THMsg <$> AddTopDecls <$> get - 13 -> THMsg <$> (IsExtEnabled <$> get) - 14 -> THMsg <$> return ExtsEnabled - 15 -> THMsg <$> return StartRecover - 16 -> THMsg <$> EndRecover <$> get - 17 -> THMsg <$> return FailIfErrs - 18 -> return (THMsg RunTHDone) - 19 -> THMsg <$> AddModFinalizer <$> get - 20 -> THMsg <$> (AddForeignFilePath <$> get <*> get) - 21 -> THMsg <$> AddCorePlugin <$> get - 22 -> THMsg <$> ReifyType <$> get - 23 -> THMsg <$> (PutDoc <$> get <*> get) - 24 -> THMsg <$> GetDoc <$> get - 25 -> THMsg <$> return GetPackageRoot - 26 -> THMsg <$> AddDependentDirectory <$> get - n -> error ("getTHMessage: unknown message " ++ show n) +-- data THMsg = forall a . (Binary a, Show a) => THMsg (THMessage a) +-- +-- getTHMessage :: Get THMsg +-- getTHMessage = do +-- b <- getWord8 +-- case b of +-- 0 -> THMsg <$> NewName <$> get +-- 1 -> THMsg <$> (Report <$> get <*> get) +-- 2 -> THMsg <$> (LookupName <$> get <*> get) +-- 3 -> THMsg <$> Reify <$> get +-- 4 -> THMsg <$> ReifyFixity <$> get +-- 5 -> THMsg <$> (ReifyInstances <$> get <*> get) +-- 6 -> THMsg <$> ReifyRoles <$> get +-- 7 -> THMsg <$> (ReifyAnnotations <$> get <*> get) +-- 8 -> THMsg <$> ReifyModule <$> get +-- 9 -> THMsg <$> ReifyConStrictness <$> get +-- 10 -> THMsg <$> AddDependentFile <$> get +-- 11 -> THMsg <$> AddTempFile <$> get +-- 12 -> THMsg <$> AddTopDecls <$> get +-- 13 -> THMsg <$> (IsExtEnabled <$> get) +-- 14 -> THMsg <$> return ExtsEnabled +-- 15 -> THMsg <$> return StartRecover +-- 16 -> THMsg <$> EndRecover <$> get +-- 17 -> THMsg <$> return FailIfErrs +-- 18 -> return (THMsg RunTHDone) +-- 19 -> THMsg <$> AddModFinalizer <$> get +-- 20 -> THMsg <$> (AddForeignFilePath <$> get <*> get) +-- 21 -> THMsg <$> AddCorePlugin <$> get +-- 22 -> THMsg <$> ReifyType <$> get +-- 23 -> THMsg <$> (PutDoc <$> get <*> get) +-- 24 -> THMsg <$> GetDoc <$> get +-- 25 -> THMsg <$> return GetPackageRoot +-- 26 -> THMsg <$> AddDependentDirectory <$> get +-- n -> error ("getTHMessage: unknown message " ++ show n) putTHMessage :: THMessage a -> Put putTHMessage m = case m of @@ -719,11 +733,27 @@ serializeBCOs rbcos = parMap doChunk (chunkList 100 rbcos) -- ----------------------------------------------------------------------------- -- Reading/writing messages +type CorrelationId = Int +data Request = Request !CorrelationId Msg +data Reply = Reply !CorrelationId LB.ByteString + +instance Binary Request where + put (Request i (Msg m)) = put i >> putMessage m + get = Request <$> get <*> getMessage + +instance Binary Reply where + put (Reply i bs) = put i >> put bs + get = Reply <$> get <*> get + -- | An opaque pipe for bidirectional binary data transmission. data Pipe = Pipe - { getSome :: !(IO ByteString) - , putAll :: !(B.Builder -> IO ()) - , pipeLeftovers :: !(IORef (Maybe ByteString)) + { getSome :: !(IO ByteString) + , putAll :: !(B.Builder -> IO ()) + , pipeLeftovers :: !(IORef (Maybe ByteString)) + , pipeLock :: !(MVar ()) -- ^ Lock to prevent concurrent access to the stream + , pipePending :: !(IORef (IntMap (MVar LB.ByteString))) + , pipeDrainThread :: !(MVar ThreadId) + , pipeNextReq :: !(IORef Int) } -- | Make a 'Pipe' from a 'Handle' to read and a 'Handle' to write. @@ -733,30 +763,59 @@ mkPipeFromHandles pipeRead pipeWrite = do putAll b = do B.hPutBuilder pipeWrite b hFlush pipeWrite - pipeLeftovers <- newIORef Nothing - pure $ Pipe { getSome, putAll, pipeLeftovers } + mkPipeFromContinuations getSome putAll -- | Make a 'Pipe' from a reader function and a writer function. mkPipeFromContinuations :: IO ByteString -> (B.Builder -> IO ()) -> IO Pipe mkPipeFromContinuations getSome putAll = do - pipeLeftovers <- newIORef Nothing - pure $ Pipe { getSome, putAll, pipeLeftovers } + pipeLeftovers <- newIORef Nothing + pipeLock <- newMVar () + pipePending <- newIORef IntMap.empty + pipeDrainThread <- newEmptyMVar + pipeNextReq <- newIORef 0 + let p = Pipe { .. } + + -- Fork thread to drain read end. + drainTid <- forkIO (drainPipe p) + putMVar pipeDrainThread drainTid + -- todo: proper thread clean up and no leaks -remoteCall :: Binary a => Pipe -> Message a -> IO a + pure p + +remoteCall :: (Show a, Binary a) => Pipe -> Message a -> IO a remoteCall pipe msg = do - writePipe pipe (putMessage msg) - readPipe pipe get -writePipe :: Pipe -> Put -> IO () -writePipe Pipe{..} put = putAll $ execPut put + -- Mark pending + uq <- freshReqId pipe + wv <- newEmptyMVar + atomicModifyIORef' (pipePending pipe) $ + \m -> (IntMap.insert uq wv m, ()) + + -- Write request + writePipe pipe (put (Request uq (Msg msg))) + + -- Block waiting for reply + runGet get <$> takeMVar wv remoteTHCall :: Binary a => Pipe -> THMessage a -> IO a remoteTHCall pipe msg = do writePipe pipe (putTHMessage msg) readPipe pipe get +drainPipe :: Pipe -> IO () +drainPipe p = forever $ do + Reply uq bs <- readPipe p get + wv <- atomicModifyIORef' (pipePending p) $ \m -> do + case IntMap.lookup uq m of + Nothing -> error "drainPipe: Received reply to no pending request" + Just wv -> (IntMap.delete uq m, wv) + putMVar wv bs -- signal matching request + +writePipe :: Pipe -> Put -> IO () +writePipe p@Pipe{..} put = withLock p $ putAll $ execPut put + readPipe :: Pipe -> Get a -> IO a -readPipe Pipe{..} get = do +readPipe p@Pipe{..} get = withLock p $ do leftovers <- readIORef pipeLeftovers m <- getBin getSome get leftovers case m of @@ -786,3 +845,9 @@ getBin getsome get leftover = go leftover (runGetIncremental get) else go Nothing (fun (Just b)) go _lft (Fail _rest _off str) = throwIO (ErrorCall ("getBin: " ++ str)) + +withLock :: Pipe -> IO c -> IO c +withLock Pipe{..} = bracket (takeMVar pipeLock) (putMVar pipeLock) . const + +freshReqId :: Pipe -> IO Int +freshReqId Pipe{pipeNextReq} = atomicModifyIORef' pipeNextReq $ \i -> (i+1, i) ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -128,6 +128,15 @@ run m = case m of Seq ref -> doSeq ref ResumeSeq ref -> resumeSeq ref + WaitThreadResult tid -> localRef tid >>= atomically . readThreadEvalStatus + WaitAnyThreadBreak -> atomically $ readAnyThreadEvalBreak + WaitThreadResultOrAnyThreadBreak t -> do + tid <- localRef t + atomically $ + readThreadEvalStatus tid + `orElse` + (EvalPaused <$> readAnyThreadEvalBreak) + Shutdown -> unexpectedMessage m RunTH {} -> unexpectedMessage m RunModFinalizers {} -> unexpectedMessage m @@ -206,7 +215,7 @@ tryEval io = do -------------------------------------------------------------------------------- -evalStmt :: EvalOpts -> EvalExpr HValueRef -> IO (EvalStatus [HValueRef]) +evalStmt :: EvalOpts -> EvalExpr HValueRef -> IO (RemoteRef ThreadId) evalStmt opts expr = do io <- mkIO expr sandboxIO opts $ do @@ -248,16 +257,16 @@ evalStringToString r str = do -- The UI process has more and therefore also can show more -- information about the breakpoint than the current iserv -- process. -doSeq :: RemoteRef a -> IO (EvalStatus ()) -doSeq ref = clearEvalStatus <$> do +doSeq :: RemoteRef a -> IO (RemoteRef ThreadId) +doSeq ref = do sandboxIO evalOptsSeq $ do _ <- (void $ evaluate =<< localRef ref) return [] -- | Process a ResumeSeq message. Continue the :force processing #2950 -- after a breakpoint. -resumeSeq :: RemoteRef ThreadId -> IO (EvalStatus ()) -resumeSeq hvref = clearEvalStatus <$> resumeStmt evalOptsSeq hvref +resumeSeq :: RemoteRef ThreadId -> IO () +resumeSeq hvref = resumeStmt evalOptsSeq hvref evalOptsSeq :: EvalOpts evalOptsSeq = EvalOpts @@ -296,15 +305,16 @@ abandonStmt hvref = do -------------------------------------------------------------------------------- -resumeStmt :: EvalOpts -> RemoteRef ThreadId -> IO (EvalStatus [HValueRef]) +resumeStmt :: EvalOpts -> RemoteRef ThreadId -> IO () resumeStmt opts rtid = do resumeThreadId <- localRef rtid ResumeContext{..} <- getThreadResumeContext resumeThreadId - withBreakAction opts resumeThreadId $ \waitForResult -> - mask_ $ do - putMVar resumeBreakMVar () -- this awakens the stopped thread... - redirectInterrupts resumeThreadId $ - waitForResult + setBreakAction opts resumeThreadId -- See Note [TODO: all break options must be set every time] + -- withBreakAction opts resumeThreadId $ \waitForResult -> + -- mask_ $ do + putMVar resumeBreakMVar () -- this awakens the stopped thread... + -- redirectInterrupts resumeThreadId $ + -- waitForResult -- When running a computation, we redirect ^C exceptions to the running -- thread. ToDo: we might want a way to continue even if the target @@ -316,7 +326,7 @@ resumeStmt opts rtid = do -- only while we execute the user's code. We can't afford to lose the final -- putMVar, otherwise deadlock ensues. (#1583, #1922, #1946) -sandboxIO :: EvalOpts -> IO [HValueRef] -> IO (EvalStatus [HValueRef]) +sandboxIO :: EvalOpts -> IO [HValueRef] -> IO (RemoteRef ThreadId) sandboxIO opts io | useSandboxThread opts = do @@ -336,17 +346,31 @@ sandboxIO opts io tid <- forkIO $ do takeMVar wait -- don't run anything in this thread before - -- `withBreakAction` has a chance to set up. + -- `setBreakAction` has a chance to set up. tid <- myThreadId labelThread tid "GHCi sandbox" + + -- WHEN THE THREAD IS FINISHED, write the value itself. + -- + -- we only write the TID status map in two places: + -- + -- When the "main" thread finishes (here) + -- When any thread hits a breakpoint (global break action) unsafeUnmask runIt >>= writeThreadEvalStatus tid + -- TODO: This unsafe-unmask is very dubious. Consult with Andrea. I + -- don't think we should be uninterruptable masking interp commands + -- somewhere else. This should just be runIt? - -- We are running in uninterruptibleMask - withBreakAction opts tid $ \waitForResult -> do - putMVar wait () - redirectInterrupts tid $ unsafeUnmask $ - waitForResult + -- We are running in uninterruptibleMask -- TODO WHY?? + setBreakAction opts tid + putMVar wait () + + mkRemoteRef tid + -- withBreakAction opts tid $ \waitForResult -> do + -- putMVar wait () + -- redirectInterrupts tid $ unsafeUnmask $ + -- waitForResult | otherwise = do @@ -360,7 +384,17 @@ sandboxIO opts io -- tracing, etc.) need the expression to be running in a -- separate thread, so debugging is only enabled when -- using the sandbox. - runIt + tid <- forkIO (pure ()) + runIt >>= writeThreadEvalStatus tid + mkRemoteRef tid + -- We `runIt` on the main thread, but fork a new thread to store to the + -- result with `writeThreadEvalStatus` to fit the asynchronous API. We + -- can't use myThreadId because if the user happens to runIt twice + -- before awaiting, the second result will clobber the first. + + -- TODO We have to be careful evacuating this map bc there may be + -- uncollected results from finished threads. So the thread map can't + -- be weak refs ? Or maybe because of the RemoteRef it's fine. Ah, prob. where runIt = measureAlloc $ tryEval $ rethrow opts $ clearCCS io @@ -415,12 +449,16 @@ sandboxIO opts io -- whenever "main" or one of the threads spawned by "main" hit a breakpoint, -- rather than just "main" being observed. This should be used for the main -- debuggee execution of a debugger. -withBreakAction :: EvalOpts -> ThreadId -> (IO (EvalStatus [HValueRef]) -> IO a) -> IO a -withBreakAction opts tid@(ThreadId tid#) act = do +-- withBreakAction :: EvalOpts -> ThreadId -> (IO (EvalStatus [HValueRef]) -> IO a) -> IO a +-- withBreakAction opts tid@(ThreadId tid#) act = do + +setBreakAction :: EvalOpts -> ThreadId -> IO () +setBreakAction opts tid@(ThreadId tid#) = do ctx <- getThreadResumeContext tid - bracket (setBreakAction ctx) (resetBreakAction ctx) (\_ -> act (waitForResult ctx)) + setBreakAction' ctx + -- bracket _ (resetBreakAction ctx) (\_ -> act (waitForResult ctx)) where - setBreakAction ctx = do + setBreakAction' ctx = do -- TODO: TERRIBLY NOT MULTI-THREAD FRIENDLY. Each thread needs its own RTS flag exceptionFlag, like we have for step-in or step-out. runIf breakOnException $ \_ -> poke exceptionFlag 1 -- Breaking on exceptions is not enabled by default, since it @@ -433,7 +471,7 @@ withBreakAction opts tid@(ThreadId tid#) act = do runIfCtx ctx isolateThreadBreaks setIsolatedCtx resetBreakAction ctx () = do - poke exceptionFlag 0 + poke exceptionFlag 0 -- just wrong, expection flag should be per-thread rts_disableStopAfterReturn tid# rts_disableStopNextBreakpoint tid# runIfCtx ctx isolateThreadBreaks unsetIsolatedCtx @@ -485,9 +523,3 @@ redirectInterrupts target wait = do Nothing -> wait Just target -> do throwTo target (e :: SomeException); wait -clearEvalStatus :: EvalStatus a -> EvalStatus () -clearEvalStatus = \case - EvalComplete w (EvalException se) -> EvalComplete w (EvalException se) - EvalComplete w (EvalSuccess _) -> EvalComplete w (EvalSuccess ()) - EvalBreak ap mb rt rccs -> EvalBreak ap mb rt rccs - ===================================== libraries/ghci/GHCi/Server.hs ===================================== @@ -70,6 +70,14 @@ servWithCustom verbose hook pipe restore customHandler = loop when verbose $ trace ("msg: " ++ (show msg)) case msg of + -- The expressions which block waiting for a result musn't block the + -- server thread, so send them off and notify over the wire when done. + -- + -- The other end (see 'remoteCall') will be processing notifications, and + -- it will use the returned pointer as the index for the matching notification. + WaitThreadResult {} -> forkIO (run msg >>= (notification =<< myThreadId)) >>= reply . mkRemoteRef + WaitAnyThreadBreak {} -> forkIO (run msg >>= (notification =<< myThreadId)) >>= reply . mkRemoteRef + WaitThreadResultOrAnyThreadBreak {} -> forkIO (run msg >>= (notification =<< myThreadId)) >>= reply . mkRemoteRef CustomMessage tag payload -> handleCustom tag payload Shutdown -> return () RunTH st q ty loc -> wrapRunTH $ runTH pipe st q ty loc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7150ad38a9ef92ff9a00e345b5b3f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a7150ad38a9ef92ff9a00e345b5b3f… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0