July 2026 - ghc-commits

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Introduce global unit database cache
by Marge Bot (＠marge-bot) 28 Jul '26

28 Jul '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5d0ab71a by fendor at 2026-07-27T17:31:05-04:00 Introduce global unit database cache As a first step for better sharing of `UnitInfo` across `UnitEnv`, we introduce a new datatype called `ExternalUnitDatabases`. It primarily serves as an in-memory representation of *all* `UnitDatabase`s across `UnitEnv`. This means, if multiple `HomeUnitEnv`s depend on the same database, one way or another, we make sure that we don't parse from disk every time. Instead, we store the in-memory representation in `ExternalUnitDatabases`. `ExternalUnitDatabaseCache` is the equivalent of `ExternalUnitState` in the `UnitEnv`. It is a mutable variable wrapping `ExternalUnitDatabases`. The mutable `ExternalUnitDatabaseCache` is used in `initUnits` to make sure we don't parse the same unit database multiple times. Almost by accident, we change the semantics of `initUnits` to honour modifications to `packageDBFlags`. The inability to change `packageDBFlags` while also reusing the already parsed `UnitDatabase`s was reported in #26423 as a bug. Hence, we think this behaviour change is warranted and acceptable, especially since it comes with a breaking change to the `initUnits` API. Add regression test for #26423 Closes #26423 - - - - - 6cce494a by fendor at 2026-07-27T17:31:05-04:00 Introduce UnitIndex for global external unit caching `UnitInfo`s have been observed to cause a lot of memory usage in #27500. Especially with multiple home units, as the same (external) units are processed from scratch, even though most of the time we end up with exactly the same `UnitInfo`. We introduce a `UnitEnv` global cache that allows us to store external unit information that is used across all `HomeUnitEnv`s. The most important change in this commit is the introduction of the `UnitIndex`. It stores a global mapping of `UnitId` -> `UnitInfo`, and `initUnits` always uses the cached `UnitInfo` entry to populate each `HomeUnitEnv`'s `UnitState`. This allows us to ensure the following property: > Each `UnitInfo` should be alive exactly once in GHC. All `UnitState`s should reference 'UnitInfo's stored in the 'UnitIndex'. This ensured by calling 'initUnits' with the 'UnitIndex'. In addition, the `ExternalUnitDatabases` may also hold a reference to each on-disk representation of `UnitInfo`. This means, we impose an hard upper bound on the number of `UnitInfo`s alive in the GHC session: > The number of alive `UnitInfo`s closure objects must be the > sum of all loaded unit database times two. We add performance regression tests that make sure the number of live `UnitInfo` cannot exceed this threshold. Closes #27500 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiComponentModulesRecomp100 mhu-perf LinkableUsage02 ------------------------- These metrics increases are especially notable, as we are not even sharing anything big but merely the global package database with 50 entries. It shows how careful sharing of `UnitInfo` can improve memory usage. We expect this to be much more notable when the whole cabal package database is shared across multiple home units. `LinkableUsage02` metric decreases on unreg and i386 platform, only. --- Technical details To share the `UnitInfo`s correctly, it is important that we extract the `WireMap` into the `UnitIndex`. At the moment of writing, `WireMap` must be globally the same for all `HomeUnitEnv`s. This is important, as we could otherwise not cache the "fully-resolved" `UnitInfo`, as we don't change the `UnitId` or `unitAbiHash` when resolving wired-in units. Thus, there could be ambiguities, when the `WireMap` is not the same for all `UnitState`s across the `UnitEnv`. We consider a `UnitInfo` fully-resolved, if wired-in units have been updated, the `UnitInfo` has been validated and variables in the unit config, such as `${pkgroot}` have been resolved. Updating the wired-in units requires the `WireMap` to be globally the same. - - - - - f8e3bee9 by Zubin Duggal at 2026-07-27T17:31:49-04:00 testsuite: skip runtime stats tests on debugged compilers Debugged flavours build the boot libraries without optimisation, so the runtime numbers do not match the baselines. - - - - - 1e326770 by Zubin Duggal at 2026-07-27T17:31:50-04:00 testsuite: mark #20706 tests fragile rather than broken Whether the static linux linker issues manifest depends on the host toolchain. - - - - - c0b13cbe by Zubin Duggal at 2026-07-27T17:31:50-04:00 testsuite: exclude libnuma from mostly-static It needs static system libraries (libnuma.a) that many platforms do not ship. Fixes #26914 - - - - - 76322136 by Alan Zimmerman at 2026-07-28T10:32:08-04:00 EPA: ClsInstDecl with decls as [LHsDecl GhcPs] in GhcPs Similar to 4fdfe75731e01dad7d7fa474c2703d0d3965afb1, this commit changes the as-parsed representation of class instance declarations to [LHsDecl GhcPs], and only separates them by type from the renamer onward. This also allows us to remove all the AnnSortKey machinery for exact printing, as it is now no longer needed. - - - - - a2e94c6b by Cheng Shao at 2026-07-28T10:32:09-04:00 hadrian: implement and use writeFileAtomic to fix race condition This patch implements `writeFileAtomic` in hadrian and change all invocations of shake non-atomic `writeFile'` to use `writeFileAtomic`, to avoid multiple hadrian concurrent invocations overwriting the same in-tree generated file not in the build root directory. Fixes #27536. Additional notes: - `writeFileChanged`/`writeFileChangedBS` cannot be made atomic since it involves reading the file's older version, so their uses are left alone. It doesn't affect #27536 given their outputs are contained in the build root directory. - It's possible to shrink this patch by only making writes outside the build root directory atomic. But I think it's not worth the effort for fine grained distinction here, and atomic writes within the build root directory should also improve robustness of a hadrian build. - In the longer term we do want to make a ghc build only generate files within the build root directory, though that's a lot of work and outside the scope of this particular bugfix. Co-authored-by: Codex <codex(a)openai.com> - - - - - 100 changed files: - + changelog.d/T26423 - + changelog.d/unit-index - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Hsc.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Stats.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Unit/Env.hs - + compiler/GHC/Unit/External/Database.hs - + compiler/GHC/Unit/External/Index.hs - + compiler/GHC/Unit/External/ModuleOrigin.hs - + compiler/GHC/Unit/External/Providers.hs - + compiler/GHC/Unit/External/Query.hs - + compiler/GHC/Unit/External/Substitution.hs - + compiler/GHC/Unit/External/Validate.hs - + compiler/GHC/Unit/External/Visibility.hs - + compiler/GHC/Unit/External/Wired.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/State.hs-boot - compiler/GHC/Unit/Types.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/ghc.cabal.in - ghc/GHCi/UI.hs - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Nofib.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Rules/SourceDist.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - testsuite/driver/testlib.py - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/driver/T26423/Hello.hs - + testsuite/tests/driver/T26423/Makefile - + testsuite/tests/driver/T26423/T26423.hs - + testsuite/tests/driver/T26423/T26423.stderr - + testsuite/tests/driver/T26423/T26423.stdout - + testsuite/tests/driver/T26423/all.T - + testsuite/tests/driver/T26423/test/Test.hs - + testsuite/tests/driver/T26423/test/test.pkg - + testsuite/tests/driver/TUnitInfo/Foo.hs - + testsuite/tests/driver/TUnitInfo/Makefile - + testsuite/tests/driver/TUnitInfo/all.T - + testsuite/tests/driver/TUnitInfo/genMhu.sh - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-mhu.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-single.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.stdout - testsuite/tests/driver/all.T - testsuite/tests/driver/mostly-static/Makefile - testsuite/tests/ghci/T13786/all.T - testsuite/tests/ghci/linking/all.T - testsuite/tests/ghci/linking/dyn/all.T - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/package/T20010/all.T - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/plugins/all.T - testsuite/tests/printer/Test24533.stdout - testsuite/tests/rts/all.T - testsuite/tests/rts/linker/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2be7ecabcf558c0983c791d3b2fbea… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2be7ecabcf558c0983c791d3b2fbea… 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/supersven/hadrian-cross-stage3] CI: Use final cross stage wording more consistently
by Sven Tennie (＠supersven) 28 Jul '26

28 Jul '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 5fdd888b by GHC GitLab CI at 2026-07-28T16:31:21+02:00 CI: Use final cross stage wording more consistently - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -62,9 +62,9 @@ Common Modes: Environment variables affecting the build: CROSS_TARGET Triple of cross-compilation target. - CROSS_STAGE The stage of the cross-compiler to build either - * 2: Build a normal cross-compiler bindist - * 3: Build a target executable bindist (with the stage2 cross-compiler) + FINAL_CROSS_STAGE The final stage of the cross-compiler to build either + * 2: Build a cross-compiler bindist + * 3: Build a target executable bindist (implies the cross-compiler bindist of 2) VERBOSE Set to non-empty for verbose build output RUNTEST_ARGS Arguments passed to runtest.py TEST_WAYS Testsuite ways to run @@ -573,7 +573,7 @@ function build_hadrian() { export XZ_OPT="${XZ_OPT:-} -T$cores" fi - case "${CROSS_STAGE:-2}" in + case "${FINAL_CROSS_STAGE:-2}" in 2) BINDIST_TARGET="binary-dist";; # Stage2 cross-compiler bindists are (almost) a byproduct of Stage3 # cross-compiled bindists. So, we bundle both of them when the Stage3 @@ -581,10 +581,10 @@ function build_hadrian() { 3) BINDIST_TARGET="binary-dist binary-dist-stage3" if [[ -z "${BIN_DIST_NAME_STAGE3:-}" ]]; then - fail "CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" + fail "FINAL_CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" fi ;; - *) fail "Unknown CROSS_STAGE, must be 2 or 3";; + *) fail "Unknown FINAL_CROSS_STAGE, must be 2 or 3";; esac if [[ -n "${REINSTALL_GHC:-}" ]]; then @@ -598,7 +598,7 @@ function build_hadrian() { *) run_hadrian test:all_deps $BINDIST_TARGET mv _build/bindist/ghc*.tar.xz "$BIN_DIST_NAME.tar.xz" - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then mv _build/bindist-stage3/ghc*.tar.xz "$BIN_DIST_NAME_STAGE3.tar.xz" fi ;; @@ -708,7 +708,7 @@ function test_hadrian() { # > main = putStrLn "hello world" run diff -w expected actual - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then local stage3_dir stage3_dir="$(echo _build/bindist-stage3/ghc-*/)" local stage3_ghc="$stage3_dir/bin/ghc$exe" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -159,7 +159,7 @@ data BuildConfig , withNuma :: Bool , withZstd :: Bool , crossTarget :: Maybe String - , crossStage :: Maybe FinalCrossStage + , finalCrossStage :: Maybe FinalCrossStage , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String , fullyStatic :: Bool @@ -229,7 +229,7 @@ vanilla = BuildConfig , withNuma = False , withZstd = False , crossTarget = Nothing - , crossStage = Nothing + , finalCrossStage = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing , fullyStatic = False @@ -275,7 +275,7 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } --- | The final stage for which binary distrubutions should be built +-- | The final stage for which binary distributions should be built -- -- `Stage2` builds a cross-compiler (build == host, host /= target). `Stage3` -- implies `Stage2` and additionally builds a cross-compiled compiler (build /= @@ -294,7 +294,7 @@ crossConfig :: String -- ^ target triple -> BuildConfig crossConfig triple emulator configure_wrapper crossStage = vanilla { crossTarget = Just triple - , crossStage = Just crossStage + , finalCrossStage = Just crossStage , crossEmulator = emulator , configureWrapper = configure_wrapper } @@ -370,8 +370,7 @@ binDistName :: Arch -> Opsys -> BuildConfig -> String binDistName arch opsys bc = "ghc-" ++ testEnv arch opsys bc -- | The bindist name for the stage3 (target) artifact produced by a combined --- cross job (crossStage == Just 3). This preserves the naming convention --- expected by downstream consumers. +-- cross job (crossStage == Just 3). binDistNameStage3 :: Arch -> Opsys -> BuildConfig -> String binDistNameStage3 arch opsys bc = "ghc-" ++ intercalate "-" (concat [ [ archName arch, opsysName opsys ] @@ -907,7 +906,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } [ opsysVariables arch opsys , "TEST_ENV" =: testEnv arch opsys buildConfig , "BIN_DIST_NAME" =: binDistName arch opsys buildConfig - , if crossStage buildConfig == Just Stage3 + , if finalCrossStage buildConfig == Just Stage3 then "BIN_DIST_NAME_STAGE3" =: binDistNameStage3 arch opsys buildConfig else mempty , "BUILD_FLAVOUR" =: flavourString jobFlavour @@ -916,7 +915,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } , "INSTALL_CONFIGURE_ARGS" =: "--enable-strict-ghc-toolchain-check" , maybe mempty ("CONFIGURE_WRAPPER" =:) (configureWrapper buildConfig) , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe mempty (("CROSS_STAGE" =:) . show . crossStageToInt) (crossStage buildConfig) + , maybe mempty (("FINAL_CROSS_STAGE" =:) . show . crossStageToInt) (finalCrossStage buildConfig) , case crossEmulator buildConfig of NoEmulator -- we need an emulator but it isn't set. Won't run the testsuite @@ -950,7 +949,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } trim = dropWhileEnd isSpace . dropWhile isSpace stage3Artifacts - | crossStage buildConfig == Just Stage3 = + | finalCrossStage buildConfig == Just Stage3 = [binDistNameStage3 arch opsys buildConfig ++ ".tar.xz"] | otherwise = [] @@ -1323,7 +1322,8 @@ cross_jobs = [ -- x86 -> aarch64 validateBuilds Amd64 (Linux Debian13) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing Stage2) - -- x86_64 (build) -> riscv64 (host/target) + -- Stage2: x86_64 (build/host) -> riscv64 (target) + -- Stage3: x86_64 (build) -> riscv64 (host/target) , addValidateRule RiscV (validateBuilds Amd64 (Linux Debian13Riscv) (crossConfig "riscv64-linux-gnu" (Emulator "qemu-riscv64 -L /usr/riscv64-linux-gnu") Nothing Stage3)) -- x86_64 -> loongarch64 ===================================== .gitlab/jobs.yaml ===================================== @@ -319,9 +319,9 @@ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONF_CC_OPTS_STAGE2": "-fuse-ld=/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld --rtlib=compiler-rt", "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-unknown-mingw32", "CXX": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-clang++", + "FINAL_CROSS_STAGE": "2", "HADRIAN_ARGS": "--docs=none", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LD": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld", @@ -403,9 +403,9 @@ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONF_CC_OPTS_STAGE2": "-fuse-ld=/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld --rtlib=compiler-rt", "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-unknown-mingw32", "CXX": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-clang++", + "FINAL_CROSS_STAGE": "2", "HADRIAN_ARGS": "--docs=none", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LD": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld", @@ -1127,9 +1127,9 @@ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONF_CC_OPTS_STAGE2": "-fuse-ld=/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld --rtlib=compiler-rt", "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-unknown-mingw32", "CXX": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-clang++", + "FINAL_CROSS_STAGE": "2", "HADRIAN_ARGS": "--docs=none", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LD": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld", @@ -1212,9 +1212,9 @@ "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONF_CC_OPTS_STAGE2": "-fuse-ld=/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld --rtlib=compiler-rt", "CROSS_EMULATOR": "/opt/wine-arm64ec-msys2-deb12/bin/wine", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-unknown-mingw32", "CXX": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-clang++", + "FINAL_CROSS_STAGE": "2", "HADRIAN_ARGS": "--docs=none", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LD": "/opt/llvm-mingw-linux/bin/aarch64-w64-mingw32-ld", @@ -2010,8 +2010,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -2077,8 +2077,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-int_native-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -2144,8 +2144,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -2212,8 +2212,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_STAGE": "2", "CROSS_TARGET": "javascript-unknown-ghcjs", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate", @@ -2471,8 +2471,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-linux-gnu", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb13-cross_aarch64-linux-gnu-validate", @@ -2797,8 +2797,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", - "CROSS_STAGE": "3", "CROSS_TARGET": "riscv64-linux-gnu", + "FINAL_CROSS_STAGE": "3", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb13-riscv-cross_riscv64-linux-gnu-validate", @@ -3701,8 +3701,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-loongarch64 -L /usr/loongarch64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "loongarch64-linux-gnu", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-ubuntu24_04-loongarch-cross_loongarch64-linux-gnu-validate", @@ -5997,8 +5997,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -6064,8 +6064,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-int_native-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -6131,8 +6131,8 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_23-wasm-unreg-cross_wasm32-wasi-release+host_fully_static+text_simdutf", "BUILD_FLAVOUR": "release+host_fully_static+text_simdutf", "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", - "CROSS_STAGE": "2", "CROSS_TARGET": "wasm32-wasi", + "FINAL_CROSS_STAGE": "2", "FIREFOX_LAUNCH_OPTS": "{\"browser\":\"firefox\",\"executablePath\":\"/usr/bin/firefox\"}", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs --docs=no-sphinx-man", "RUNTEST_ARGS": "", @@ -6198,8 +6198,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_STAGE": "2", "CROSS_TARGET": "javascript-unknown-ghcjs", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate", @@ -6453,8 +6453,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "aarch64-linux-gnu", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb13-cross_aarch64-linux-gnu-validate", @@ -6775,8 +6775,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", - "CROSS_STAGE": "3", "CROSS_TARGET": "riscv64-linux-gnu", + "FINAL_CROSS_STAGE": "3", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-deb13-riscv-cross_riscv64-linux-gnu-validate", @@ -7666,8 +7666,8 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-loongarch64 -L /usr/loongarch64-linux-gnu", - "CROSS_STAGE": "2", "CROSS_TARGET": "loongarch64-linux-gnu", + "FINAL_CROSS_STAGE": "2", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", "TEST_ENV": "x86_64-linux-ubuntu24_04-loongarch-cross_loongarch64-linux-gnu-validate", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5fdd888ba341a0f232f81fda8af783f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5fdd888ba341a0f232f81fda8af783f… 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/supersven/hadrian-cross-stage3] CI: Use final cross stage wording more consistently
by Sven Tennie (＠supersven) 28 Jul '26

28 Jul '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: e41ef1b5 by GHC GitLab CI at 2026-07-28T16:29:02+02:00 CI: Use final cross stage wording more consistently - - - - - 2 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -62,9 +62,9 @@ Common Modes: Environment variables affecting the build: CROSS_TARGET Triple of cross-compilation target. - CROSS_STAGE The stage of the cross-compiler to build either - * 2: Build a normal cross-compiler bindist - * 3: Build a target executable bindist (with the stage2 cross-compiler) + FINAL_CROSS_STAGE The final stage of the cross-compiler to build either + * 2: Build a cross-compiler bindist + * 3: Build a target executable bindist (implies the cross-compiler bindist of 2) VERBOSE Set to non-empty for verbose build output RUNTEST_ARGS Arguments passed to runtest.py TEST_WAYS Testsuite ways to run @@ -573,7 +573,7 @@ function build_hadrian() { export XZ_OPT="${XZ_OPT:-} -T$cores" fi - case "${CROSS_STAGE:-2}" in + case "${FINAL_CROSS_STAGE:-2}" in 2) BINDIST_TARGET="binary-dist";; # Stage2 cross-compiler bindists are (almost) a byproduct of Stage3 # cross-compiled bindists. So, we bundle both of them when the Stage3 @@ -581,10 +581,10 @@ function build_hadrian() { 3) BINDIST_TARGET="binary-dist binary-dist-stage3" if [[ -z "${BIN_DIST_NAME_STAGE3:-}" ]]; then - fail "CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" + fail "FINAL_CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" fi ;; - *) fail "Unknown CROSS_STAGE, must be 2 or 3";; + *) fail "Unknown FINAL_CROSS_STAGE, must be 2 or 3";; esac if [[ -n "${REINSTALL_GHC:-}" ]]; then @@ -598,7 +598,7 @@ function build_hadrian() { *) run_hadrian test:all_deps $BINDIST_TARGET mv _build/bindist/ghc*.tar.xz "$BIN_DIST_NAME.tar.xz" - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then mv _build/bindist-stage3/ghc*.tar.xz "$BIN_DIST_NAME_STAGE3.tar.xz" fi ;; @@ -708,7 +708,7 @@ function test_hadrian() { # > main = putStrLn "hello world" run diff -w expected actual - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then local stage3_dir stage3_dir="$(echo _build/bindist-stage3/ghc-*/)" local stage3_ghc="$stage3_dir/bin/ghc$exe" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -159,7 +159,7 @@ data BuildConfig , withNuma :: Bool , withZstd :: Bool , crossTarget :: Maybe String - , crossStage :: Maybe FinalCrossStage + , finalCrossStage :: Maybe FinalCrossStage , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String , fullyStatic :: Bool @@ -229,7 +229,7 @@ vanilla = BuildConfig , withNuma = False , withZstd = False , crossTarget = Nothing - , crossStage = Nothing + , finalCrossStage = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing , fullyStatic = False @@ -275,7 +275,7 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } --- | The final stage for which binary distrubutions should be built +-- | The final stage for which binary distributions should be built -- -- `Stage2` builds a cross-compiler (build == host, host /= target). `Stage3` -- implies `Stage2` and additionally builds a cross-compiled compiler (build /= @@ -294,7 +294,7 @@ crossConfig :: String -- ^ target triple -> BuildConfig crossConfig triple emulator configure_wrapper crossStage = vanilla { crossTarget = Just triple - , crossStage = Just crossStage + , finalCrossStage = Just crossStage , crossEmulator = emulator , configureWrapper = configure_wrapper } @@ -370,8 +370,7 @@ binDistName :: Arch -> Opsys -> BuildConfig -> String binDistName arch opsys bc = "ghc-" ++ testEnv arch opsys bc -- | The bindist name for the stage3 (target) artifact produced by a combined --- cross job (crossStage == Just 3). This preserves the naming convention --- expected by downstream consumers. +-- cross job (crossStage == Just 3). binDistNameStage3 :: Arch -> Opsys -> BuildConfig -> String binDistNameStage3 arch opsys bc = "ghc-" ++ intercalate "-" (concat [ [ archName arch, opsysName opsys ] @@ -907,7 +906,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } [ opsysVariables arch opsys , "TEST_ENV" =: testEnv arch opsys buildConfig , "BIN_DIST_NAME" =: binDistName arch opsys buildConfig - , if crossStage buildConfig == Just Stage3 + , if finalCrossStage buildConfig == Just Stage3 then "BIN_DIST_NAME_STAGE3" =: binDistNameStage3 arch opsys buildConfig else mempty , "BUILD_FLAVOUR" =: flavourString jobFlavour @@ -916,7 +915,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } , "INSTALL_CONFIGURE_ARGS" =: "--enable-strict-ghc-toolchain-check" , maybe mempty ("CONFIGURE_WRAPPER" =:) (configureWrapper buildConfig) , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe mempty (("CROSS_STAGE" =:) . show . crossStageToInt) (crossStage buildConfig) + , maybe mempty (("FINAL_CROSS_STAGE" =:) . show . crossStageToInt) (finalCrossStage buildConfig) , case crossEmulator buildConfig of NoEmulator -- we need an emulator but it isn't set. Won't run the testsuite @@ -950,7 +949,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } trim = dropWhileEnd isSpace . dropWhile isSpace stage3Artifacts - | crossStage buildConfig == Just Stage3 = + | finalCrossStage buildConfig == Just Stage3 = [binDistNameStage3 arch opsys buildConfig ++ ".tar.xz"] | otherwise = [] @@ -1323,7 +1322,8 @@ cross_jobs = [ -- x86 -> aarch64 validateBuilds Amd64 (Linux Debian13) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing Stage2) - -- x86_64 (build) -> riscv64 (host/target) + -- Stage2: x86_64 (build/host) -> riscv64 (target) + -- Stage3: x86_64 (build) -> riscv64 (host/target) , addValidateRule RiscV (validateBuilds Amd64 (Linux Debian13Riscv) (crossConfig "riscv64-linux-gnu" (Emulator "qemu-riscv64 -L /usr/riscv64-linux-gnu") Nothing Stage3)) -- x86_64 -> loongarch64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e41ef1b5fe957a79cc74622e3f5c580… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e41ef1b5fe957a79cc74622e3f5c580… 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/supersven/hadrian-cross-stage3] CI: Use final cross stage wording more consistently
by Sven Tennie (＠supersven) 28 Jul '26

28 Jul '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: afe16402 by GHC GitLab CI at 2026-07-28T16:24:23+02:00 CI: Use final cross stage wording more consistently - - - - - 2 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -62,9 +62,9 @@ Common Modes: Environment variables affecting the build: CROSS_TARGET Triple of cross-compilation target. - CROSS_STAGE The stage of the cross-compiler to build either - * 2: Build a normal cross-compiler bindist - * 3: Build a target executable bindist (with the stage2 cross-compiler) + FINAL_CROSS_STAGE The final stage of the cross-compiler to build either + * 2: Build a cross-compiler bindist + * 3: Build a target executable bindist (implies the cross-compiler bindist of 2) VERBOSE Set to non-empty for verbose build output RUNTEST_ARGS Arguments passed to runtest.py TEST_WAYS Testsuite ways to run @@ -573,7 +573,7 @@ function build_hadrian() { export XZ_OPT="${XZ_OPT:-} -T$cores" fi - case "${CROSS_STAGE:-2}" in + case "${FINAL_CROSS_STAGE:-2}" in 2) BINDIST_TARGET="binary-dist";; # Stage2 cross-compiler bindists are (almost) a byproduct of Stage3 # cross-compiled bindists. So, we bundle both of them when the Stage3 @@ -581,10 +581,10 @@ function build_hadrian() { 3) BINDIST_TARGET="binary-dist binary-dist-stage3" if [[ -z "${BIN_DIST_NAME_STAGE3:-}" ]]; then - fail "CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" + fail "FINAL_CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" fi ;; - *) fail "Unknown CROSS_STAGE, must be 2 or 3";; + *) fail "Unknown FINAL_CROSS_STAGE, must be 2 or 3";; esac if [[ -n "${REINSTALL_GHC:-}" ]]; then @@ -598,7 +598,7 @@ function build_hadrian() { *) run_hadrian test:all_deps $BINDIST_TARGET mv _build/bindist/ghc*.tar.xz "$BIN_DIST_NAME.tar.xz" - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then mv _build/bindist-stage3/ghc*.tar.xz "$BIN_DIST_NAME_STAGE3.tar.xz" fi ;; @@ -708,7 +708,7 @@ function test_hadrian() { # > main = putStrLn "hello world" run diff -w expected actual - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then local stage3_dir stage3_dir="$(echo _build/bindist-stage3/ghc-*/)" local stage3_ghc="$stage3_dir/bin/ghc$exe" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -159,7 +159,7 @@ data BuildConfig , withNuma :: Bool , withZstd :: Bool , crossTarget :: Maybe String - , crossStage :: Maybe FinalCrossStage + , finalCrossStage :: Maybe FinalCrossStage , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String , fullyStatic :: Bool @@ -229,7 +229,7 @@ vanilla = BuildConfig , withNuma = False , withZstd = False , crossTarget = Nothing - , crossStage = Nothing + , finalCrossStage = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing , fullyStatic = False @@ -275,7 +275,7 @@ static = vanilla { fullyStatic = True } staticNativeInt :: BuildConfig staticNativeInt = static { bignumBackend = Native } --- | The final stage for which binary distrubutions should be built +-- | The final stage for which binary distributions should be built -- -- `Stage2` builds a cross-compiler (build == host, host /= target). `Stage3` -- implies `Stage2` and additionally builds a cross-compiled compiler (build /= @@ -294,7 +294,7 @@ crossConfig :: String -- ^ target triple -> BuildConfig crossConfig triple emulator configure_wrapper crossStage = vanilla { crossTarget = Just triple - , crossStage = Just crossStage + , finalCrossStage = Just crossStage , crossEmulator = emulator , configureWrapper = configure_wrapper } @@ -907,7 +907,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } [ opsysVariables arch opsys , "TEST_ENV" =: testEnv arch opsys buildConfig , "BIN_DIST_NAME" =: binDistName arch opsys buildConfig - , if crossStage buildConfig == Just Stage3 + , if finalCrossStage buildConfig == Just Stage3 then "BIN_DIST_NAME_STAGE3" =: binDistNameStage3 arch opsys buildConfig else mempty , "BUILD_FLAVOUR" =: flavourString jobFlavour @@ -916,7 +916,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } , "INSTALL_CONFIGURE_ARGS" =: "--enable-strict-ghc-toolchain-check" , maybe mempty ("CONFIGURE_WRAPPER" =:) (configureWrapper buildConfig) , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe mempty (("CROSS_STAGE" =:) . show . crossStageToInt) (crossStage buildConfig) + , maybe mempty (("FINAL_CROSS_STAGE" =:) . show . crossStageToInt) (finalCrossStage buildConfig) , case crossEmulator buildConfig of NoEmulator -- we need an emulator but it isn't set. Won't run the testsuite @@ -950,7 +950,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } trim = dropWhileEnd isSpace . dropWhile isSpace stage3Artifacts - | crossStage buildConfig == Just Stage3 = + | finalCrossStage buildConfig == Just Stage3 = [binDistNameStage3 arch opsys buildConfig ++ ".tar.xz"] | otherwise = [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afe16402bca001c5f0ae0bc11ee880b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afe16402bca001c5f0ae0bc11ee880b… 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/supersven/hadrian-cross-stage3] CI: Use final cross stage wording more consistently
by Sven Tennie (＠supersven) 28 Jul '26

28 Jul '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 2c132e4d by GHC GitLab CI at 2026-07-28T16:22:50+02:00 CI: Use final cross stage wording more consistently - - - - - 2 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -62,9 +62,9 @@ Common Modes: Environment variables affecting the build: CROSS_TARGET Triple of cross-compilation target. - CROSS_STAGE The stage of the cross-compiler to build either - * 2: Build a normal cross-compiler bindist - * 3: Build a target executable bindist (with the stage2 cross-compiler) + FINAL_CROSS_STAGE The final stage of the cross-compiler to build either + * 2: Build a cross-compiler bindist + * 3: Build a target executable bindist (implies the cross-compiler bindist of 2) VERBOSE Set to non-empty for verbose build output RUNTEST_ARGS Arguments passed to runtest.py TEST_WAYS Testsuite ways to run @@ -573,7 +573,7 @@ function build_hadrian() { export XZ_OPT="${XZ_OPT:-} -T$cores" fi - case "${CROSS_STAGE:-2}" in + case "${FINAL_CROSS_STAGE:-2}" in 2) BINDIST_TARGET="binary-dist";; # Stage2 cross-compiler bindists are (almost) a byproduct of Stage3 # cross-compiled bindists. So, we bundle both of them when the Stage3 @@ -581,10 +581,10 @@ function build_hadrian() { 3) BINDIST_TARGET="binary-dist binary-dist-stage3" if [[ -z "${BIN_DIST_NAME_STAGE3:-}" ]]; then - fail "CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" + fail "FINAL_CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" fi ;; - *) fail "Unknown CROSS_STAGE, must be 2 or 3";; + *) fail "Unknown FINAL_CROSS_STAGE, must be 2 or 3";; esac if [[ -n "${REINSTALL_GHC:-}" ]]; then @@ -598,7 +598,7 @@ function build_hadrian() { *) run_hadrian test:all_deps $BINDIST_TARGET mv _build/bindist/ghc*.tar.xz "$BIN_DIST_NAME.tar.xz" - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then mv _build/bindist-stage3/ghc*.tar.xz "$BIN_DIST_NAME_STAGE3.tar.xz" fi ;; @@ -708,7 +708,7 @@ function test_hadrian() { # > main = putStrLn "hello world" run diff -w expected actual - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then local stage3_dir stage3_dir="$(echo _build/bindist-stage3/ghc-*/)" local stage3_ghc="$stage3_dir/bin/ghc$exe" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -159,7 +159,7 @@ data BuildConfig , withNuma :: Bool , withZstd :: Bool , crossTarget :: Maybe String - , crossStage :: Maybe FinalCrossStage + , finalCrossStage :: Maybe FinalCrossStage , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String , fullyStatic :: Bool @@ -229,7 +229,7 @@ vanilla = BuildConfig , withNuma = False , withZstd = False , crossTarget = Nothing - , crossStage = Nothing + , finalCrossStage = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing , fullyStatic = False @@ -294,7 +294,7 @@ crossConfig :: String -- ^ target triple -> BuildConfig crossConfig triple emulator configure_wrapper crossStage = vanilla { crossTarget = Just triple - , crossStage = Just crossStage + , finalCrossStage = Just crossStage , crossEmulator = emulator , configureWrapper = configure_wrapper } @@ -907,7 +907,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } [ opsysVariables arch opsys , "TEST_ENV" =: testEnv arch opsys buildConfig , "BIN_DIST_NAME" =: binDistName arch opsys buildConfig - , if crossStage buildConfig == Just Stage3 + , if finalCrossStage buildConfig == Just Stage3 then "BIN_DIST_NAME_STAGE3" =: binDistNameStage3 arch opsys buildConfig else mempty , "BUILD_FLAVOUR" =: flavourString jobFlavour @@ -916,7 +916,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } , "INSTALL_CONFIGURE_ARGS" =: "--enable-strict-ghc-toolchain-check" , maybe mempty ("CONFIGURE_WRAPPER" =:) (configureWrapper buildConfig) , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe mempty (("CROSS_STAGE" =:) . show . crossStageToInt) (crossStage buildConfig) + , maybe mempty (("FINAL_CROSS_STAGE" =:) . show . crossStageToInt) (finalCrossStage buildConfig) , case crossEmulator buildConfig of NoEmulator -- we need an emulator but it isn't set. Won't run the testsuite @@ -950,7 +950,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } trim = dropWhileEnd isSpace . dropWhile isSpace stage3Artifacts - | crossStage buildConfig == Just Stage3 = + | finalCrossStage buildConfig == Just Stage3 = [binDistNameStage3 arch opsys buildConfig ++ ".tar.xz"] | otherwise = [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c132e4db658b422d477a2c527f9406… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c132e4db658b422d477a2c527f9406… 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/supersven/hadrian-cross-stage3] CI: Use final cross stage wording more consistently
by Sven Tennie (＠supersven) 28 Jul '26

28 Jul '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 2c3880a2 by GHC GitLab CI at 2026-07-28T16:16:42+02:00 CI: Use final cross stage wording more consistently - - - - - 2 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -62,9 +62,9 @@ Common Modes: Environment variables affecting the build: CROSS_TARGET Triple of cross-compilation target. - CROSS_STAGE The stage of the cross-compiler to build either - * 2: Build a normal cross-compiler bindist - * 3: Build a target executable bindist (with the stage2 cross-compiler) + FINAL_CROSS_STAGE The final stage of the cross-compiler to build either + * 2: Build a cross-compiler bindist + * 3: Build a target executable bindist (implies the cross-compiler bindist of 2) VERBOSE Set to non-empty for verbose build output RUNTEST_ARGS Arguments passed to runtest.py TEST_WAYS Testsuite ways to run @@ -573,7 +573,7 @@ function build_hadrian() { export XZ_OPT="${XZ_OPT:-} -T$cores" fi - case "${CROSS_STAGE:-2}" in + case "${FINAL_CROSS_STAGE:-2}" in 2) BINDIST_TARGET="binary-dist";; # Stage2 cross-compiler bindists are (almost) a byproduct of Stage3 # cross-compiled bindists. So, we bundle both of them when the Stage3 @@ -581,10 +581,10 @@ function build_hadrian() { 3) BINDIST_TARGET="binary-dist binary-dist-stage3" if [[ -z "${BIN_DIST_NAME_STAGE3:-}" ]]; then - fail "CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" + fail "FINAL_CROSS_STAGE=3 requires BIN_DIST_NAME_STAGE3 to be set" fi ;; - *) fail "Unknown CROSS_STAGE, must be 2 or 3";; + *) fail "Unknown FINAL_CROSS_STAGE, must be 2 or 3";; esac if [[ -n "${REINSTALL_GHC:-}" ]]; then @@ -598,7 +598,7 @@ function build_hadrian() { *) run_hadrian test:all_deps $BINDIST_TARGET mv _build/bindist/ghc*.tar.xz "$BIN_DIST_NAME.tar.xz" - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then mv _build/bindist-stage3/ghc*.tar.xz "$BIN_DIST_NAME_STAGE3.tar.xz" fi ;; @@ -708,7 +708,7 @@ function test_hadrian() { # > main = putStrLn "hello world" run diff -w expected actual - if [[ "${CROSS_STAGE:-2}" == "3" ]]; then + if [[ "${FINAL_CROSS_STAGE:-2}" == "3" ]]; then local stage3_dir stage3_dir="$(echo _build/bindist-stage3/ghc-*/)" local stage3_ghc="$stage3_dir/bin/ghc$exe" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -159,7 +159,7 @@ data BuildConfig , withNuma :: Bool , withZstd :: Bool , crossTarget :: Maybe String - , crossStage :: Maybe FinalCrossStage + , finalCrossStage :: Maybe FinalCrossStage , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String , fullyStatic :: Bool @@ -229,7 +229,7 @@ vanilla = BuildConfig , withNuma = False , withZstd = False , crossTarget = Nothing - , crossStage = Nothing + , finalCrossStage = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing , fullyStatic = False @@ -294,7 +294,7 @@ crossConfig :: String -- ^ target triple -> BuildConfig crossConfig triple emulator configure_wrapper crossStage = vanilla { crossTarget = Just triple - , crossStage = Just crossStage + , finalCrossStage = Just crossStage , crossEmulator = emulator , configureWrapper = configure_wrapper } @@ -907,7 +907,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } [ opsysVariables arch opsys , "TEST_ENV" =: testEnv arch opsys buildConfig , "BIN_DIST_NAME" =: binDistName arch opsys buildConfig - , if crossStage buildConfig == Just Stage3 + , if finalCrossStage buildConfig == Just Stage3 then "BIN_DIST_NAME_STAGE3" =: binDistNameStage3 arch opsys buildConfig else mempty , "BUILD_FLAVOUR" =: flavourString jobFlavour @@ -916,7 +916,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } , "INSTALL_CONFIGURE_ARGS" =: "--enable-strict-ghc-toolchain-check" , maybe mempty ("CONFIGURE_WRAPPER" =:) (configureWrapper buildConfig) , maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig) - , maybe mempty (("CROSS_STAGE" =:) . show . crossStageToInt) (crossStage buildConfig) + , maybe mempty (("FINAL_CROSS_STAGE" =:) . show . crossStageToInt) (finalCrossStage buildConfig) , case crossEmulator buildConfig of NoEmulator -- we need an emulator but it isn't set. Won't run the testsuite @@ -950,7 +950,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } trim = dropWhileEnd isSpace . dropWhile isSpace stage3Artifacts - | crossStage buildConfig == Just Stage3 = + | finalCrossStage buildConfig == Just Stage3 = [binDistNameStage3 arch opsys buildConfig ++ ".tar.xz"] | otherwise = [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c3880a2462c2cf3033102113594748… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c3880a2462c2cf3033102113594748… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/sjakobi/udfm-placement] Use a pigeonhole sort for deterministic UniqDFM iteration
by Simon Jakobi (＠sjakobi) 28 Jul '26

28 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/udfm-placement at Glasgow Haskell Compiler / GHC Commits: b74f794f by Simon Jakobi at 2026-07-28T15:59:47+02:00 Use a pigeonhole sort for deterministic UniqDFM iteration Deterministic UniqDFM iteration used a list mergesort, allocating O(n log n) cons cells and contributing significantly to compiler allocations (#27459). Use a pigeonhole sort where appropriate, while retaining the mergesort fallback. See Note [Sorting a UDFM] and Note [Cost of deterministic iteration]. ------------------------- Metric Decrease: InstanceMatching InstanceMatching1 ManyAlternatives T13719 ------------------------- Assisted-by: gpt-5.6-sol via Codex CLI - - - - - 5 changed files: - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs - compiler/GHC/Data/Word64Map/Strict.hs - compiler/GHC/Data/Word64Map/Strict/Internal.hs - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -170,6 +170,7 @@ module GHC.Data.Word64Map.Internal ( , map , mapWithKey , traverseWithKey + , traverseWithKey_ , traverseMaybeWithKey , mapAccum , mapAccumWithKey @@ -2520,6 +2521,16 @@ traverseWithKey f = go | otherwise = liftA2 (Bin p m) (go l) (go r) {-# INLINE traverseWithKey #-} +-- | $O(n)$. Visit each key\/value pair in ascending key order, discarding +-- the results. +traverseWithKey_ :: Applicative t => (Key -> a -> t ()) -> Word64Map a -> t () +traverseWithKey_ f = go + where + go Nil = pure () + go (Tip k v) = f k v + go (Bin _ _ l r) = go l *> go r +{-# INLINE traverseWithKey_ #-} + -- | $O(n)$. The function @'mapAccum'@ threads an accumulating -- argument through the map in ascending order of keys. -- ===================================== compiler/GHC/Data/Word64Map/Lazy.hs ===================================== @@ -149,6 +149,7 @@ module GHC.Data.Word64Map.Lazy ( , WM.map , mapWithKey , traverseWithKey + , traverseWithKey_ , traverseMaybeWithKey , mapAccum , mapAccumWithKey ===================================== compiler/GHC/Data/Word64Map/Strict.hs ===================================== @@ -166,6 +166,7 @@ module GHC.Data.Word64Map.Strict ( , map , mapWithKey , traverseWithKey + , traverseWithKey_ , traverseMaybeWithKey , mapAccum , mapAccumWithKey ===================================== compiler/GHC/Data/Word64Map/Strict/Internal.hs ===================================== @@ -168,6 +168,7 @@ module GHC.Data.Word64Map.Strict.Internal ( , map , mapWithKey , traverseWithKey + , traverseWithKey_ , traverseMaybeWithKey , mapAccum , mapAccumWithKey @@ -330,6 +331,7 @@ import GHC.Data.Word64Map.Internal , toAscList , toDescList , toList + , traverseWithKey_ , union , unions , withoutKeys ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -14,6 +14,9 @@ See Note [Unique Determinism] in GHC.Types.Unique for explanation why @Unique@ o is not deterministic. -} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + {-# OPTIONS_GHC -Wall #-} module GHC.Types.Unique.DFM ( @@ -79,6 +82,9 @@ import Data.Functor.Classes (Eq1 (..)) import Data.List (sortBy) import Data.Function (on) import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM) +import GHC.Data.SmallArray +import GHC.Exts (State#, build) +import GHC.ST (ST(..), runST) import Unsafe.Coerce import qualified GHC.Data.Word64Set as W @@ -96,10 +102,10 @@ import qualified GHC.Data.Word64Set as W -- This means `alterUDFM` consistent with `addToUDFM` and `adjustUDFM`, -- so that for example `alterUDFM id k = id` and `alterUDFM (fmap f) k = adjustUDFM f k` -- --- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts its result by this serial --- number. So you should only use `UniqDFM` if you need the deterministic --- property. +-- There is an implementation cost: each element is given an insertion tag +-- as it is added, and functions like `udfmToList` or `eltsUDFM` order their +-- results by this tag (see Note [Cost of deterministic iteration]). So you +-- should only use `UniqDFM` if you need the deterministic property. -- -- `foldUDFM` also preserves determinism. -- @@ -112,7 +118,7 @@ import qualified GHC.Data.Word64Set as W -- -- -- There's more than one way to implement this. The implementation here tags --- every value with the insertion time that can later be used to sort the +-- every value with its insertion tag that can later be used to sort the -- values when asked to convert to a list. -- -- Updating an existing key keeps the old tag. This keeps the order stable for @@ -125,7 +131,7 @@ import qualified GHC.Data.Word64Set as W -- -- An alternative would be to have -- --- data UniqDFM ele = UDFM (M.IntMap ele) [ele] +-- data UniqDFM ele = UDFM (Word64Map ele) [ele] -- -- where the list determines the order. This makes deletion tricky as we'd -- only accumulate elements in that list, but makes merging easier as you @@ -133,11 +139,11 @@ import qualified GHC.Data.Word64Set as W -- Deletion can probably be done in amortized fashion when the size of the -- list is twice the size of the set. --- | A type of values tagged with insertion time +-- | A type of values carrying an insertion tag data TaggedVal val = TaggedVal !val - {-# UNPACK #-} !Int -- ^ insertion time + {-# UNPACK #-} !Int -- ^ insertion tag deriving stock (Data, Functor, Foldable, Traversable) taggedFst :: TaggedVal val -> val @@ -159,18 +165,30 @@ instance Eq val => Eq (TaggedVal val) where data UniqDFM key ele = UDFM !(M.Word64Map (TaggedVal ele)) -- A map where keys are Unique's values and - -- values are tagged with insertion time. - -- The invariant is that all the tags will - -- be distinct within a single map - {-# UNPACK #-} !Int -- Upper bound on the values' insertion - -- time. See Note [Overflow on plusUDFM] + -- values carry an insertion tag. + {-# UNPACK #-} !Int -- Upper bound on the values' insertion + -- tags. See Note [Overflow on plusUDFM] + -- See Note [UDFM invariants] deriving (Data, Functor) --- | Deterministic, in O(n log n). +{- Note [UDFM invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~ +In a map (UDFM m ub): + + (a) The insertion tags of the elements of m are distinct. + (b) Every tag lies in [0, ub). + +Consequently ub >= size m. + +The tags determine the order of deterministic iteration (eltsUDFM, +udfmToList). See Note [Sorting a UDFM]. +-} + +-- | Deterministic. See Note [Cost of deterministic iteration]. instance Foldable (UniqDFM key) where foldr = foldUDFM --- | Deterministic, in O(n log n). +-- | Deterministic. See Note [Cost of deterministic iteration]. instance Traversable (UniqDFM key) where traverse f = fmap listToUDFM_Directly . traverse (\(u,a) -> (u,) <$> f a) @@ -264,8 +282,8 @@ plusUDFM_CK f udfml@(UDFM _ i) udfmr@(UDFM _ j) -- Note [Overflow on plusUDFM] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- There are multiple ways of implementing plusUDFM. --- The main problem that needs to be solved is overlap on times of --- insertion between different keys in two maps. +-- The main problem that needs to be solved is overlap on insertion +-- tags between different keys in two maps. -- Consider: -- -- A = fromList [(a, (x, 1))] @@ -325,13 +343,27 @@ elemUDFM :: Uniquable key => key -> UniqDFM key elt -> Bool elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m -- | Performs a deterministic fold over the UniqDFM. --- It's O(n log n) while the corresponding function on `UniqFM` is O(n). +-- +-- O(n) in the common case, with an O(n log n) fallback. +-- +-- See Note [Cost of deterministic iteration]. foldUDFM :: (elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldUDFM #-} --- This INLINE prevents a regression in !10568 -foldUDFM k z m = foldr k z (eltsUDFM m) - --- | Like 'foldUDFM' but the function also receives a key +-- Specialises k and z into M.foldr on the small-map path. +foldUDFM k z (UDFM m ub) + | M.compareSize m 1 /= GT = M.foldr (k . taggedFst) z m + | otherwise = fold_udfm k z m ub + +fold_udfm :: (elt -> a -> a) -> a -> M.Word64Map (TaggedVal elt) -> Int -> a +{-# NOINLINE fold_udfm #-} +-- Kept out of line so that foldUDFM's consumers don't inline the sort machinery. +fold_udfm k z m ub + | usePigeonholeSort m ub = foldr k z (pigeonholeSort ub (\_ tv -> tv) m) + | otherwise = foldr k z (map taggedFst (sort_it m)) + +-- | Like 'foldUDFM' but the function also receives a key. +-- +-- See Note [Cost of deterministic iteration]. foldWithKeyUDFM :: (Unique -> elt -> a -> a) -> a -> UniqDFM key elt -> a {-# INLINE foldWithKeyUDFM #-} -- This INLINE was copied from foldUDFM @@ -346,14 +378,113 @@ nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m where k' acc (TaggedVal v _) = k v acc +{- Note [Cost of deterministic iteration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Deterministic iteration -- foldUDFM, eltsUDFM, udfmToList, and everything +built on them -- orders elements by insertion tag. The element with the +smallest tag can sit anywhere in the map, so every tag must be inspected, +and, given a @UDFM m ub@ on the pigeonhole-sort path, an array with ub slots +must be filled, before the first element can be emitted (see +Note [Sorting a UDFM]). So beyond maps of a single element, deterministic +iteration cannot stream: demanding any of the result processes the whole +map. #27459 shows that cost hitting a consumer that only needed to know +whether the result was non-empty. + +So: to test for emptiness, use isNullUDFM rather than null on eltsUDFM; +for order-oblivious queries, prefer short-circuiting anyUDFM/allUDFM; and +if you don't need the deterministic order at all, use nonDetStrictFoldUDFM. +-} + +-- | Deterministic, in order of insertion. +-- +-- See Note [Sorting a UDFM] and Note [Cost of deterministic iteration]. eltsUDFM :: UniqDFM key elt -> [elt] -{-# INLINE eltsUDFM #-} --- The INLINE makes it a good producer (from the map) -eltsUDFM (UDFM m _i) = map taggedFst (sort_it m) +{-# INLINE eltsUDFM #-} -- so the small case is a good producer + -- This matters for T13719. +eltsUDFM (UDFM m ub) + | M.compareSize m 1 /= GT = build (\c n -> M.foldr (c . taggedFst) n m) + | otherwise = elts_udfm m ub + +elts_udfm :: M.Word64Map (TaggedVal elt) -> Int -> [elt] +{-# NOINLINE elts_udfm #-} +-- Kept out of line so that eltsUDFM's consumers don't inline the sort machinery. +elts_udfm m ub + | usePigeonholeSort m ub = pigeonholeSort ub (\_ tv -> tv) m + | otherwise = map taggedFst (sort_it m) sort_it :: M.Word64Map (TaggedVal elt) -> [TaggedVal elt] sort_it m = sortBy (compare `on` taggedSnd) (M.elems m) + +{- Note [Sorting a UDFM] +~~~~~~~~~~~~~~~~~~~~~~~~ +Deterministic iteration must yield a map's elements in order of their +insertion tags. The obvious way is to sort on the tags, but we can do better: +in (UDFM m ub) the tags are distinct indices into [0, ub) (see +Note [UDFM invariants]), so each element can simply be placed at its own +tag in an ub-slot array, which is then read back in index order. This is +pigeonhole sort, with one element per hole. + +Cost: writing the elements is O(n) for n = M.size m, while allocating the +array and reading it back are O(ub). Since n <= ub the total is O(ub). No +comparisons are made. + +So the method wins only while the array stays dense, and ub never shrinks +(overwrites keep bumping it, delete/filter shrink n but not ub). +usePigeonholeSort therefore takes this path only when ub <= 4 * n, which +bounds its cost at O(n), and falls back to the O(n log n) comparison sort +otherwise. + +Unfilled slots contain a TaggedVal with tag -1 and value +@unsafeCoerce () :: r@. This is safe because the value is never used: only +slots with non-negative tags are read. + +pigeonholeSort also avoids intermediate lists: it fills the array by +traversing the map directly, and emits its readout with 'build', so the foldr +in fold_udfm fuses with it. This contributes significantly to the allocation +reductions in InstanceMatching1 in !16292. +-} + +-- | @ub <= 4 * size m@, computed without a full 'M.size' traversal. +usePigeonholeSort :: M.Word64Map a -> Int -> Bool +usePigeonholeSort m ub = M.compareSize m ceil_ub_div_4 /= LT + where + ceil_ub_div_4 = (ub + 3) `div` 4 -- ceil(ub/4): ub <= 4*n iff n >= ceil(ub/4) + +-- | Order the map's elements by tag. The tags must be distinct and in +-- @[0, ub)@, and @mk@ must preserve them. See Note [Sorting a UDFM]. +pigeonholeSort :: forall e r. Int + -> (M.Key -> TaggedVal e -> TaggedVal r) + -> M.Word64Map (TaggedVal e) + -> [r] +{-# INLINE pigeonholeSort #-} -- Specialise mk and enable foldr/build fusion. +pigeonholeSort ub mk m = build gen + where + -- The tag -1 marks unfilled slots; the value field is never read, but it + -- is strict, so it needs a WHNF value of type r. See Note [Sorting a UDFM]. + hole :: TaggedVal r + hole = TaggedVal (unsafeCoerce ()) (-1) + + fill :: SmallMutableArray s (TaggedVal r) -> State# s -> (# State# s, () #) + fill marr s = case M.traverseWithKey_ write m of ST st -> st s + where + write k tv = ST (\s' -> + (# writeSmallArray marr (taggedSnd tv) (mk k tv) s', () #)) + + gen :: forall b. (r -> b -> b) -> b -> b + gen cons nil = runST (ST (\s0 -> + case newSmallArray ub hole s0 of + (# s1, marr #) -> case fill marr s1 of + (# s2, () #) -> case unsafeFreezeSmallArray marr s2 of + (# s3, arr #) -> (# s3, readout arr 0 #))) + where + readout :: SmallArray (TaggedVal r) -> Int -> b + readout arr j + | j >= ub = nil + | t < 0 = readout arr (j + 1) + | otherwise = cons v (readout arr (j + 1)) + where TaggedVal v t = indexSmallArray arr j + filterUDFM :: (elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i @@ -371,11 +502,22 @@ udfmRestrictKeysSet (UDFM val_set i) set = in UDFM (M.restrictKeys val_set key_set) i -- | Converts `UniqDFM` to a list, with elements in deterministic order. --- It's O(n log n) while the corresponding function on `UniqFM` is O(n). +-- +-- O(n) in the common case, with an O(n log n) fallback. +-- +-- See Note [Cost of deterministic iteration]. udfmToList :: UniqDFM key elt -> [(Unique, elt)] -udfmToList (UDFM m _i) = - [ (mkUniqueGrimily k, taggedFst v) - | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ] +-- NB: no INLINE, unlike eltsUDFM. udfmToList's one hot consumer is +-- traverseUSDFM in the pattern-match checker, which doesn't fuse. Inlining +-- the size dispatch into it regresses T17836. +udfmToList (UDFM m ub) + | M.compareSize m 1 /= GT = + M.foldrWithKey (\k tv r -> (mkUniqueGrimily k, taggedFst tv) : r) [] m + | usePigeonholeSort m ub = pigeonholeSort ub + (\k tv -> TaggedVal (mkUniqueGrimily k, taggedFst tv) (taggedSnd tv)) m + | otherwise = + [ (mkUniqueGrimily k, taggedFst v) + | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ] -- Determines whether two 'UniqDFM's contain the same keys. equalKeysUDFM :: UniqDFM key a -> UniqDFM key b -> Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b74f794f0009e657938b42bf3b50e7c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b74f794f0009e657938b42bf3b50e7c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/andreask/riscv-linker-fix
by Andreas Klebinger (＠AndreasK) 28 Jul '26

28 Jul '26

Andreas Klebinger pushed new branch wip/andreask/riscv-linker-fix at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/riscv-linker-fix You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/uniquedfm-todo
by Zubin (＠wz1000) 28 Jul '26

28 Jul '26

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

1 0

[Git][ghc/ghc][wip/sjakobi/T27368-ppr] Cmm: print unreachable blocks under -dppr-debug (#27368)
by Simon Jakobi (＠sjakobi) 28 Jul '26

28 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/T27368-ppr at Glasgow Haskell Compiler / GHC Commits: 9c0307ff by Simon Jakobi at 2026-07-28T14:43:18+02:00 Cmm: print unreachable blocks under -dppr-debug (#27368) Unreachable blocks linger in a CmmGraph's block map for most of the Cmm pipeline, but pprCmmGraph only ever printed the blocks reachable from the entry, so dumps looked consistent while the graph was not. Bugs like #27368 were hard to debug due to this. pprCmmGraph now appends the stored-but-unreachable blocks under a "// unreachable blocks:" heading when -dppr-debug is on. Existing dumps are unchanged. See Note [unreachable blocks] in GHC.Cmm.Pipeline. Assisted-by: Claude Opus 5 - - - - - 7 changed files: - + changelog.d/T27368-ppr-unreachable-cmm-blocks.md - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/Pipeline.hs - docs/users_guide/debugging.rst - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.cmm - + testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr - testsuite/tests/cmm/should_compile/all.T Changes: ===================================== changelog.d/T27368-ppr-unreachable-cmm-blocks.md ===================================== @@ -0,0 +1,10 @@ +section: cmm +issues: #27368 +mrs: !16417 +synopsis: + Cmm dumps now show unreachable blocks under ``-dppr-debug`` +description: + Unreachable blocks stay in a Cmm graph's block map for most of the Cmm + pipeline, but ``-ddump-cmm-*`` only ever printed the blocks reachable from + the graph's entry. Adding ``-dppr-debug`` now appends the stored but + unreachable blocks, which makes bugs like #27368 visible in the dumps. ===================================== compiler/GHC/Cmm.hs ===================================== @@ -151,15 +151,24 @@ instance OutputableP Platform CmmGraph where toBlockMap :: CmmGraph -> LabelMap CmmBlock toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body +-- | Print the blocks reachable from the entry, in reverse postorder. Under +-- @-dppr-debug@ the blocks that are stored in the graph but unreachable are +-- appended too; see Note [unreachable blocks] in "GHC.Cmm.Pipeline". pprCmmGraph :: Platform -> CmmGraph -> SDoc pprCmmGraph platform g = text "{" <> text "offset" - $$ nest 2 (vcat $ map (pdoc platform) blocks) + $$ nest 2 (vcat (map (pdoc platform) blocks) $$ unreachable) $$ text "}" - where blocks = revPostorder g - -- revPostorder has the side-effect of discarding unreachable code, - -- so pretty-printed Cmm will omit any unreachable blocks. This can - -- sometimes be confusing. + where + blocks = revPostorder g + + unreachable = getPprDebug $ \debug -> + if not debug || mapNull dead_blocks + then empty + else text "// unreachable blocks:" + $$ nest 2 (vcat $ map (pdoc platform) (mapElems dead_blocks)) + + dead_blocks = foldr (mapDelete . entryLabel) (toBlockMap g) blocks revPostorder :: CmmGraph -> [CmmBlock] revPostorder g = {-# SCC "revPostorder" #-} ===================================== compiler/GHC/Cmm/Pipeline.hs ===================================== @@ -357,6 +357,7 @@ containing junk code. These aren't necessarily a problem, but removing them is good because it might save time in the native code generator later. +To make unreachable blocks visible in -ddump-cmm-* output, add -dppr-debug. -} dumpGraph :: Logger -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO () ===================================== docs/users_guide/debugging.rst ===================================== @@ -564,6 +564,11 @@ C-\- representation These flags dump various phases of GHC's C-\- pipeline. +Cmm dumps print the blocks reachable from a graph's entry, in reverse +post-order. Blocks can linger in a graph without being reachable; adding +:ghc-flag:`-dppr-debug` to any of these dump flags additionally prints those, +under a ``// unreachable blocks:`` heading. + .. ghc-flag:: -ddump-cmm-verbose-by-proc :shortdesc: Show output from main C-\- pipeline passes (grouped by proc) :type: dynamic @@ -574,9 +579,6 @@ These flags dump various phases of GHC's C-\- pipeline. the chosen backend. Currently only the NCG backends runs additional passes ( :ghc-flag:`-ddump-opt-cmm` ). - Cmm dumps don't include unreachable blocks since we print - blocks in reverse post-order. - .. ghc-flag:: -ddump-cmm-verbose :shortdesc: Write output from main C-\- pipeline passes to files :type: dynamic ===================================== testsuite/tests/cmm/should_compile/T27368-ppr-debug.cmm ===================================== @@ -0,0 +1,19 @@ +#include "Cmm.h" + +// The block "dead" is stored in the graph but no block branches to it, so it +// only shows up in Cmm dumps under -dppr-debug. +testUnreachable (W_ x) +{ + if (x > 0) { + goto live; + } + return (x); + +dead: + x = x + 42; + return (x); + +live: + x = x - 1; + return (x); +} ===================================== testsuite/tests/cmm/should_compile/T27368-ppr-debug.stderr ===================================== @@ -0,0 +1 @@ +// unreachable blocks: ===================================== testsuite/tests/cmm/should_compile/all.T ===================================== @@ -13,6 +13,9 @@ test('T20725', normal, compile, ['-package ghc']) test('T23610', normal, makefile_test, ['T23610']) test('T24224', [cmm_src, grep_errmsg(r'(F64.*);', [1]), only_ways(['normal'])], compile, ['-no-hs-main -ddump-cmm -dsuppress-all -dsuppress-uniques']) test('T24474', cmm_src, compile, ['-optc-g3']) +# -dppr-debug makes stored-but-unreachable blocks visible in Cmm dumps (#27368) +test('T27368-ppr-debug', [cmm_src, grep_errmsg(r'(// unreachable blocks:)', [1]), only_ways(['normal'])], + compile, ['-no-hs-main -ddump-cmm-verbose-by-proc -dppr-debug -dsuppress-uniques']) test('T24474-cmm-gets-c-opts', cmm_src, compile, ['-optc-DFOO']) test('T24474-cmm-opt-order', cmm_src, compile, ['-optc-DFOO ' '-optCmmP-UFOO ' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c0307ff34b073a17ed7be9b8f9181f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c0307ff34b073a17ed7be9b8f9181f… 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