- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/9.14.2-backports] 2 commits: hadrian: add text and parsec to stage0Packages
by Zubin (＠wz1000) 28 Jul '26

28 Jul '26

Zubin pushed to branch wip/9.14.2-backports at Glasgow Haskell Compiler / GHC Commits: 70252160 by Zubin Duggal at 2026-07-28T21:39:21+05:30 hadrian: add text and parsec to stage0Packages text depends on template-haskell-lift, and template-haskell-lift needs to be built in tree rather than using the boot package, so `text` and `parsec` (which depends on `text`) must also be built in tree rather than copied from the boot pkgdb. Also need to disable -simdutf for text when building the stage0 version, wasm backend doesn't like -simdutf. - - - - - b72a3cb7 by Zubin Duggal at 2026-07-28T21:39:21+05:30 Prepare 9.14.2 Bump filpath submodule to 1.5.5.0 Bump Win32 submodule to 2.14.2.2 Metric Increase: T4029 T13379 haddock.base libdir Metric Decrease: T5030 T24602_perf_size T25046_perf_size_gzip T25046_perf_size_unicode T25046_perf_size_unicode_gzip - - - - - 47 changed files: - − changelog.d/26616 - − changelog.d/T26978 - − changelog.d/T26979 - − changelog.d/T27046 - − changelog.d/T27047 - − changelog.d/T27123.md - − changelog.d/T27124.md - − changelog.d/T27131 - − changelog.d/T27182.md - − changelog.d/T27202 - − changelog.d/T27225 - − changelog.d/T27386 - − changelog.d/bump-process - − changelog.d/deterministic-usage-order - − changelog.d/fix-absent-dict-projection - − changelog.d/fix-blackhole-handling - − changelog.d/fix-cmm-atomic-load-store - − changelog.d/fix-compacting-gc-ap-27434 - − changelog.d/fix-exponential-case-desugar-27383 - − changelog.d/fix-finalizers-27072 - − changelog.d/fix-layout-stack-fcall - − changelog.d/fix-peekitbl-no-tntc - − changelog.d/fix-use-std-ap-thunk - − changelog.d/ghc-pkg-faster-closure - − changelog.d/hadrian-stale-package-confs-26661 - − changelog.d/jobserver-leak-fix - − changelog.d/more-efficient-home-unit-imports-finding - − changelog.d/reexported-module-errors - − changelog.d/semaphore-v2 - − changelog.d/tag-inference-27005 - − changelog.d/unused-type - − changelog.d/wasm-fix-serviceworker - − changelog.d/windows-rethrow-overlapped-exception - configure.ac - docs/users_guide/9.14.2-notes.rst - hadrian/bootstrap/generate_bootstrap_plans - + hadrian/bootstrap/plan-9_10_3.json - + hadrian/bootstrap/plan-9_12_4.json - + hadrian/bootstrap/plan-bootstrap-9_10_3.json - + hadrian/bootstrap/plan-bootstrap-9_12_4.json - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/Win32 - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/filepath The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f3b5006de268c5d4c138d09e51451… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f3b5006de268c5d4c138d09e51451… 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/andreask/arm-ffi] 6 commits: arm64 ncg: Fix truncation/extension logic for genCondJump.
by Andreas Klebinger (＠AndreasK) 28 Jul '26

28 Jul '26

Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC Commits: 0359549b by Andreas Klebinger at 2026-07-27T08:46:24+00:00 arm64 ncg: Fix truncation/extension logic for genCondJump. We used to sign-extend the comparison registers in place which could clobber local variables. - - - - - 5c603651 by Andreas Klebinger at 2026-07-27T21:31:10+00:00 Add test for #27533 In the ticket we observed a single-byte read being implemented as multi-byte read causing issues. - - - - - 2445ef22 by Andreas Klebinger at 2026-07-27T21:32:39+00:00 Added an assert for correct widths to arm64 backend - - - - - 2b8ee333 by Andreas Klebinger at 2026-07-28T06:41:49+00:00 arm64 ncg: Fix MO_V_Broadcast for non-literals. We now use OpReg instead of OpScalarAsVec as required since we broadcast a gp register. Also adds a test. Fixes #27533. - - - - - fca96f28 by Andreas Klebinger at 2026-07-28T08:38:08+00:00 cmmLint: Check address width to be equal to wordWidth. - - - - - e5d9fac3 by Andreas Klebinger at 2026-07-28T15:04:51+00:00 arm64 ncg: Fix subword store/load instructions. We used to read those at 32bit width even for smaller values possibly resulting in invalid memory access. Now we construct the suffix for subword variants based on the instruction format for these. - - - - - 12 changed files: - compiler/GHC/Cmm/Lint.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - + testsuite/tests/codeGen/should_run/T27533.hs - + testsuite/tests/codeGen/should_run/T27533.stdout - + testsuite/tests/codeGen/should_run/T27533_cmm.cmm - testsuite/tests/codeGen/should_run/T27538.hs - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/simd/should_run/T27565.hs - + testsuite/tests/simd/should_run/T27565.stdout - testsuite/tests/simd/should_run/all.T Changes: ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -88,8 +88,9 @@ lintCmmBlock labels block -- byte/word mismatches. lintCmmExpr :: CmmExpr -> CmmLint CmmType -lintCmmExpr (CmmLoad expr rep _alignment) = do - _ <- lintCmmExpr expr +lintCmmExpr e@(CmmLoad expr rep _alignment) = do + ty <- lintCmmExpr expr + lintAddrTy e ty -- Disabled, if we have the inlining phase before the lint phase, -- we can have funny offsets due to pointer tagging. -- EZY -- when (widthInBytes (typeWidth rep) >= platformWordSizeInBytes platform) $ @@ -112,6 +113,15 @@ lintCmmExpr expr = do platform <- getPlatform return (cmmExprType platform expr) +-- We require every address to refer to be word-width since we don't support 32 +-- bit pointers on 64bit platforms. +lintAddrTy :: CmmExpr -> CmmType -> CmmLint () +lintAddrTy e addr_ty = do + p <- getPlatform + -- We don't support any platforms where wordwidth /= ptrWidth currently. + unless (addr_ty `cmmCompatType` bWord p) $ cmmLintErr (text "Non word-width address found in:" <+> pdoc p e) + + -- | Check for obviously out-of-bounds shift operations lintShiftOp :: MachOp -> [(CmmExpr, CmmType)] -> CmmLint () lintShiftOp op [(_, arg_ty), (CmmLit (CmmInt n _), _)] @@ -173,10 +183,10 @@ lintCmmMiddle node = case node of unless (erep `cmmCompatType` reg_ty) $ cmmLintAssignErr (CmmAssign reg expr) erep reg_ty - CmmStore l r _alignment -> do - _ <- lintCmmExpr l - _ <- lintCmmExpr r - return () + CmmStore addr rhs _alignment -> do + addr_ty <- lintCmmExpr addr + _ <- lintCmmExpr rhs + lintAddrTy addr addr_ty CmmUnsafeForeignCall target _formals actuals -> do let lintArg expr = do ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -376,8 +376,10 @@ getRegisterReg platform (CmmGlobal reg@(GlobalRegUse mid _ty)) -- ----------------------------------------------------------------------------- -- General things for putting together code sequences --- | The dual to getAnyReg: compute an expression into a register, but --- we don't mind which one it is. +-- | Computes the register into some register, but we can't pick which one. +-- This means the register might be mapped to a global or local variable and +-- we can only mutate the result reg in place if we know the Cmm expression can't +-- refer to local or global variables. getSomeReg :: CmmExpr -> NatM (Reg, Format, InstrBlock) getSomeReg expr = do r <- getRegister expr @@ -955,7 +957,7 @@ getRegister' config plat expr return $ Fixed (intFormat to) trunc_reg (code `appOL` code_trunc) -- Vector - MO_V_Broadcast l w -> return $ Any fmt (\dst -> code `snocOL` DUP fmt (OpReg vw dst) (OpScalarAsVec w reg)) + MO_V_Broadcast l w -> return $ Any fmt (\dst -> code `snocOL` DUP fmt (OpReg vw dst) (OpReg w reg)) where fmt = VecFormat l (intScalarFormat w) vw = formatToWidth fmt MO_VF_Broadcast l w -> return $ Any fmt (\dst -> code `snocOL` DUP fmt (OpReg vw dst) (OpScalarAsVec w reg)) @@ -1071,7 +1073,7 @@ getRegister' config plat expr in return $ Any (intFormat to) $ \dst -> code `snocOL` SBFM (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt 0)) (toImm (min from to)) `appOL` - -- At this point an 8- or 16-bit value would be sign-extended + -- At this point an 8- or 16-bit value is sign-extended -- to 32-bits. Truncate back down the final width. truncateSubwordRegInplace to dst @@ -1760,7 +1762,7 @@ getRegister' config plat expr tmp <- getNewRegNat format return $ Any format $ \dst -> code_x `appOL` code_y `appOL` - if dst == reg_y + if dst == reg_y --unlike MO_V_Insert here y/dst can overlap. then toOL [ MOV (OpReg W128 tmp) (OpReg W128 reg_x) , INS format (OpVecLane w tmp index) (OpScalarAsVec w reg_y) , MOV (OpReg W128 dst) (OpReg W128 tmp) @@ -2062,23 +2064,33 @@ genCondJump bid expr = do -- compute both sides. (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - let x' = OpReg w reg_x - y' = OpReg w reg_y - return $ case w of - W8 -> code_x `appOL` code_y `appOL` toOL [ UXTB x' x', UXTB y' y', CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - W16 -> code_x `appOL` code_y `appOL` toOL [ UXTH x' x', UXTH y' y', CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - _ -> code_x `appOL` code_y `appOL` toOL [ CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] + + -- If all computations reliably produce zero-extended subword results + -- this truncation is redundant. But for now better to be correct than + -- fast. + (reg_x', trunc_x) <- truncateSubwordReg w reg_x + -- TODO: Use CMP on OpRegExt rather than extending explicitly. + (reg_y', trunc_y) <- truncateSubwordReg w reg_y + + let x' = OpReg w reg_x' + y' = OpReg w reg_y' + return $ concatOL [code_x, trunc_x, code_y, trunc_y, + toOL [CMP x' y', (annExpr expr (BCOND cmp (TBlock bid)))]] sbcond w cmp = do -- compute both sides. (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - let x' = OpReg w reg_x - y' = OpReg w reg_y - return $ case w of - W8 -> code_x `appOL` code_y `appOL` toOL [ SXTB x' x', SXTB y' y', CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - W16 -> code_x `appOL` code_y `appOL` toOL [ SXTH x' x', SXTH y' y', CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] - _ -> code_x `appOL` code_y `appOL` toOL [ CMP x' y', (annExpr expr (BCOND cmp (TBlock bid))) ] + + -- W64 always works, even if we ultimately compare at W32. + (reg_x', ext_x) <- signExtendReg w W64 reg_x + -- TODO: Use CMP on OpRegExt rather than extending explicitly. + (reg_y', ext_y) <- signExtendReg w W64 reg_y + + let x' = OpReg w reg_x' + y' = OpReg w reg_y' + return $ concatOL [code_x, ext_x, code_y, ext_y, + toOL [CMP x' y', (annExpr expr (BCOND cmp (TBlock bid)))]] fbcond w cmp = do -- ensure we get float regs @@ -2750,6 +2762,7 @@ genCCall target dest_regs arg_regs = do | [p_reg, val_reg] <- arg_regs -> do (p, _fmt_p, code_p) <- getSomeReg p_reg (val, fmt_val, code_val) <- getSomeReg val_reg + massert (fmt_val == intFormat w) let instr = case ord of MemOrderRelaxed -> STR _ -> STLR ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -771,7 +771,8 @@ data Instr | MOVZ Operand Operand | MVN Operand Operand -- rd = ~rn | ORR Format Operand Operand Operand -- rd = rn | op2 - -- Load and stores. + -- Load and stores, we support subwords by picking the subword variant + -- based on the format. -- TODO STR/LDR might want to change to STP/LDP with XZR for the second register. | STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr | STLR Format Operand Operand -- stlr Xn, address-mode // Xn -> *addr ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -569,12 +569,8 @@ pprInstr platform instr = case instr of -- NOTE: GHC may do whacky things where it only load the lower part of an -- address. Not observing the correct size when loading will lead -- inevitably to crashes. - STR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tstrb") o1 o2 - STR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tstrh") o1 o2 - STR _f o1 o2 -> op2 (text "\tstr") o1 o2 - STLR _f o1 o2 -> op2 (text "\tstlr") o1 o2 + STR f o1 o2 -> op2 (subword_suffix f $ text "\tstr") o1 o2 + STLR f o1 o2 -> op2 (subword_suffix f $ text "\tstlr") o1 o2 LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> let (adrp', ldr') = op_adrp_reloc_dynamic $ pprAsmLabel platform lbl in @@ -622,12 +618,8 @@ pprInstr platform instr = case instr of op_adrp o1 adrp' $$ op_add o1 ldr' - LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tldrb") o1 o2 - LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tldrh") o1 o2 - LDR _f o1 o2 -> op2 (text "\tldr") o1 o2 - LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2 + LDR f o1 o2 -> op2 (subword_suffix f $ text "\tldr") o1 o2 + LDAR f o1 o2 -> op2 (subword_suffix f $ text "\tldar") o1 o2 -- 8. Synchronization Instructions ------------------------------------------- DMBISH DmbLoadStore -> line $ text "\tdmb ish" @@ -698,6 +690,12 @@ pprInstr platform instr = case instr of check_off off = if off >= 0 && off <= 4095 then char '#' <> int off else pgmError $ "GHC.CmmToAsm.AArch64.Ppr.check_off : " ++ show off ++ " is out of 12 bit" + -- Some instructions encode with via b/h suffix on the instruction. + -- We handle this here relying on the format rather then the operands. + subword_suffix II8 t = t <> char 'b' + subword_suffix II16 t = t <> char 'h' + subword_suffix _ t = t + pprBcond :: IsLine doc => Cond -> doc pprBcond c = text "b." <> pprCond c ===================================== testsuite/tests/codeGen/should_run/T27533.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, GHCForeignImportPrim, UnliftedFFITypes #-} + +import GHC.Exts +import GHC.IO (IO(..)) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Ptr (Ptr(..)) +import Numeric (showHex) +import System.IO + +foreign import prim "store8" store8# :: Addr# -> Word# +foreign import prim "load8" load8# :: Addr# -> Word# + +main :: IO () +main = do + hSetBuffering stdout NoBuffering + allocaBytes 8 $ \(Ptr a) -> do + -- 1. Silent corruption: release-store of 1 byte into an all-ones word. + IO (\s -> (# writeWordOffAddr# a 0# 0xFFFFFFFFFFFFFFFF## s, () #)) + case store8# a of _ -> return () -- case on unlifted Word# forces the call + w <- IO (\s -> case readWordOffAddr# a 0# s of (# s', v #) -> (# s', W# v #)) + putStrLn ("after 1-byte release-store: 0x" ++ showHex w "") + -- expected 0xffffffffffffff43; buggy NCG gives 0xffffffff00000043 + + -- 2. SIGBUS: acquire-load of 1 byte at an odd address (well-defined). + r <- IO (\s -> (# s, W# (load8# (a `plusAddr#` 1#)) #)) + putStrLn ("acquire byte load at p+1: 0x" ++ showHex r "") + -- expected 0xff; buggy NCG dies with SIGBUS before printing ===================================== testsuite/tests/codeGen/should_run/T27533.stdout ===================================== @@ -0,0 +1,2 @@ +after 1-byte release-store: 0xffffffffffffff43 +acquire byte load at p+1: 0xff ===================================== testsuite/tests/codeGen/should_run/T27533_cmm.cmm ===================================== @@ -0,0 +1,14 @@ +#include "Cmm.h" + +// Release-store one byte at p. Must touch exactly 1 byte. +store8 (W_ p) { + %release I8[p] = 67 :: I8; + return (0); +} + +// Acquire-load one byte from p. +load8 (W_ p) { + I8 v; + v = %acquire I8[p]; + return (%zx64(v)); +} ===================================== testsuite/tests/codeGen/should_run/T27538.hs ===================================== @@ -14,6 +14,7 @@ f x = if isTrue# (x `ltInt8#` intToInt8# 0#) main :: IO () main = do + -- Test for use of byte-width read. let !(I# i) = ix x = indexInt8OffAddr# "\x80"# i putStrLn ("f(0x80) = " ++ show (I# (f x))) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -298,6 +298,10 @@ test('aarch64-sxtw-run', test('T27430', [req_c, extra_ways(['optasm'])], compile_and_run, ['T27430_c.c']) +test('T27533', [req_cmm, extra_ways(['optasm'])], multi_compile_and_run, + ['T27533', [('T27533_cmm.cmm', '')], '-O']) + test('T27537', normal, compile_and_run, ['-O']) test('T27538', normal, compile_and_run, ['-O']) + ===================================== testsuite/tests/simd/should_run/T27565.hs ===================================== @@ -0,0 +1,36 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +module Main (main) where +import GHC.Exts +import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..)) + +{-# OPAQUE broadcast_i8 #-} +broadcast_i8 :: Int8# -> Int8X16# +broadcast_i8 x = broadcastInt8X16# x + +{-# OPAQUE broadcast_i16 #-} +broadcast_i16 :: Int16# -> Int16X8# +broadcast_i16 x = broadcastInt16X8# x + +{-# OPAQUE broadcast_i32 #-} +broadcast_i32 :: Int32# -> Int32X4# +broadcast_i32 x = broadcastInt32X4# x + +{-# OPAQUE broadcast_i64 #-} +broadcast_i64 :: Int64# -> Int64X2# +broadcast_i64 x = broadcastInt64X2# x + +main :: IO () +main = do + case unpackInt8X16# (broadcast_i8 (intToInt8# 32#)) of + (# a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15 #) -> + print [ I8# a0, I8# a1, I8# a2, I8# a3, I8# a4, I8# a5, I8# a6, I8# a7 + , I8# a8, I8# a9, I8# a10, I8# a11, I8# a12, I8# a13, I8# a14, I8# a15 ] + case unpackInt16X8# (broadcast_i16 (intToInt16# 32#)) of + (# b0,b1,b2,b3,b4,b5,b6,b7 #) -> + print [ I16# b0, I16# b1, I16# b2, I16# b3, I16# b4, I16# b5, I16# b6, I16# b7 ] + case unpackInt32X4# (broadcast_i32 (intToInt32# 32#)) of + (# c0,c1,c2,c3 #) -> + print [ I32# c0, I32# c1, I32# c2, I32# c3 ] + case unpackInt64X2# (broadcast_i64 (intToInt64# 32#)) of + (# d0,d1 #) -> + print [ I64# d0, I64# d1 ] ===================================== testsuite/tests/simd/should_run/T27565.stdout ===================================== @@ -0,0 +1,4 @@ +[32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32] +[32,32,32,32,32,32,32,32] +[32,32,32,32] +[32,32] ===================================== testsuite/tests/simd/should_run/all.T ===================================== @@ -217,3 +217,5 @@ test('StackAlignment64' , compile_and_run if have_cpu_feature('avx512f') else compile , ['StackAlignment64_main.c'] ) + +test('T27565', [], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1523beef0d172548211894720063a3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1523beef0d172548211894720063a3… 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] 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