- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/mangoiv/9.12.5-rc4] rts: Fix missing memory barrier in eval_thunk_selector (#27477)
by Magnus (＠MangoIV) 09 Sep '26

09 Sep '26

Magnus pushed to branch wip/mangoiv/9.12.5-rc4 at Glasgow Haskell Compiler / GHC Commits: 45b16ebe by Luite Stegeman at 2026-09-09T11:46:00+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 (cherry picked from commit 06eee015be4e361fe9cb33e8a608ab2ea1386b52) - - - - - 5 changed files: - + changelog.d/fix-parallel-gc-selector-race-27477 - rts/sm/Evac.c - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T Changes: ===================================== changelog.d/fix-parallel-gc-selector-race-27477 ===================================== @@ -0,0 +1,10 @@ +section: rts +synopsis: Fix a parallel GC race on weakly-ordered architectures (AArch64) that could crash or silently corrupt the heap +description: + On weakly-ordered architectures such as AArch64 programs using + could crash during parallel garbage collection (segmentation fault + or ``internal error: eval_thunk_selector: strange selectee <n>``) or + continue running with silently corrupted heap data, due to a missing + memory barrier in the parallel GC. +mrs: !16488 +issues: #27477 ===================================== rts/sm/Evac.c ===================================== @@ -1360,7 +1360,11 @@ selector_loop: // from-space during marking, for example. We rely on the property // that evacuate() doesn't mind if it gets passed a to-space pointer. - info = RELAXED_LOAD((StgInfoTable**) &selectee->header.info); + // NB. this load must be ordered: the selectee may be updated + // concurrently by another GC thread's unchain_thunk_selectors(), + // which publishes an indirection by writing the indirectee and + // then RELEASE-storing the info pointer. See #27477. + info = ACQUIRE_LOAD((StgInfoTable**) &selectee->header.info); if (IS_FORWARDING_PTR(info)) { // We don't follow pointers into to-space; the constructor ===================================== testsuite/tests/rts/T27477.hs ===================================== @@ -0,0 +1,169 @@ +{-# LANGUAGE BangPatterns #-} + +-- Stress test for #27477: missing ACQUIRE in eval_thunk_selector +-- (rts/sm/Evac.c). +-- +-- With the bug present this test crashes or reports value mismatches +-- within a few seconds on AArch64; on strongly-ordered targets +-- it just passes. + +module Main (main) where + +import Control.Concurrent +import Control.Exception +import Control.Monad +import Data.IORef +import System.Environment +import System.Exit +import System.IO +import System.Mem (performMinorGC) + +data T = T { nxt :: T, val :: !Int } + +-- expected values and the cells that should evaluate to them +type Batch = ([Int], [T]) + +tailD, branchD, branchesPerCell :: Int +tailD = 12 -- shared tail length per cluster +branchD = 3 -- private branch length +branchesPerCell = 2 +-- tailD + branchD must stay below MAX_THUNK_SELECTOR_DEPTH (16) + +{-# NOINLINE spineEnd #-} +spineEnd :: T +spineEnd = errorWithoutStackTrace "spine end reached" + +-- Fully evaluated spine of constructors; cell i from the head has val i+1. +buildSpine :: Int -> IO T +buildSpine len = evaluate (go len (T spineEnd 0)) + where + go :: Int -> T -> T + go 0 acc = acc + go k acc = go (k - 1) (T acc k) + +-- k selector thunks, shallow-first: cell i selects from cell i-1, +-- cell 0 selects from t. If t evaluates to spine cell m (val m+1), +-- cell i evaluates to spine cell m+1+i (val m+2+i). +{-# NOINLINE selChain #-} +selChain :: Int -> T -> [T] +selChain 0 _ = [] +selChain k t = let t' = nxt t in t' : selChain (k - 1) t' + +lenL :: [a] -> Int +lenL = go 0 + where + go !n [] = n + go !n (_ : xs) = go (n + 1) xs + +everyN :: Int -> [a] -> [a] +everyN _ [] = [] +everyN n (x : xs) = x : everyN n (drop (n - 1) xs) + +-- One branch hanging off tail cell tj (which evaluates to val jval): +-- branch cell i evaluates to jval+1+i. Returned deepest-first. +{-# NOINLINE mkBranch #-} +mkBranch :: Int -> T -> IO Batch +mkBranch jval tj = do + let cells = selChain branchD tj + _ <- evaluate (lenL cells) + let expected = [ jval + 1 + i | i <- [0 .. branchD - 1] ] + pure (reverse expected, reverse cells) + +-- A cluster: one private spine, one shared tail of selectors over it, +-- branchesPerCell branches of selectors converging on every tail cell. +-- Neither the spine nor the tail is returned: they must stay reachable +-- only through the branch selectors. +buildCluster :: IO [Batch] +buildCluster = do + sp <- buildSpine (tailD + branchD + 4) + let tails = selChain tailD sp + _ <- evaluate (lenL tails) + bss <- forM (zip [0 ..] tails) $ \(j, tj) -> + replicateM branchesPerCell (mkBranch (j + 2) tj) + pure (concat bss) + +verifyBatch :: IORef Int -> Int -> Batch -> IO () +verifyBatch errs wid (es0, ts0) = go es0 ts0 + where + go (e : es) (t : ts) = do + v <- evaluate (val t) + when (v /= e) $ do + hPutStrLn stderr $ + "MISMATCH worker=" ++ show wid + ++ " expected=" ++ show e ++ " got=" ++ show v + modifyIORef' errs (+ 1) + go es ts + go _ _ = pure () + +-- simple cyclic barrier +newtype Barrier = Barrier (MVar (Int, [MVar ()])) + +newBarrier :: IO Barrier +newBarrier = Barrier <$> newMVar (0, []) + +awaitBarrier :: Barrier -> Int -> IO () +awaitBarrier (Barrier st) total = do + w <- newEmptyMVar + join $ modifyMVar st $ \(k, ws) -> + if k + 1 == total + then pure ((0, []), mapM_ (\m -> putMVar m ()) ws) + else pure ((k + 1, w : ws), takeMVar w) + +worker :: Int -> Int -> Int -> Barrier -> [IORef [Batch]] -> IORef Int -> Int -> IO () +worker rounds clusters nWorkers bar slots errs wid = + forM_ [1 .. rounds] $ \(_r :: Int) -> do + -- build fresh selector clusters, publish them + batches <- concat <$> replicateM clusters buildCluster + writeIORef (slots !! wid) batches + awaitBarrier bar nWorkers + -- root each branch's deepest cell via fresh cons cells in our own + -- nursery (so our GC thread evacuates the shared cells itself), in + -- a per-worker interleaved order so that different GC threads + -- sweep different branches of the same shared tails concurrently + published <- mapM readIORef slots + let allBatches = concat published + ordered + | nWorkers > 1 = + concat [ everyN nWorkers (drop ((wid + k) `mod` nWorkers) allBatches) + | k <- [0 .. nWorkers - 1] ] + | otherwise = allBatches + deepTs = [ t | (_, t : _) <- ordered ] + deepEs = [ e | (e : _, _) <- ordered ] + _ <- evaluate (lenL deepTs) + _ <- evaluate (lenL deepEs) + awaitBarrier bar nWorkers + -- run a parallel GC with everything live + when (wid == 0) performMinorGC + awaitBarrier bar nWorkers + -- force everything and check the values + verifyBatch errs wid (deepEs, deepTs) + awaitBarrier bar nWorkers + +main :: IO () +main = do + hSetBuffering stderr LineBuffering + args <- getArgs + let atDef d i = if length args > i then read (args !! i) else d + rounds = atDef 600 0 + clusters = atDef 48 1 + n <- getNumCapabilities + bar <- newBarrier + slots <- replicateM n (newIORef []) + errs <- newIORef 0 + dones <- forM [0 .. n - 1] $ \i -> do + done <- newEmptyMVar + _ <- forkOn i $ + (worker rounds clusters n bar slots errs i >> putMVar done Nothing) + `catch` \e -> putMVar done (Just (e :: SomeException)) + pure done + results <- mapM takeMVar dones + forM_ results $ \r -> case r of + Just e -> do + hPutStrLn stderr ("worker exception: " ++ show e) + exitWith (ExitFailure 2) + Nothing -> pure () + ec <- readIORef errs + when (ec > 0) $ do + hPutStrLn stderr ("FAILED: " ++ show ec ++ " mismatches") + exitWith (ExitFailure 2) + putStrLn "OK" ===================================== testsuite/tests/rts/T27477.stdout ===================================== @@ -0,0 +1 @@ +OK ===================================== testsuite/tests/rts/all.T ===================================== @@ -639,5 +639,11 @@ test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_ru test('T25560', [req_c_rts, ignore_stderr], compile_and_run, ['']) test('TestProddableBlockSet', [req_c_rts], multimod_compile_and_run, ['TestProddableBlockSet.c', '-no-hs-main']) - test('T27123', [when(have_profiling(), extra_ways(['prof']))], compile_and_run, ['-O -package ghc']) +test('T27477', + [ extra_run_opts('600 24 +RTS -N4 -A1m -RTS') + , req_ghc_smp + , req_target_smp + , only_ways(['threaded1', 'threaded2']) + ], + compile_and_run, ['-O2']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45b16ebe4a65a1551e1c8da494043c5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45b16ebe4a65a1551e1c8da494043c5… 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/T25450-march-native] Implement -march=native for x86/x86_64
by Simon Jakobi (＠sjakobi) 09 Sep '26

09 Sep '26

Simon Jakobi pushed to branch wip/sjakobi/T25450-march-native at Glasgow Haskell Compiler / GHC Commits: ab0e58e4 by Simon Jakobi at 2026-09-09T11:11:19+02:00 Implement -march=native for x86/x86_64 Add a -march=native flag that probes the host CPU and enables the matching CPU-feature DynFlags, so it affects both the NCG and the LLVM backend. Detected features are folded additively into the existing flags, so explicit -m... options are never disabled. The probe is a small C shim over GCC/Clang's __builtin_cpu_supports. The deviations that remain are documented in compiler/cbits/cpu_features_x86.c. The RTS exports the runtime symbols behind the builtin (__cpu_model & co.) so GHCi's runtime linker can load the ghc library where GHCi links statically, e.g. on Windows or musl. One export, __cpu_indicator_init_local, is a weak reference: only the musl GCC patch carried by Alpine and Gentoo (aports 0013-libgcc_s.patch) makes __builtin_cpu_init call that alias, defining it in static libgcc.a. A strong reference would break the RTS link with other musl toolchains (clang/compiler-rt, unpatched gcc), which lack the alias but also never emit references to it, so their NULL table entry is inert. The flag is registered in expected-undocumented-flags.txt due to #27321. Thanks to @aratamizuki for pointing out the macOS AVX-512 XSAVE quirk and for testing! Closes #25450 Assisted-by: Claude Fable 5 - - - - - 17 changed files: - + changelog.d/march-native - changelog.d/print-enabled-cpu-features - + compiler/GHC/Driver/CpuFeatures.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - + compiler/cbits/cpu_features_x86.c - compiler/ghc.cabal.in - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/using.rst - rts/RtsSymbols.c - testsuite/tests/codeGen/should_gen_asm/all.T - + testsuite/tests/codeGen/should_gen_asm/march-native-enables-popcnt.asm - + testsuite/tests/codeGen/should_gen_asm/march-native-enables-popcnt.hs - testsuite/tests/driver/all.T - + testsuite/tests/driver/march_native.stdout - + testsuite/tests/driver/march_native_additive.stdout - + testsuite/tests/driver/march_native_unsupported_arch.stderr Changes: ===================================== changelog.d/march-native ===================================== @@ -0,0 +1,12 @@ +section: compiler +synopsis: Add -march=native flag +issues: #25450 +mrs: !16126 + +description: + GHC now supports ``-march=native`` on x86 and x86_64. It probes the CPU of the + machine running GHC and enables all of the corresponding ``-m...`` CPU-feature + options automatically (such as ``-msse4.2``, ``-mavx2``, ``-mbmi2`` and + ``-mfma``), for both the native code generator and the LLVM backend. The + detected features are enabled in addition to any explicitly requested feature + flags. The flag is rejected for non-x86 targets and when cross-compiling. ===================================== changelog.d/print-enabled-cpu-features ===================================== @@ -8,9 +8,11 @@ description: prints a JSON object describing the CPU features currently enabled for code generation, together with a set of ``-m...`` flags that reproduce the effective feature set for the current target. - Dynamic options such as ``-mavx2`` and ``-mbmi2`` are respected. :: + Dynamic options such as ``-mavx2`` and ``-mbmi2`` are respected, so the flag + can also be used to inspect which features :ghc-flag:`-march=native` detected + and enabled. :: - $ ghc -mavx2 --print-enabled-cpu-features + $ ghc -march=native --print-enabled-cpu-features {"tag":"enabled-cpu-features","version":1,"target":"x86_64-linux-gnu", - "features":["SSE","SSE2","SSE3","SSSE3","SSE4.1","SSE4.2","AVX","AVX2"], - "as_m_flags":["-mavx2"]} + "features":["SSE","SSE2","SSE3","SSSE3","SSE4.1","SSE4.2","AVX","AVX2","BMI1","BMI2","FMA"], + "as_m_flags":["-mavx2","-mbmi2","-mfma"]} ===================================== compiler/GHC/Driver/CpuFeatures.hs ===================================== @@ -0,0 +1,64 @@ +{-# LANGUAGE CPP #-} + +module GHC.Driver.CpuFeatures + ( X86CpuFeature(..) + , cachedX86CpuFeatures + ) where + +import GHC.Prelude + +import Data.Word (Word64) +import System.IO.Unsafe (unsafePerformIO) + +-- | x86 CPU features understood by GHC's native CPU feature probe. +data X86CpuFeature + = SSE2 + | SSE3 + | SSSE3 + | SSE4_1 + | SSE4_2 + | AVX + | AVX2 + | AVX512F + | AVX512BW + | AVX512CD + | AVX512DQ + | AVX512VL + | BMI1 + | BMI2 + | FMA + | GFNI + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | Decode the bitmask returned by 'ghc_detect_x86_cpu_features'. +-- +-- Bit positions are constructor order, which must match the enum in +-- @compiler/cbits/cpu_features_x86.c@. +decodeX86CpuFeatureMask :: Word64 -> [X86CpuFeature] +decodeX86CpuFeatureMask mask = + [ feat + | feat <- [minBound .. maxBound] + , testBit mask (fromEnum feat) + ] + +-- | Low-level FFI access to the C probe. +detectX86CpuFeatureMask :: IO Word64 +#if defined(javascript_HOST_ARCH) +detectX86CpuFeatureMask = pure 0 +#else +detectX86CpuFeatureMask = c_ghc_detect_x86_cpu_features +#endif + +-- | Probe host x86 CPU features and decode them into an ordered feature list. +detectX86CpuFeatures :: IO [X86CpuFeature] +detectX86CpuFeatures = decodeX86CpuFeatureMask <$> detectX86CpuFeatureMask + +-- | The host's x86 CPU features, probed once and memoized. +cachedX86CpuFeatures :: [X86CpuFeature] +cachedX86CpuFeatures = unsafePerformIO detectX86CpuFeatures +{-# NOINLINE cachedX86CpuFeatures #-} + +#if !defined(javascript_HOST_ARCH) +foreign import ccall unsafe "ghc_detect_x86_cpu_features" + c_ghc_detect_x86_cpu_features :: IO Word64 +#endif ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -473,6 +473,8 @@ data DynFlags = DynFlags { fma :: Bool, -- ^ Enable FMA instructions. gfni :: Bool, -- ^ Enable GFNI Instructions. la664 :: Bool, -- ^ Enable LA664 instructions + marchNative :: Bool, -- ^ @-march=native@ was requested; the host + -- CPU features are applied during flag parsing. -- Constants used to control the amount of optimization done. @@ -765,6 +767,7 @@ defaultDynFlags mySettings = gfni = False, -- For LoongArch, la464 is used by default. la664 = False, + marchNative = False, maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -245,6 +245,8 @@ import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile import GHC.Platform.ArchOS +import GHC.Platform.Host (hostPlatformArch) +import qualified GHC.Driver.CpuFeatures as Cpu import GHC.Unit.Types import GHC.Unit.Parser @@ -907,8 +909,10 @@ parseDynamicFlagsFull activeFlags cmdline logger dflags0 args = do unless (null errs) $ liftIO $ throwGhcExceptionIO $ errorsToGhcException $ map ((rdr . ppr . getLoc &&& unLoc) . errMsg) $ errs + dflags1' <- applyMarchNative dflags1 + -- check for disabled flags in safe haskell - let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1 + let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1' theWays = ways dflags2 unless (allowed_combination theWays) $ liftIO $ @@ -1743,6 +1747,7 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "mavx512vl" (noArg (\d -> d { avx512vl = True })) , make_ord_flag defGhcFlag "mfma" (noArg (\d -> d { fma = True })) , make_ord_flag defGhcFlag "mgfni" (noArg (\d -> d { gfni = True })) + , make_ord_flag defGhcFlag "march=native" (noArg (\d -> d { marchNative = True })) , make_ord_flag defGhcFlag "mla664" (noArg (\d -> d { la664 = True })) @@ -3826,6 +3831,53 @@ x86AsMFlags dflags = gfniFlags = [ "-mgfni" | gfni dflags ] +-- | Apply a requested @-march=native@ by probing the host CPU and enabling the +-- matching CPU-feature flags. +applyMarchNative :: MonadIO m => DynFlags -> m DynFlags +applyMarchNative dflags + | not (marchNative dflags) = return dflags + | otherwise = do + let arch = platformArch (targetPlatform dflags) + unless (arch == ArchX86 || arch == ArchX86_64) $ liftIO $ + throwGhcExceptionIO $ CmdLineError + "-march=native is only supported on x86 and x86_64 targets" + unless (arch == hostPlatformArch) $ liftIO $ + throwGhcExceptionIO $ CmdLineError + "-march=native is not supported when cross-compiling" + return (applyX86CpuFeatures Cpu.cachedX86CpuFeatures dflags) + +-- | Enable the 'DynFlags' CPU-feature fields corresponding to a probed set of +-- host x86 features. +applyX86CpuFeatures :: [Cpu.X86CpuFeature] -> DynFlags -> DynFlags +applyX86CpuFeatures feats dflags = dflags + { sseAvxVersion = foldr (max . Just) (sseAvxVersion dflags) sseLevels + , bmiVersion = foldr (max . Just) (bmiVersion dflags) bmiLevels + , avx512f = avx512f dflags || has Cpu.AVX512F + , avx512bw = avx512bw dflags || has Cpu.AVX512BW + , avx512cd = avx512cd dflags || has Cpu.AVX512CD + , avx512dq = avx512dq dflags || has Cpu.AVX512DQ + , avx512vl = avx512vl dflags || has Cpu.AVX512VL + , fma = fma dflags || has Cpu.FMA + , gfni = gfni dflags || has Cpu.GFNI + } + where + has feat = feat `elem` feats + sseLevels = [ lvl | feat <- feats, Just lvl <- [sseLevelOf feat] ] + bmiLevels = [ lvl | feat <- feats, Just lvl <- [bmiLevelOf feat] ] + sseLevelOf feat = case feat of + Cpu.SSE2 -> Just SSE2 + Cpu.SSE3 -> Just SSE3 + Cpu.SSSE3 -> Just SSSE3 + Cpu.SSE4_1 -> Just SSE4 + Cpu.SSE4_2 -> Just SSE42 + Cpu.AVX -> Just AVX1 + Cpu.AVX2 -> Just AVX2 + _ -> Nothing + bmiLevelOf feat = case feat of + Cpu.BMI1 -> Just BMI1 + Cpu.BMI2 -> Just BMI2 + _ -> Nothing + -- | Query if the target RTS has the given 'Ways'. It's computed from -- the @"RTS ways"@ field in the settings file. targetHasRTSWays :: DynFlags -> Ways -> Bool ===================================== compiler/cbits/cpu_features_x86.c ===================================== @@ -0,0 +1,97 @@ +#include <HsFFI.h> + +/* Runtime x86 CPU feature detection backing GHC.Driver.CpuFeatures + (-march=native). + + The bit positions in the returned mask are GHC's own; the enum below + must match the constructor order of X86CpuFeature in + GHC.Driver.CpuFeatures. + + The __builtin_cpu_* calls below compile to references to libgcc/compiler-rt + symbols (__cpu_model & co.), which GHCi's runtime linker can only resolve + because the RTS exports them: see RTS_X86_CPU_MODEL_SYMBOLS in + rts/RtsSymbols.c and keep its guards in sync with this file's. */ + +enum { + GHC_X86_FEAT_SSE2 = 0, + GHC_X86_FEAT_SSE3, + GHC_X86_FEAT_SSSE3, + GHC_X86_FEAT_SSE4_1, + GHC_X86_FEAT_SSE4_2, + GHC_X86_FEAT_AVX, + GHC_X86_FEAT_AVX2, + GHC_X86_FEAT_AVX512F, + GHC_X86_FEAT_AVX512BW, + GHC_X86_FEAT_AVX512CD, + GHC_X86_FEAT_AVX512DQ, + GHC_X86_FEAT_AVX512VL, + GHC_X86_FEAT_BMI1, + GHC_X86_FEAT_BMI2, + GHC_X86_FEAT_FMA, + GHC_X86_FEAT_GFNI +}; + +#if (defined(__i386__) || defined(__x86_64__)) \ + && (defined(__GNUC__) || defined(__clang__)) + +/* GFNI joined the __builtin_cpu_supports feature lists later than the + other features here (GCC 11; compiler-rt's cpu_model in LLVM 12). + Under an older bootstrap compiler we conservatively report no GFNI. */ +#if (defined(__clang_major__) && __clang_major__ >= 12) \ + || (!defined(__clang__) && defined(__GNUC__) && __GNUC__ >= 11) +#define GHC_HAS_CPU_SUPPORTS_GFNI 1 +#else +#define GHC_HAS_CPU_SUPPORTS_GFNI 0 +#endif + +HsWord64 ghc_detect_x86_cpu_features(void) +{ + __builtin_cpu_init(); + + HsWord64 feats = 0; + + /* __builtin_cpu_supports returns the feature's (nonzero) mask bit, + not 0/1, so it must be normalized before shifting. */ +#define GHC_CPU_FEATURE(name, bit) \ + if (__builtin_cpu_supports(name)) { feats |= ((HsWord64)1 << (bit)); } + + GHC_CPU_FEATURE("sse2", GHC_X86_FEAT_SSE2) + GHC_CPU_FEATURE("sse3", GHC_X86_FEAT_SSE3) + GHC_CPU_FEATURE("ssse3", GHC_X86_FEAT_SSSE3) + GHC_CPU_FEATURE("sse4.1", GHC_X86_FEAT_SSE4_1) + GHC_CPU_FEATURE("sse4.2", GHC_X86_FEAT_SSE4_2) + GHC_CPU_FEATURE("avx", GHC_X86_FEAT_AVX) + GHC_CPU_FEATURE("avx2", GHC_X86_FEAT_AVX2) + GHC_CPU_FEATURE("avx512f", GHC_X86_FEAT_AVX512F) + GHC_CPU_FEATURE("avx512bw", GHC_X86_FEAT_AVX512BW) + GHC_CPU_FEATURE("avx512cd", GHC_X86_FEAT_AVX512CD) + GHC_CPU_FEATURE("avx512dq", GHC_X86_FEAT_AVX512DQ) + GHC_CPU_FEATURE("avx512vl", GHC_X86_FEAT_AVX512VL) + GHC_CPU_FEATURE("bmi", GHC_X86_FEAT_BMI1) + GHC_CPU_FEATURE("bmi2", GHC_X86_FEAT_BMI2) + + /* FMA is usable only when the OS saves the AVX register state. However + compiler-rt's cpu_model/x86.c reports "fma" from the raw CPUID bit. */ + if (__builtin_cpu_supports("fma") && __builtin_cpu_supports("avx")) { + feats |= ((HsWord64)1 << GHC_X86_FEAT_FMA); + } + +#if GHC_HAS_CPU_SUPPORTS_GFNI + GHC_CPU_FEATURE("gfni", GHC_X86_FEAT_GFNI) +#endif + +#undef GHC_CPU_FEATURE + + return feats; +} + +#else + +/* Non-x86 host, or a compiler without __builtin_cpu_supports (e.g. MSVC): + report no features. */ +HsWord64 ghc_detect_x86_cpu_features(void) +{ + return 0; +} + +#endif ===================================== compiler/ghc.cabal.in ===================================== @@ -187,6 +187,7 @@ Library else c-sources: cbits/cutils.c + cbits/cpu_features_x86.c cbits/genSym.c cbits/keepCAFsForGHCi.c @@ -518,6 +519,7 @@ Library GHC.Driver.Config.StgToCmm GHC.Driver.Config.Tidy GHC.Driver.Config.StgToJS + GHC.Driver.CpuFeatures GHC.Driver.DynFlags GHC.Driver.IncludeSpecs GHC.Driver.Downsweep ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -74,6 +74,7 @@ -instantiated-with -keep-hi-file -keep-o-file +-march=native -n -no-keep-hi-file -no-keep-o-file ===================================== docs/users_guide/using.rst ===================================== @@ -539,7 +539,9 @@ The available mode flags are: Print a JSON object describing the CPU features currently enabled for code generation, together with a set of ``-m...`` flags that reproduce the effective feature set for the current target. - Dynamic options such as ``-mavx2`` and ``-mbmi2`` are respected. + Dynamic options such as ``-mavx2`` and ``-mbmi2`` are respected, so this flag + can also be used to inspect which features :ghc-flag:`-march=native` detected + and enabled. .. ghc-flag:: --print-debug-on :shortdesc: print whether GHC was built with ``-DDEBUG`` @@ -1897,6 +1899,34 @@ Some flags only make sense for particular target platforms. so this flag has no effect when used with the :ref:`native code generator <native-code-gen>` or the :ref:`LLVM backend <llvm-code-gen>`. +.. ghc-flag:: -march=native + :shortdesc: (x86 only) Enable all CPU features supported by the host + :type: dynamic + :category: platform-options + + (x86/x86_64 only) Probe the CPU of the machine running GHC and enable all of + the corresponding ``-m...`` CPU-feature options automatically (for example + ``-msse4.2``, ``-mavx2``, ``-mbmi2``, ``-mfma``). The detected features apply + to both the :ref:`native code generator <native-code-gen>` and the + :ref:`LLVM backend <llvm-code-gen>`. + + The detected features are enabled *in addition* to any CPU-feature flags you + pass explicitly, regardless of their order on the command line; ``-march=native`` + never disables a feature. + + The features that were detected and enabled can be inspected with + :ghc-flag:`--print-enabled-cpu-features`. + + .. warning:: + + Code compiled with ``-march=native`` may use instructions that are not + available on other CPUs, and is therefore not portable to a different + machine. + + Only x86 and x86_64 targets are supported so far; the flag is rejected on + other targets. It is also rejected when cross-compiling, since the host CPU + is then unrelated to the target. + Haddock ------- ===================================== rts/RtsSymbols.c ===================================== @@ -1039,6 +1039,41 @@ extern char **environ; #define RTS_ARM_OUTLINE_ATOMIC_SYMBOLS #endif +// libgcc/compiler-rt symbols behind __builtin_cpu_supports/__builtin_cpu_init, +// referenced by compiler/cbits/cpu_features_x86.c (-march=native). +// Without them the runtime linker cannot load the ghc library's object code +// (e.g. for plugins in a statically linked GHCi). Keep the guards in sync +// with cpu_features_x86.c. +#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) \ + && (defined(__GNUC__) || defined(__clang__)) +// __cpu_features2 holds the feature words beyond the first 32 (e.g. GFNI) +// and only exists in the runtimes of GCC >= 11 resp. LLVM >= 12. +#if (defined(__clang_major__) && __clang_major__ >= 12) \ + || (!defined(__clang__) && defined(__GNUC__) && __GNUC__ >= 11) +#define RTS_X86_CPU_FEATURES2_SYMBOLS \ + SymI_NeedsDataProto(__cpu_features2) +#else +#define RTS_X86_CPU_FEATURES2_SYMBOLS +#endif +// Alpine's and Gentoo's musl GCCs patch __builtin_cpu_init to call +// __cpu_indicator_init_local, an alias of __cpu_indicator_init. Weak +// because other musl toolchains lack the alias (and don't reference it). +#if defined(linux_HOST_OS) && !defined(__GLIBC__) +extern void __cpu_indicator_init_local(void) __attribute__((weak)); +#define RTS_X86_CPU_INDICATOR_INIT_LOCAL_SYMBOLS \ + SymI_NeedsProto(__cpu_indicator_init_local) +#else +#define RTS_X86_CPU_INDICATOR_INIT_LOCAL_SYMBOLS +#endif +#define RTS_X86_CPU_MODEL_SYMBOLS \ + SymI_NeedsProto(__cpu_indicator_init) \ + SymI_NeedsDataProto(__cpu_model) \ + RTS_X86_CPU_INDICATOR_INIT_LOCAL_SYMBOLS \ + RTS_X86_CPU_FEATURES2_SYMBOLS +#else +#define RTS_X86_CPU_MODEL_SYMBOLS +#endif + // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, SYM_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -1199,6 +1234,7 @@ RTS_OPENBSD_ONLY_SYMBOLS RTS_LIBC_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_ARCH_LIBGCC_SYMBOLS +RTS_X86_CPU_MODEL_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS RTS_ARM_OUTLINE_ATOMIC_SYMBOLS @@ -1254,6 +1290,7 @@ void initLinkerRtsSyms (StrHashTable *symhash) { RTS_OPENBSD_ONLY_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_ARCH_LIBGCC_SYMBOLS + RTS_X86_CPU_MODEL_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS RTS_ARM_OUTLINE_ATOMIC_SYMBOLS ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -17,6 +17,11 @@ test('msse-option-order', [unless(arch('x86_64') or arch('i386'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', False, '-msse4.2 -msse2']) test('mavx-should-enable-popcnt', [unless(arch('x86_64') or arch('i386'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', False, '-mavx']) +# -march=native probes the host CPU, so gate on the host actually having SSE4.2 +# (have_cpu_feature reports nothing under cross, skipping the test there too). +test('march-native-enables-popcnt', + [unless((arch('x86_64') or arch('i386')) and have_cpu_feature('sse4_2'), skip), + when(unregisterised(), skip)], compile_grep_asm, ['hs', False, '-march=native']) test('avx512-int64-mul', [unless(arch('x86_64'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512dq -mavx512vl']) test('avx512-int64-minmax', [unless(arch('x86_64'), skip), ===================================== testsuite/tests/codeGen/should_gen_asm/march-native-enables-popcnt.asm ===================================== @@ -0,0 +1 @@ +popcnt(?![0-9]) \ No newline at end of file ===================================== testsuite/tests/codeGen/should_gen_asm/march-native-enables-popcnt.hs ===================================== @@ -0,0 +1,11 @@ +-- `-march=native` enables the host's CPU features. On a host with SSE4.2 +-- (gated in all.T via have_cpu_feature) this makes popCount compile to a +-- `popcnt` instruction rather than the SSE2-baseline software fallback. +import Data.Bits + +{-# NOINLINE foo #-} +foo :: Int -> Int +foo x = 1 + popCount x + +main :: IO () +main = print (foo 42) ===================================== testsuite/tests/driver/all.T ===================================== @@ -7,6 +7,12 @@ def normalise_unknown_flag(msg): m = re.search(r'unrecognised flag: \S+', msg) return m.group(0) + '\n' if m else msg +def normalise_march_native_error(msg): + # Keep only the stable '-march=native ...' diagnostic; the program-name + # prefix and any usage trailer vary across configurations. + m = re.search(r'-march=native is [^\n]+', msg) + return m.group(0) + '\n' if m else msg + test('driver011', [extra_files(['A011.hs'])], makefile_test, ['test011']) test('driver012', [extra_files(['A012.hs'])], makefile_test, ['test012']) @@ -265,6 +271,29 @@ test('print_enabled_cpu_features_unknown_flag', run_command, ['{compiler} -mavx22 --print-enabled-cpu-features']) +# -march=native enables at least the x86_64 baseline (SSE2). The full feature +# set is host-dependent, so we only assert the always-present baseline. +test('march_native', + [unless(arch('x86_64') or arch('i386'), skip)], + run_command, + ['{compiler} -march=native --print-enabled-cpu-features | grep -o SSE2']) + +# On non-x86 targets -march=native must be rejected. +test('march_native_unsupported_arch', + [when(arch('x86_64') or arch('i386'), skip), + normalise_errmsg_fun(normalise_march_native_error), exit_code(1)], + run_command, + ['{compiler} -march=native --print-enabled-cpu-features']) + +# -march=native is additive with explicit -m flags, regardless of order: an +# explicitly requested feature (here AVX2, forced on independent of the host) is +# still present whether the flag comes before or after -march=native. +test('march_native_additive', + [unless(arch('x86_64') or arch('i386'), skip)], + run_command, + ['{compiler} -mavx2 -march=native --print-enabled-cpu-features | grep -o AVX2 && ' + '{compiler} -march=native -mavx2 --print-enabled-cpu-features | grep -o AVX2']) + test('T10219', normal, run_command, # `-x hspp` in make mode should work. # Note: need to specify `-x hspp` before the filename. ===================================== testsuite/tests/driver/march_native.stdout ===================================== @@ -0,0 +1 @@ +SSE2 ===================================== testsuite/tests/driver/march_native_additive.stdout ===================================== @@ -0,0 +1,2 @@ +AVX2 +AVX2 ===================================== testsuite/tests/driver/march_native_unsupported_arch.stderr ===================================== @@ -0,0 +1 @@ +-march=native is only supported on x86 and x86_64 targets View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab0e58e4b9a708d6a576b2d9d5bd235… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab0e58e4b9a708d6a576b2d9d5bd235… 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/T27731] 5 commits: rts: fix ctoi_tuple_spill_words getting out of sync
by Simon Peyton Jones (＠simonpj) 09 Sep '26

09 Sep '26

Simon Peyton Jones pushed to branch wip/T27731 at Glasgow Haskell Compiler / GHC Commits: 192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00 rts: fix ctoi_tuple_spill_words getting out of sync Fix a few places that were not updating ctoi_tuple_spill_words correctly, leading to corruption/crashes when dealing with large unboxed tuples in bytecode: - captureContinuationAndAbort - findRetryFrameHelper/findAtomicallyFrameHelper - interpretBCO bci_BRK_FUN fixes #27633 - - - - - 604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00 Hadrian: don't capture the testsuite driver's output (#27780) a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the cmd' wrapper. cmd' always captures stdout and stderr, and since the caller asks for Exit, it returns without dumping what it captured. As a result the testsuite output no longer appears in CI job logs: failures, performance metrics and the summary were lost with the job. Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that commit do. Fixes #27780. Assisted-by: Claude Fable 5.1 - - - - - 06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 - - - - - f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - 6b7dcb25 by Simon Peyton Jones at 2026-09-09T10:14:38+01:00 Simplify the error-suppression mechanism in GHC.Tc.Errors In GHC.Tc.Errors.reportWanteds we suppress some errors in favour of others. But the mechanism had grown crufty, and #27331 exposed a bug. This MR makes it simpler and more uniform, by doing everything via the `ei_suppress` field of the ErrorItem. Claude then found another closely-related bug (see the review linked on !16564). That bug is immortalised in new test T18851d. I'm still not happy with `ignoreConstraint` but we can worry about that another day; I have not touched it. - - - - - 34 changed files: - + changelog.d/T27731 - + changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Types/Constraint.hs - hadrian/src/Builder.hs - rts/Continuation.c - rts/Interpreter.c - rts/Schedule.c - rts/sm/Evac.c - + testsuite/tests/bytecode/T27633/Obj.hs - + testsuite/tests/bytecode/T27633/T27633a.hs - + testsuite/tests/bytecode/T27633/T27633a.stdout - + testsuite/tests/bytecode/T27633/T27633b.hs - + testsuite/tests/bytecode/T27633/T27633b.stdout - + testsuite/tests/bytecode/T27633/all.T - + testsuite/tests/ghci.debugger/scripts/T27633c.hs - + testsuite/tests/ghci.debugger/scripts/T27633c.script - + testsuite/tests/ghci.debugger/scripts/T27633c.stdout - + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs - testsuite/tests/ghci.debugger/scripts/all.T - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T - testsuite/tests/typecheck/should_fail/FunDepOrigin1b.hs - testsuite/tests/typecheck/should_fail/T18851.stderr - + testsuite/tests/typecheck/should_fail/T18851e.hs - + testsuite/tests/typecheck/should_fail/T18851e.stderr - + testsuite/tests/typecheck/should_fail/T27731.hs - + testsuite/tests/typecheck/should_fail/T27731.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/327f9854de01423b8c419798467097… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/327f9854de01423b8c419798467097… 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/T26543b] Improve the atvFolder stuff
by Simon Peyton Jones (＠simonpj) 09 Sep '26

09 Sep '26

Simon Peyton Jones pushed to branch wip/T26543b at Glasgow Haskell Compiler / GHC Commits: e2f4f707 by Simon Peyton Jones at 2026-09-09T10:09:22+01:00 Improve the atvFolder stuff ...to use the same idiom that we already use in exprFreeVars. - - - - - 3 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Types/Var/FV.hs Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -223,11 +223,11 @@ addCoreBndrsFV bndrs fv = foldr addCoreBndrFV fv bndrs unitFV :: Var -> SelectiveDFV -- Deals with an occurrence -- Shallow: does not look at the kind -unitFV v = MkFV (\bvs -> EndoOS (do_it bvs)) +unitFV v = MkFV (\env -> EndoOS (do_it env)) where - do_it (is_interesting,bvs) acc + do_it (bvs, is_interesting) acc + | v `elemVarSet` bvs = acc -- First exclude the bound vars | not (is_interesting v) = acc -- The "selective" bit - | v `elemVarSet` bvs = acc | v `elemDVarSet` acc = acc | otherwise = acc `extendDVarSet` v ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -443,11 +443,11 @@ selectiveTcvFolder , tcf_hole = do_hole , tcf_tycobinder = addBndrSelectiveFV } where - do_tcv v = MkFV (\bvs -> EndoOS (do_it bvs)) + do_tcv v = MkFV (\env -> EndoOS (do_it env)) where - do_it (is_interesting,bvs) acc + do_it (bvs,is_interesting) acc + | v `elemVarSet` bvs = acc -- First exclude bound variables | not (is_interesting v) = acc -- The "selective" bit - | v `elemVarSet` bvs = acc | v `elemDVarSet` acc = acc | otherwise = acc `extendDVarSet` v @@ -847,43 +847,67 @@ invisibleVarsOfTypes = foldr (unionVarSet . invisibleVarsOfType) emptyVarSet * * ********************************************************************* -} -{-# INLINE afvFolder #-} -- so that specialization to (const True) works -afvFolder :: (TyCoVar -> Bool) -> TyCoFolder (FV TyCoVarSet DM.Any) +{- Note [Any-free-var folder] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The "any-free-var" folders take a `check_fv` predicate (TyCoVar -> Bool) and +check if any free variable of the type/coercion satisfies it. Our main folders +look like: + + afv_type :: Type -> FV (BoundVars, TyVar -> Bool) Any + +where we cleverly pair the predicate with the forall-bound variables of the type +in the "env" field of (FV env Any). This way we can build the /folder/ once and +for all (independent of the `check_fv` predicate), and the loop passes down +the pair. + +The same idiom is used in `exprFreeVarsDSet` and friends. + +However we are careful to inline `atvFolder` and `runAny` so that we get those +nice tight loops. +-} + +{-# INLINE afvFolder #-} -- See Note [Inlining any-fvs] +afvFolder :: TyCoFolder (FV (BoundVars, TyCoVar -> Bool) DM.Any) -- 'afvFolder' is short for "any-free-var folder", good for checking --- if any shallow free var of a type satisfies a predicate `check_fv` -afvFolder check_fv = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms] - , tcf_tyvar = do_tcv, tcf_covar = do_tcv - , tcf_hole = do_hole - , tcf_tycobinder = addBndrFV } +-- if any shallow free var of a type satisfies a predicate `check_fv` +-- The "env" of the (FV env Any) is a pair (bvs,pred) of +-- the bound variables (which are definitely not free), and +-- an "interesting var" predicate which the client supplies +afvFolder = TyCoFolder { tcf_view = noView -- See Note [Free vars and synonyms] + , tcf_tyvar = do_tcv, tcf_covar = do_tcv + , tcf_hole = do_hole + , tcf_tycobinder = addBndrSelectiveFV } where - do_tcv tv = MkFV $ \ bvs -> + do_tcv tv = MkFV $ \ (bvs,check_fv) -> Any (not (tv `elemVarSet` bvs) && check_fv tv) do_hole hole = do_tcv (coHoleCoVar hole) +afv_type :: Type -> FV (BoundVars, TyVar -> Bool) DM.Any +afv_types :: [Type] -> FV (BoundVars, TyVar -> Bool) DM.Any +afv_co :: Coercion -> FV (BoundVars, TyVar -> Bool) DM.Any +(afv_type, afv_types, afv_co, _) = foldTyCo afvFolder + +runAny :: (TyVar -> Bool) -> FV (BoundVars, TyCoVar -> Bool) DM.Any -> Bool +{-# INLINE runAny #-} +runAny check_fv fvs = DM.getAny $ runFV fvs (emptyVarSet, check_fv) + anyFreeVarsOfType :: (TyCoVar -> Bool) -> Type -> Bool -anyFreeVarsOfType check_fv ty = DM.getAny (runFVTop (f ty)) - where (f, _, _, _) = foldTyCo (afvFolder check_fv) +anyFreeVarsOfType check_fv ty = runAny check_fv (afv_type ty) anyFreeVarsOfTypes :: (TyCoVar -> Bool) -> [Type] -> Bool -anyFreeVarsOfTypes check_fv tys = DM.getAny (runFVTop (f tys)) - where (_, f, _, _) = foldTyCo (afvFolder check_fv) +anyFreeVarsOfTypes check_fv tys = runAny check_fv (afv_types tys) anyFreeVarsOfCo :: (TyCoVar -> Bool) -> Coercion -> Bool -anyFreeVarsOfCo check_fv co = DM.getAny (runFVTop (f co)) - where (_, _, f, _) = foldTyCo (afvFolder check_fv) +anyFreeVarsOfCo check_fv co = runAny check_fv (afv_co co) noFreeVarsOfType :: Type -> Bool -noFreeVarsOfType ty = not $ DM.getAny (runFVTop (f ty)) - where (f, _, _, _) = foldTyCo (afvFolder (const True)) +noFreeVarsOfType ty = not $ runAny (const True) (afv_type ty) noFreeVarsOfTypes :: [Type] -> Bool -noFreeVarsOfTypes tys = not $ DM.getAny (runFVTop (f tys)) - where (_, f, _, _) = foldTyCo (afvFolder (const True)) +noFreeVarsOfTypes tys = not $ runAny (const True) (afv_types tys) noFreeVarsOfCo :: Coercion -> Bool -noFreeVarsOfCo co = not $ DM.getAny (runFVTop (f co)) - where (_, _, f, _) = foldTyCo (afvFolder (const True)) - +noFreeVarsOfCo co = not $ runAny (const True) (afv_co co) {- ************************************************************************ ===================================== compiler/GHC/Types/Var/FV.hs ===================================== @@ -9,7 +9,7 @@ module GHC.Types.Var.FV ( runFVSelective, runFVSelectiveList, runFVSelectiveSet, InterestingVarFun, - addBndrFV, addBndrsFV, addBndrSelectiveFV, addBndrsSelectiveFV, + updEnvFV, addBndrFV, addBndrsFV, addBndrSelectiveFV, addBndrsSelectiveFV, emptyFV, -- or `mempty` unionFV, -- or `mappend` mapUnionFV @@ -138,7 +138,7 @@ type BoundVars = TyCoVarSet type VarSetFV = FV BoundVars (EndoOS TyCoVarSet) type DVarSetFV = FV BoundVars (EndoOS DTyCoVarSet) -type SelectiveDFV = FV (InterestingVarFun, BoundVars) (EndoOS DVarSet) +type SelectiveDFV = FV (BoundVars, InterestingVarFun) (EndoOS DVarSet) -- VarSetFV: collects a VarSet -- DVarSetFV: collects a DVarSet (deterministic) -- SelectiveDFV: selectively collects a DVarSet @@ -174,28 +174,28 @@ emptyFV = MkFV (\_ -> mempty) unionFV :: Semigroup a => FV env a -> FV env a -> FV env a unionFV (MkFV' f1) (MkFV' f2) = MkFV (\env -> f1 env <> f2 env) -upd_bndrs_fv :: (env -> env) -> FV env a -> FV env a -{-# INLINE addBndrFV #-} -upd_bndrs_fv upd f = MkFV (\bvs -> runFV f $! upd bvs) +updEnvFV :: (env -> env) -> FV env a -> FV env a +updEnvFV upd f = MkFV (\bvs -> runFV f $! upd bvs) -- Strict application to avoid making a thunk addBndrFV :: TyCoVar -> FV BoundVars a -> FV BoundVars a -addBndrFV tcv = upd_bndrs_fv (\bvs -> extendVarSet bvs tcv) +{-# INLINE addBndrFV #-} +addBndrFV tcv = updEnvFV (\bvs -> extendVarSet bvs tcv) addBndrsFV :: [Var] -> FV BoundVars a -> FV BoundVars a -addBndrsFV tcvs = upd_bndrs_fv (\bvs -> extendVarSetList bvs tcvs) +addBndrsFV tcvs = updEnvFV (\bvs -> extendVarSetList bvs tcvs) -addBndrSelectiveFV :: TyCoVar -> FV (f, BoundVars) a -> FV (f, BoundVars) a +addBndrSelectiveFV :: TyCoVar -> FV (BoundVars, f) a -> FV (BoundVars, f) a addBndrSelectiveFV tcv - = upd_bndrs_fv (\(f,bvs) -> let !bvs' = extendVarSet bvs tcv + = updEnvFV (\(bvs,f) -> let !bvs' = extendVarSet bvs tcv -- Strict let to avoid thunks - in (f,bvs')) + in (bvs',f)) -addBndrsSelectiveFV :: [Var] -> FV (f, BoundVars) a -> FV (f, BoundVars) a +addBndrsSelectiveFV :: [Var] -> FV (BoundVars, f) a -> FV (BoundVars, f) a addBndrsSelectiveFV bs - = upd_bndrs_fv (\(f,bvs) -> let !bvs' = extendVarSetList bvs bs + = updEnvFV (\(bvs,f) -> let !bvs' = extendVarSetList bvs bs -- Strict let to avoid thunks - in (f,bvs')) + in (bvs',f)) mapUnionFV :: (Foldable t, Monoid acc) => (a -> FV env acc) -> t a -> FV env acc @@ -221,7 +221,7 @@ runTyCoVarsDSet f = runFVAcc f emptyDVarSet runFVSelective :: InterestingVarFun -> SelectiveDFV -> DVarSet runFVSelective interesting f - = runEndoOS (runFV f (interesting, emptyVarSet)) emptyDVarSet + = runEndoOS (runFV f (emptyVarSet, interesting)) emptyDVarSet runFVSelectiveList :: InterestingVarFun -> SelectiveDFV -> [Var] runFVSelectiveList interesting f = dVarSetElems (runFVSelective interesting f) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2f4f707b4ea34b99a04a7611618562… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2f4f707b4ea34b99a04a7611618562… 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] 3 commits: EPA Fix HsCmdDo exact print with comments
by Marge Bot (＠marge-bot) 09 Sep '26

09 Sep '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - c358ef9d by Simon Jakobi at 2026-09-09T03:32:34-04:00 FastString: Drop mkFastStringWith's constructor callback All three callers passed the same callback, a partial application of mkNewFastStringShortByteString to the string being interned. That partial application is allocated as a closure before the table lookup, on the common hit path too, although the callback is needed only after a miss. Drop the parameter and call mkNewFastStringShortByteString directly after a miss. Since nothing is passed "with" anymore, rename the function to internSB. Suggested by Simon PJ in #27528: https://gitlab.haskell.org/ghc/ghc/-/work_items/27528#note_687031 Assisted-by: Claude Fable 5 - - - - - 04fcdddb by Alan Zimmerman at 2026-09-09T03:32:35-04:00 EPA: Exact print ConDeclGADT without custom enterAnn !16321 brought in explicit capture of parens in a ConDeclGADT. The ExactPrint update introduced a modification of the fundamental function in exact printing, `enterAnn`, by splitting it into a version allowing injection of functionality normally handled by the ExactPrint class methods. This commit refactors that code, to restore the prior `enterAnn` version, by following the convention in ExactPrint of introducing a helper data structure with its own `ExactPrint` instance to achieve the same effect. - - - - - 4 changed files: - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -320,7 +320,7 @@ data FastStringTable = FastStringTable -- ^ Number of computed z-encodings for all buckets. -- -- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk - -- in 'mkFastStringWith' and needs to be boxed any way. + -- in 'internSB' and needs to be boxed any way. -- If this is unpacked, then we box this single 'FastMutInt' once for each -- allocated FastString. (Array# (IORef FastStringTableSegment)) -- ^ concurrent segments @@ -474,9 +474,10 @@ The procedure goes like this: * Otherwise, insert and return the string we created. -} -mkFastStringWith - :: (Int -> FastMutInt-> IO FastString) -> ShortByteString -> IO FastString -mkFastStringWith mk_fs sbs = do +-- | Return the interned 'FastString' for the given bytes, creating and +-- inserting one on a table miss. +internSB :: ShortByteString -> IO FastString +internSB sbs = do FastStringTableSegment lock _ buckets# <- readIORef segmentRef let idx# = hashToIndex# buckets# hash# bucket <- IO $ readArray# buckets# idx# @@ -487,7 +488,7 @@ mkFastStringWith mk_fs sbs = do -- only run partially and putMVar is not called after takeMVar. noDuplicate n <- get_uid - new_fs <- mk_fs n n_zencs + new_fs <- mkNewFastStringShortByteString sbs n n_zencs withMVar lock $ \_ -> insert new_fs where !(FastStringTable uid n_zencs segments#) = stringTable @@ -523,11 +524,11 @@ bucket_match fs sbs = go fs mkFastStringBytes :: Ptr Word8 -> Int -> FastString mkFastStringBytes !ptr !len = - -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is + -- NB: Might as well use unsafeDupablePerformIO, since internSB is -- idempotent. unsafeDupablePerformIO $ do sbs <- newSBSFromPtr ptr len - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + internSB sbs newSBSFromPtr :: Ptr a -> Int -> IO ShortByteString newSBSFromPtr (Ptr src#) (I# len#) = @@ -541,14 +542,13 @@ newSBSFromPtr (Ptr src#) (I# len#) = mkFastStringByteString :: ByteString -> FastString mkFastStringByteString bs = let sbs = SBS.toShort bs in - inlinePerformIO $ - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + inlinePerformIO $ internSB sbs -- | Create a 'FastString' from an existing 'ShortByteString' without -- copying. mkFastStringShortByteString :: ShortByteString -> FastString mkFastStringShortByteString sbs = - inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + inlinePerformIO $ internSB sbs -- | Create a 'FastString' from an 'HText' mkFastStringShortText :: ShortText -> FastString @@ -560,7 +560,7 @@ mkFastString :: String -> FastString mkFastString str = inlinePerformIO $ do let !sbs = utf8EncodeShortByteString str - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + internSB sbs -- The following rule is used to avoid polluting the non-reclaimable FastString -- table with transient strings when we only want their encoding. ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -58,6 +58,7 @@ import Language.Haskell.Syntax.Doc import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Module.Name +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass pass)) = SrcSpan deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass) ===================================== compiler/GHC/Hs/Extension/Pass.hs ===================================== @@ -46,6 +46,7 @@ type instance XRec (GhcPass p) a = XRecGhc a -- but pass-independent, source location type XRecGhc a = GenLocated (Anno a) a +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine type instance Anno (HsDocString (GhcPass _)) = SrcSpan type instance Anno HsDocStringChunk = SrcSpan ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -370,10 +370,6 @@ cua CanUpdateAnchor f = f cua CanUpdateAnchorOnly _ = return [] cua NoCanUpdateAnchor _ = return [] -enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a -enterAnn = enterAnnWith exact setAnnotationAnchor - -{-# INLINE enterAnnWith #-} -- | "Enter" an annotation, by using the associated 'anchor' field as -- the new reference point for calculating all DeltaPos positions. -- This is the heart of the exact printing process. @@ -381,17 +377,14 @@ enterAnn = enterAnnWith exact setAnnotationAnchor -- This is combination of the ghc=exactprint Delta.withAST and -- Print.exactPC functions and effectively does the delta processing -- immediately followed by the print processing. JIT ghc-exactprint. -enterAnnWith :: (Monad m, Monoid w, Typeable a, Typeable b) => - (a -> EP w m b) -> -- exact - (b -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> b) -> -- setAnnotationAnchor - Entry -> a -> EP w m b -enterAnnWith exactVia _ NoEntryVal a = do +enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a +enterAnn NoEntryVal a = do p <- getPosP debugM $ "enterAnn:starting:NO ANN:(p,a) =" ++ show (p, astId a) - r <- exactVia a + r <- exact a debugM $ "enterAnn:done:NO ANN:p =" ++ show (p, astId a) return r -enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do +enterAnn !(Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do acceptSpan <- getAcceptSpan setAcceptSpan False case anchor' of @@ -502,7 +495,7 @@ enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpd advance edp debugM $ "enterAnn:exact a starting:" ++ show (showAst anchor') - a' <- exactVia a + a' <- exact a debugM $ "enterAnn:exact a done:" ++ show (showAst anchor') -- Core recursive exactprint done, start end of Entry processing @@ -556,8 +549,8 @@ enterAnnWith exactVia setAnnAnchor !(Entry anchor' trailing_anns cs flush canUpd EpaSpan s -> EpaDelta s edp [] _ -> EpaDelta noSrcSpan edp [] let r = case canUpdateAnchor of - CanUpdateAnchor -> setAnnAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs) - CanUpdateAnchorOnly -> setAnnAnchor a' newAnchor [] emptyComments + CanUpdateAnchor -> setAnnotationAnchor a' newAnchor trailing' (mkEpaComments priorCs postCs) + CanUpdateAnchorOnly -> setAnnotationAnchor a' newAnchor [] emptyComments NoCanUpdateAnchor -> a' return r @@ -3404,13 +3397,13 @@ instance ExactPrint (HsCmd GhcPs) where e' <- markAnnotated e return (HsCmdLet (tkLet', tkIn') binds' e') - exact (HsCmdDo (an0,loc) (L l es)) = do + exact (HsCmdDo (an0,loc) es) = do debugM $ "HsCmdDo" loc' <- printStringAtAA loc "do" (an1,es') <- markAnnList' an0 $ do - ee <- mapM markAnnotated es + ee <- markAnnotated es return ee - return (HsCmdDo (an1,loc') (L l es')) + return (HsCmdDo (an1,loc') es') -- --------------------------------------------------------------------- @@ -4264,26 +4257,13 @@ instance ExactPrint (ConDecl GhcPs) where epTokensToComments "(" ops epTokensToComments ")" cps - -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558 outer_bndrs' <- case outer_bndrs of L _ (HsOuterImplicit _) -> return outer_bndrs _ -> markAnnotated outer_bndrs - (inner_bndrs', (mcxt', args', res_ty')) <- markGadtArgs inner_bndrs $ do - mcxt' <- markAnnotated mcxt - args' <- - case args of - (PrefixConGADT x args0) -> do - args0' <- mapM markAnnotated args0 - return (PrefixConGADT x args0') - (RecConGADT (oc,cc,rarr) fields) -> do - oc' <- markEpToken oc - fields' <- markAnnotated fields - cc' <- markEpToken cc - rarr' <- markEpUniToken rarr - return (RecConGADT (oc',cc',rarr') fields') - res_ty' <- markAnnotated res_ty - return (mcxt', args', res_ty') + let ib = toInnerBindings inner_bndrs (mcxt, args, res_ty) + ib' <- markAnnotated ib + let (inner_bndrs', (mcxt', args', res_ty')) = fromInnerBindings ib' return (ConDeclGADT { con_g_ext = AnnConDeclGADT [] [] dcol' , con_names = cons' @@ -4293,43 +4273,54 @@ instance ExactPrint (ConDecl GhcPs) where , con_modifiers = mods' , con_res_ty = res_ty', con_doc = doc }) --- | Exact print the inner binders of a GADT signature. --- --- It's that complicated because we need to mark comments/trailing anns --- stored inside `L` and mark closing parenthesis _after_ we mark inner --- type: --- --- data T a b where --- MkT :: --- forall a. ( -- mark inside `markGadtArgs` --- forall b. some type -> T a b -- mark everything there --- ) -- mark inside `markGadtArgs` --- --- We don't have the same problem for `HsArgPar` because we ignore it --- during exact-print, "Does not appear in original source" -markGadtArgs :: (Monad m, Monoid w, Typeable a) - => [LHsGadtTelescope GhcPs] -> EP w m a - -> EP w m ([LHsGadtTelescope GhcPs], a) -markGadtArgs args inner_action = go args +-- --------------------------------------------------------------------- + +data InnerBindings + = InnerMore (LHsGadtTelescope GhcPs) InnerBindings + | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) + +toInnerBindings :: [LHsGadtTelescope GhcPs] + -> (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) -> InnerBindings +toInnerBindings [] inner = InnerDone inner +toInnerBindings (b:bs) inner = InnerMore b (toInnerBindings bs inner) + +fromInnerBindings :: InnerBindings -> ([LHsGadtTelescope GhcPs], (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs)) +fromInnerBindings = go [] where - go [] = do - r <- inner_action - return ([], r) - go (arg:xs) = enterAnnWith (exact_arg xs) setAnchor (entryFromLocatedA arg) arg + go acc (InnerMore b n) = go (b:acc) n + go acc (InnerDone x) = (acc,x) - exact_arg xs (L l (HsGadtForAll _ tele)) = do - tele' <- markAnnotated tele - (xs', r) <- go xs - return (L l (HsGadtForAll noExtField tele') : xs', r) - exact_arg xs (L l (HsGadtPar (lp, rp))) = do - lp' <- markEpToken lp - (xs', r) <- go xs - rp' <- markEpToken rp - return (L l (HsGadtPar (lp',rp')) : xs', r) +instance ExactPrint InnerBindings where + getAnnotationEntry (InnerMore (L li _) _) = fromAnn li + getAnnotationEntry (InnerDone _) = NoEntryVal - -- The binder just entered is the head of the returned list - setAnchor (arg':xs', r) anc ts cs = (setAnchorAn arg' anc ts cs : xs', r) - setAnchor ([], r) _ _ _ = ([], r) + setAnnotationAnchor (InnerMore li n) anc ts cs = InnerMore (setAnchorAn li anc ts cs) n + setAnnotationAnchor (InnerDone x) _ _ _ = InnerDone x + + exact (InnerMore (L li (HsGadtForAll x tele)) n) = do + tele' <- markAnnotated tele + n' <- markAnnotated n + return (InnerMore (L li (HsGadtForAll x tele')) n') + exact (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do + lp' <- markEpToken lp + xs' <- markAnnotated xs + rp' <- markEpToken rp + return (InnerMore (L l (HsGadtPar (lp',rp'))) xs') + exact (InnerDone (mcxt, args, res_ty)) = do + mcxt' <- markAnnotated mcxt + args' <- + case args of + (PrefixConGADT x args0) -> do + args0' <- mapM markAnnotated args0 + return (PrefixConGADT x args0') + (RecConGADT (oc,cc,rarr) fields) -> do + oc' <- markEpToken oc + fields' <- markAnnotated fields + cc' <- markEpToken cc + rarr' <- markEpUniToken rarr + return (RecConGADT (oc',cc',rarr') fields') + res_ty' <- markAnnotated res_ty + return (InnerDone (mcxt', args', res_ty')) -- --------------------------------------------------------------------- @@ -4508,10 +4499,10 @@ instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] whe Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do debugM $ "LocatedL [ExprLStmt: snocView" ls' <- markAnnotated ls - initStmts' <- markAnnotated initStmts + initStmts' <- mapM markAnnotated initStmts return (initStmts' ++ [ls']) _ -> do - stmts' <- markAnnotated stmts + stmts' <- mapM markAnnotated stmts return stmts' instance ExactPrint [Located HsDocStringChunk] where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ab270a20d1152aaf89c17c70cdf8c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ab270a20d1152aaf89c17c70cdf8c… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/substitution-via-mapper] 11 commits: rts: fix ctoi_tuple_spill_words getting out of sync
by Simon Peyton Jones (＠simonpj) 09 Sep '26

09 Sep '26

Simon Peyton Jones pushed to branch wip/substitution-via-mapper at Glasgow Haskell Compiler / GHC Commits: 192be0b6 by Luite Stegeman at 2026-09-07T19:43:36-04:00 rts: fix ctoi_tuple_spill_words getting out of sync Fix a few places that were not updating ctoi_tuple_spill_words correctly, leading to corruption/crashes when dealing with large unboxed tuples in bytecode: - captureContinuationAndAbort - findRetryFrameHelper/findAtomicallyFrameHelper - interpretBCO bci_BRK_FUN fixes #27633 - - - - - 604eb43c by Simon Jakobi at 2026-09-07T19:44:15-04:00 Hadrian: don't capture the testsuite driver's output (#27780) a6061455d54 switched the Testsuite RunTest case from Shake's cmd to the cmd' wrapper. cmd' always captures stdout and stderr, and since the caller asks for Exit, it returns without dumping what it captured. As a result the testsuite output no longer appears in CI job logs: failures, performance metrics and the summary were lost with the job. Use cmdExe, the uncaptured cmd, as the other plain-cmd sites in that commit do. Fixes #27780. Assisted-by: Claude Fable 5.1 - - - - - 06eee015 by Luite Stegeman at 2026-09-08T06:03:06+02:00 rts: Fix missing memory barrier in eval_thunk_selector (#27477) unchain_thunk_selectors() was missing an ACQUIRE_LOAD for the indirectee, leading to segfaults and corruption during GC on weakly-ordered architectures. Fixes #27477 - - - - - f8b2bd8f by Alan Zimmerman at 2026-09-08T09:39:12-04:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - 5c341aec by Simon Peyton Jones at 2026-09-09T08:16:21+01:00 Try using TyCoMapper for substitutions - - - - - 5fbacf20 by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Implement substitution via TyCoMapper This is a significant bit of refactoring. The dependencies look like this, where each module depends on one above Defines Needs --------------------------------------------------- GHC.Core.TyCo.Rep Type, Coercion TyCoFolder GHC.Core.TyCo.FVs Free-var finders TyCoFolder GHC.Core.TyCo.Make Lots of mkX functions Free vars TyCoMapper GHC.Core.TyCo.Subst Substitution TyCoMapper, mkX functions GHC.Core.Type coreView, typeKind Substitution coercionKind GHC.Core.TyCo.Compare Comparison coreView Some `mkX` functions (such as `mkLRCo`, `mkInstCo`, `mkCastTy`) use substitution, and so are defined in GHC.Core.Type via a hs-boot import. - - - - - cd10776c by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Make substitution strict It's nice that it is so easy to do so - - - - - 4c4683e9 by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Wibbles - - - - - 8d227953 by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Wibbles - - - - - 02eb1b02 by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Wibble imports - - - - - 6646c67a by Simon Peyton Jones at 2026-09-09T08:16:22+01:00 Wibbles - - - - - 58 changed files: - + changelog.d/fix-parallel-gc-selector-race-27477 - compiler/GHC/Builtin/WiredIn/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/TyCo/FVs.hs - + compiler/GHC/Core/TyCo/Make.hs - + compiler/GHC/Core/TyCo/Make.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Type.hs-boot - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Stg/EnforceEpt/TagSig.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Arity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Cpr.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Map.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Var/Set.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - + compiler/GHC/Utils/StrictIdentity.hs - compiler/ghc.cabal.in - hadrian/src/Builder.hs - rts/Continuation.c - rts/Interpreter.c - rts/Schedule.c - rts/sm/Evac.c - + testsuite/tests/bytecode/T27633/Obj.hs - + testsuite/tests/bytecode/T27633/T27633a.hs - + testsuite/tests/bytecode/T27633/T27633a.stdout - + testsuite/tests/bytecode/T27633/T27633b.hs - + testsuite/tests/bytecode/T27633/T27633b.stdout - + testsuite/tests/bytecode/T27633/all.T - + testsuite/tests/ghci.debugger/scripts/T27633c.hs - + testsuite/tests/ghci.debugger/scripts/T27633c.script - + testsuite/tests/ghci.debugger/scripts/T27633c.stdout - + testsuite/tests/ghci.debugger/scripts/T27633c_obj.hs - testsuite/tests/ghci.debugger/scripts/all.T - + testsuite/tests/rts/T27477.hs - + testsuite/tests/rts/T27477.stdout - testsuite/tests/rts/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cabfd30c53b023420eaa5aa8d696f5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cabfd30c53b023420eaa5aa8d696f5… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/interpolated-strings] Implement interpolated strings
by Brandon Chinn (＠brandonchinn178) 09 Sep '26

09 Sep '26

Brandon Chinn pushed to branch wip/interpolated-strings at Glasgow Haskell Compiler / GHC Commits: cb906d98 by Brandon Chinn at 2026-09-08T21:34:06-07:00 Implement interpolated strings - - - - - 76 changed files: - + changelog.d/string-interpolation - compiler/GHC/Builtin/KnownOccs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/Lexer/String.x - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Expr.hs - + compiler/GHC/Rename/String.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/ghc.cabal.in - docs/users_guide/exts/qualified_strings.rst - + docs/users_guide/exts/string_interpolation.rst - libraries/base/src/GHC/Essentials.hs - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/Data/String/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Builder/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Class/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/Default/Experimental.hs - + libraries/ghc-experimental/src/Data/String/Interpolate/ShowS/Experimental.hs - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/Data/String/Interpolate.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.hs - + testsuite/tests/parser/should_fail/MultilineStringsEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.hs - + testsuite/tests/parser/should_fail/StringInterpolationEscapeOverflow.stderr - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.hs - + testsuite/tests/parser/should_fail/StringInterpolationExtraOpen.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInPat.hs - + testsuite/tests/parser/should_fail/StringInterpolationInPat.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInType.hs - + testsuite/tests/parser/should_fail/StringInterpolationInType.stderr - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationIncompleteExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationInvalidExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.hs - + testsuite/tests/parser/should_fail/StringInterpolationLineComment.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoDelimClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExpr.stderr - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.hs - + testsuite/tests/parser/should_fail/StringInterpolationNoExprClose.stderr - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.hs - + testsuite/tests/parser/should_fail/StringInterpolationSmartQuotes.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_run/StringInterpolation.hs - + testsuite/tests/parser/should_run/StringInterpolation.stdout - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.hs - + testsuite/tests/parser/should_run/StringInterpolationOverloaded.stdout - testsuite/tests/parser/should_run/all.T - + testsuite/tests/qualified-strings/should_run/Example/SQL.hs - testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.hs - + testsuite/tests/qualified-strings/should_run/qstrings_interpolation.stdout - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb906d98d8fa83c2c26cfcf6ad6eaf3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb906d98d8fa83c2c26cfcf6ad6eaf3… 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/T27528] FastString: Drop mkFastStringWith's constructor callback
by Simon Jakobi (＠sjakobi) 09 Sep '26

09 Sep '26

Simon Jakobi pushed to branch wip/sjakobi/T27528 at Glasgow Haskell Compiler / GHC Commits: 7982819d by Simon Jakobi at 2026-09-09T00:39:11+02:00 FastString: Drop mkFastStringWith's constructor callback All three callers passed the same callback, a partial application of mkNewFastStringShortByteString to the string being interned. That partial application is allocated as a closure before the table lookup, on the common hit path too, although the callback is needed only after a miss. Drop the parameter and call mkNewFastStringShortByteString directly after a miss. Since nothing is passed "with" anymore, rename the function to internSB. Suggested by Simon PJ in #27528: https://gitlab.haskell.org/ghc/ghc/-/work_items/27528#note_687031 Assisted-by: Claude Fable 5 - - - - - 1 changed file: - compiler/GHC/Data/FastString.hs Changes: ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -320,7 +320,7 @@ data FastStringTable = FastStringTable -- ^ Number of computed z-encodings for all buckets. -- -- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk - -- in 'mkFastStringWith' and needs to be boxed any way. + -- in 'internSB' and needs to be boxed any way. -- If this is unpacked, then we box this single 'FastMutInt' once for each -- allocated FastString. (Array# (IORef FastStringTableSegment)) -- ^ concurrent segments @@ -474,9 +474,10 @@ The procedure goes like this: * Otherwise, insert and return the string we created. -} -mkFastStringWith - :: (Int -> FastMutInt-> IO FastString) -> ShortByteString -> IO FastString -mkFastStringWith mk_fs sbs = do +-- | Return the interned 'FastString' for the given bytes, creating and +-- inserting one on a table miss. +internSB :: ShortByteString -> IO FastString +internSB sbs = do FastStringTableSegment lock _ buckets# <- readIORef segmentRef let idx# = hashToIndex# buckets# hash# bucket <- IO $ readArray# buckets# idx# @@ -487,7 +488,7 @@ mkFastStringWith mk_fs sbs = do -- only run partially and putMVar is not called after takeMVar. noDuplicate n <- get_uid - new_fs <- mk_fs n n_zencs + new_fs <- mkNewFastStringShortByteString sbs n n_zencs withMVar lock $ \_ -> insert new_fs where !(FastStringTable uid n_zencs segments#) = stringTable @@ -523,11 +524,11 @@ bucket_match fs sbs = go fs mkFastStringBytes :: Ptr Word8 -> Int -> FastString mkFastStringBytes !ptr !len = - -- NB: Might as well use unsafeDupablePerformIO, since mkFastStringWith is + -- NB: Might as well use unsafeDupablePerformIO, since internSB is -- idempotent. unsafeDupablePerformIO $ do sbs <- newSBSFromPtr ptr len - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + internSB sbs newSBSFromPtr :: Ptr a -> Int -> IO ShortByteString newSBSFromPtr (Ptr src#) (I# len#) = @@ -541,14 +542,13 @@ newSBSFromPtr (Ptr src#) (I# len#) = mkFastStringByteString :: ByteString -> FastString mkFastStringByteString bs = let sbs = SBS.toShort bs in - inlinePerformIO $ - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + inlinePerformIO $ internSB sbs -- | Create a 'FastString' from an existing 'ShortByteString' without -- copying. mkFastStringShortByteString :: ShortByteString -> FastString mkFastStringShortByteString sbs = - inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + inlinePerformIO $ internSB sbs -- | Create a 'FastString' from an 'HText' mkFastStringShortText :: ShortText -> FastString @@ -560,7 +560,7 @@ mkFastString :: String -> FastString mkFastString str = inlinePerformIO $ do let !sbs = utf8EncodeShortByteString str - mkFastStringWith (mkNewFastStringShortByteString sbs) sbs + internSB sbs -- The following rule is used to avoid polluting the non-reclaimable FastString -- table with transient strings when we only want their encoding. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7982819d41f56e4ddcd6ab086ec4752… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7982819d41f56e4ddcd6ab086ec4752… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/az/exactprint-main-loop-note] EPA: Add a Note for the exact print main loop
by Alan Zimmerman (＠alanz) 09 Sep '26

09 Sep '26

Alan Zimmerman pushed to branch wip/az/exactprint-main-loop-note at Glasgow Haskell Compiler / GHC Commits: 8fe8c86e by Alan Zimmerman at 2026-09-08T22:26:54+01:00 EPA: Add a Note for the exact print main loop - - - - - 1 changed file: - utils/check-exact/ExactPrint.hs Changes: ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -239,7 +239,131 @@ setAnchorEpaL (EpAnn _ an _) anc ts cs = EpAnn anc (setTrailing (an {al_anchor = -- | Key entry point. Switches to an independent AST element with its -- own annotation, calculating new offsets, etc markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a -markAnnotated a = enterAnn (getAnnotationEntry a) a +markAnnotated a = enterAnn (getAnnotationEntry a) a -- See Note [Exact print main loop] + +{- +Note [Exact print main loop] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The exact print main loop is driven by a combination of factors +working together. It keeps track of the current printing state +(EPState), and prints each item in terms of this state, updating as it +works. + +This main loop works over a tree of items each implementing class +ExactPrint, defined as + +class (Typeable a) => ExactPrint a where + getAnnotationEntry :: a -> Entry + exact :: (Monad m, Monoid w) => a -> EP w m a + setAnnotationAnchor :: a -> EpaLocation -> [TrailingAnn] -> EpAnnComments -> a + +- getAnnotationEntry : returns the "entry" information. This carries + - The location of the first non-comment part of the item to be printed. + - Any [TrailingAnn] (semis, commas, etc) to follow the item. + - Any comments associated with the item, but not with enclosed items. + These comments may also precede or follow the entry location + - Some technical flags, relating to flushing remaining comments at the + last (topmost) item, and if the anchor can be updated (see below). + +- exact : Do the actual printing of the item, having been put in the right + place in terms of print location by the main loop, based on a call to + getAnnotationEntry for it. + +- setAnnotationAnchor : the main loop printing does two things: + - produce output, reflecting the items being printed + - convert all the locations in the item (each an EpaLocation) from its + EpaSpan version to an EpaDelta one, which is independent of absolute + location, being the spacing from the previous print output to this + entry point + To allow these updated locations to be captured, the item implements + the setAnnotationAnchor method, which updates the fields of the Entry + returned by getAnnotationEntry + +Given we have a tree structure (ParsedSource, usually) where each +child implements an ExactPrint instance, the main loop can drive the +printing, using the following machinery. + + markAnnotated :: (Monad m, Monoid w, ExactPrint a) => a -> EP w m a + markAnnotated a = enterAnn (getAnnotationEntry a) a + +This is the function which turns the crank on the main loop. +You will see it calls enterAnn with the relevant Entry for the item +being printed. + + enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a + +This manages the printing state, adding the new comments from the Entry, +positioning the print head to the entry point, takes account of whether +it is an absolute span or a delta, and prints any comments that must come +before this location. + +Once it is at this point, it calls the `exact` method on the item. This +is the only place `exact` can be called. Within `exact` implementations +the `markAnnotated` function should be used instead, to ensure the state +is managed properly for printing. + +Once the item is printed via its `exact` method, which normally +recurses via `markAnnotated` into any nested items inside it, the +`enterAnn` function prints any [TrailingAnn] from the entry and any +trailing comments. It then wraps up by calling +`setAnnotationAnchor`with the updated (now delta-based) values for the +Entry + +Printing Complicated Items +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Sometimes we need to print a sub-item which does not map cleanly onto the +ExactPrint class, usually because there are parts spread through the item +that need to be managed together while printing. + +An example is in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16321, where +ConDeclGADT needs to print its inner_bindings, but the these in turn +may have parens, e.g. + + data V a where + MkV4 :: forall a. ((forall b. (Show a => a -> (b -> V a)))) + +Here there are inner bindings for the first forall, the multiple +parens around the second forall, and the second forall, wrapping the +inner content within this. + +But the inner content `Show a => a -> (b -> V a)` had to be printed "inside" +the inner_bindings, to correctly close the nested parens. + +The approach in !16321 modified `enterAnn`, to pass in alternate versions +of the `exact` implementation. This works, but it makes an already +complicated function even more complicated. + +An ExactPrint-idiomatic approach is to create a helper data structure +to represent this nested organisation, and provide ExactPrint +instances for that. + +This is done in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16644, using + + data InnerBindings + = InnerMore (LHsGadtTelescope GhcPs) InnerBindings + | InnerDone (Maybe (LHsContext GhcPs), HsConDeclGADTDetails GhcPs, LHsType GhcPs) + +The key part of the ExactPrint instance for this is + + exact (InnerMore (L l (HsGadtPar (lp, rp))) xs) = do + lp' <- markEpToken lp + xs' <- markAnnotated xs + rp' <- markEpToken rp + return (InnerMore (L l (HsGadtPar (lp',rp'))) xs') + +This first prints the opening paren, prints the balance of the cons list, then +prints the closing paren. + +Conversions to and from this structure populate the initial values from +the ConDeclGADT, and retrieve the updated delta-based values after +printing. + +Another use of this technique involves HsModuleImpDecls. + +-} -- | For HsModule, because we do not have a proper SrcSpan, we must -- indicate to flush trailing comments when done. @@ -377,6 +501,7 @@ cua NoCanUpdateAnchor _ = return [] -- This is combination of the ghc=exactprint Delta.withAST and -- Print.exactPC functions and effectively does the delta processing -- immediately followed by the print processing. JIT ghc-exactprint. +-- See Note [Exact print main loop] enterAnn :: (Monad m, Monoid w, ExactPrint a) => Entry -> a -> EP w m a enterAnn NoEntryVal a = do p <- getPosP View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fe8c86e523436fa3111f4221eac82a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8fe8c86e523436fa3111f4221eac82a… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc] Pushed new branch wip/az/exactprint-main-loop-note
by Alan Zimmerman (＠alanz) 09 Sep '26

09 Sep '26

Alan Zimmerman pushed new branch wip/az/exactprint-main-loop-note at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/exactprint-main-loop-note 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