- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/spj-reinstallable-base2] 8 commits: fix warngs
by Rodrigo Mesquita (＠alt-romes) 15 May '26

15 May '26

Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 351af75c by Rodrigo Mesquita at 2026-05-14T17:07:30+01:00 fix warngs - - - - - 778decd3 by Rodrigo Mesquita at 2026-05-15T11:48:07+01:00 fixes - - - - - bd492169 by Rodrigo Mesquita at 2026-05-15T13:26:25+01:00 fixes - - - - - 4e99d807 by Rodrigo Mesquita at 2026-05-15T14:24:18+01:00 more fixes - - - - - 1c7a3237 by Rodrigo Mesquita at 2026-05-15T15:41:37+01:00 Fixes - - - - - 2578fb7c by Rodrigo Mesquita at 2026-05-15T16:21:41+01:00 rebindable - - - - - 8e8918c4 by Rodrigo Mesquita at 2026-05-15T16:41:48+01:00 rendundat - - - - - cec620e8 by Rodrigo Mesquita at 2026-05-15T18:44:35+01:00 wip: killing mk_known_key_name [skip ci] - - - - - 71 changed files: - compiler/GHC/Builtin/KnownKeys.hs - compiler/GHC/Builtin/TH.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Types/Name.hs - libraries/ghc-internal/src/GHC/Internal/Bits.hs - libraries/ghc-internal/src/GHC/Internal/Char.hs - libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs - libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs - libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs - libraries/ghc-internal/src/GHC/Internal/Data/Data.hs - libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs - libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs - libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs - libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Event/Array.hs - libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc - libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc - libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc - libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot - libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs - libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs - libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs - libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs - libraries/ghc-internal/src/GHC/Internal/IO.hs - libraries/ghc-internal/src/GHC/Internal/IO/Device.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs - libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs - libraries/ghc-internal/src/GHC/Internal/IO/FD.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs - libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs - libraries/ghc-internal/src/GHC/Internal/Int.hs - libraries/ghc-internal/src/GHC/Internal/Numeric.hs - libraries/ghc-internal/src/GHC/Internal/Pack.hs - libraries/ghc-internal/src/GHC/Internal/Read.hs - libraries/ghc-internal/src/GHC/Internal/STM.hs - libraries/ghc-internal/src/GHC/Internal/Show.hs - libraries/ghc-internal/src/GHC/Internal/Stable.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs - libraries/ghc-internal/src/GHC/Internal/Stats.hsc - libraries/ghc-internal/src/GHC/Internal/System/Environment.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc - libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc - libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs - libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/ghc-internal/src/GHC/Internal/Word.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17f61ab58d0b4dff5e56a34243bf14… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17f61ab58d0b4dff5e56a34243bf14… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/davide/ghc-toolchain-llvm-versions] ghc-toolchain: implement llvm program versioning logic
by David Eichmann (＠DavidEichmann) 15 May '26

15 May '26

David Eichmann pushed to branch wip/davide/ghc-toolchain-llvm-versions at Glasgow Haskell Compiler / GHC Commits: 0fe3356b by David Eichmann at 2026-05-15T17:20:29+01:00 ghc-toolchain: implement llvm program versioning logic - - - - - 3 changed files: - m4/ghc_toolchain.m4 - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs Changes: ===================================== m4/ghc_toolchain.m4 ===================================== @@ -143,7 +143,17 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN_BIN],[ GHC_TOOLCHAIN_BIN="bin/${CrossCompilePrefix}ghc-toolchain-bin" ;; NO) - # We're in the source tree, so compile ghc-toolchain + # We're in the source tree + + # Check for consistency of LLVM versions + hs_min_llvm=$(sed -n 's/^minLlvmVersion = //p' utils/ghc-toolchain/src/GHC/Toolchain/Program.hs) + hs_max_llvm=$(sed -n 's/^maxLlvmVersionExcl = //p' utils/ghc-toolchain/src/GHC/Toolchain/Program.hs) + test "$hs_min_llvm" = "$LlvmMinVersion" || \ + AC_MSG_ERROR([minLlvmVersion ($hs_min_llvm) in utils/ghc-toolchain/src/GHC/Toolchain/Program.hs must equal LlvmMinVersion ($LlvmMinVersion) in configure.ac]) + test "$hs_max_llvm" = "$LlvmMaxVersion" || \ + AC_MSG_ERROR([maxLlvmVersionExcl ($hs_max_llvm) in utils/ghc-toolchain/src/GHC/Toolchain/Program.hs must equal LlvmMaxVersion ($LlvmMaxVersion) in configure.ac]) + + # Compile ghc-toolchain "$GHC" -v0 \ -ilibraries/ghc-platform/src -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -289,13 +289,9 @@ formatOpts = [ validateOpts :: Opts -> [String] validateOpts opts = mconcat - [ assertJust _optTriple "missing --triple flag" - , assertJust _optOutput "missing --output flag" + [ ["missing --triple flag" | isNothing (optTriple opts)] + , ["missing --output flag" | isNothing (optOutput opts)] ] - where - assertJust :: Lens Opts (Maybe a) -> String -> [String] - assertJust lens msg = - [ msg | Nothing <- pure $ view lens opts ] main :: IO () main = do @@ -480,13 +476,13 @@ mkTarget opts = do throwE "Neither a object-merging tool (e.g. ld -r) nor an ar that supports -L is available" -- LLVM toolchain - llc <- optional $ findProgram "llc" (optLlc opts) ["llc"] - opt <- optional $ findProgram "opt" (optOpt opts) ["opt"] - llvmAs <- optional $ findProgram "llvm assembler" (optLlvmAs opts) ["clang"] + llc <- optional $ findLlvmProgram "llc" (optLlc opts) "llc" True + opt <- optional $ findLlvmProgram "opt" (optOpt opts) "opt" True + llvmAs <- optional $ findLlvmProgram "llvm assembler" (optLlvmAs opts) "clang" True -- for windows, also used for cross compiling windres <- optional $ findProgram "windres" (optWindres opts) ["windres"] - dlltool <- optional $ findProgram "dlltool" (optDlltool opts) ["llvm-dlltool"] + dlltool <- optional $ findLlvmProgram "dlltool" (optDlltool opts) "llvm-dlltool" False -- Darwin-specific utilities (otool, installNameTool) <- ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Toolchain.Program , _poPath , _poFlags , findProgram + , findLlvmProgram -- * Compiler programs , compile , supportsTarget @@ -23,7 +24,8 @@ module GHC.Toolchain.Program import Control.Monad import Control.Monad.IO.Class -import Data.List (intercalate, isPrefixOf) +import Data.Char (isDigit) +import Data.List (find, intercalate, isPrefixOf, tails) import Data.Maybe import System.FilePath import System.Directory @@ -131,17 +133,13 @@ programFromOpt userSpec path flags = Program { prgPath = fromMaybe path (poPath -- in the given list of candidates. -- -- If the 'ProgOpt' program flags are unspecified the program will have an empty list of flags. -findProgram :: String +findProgram :: String -- ^ The program description -> ProgOpt -- ^ path provided by user -> [FilePath] -- ^ candidate names -> M Program findProgram description userSpec candidates - | Just path <- poPath userSpec = do - let err = - [ "Failed to find " ++ description ++ "." - , "Looked for user-specified program '" ++ path ++ "' in the system search path." - ] - toProgram <$> find_it path <|> throwEs err + | Just findProgramFromProgOpts <- maybeFindProgramFromProgOpts description userSpec + = findProgramFromProgOpts | otherwise = do env <- getEnv @@ -154,17 +152,92 @@ findProgram description userSpec candidates [ "Failed to find " ++ description ++ "." , "Looked for one of " ++ show candidates' ++ " in the system search path." ] - toProgram <$> oneOf' err (map find_it candidates') <|> throwEs err + mkProgram userSpec <$> oneOf' err (map findExecutableErr candidates') <|> throwEs err + +-- Note that @configure.ac@ checks these llvm version constants (using @sed@) to +-- ensure they are the same as the @$LlvmMinVersion@ and @$LlvmMaxVersion@ +-- defined in @configure.ac@. + +-- Min llvm version (inclusive) +minLlvmVersion :: Int +minLlvmVersion = 13 + +-- Max llvm version (exclusive) +maxLlvmVersionExcl :: Int +maxLlvmVersionExcl = 23 + +-- Max llvm version (inclusive) +maxLlvmVersion :: Int +maxLlvmVersion = maxLlvmVersionExcl - 1 + +-- | Tries to find an llvm program with the highest supported llvm versions. +-- This searches for an explicitly versioned executable (postfixed with the llvm version). +-- If an explicitly versioned executable is not found, then this searches for a non-explicitly +-- versioned executable. If supported, the llvm version is checked by passing @--version@ to +-- the executable. +-- +-- If the 'ProgOpt' program flags are unspecified the program will have an empty list of flags. +findLlvmProgram :: String -- ^ The llvm program description + -> ProgOpt -- ^ path provided by user + -> FilePath -- ^ Candidate name + -> Bool -- ^ True if the program supports the @--version@ flag and the output + -- contains the llvm version number in the form @version <LLVM_VERSION>@ + -> M Program +findLlvmProgram description userSpec candidate checkVersion + | Just findProgramFromProgOpts <- maybeFindProgramFromProgOpts description userSpec + = findProgramFromProgOpts + + | otherwise = do + program <- findProgram description userSpec (versionedCandidates ++ [candidate]) + when checkVersion $ do + -- Extract the version from the `--version` output + versionOutput <- readProgramStdout program ["--version"] + let versionStrPrefix = "version " + + versionMay :: Maybe Int + versionMay = fmap (read . takeWhile isDigit . drop (length versionStrPrefix)) + . find (versionStrPrefix `isPrefixOf`) + $ tails versionOutput + + errSupportedVersions = prgPath program <> ": We only support llvm " <> show minLlvmVersion <> " upto " <> show maxLlvmVersion <> " (non-inclusive)" + case versionMay of + Nothing -> throwE (errSupportedVersions <> " (no version found).") + Just version -> when + (version < minLlvmVersion || version > maxLlvmVersion) + (throwE $ errSupportedVersions <> " (found " <> show version <> ").") + return program where - toProgram path = Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) } - - find_it name = do - r <- liftIO $ findExecutable name - case r of - Nothing -> throwE $ name ++ " not found in search path" - -- Use the given `prgPath` or candidate name rather than the - -- absolute path returned by `findExecutable`. - Just _x -> return name + versionedCandidates = + [ candidate <> postfix + | llvmVersion <- show <$> [maxLlvmVersion, maxLlvmVersion-1 .. minLlvmVersion] + , postfix <- + [ "-" <> llvmVersion + , "-" <> llvmVersion <> ".0" + , llvmVersion + ] + ] + +maybeFindProgramFromProgOpts :: String -> ProgOpt -> Maybe (M Program) +maybeFindProgramFromProgOpts description userSpec = case poPath userSpec of + Nothing -> Nothing + Just path -> do + let err = + [ "Failed to find " ++ description ++ "." + , "Looked for user-specified program '" ++ path ++ "' in the system search path." + ] + Just (mkProgram userSpec <$> findExecutableErr path <|> throwEs err) + +mkProgram :: ProgOpt -> FilePath -> Program +mkProgram userSpec path = Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) } + +findExecutableErr :: String -> M FilePath +findExecutableErr name = do + r <- liftIO $ findExecutable name + case r of + Nothing -> throwE $ name ++ " not found in search path" + -- Use the given `prgPath` or candidate name rather than the + -- absolute path returned by `findExecutable`. + Just _x -> return name -------------------- Compiling utilities -------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fe3356b40d492d7d093ba677cde09e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fe3356b40d492d7d093ba677cde09e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/T27202] Use home unit package db stacks in GHCi prompt and session unit
by Hannes Siebenhandl (＠fendor) 15 May '26

15 May '26

Hannes Siebenhandl pushed to branch wip/fendor/T27202 at Glasgow Haskell Compiler / GHC Commits: 9894df28 by fendor at 2026-05-15T17:39:19+02:00 Use home unit package db stacks in GHCi prompt and session unit In order to import modules from home unit dependencies (e.g., `Data.Map`), the ghci prompt unit needs to populate its `UnitState`. This is tricky to handle correctly, which `PackageDBFlag`s should we use to populate the `UnitState`? We decide, the most intuitive solution for users is to depend on all `PackageDBFlag`s, so that any dependency can be imported in GHCi. This assumes consistency in the `PackageDBFlag`s, so no two home units specify `PackageDBFlag`s that are inconsistent with each other. We could simply concat all the `PackageDBFlag`s of the existing home units, but later `PackageDBFlag`s shadow earlier ones, leading to the last processed home units' `PackageDBFlag`s to shadow the earlier ones. This is hard to fix, we need to give users the capability to provide ghc options for the ghci prompt home unit. However, as this is considerably more work, we decided on an approximation that should work out most of the time. Package Db stacks in cabal and stack follow a certain structure: -no-user-package-db > -package-db $cabal-store > -package-db $local-db The first two arguments are always the same, namely the `-no-user-package-db` and `-package-db`. We compute the longest common prefix over all home units, and use that as the start of the package db stack. Then, over the rest of the `PackageDBFlag`s, we simply take the union and append them to our initial stack. We assume, that the rest of package dbs only defines very few, "local" units that are usually not shadowing each other. This allows us to get a relatively consistent package database stack for the ghci prompt home unit. Similar reasoning applies to the session unit in order to add modules to the session and have dependencies available in the module. We do something similar for `-package` flags, to make sure only the correct units are actually visible in the ghci session. This time, we simply take the union of all `PackageFlag`s, allowing us to import modules from the home unit dependencies. In the future, it would be beneficial to allow the user to provide the exact ghc options to control the visibilities. For now, this will have to do. - - - - - 23 changed files: - changelog.d/T27202 - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Unit/State.hs - ghc/GHCi/UI.hs - + testsuite/tests/ghci/prog-mhu006/Makefile - + testsuite/tests/ghci/prog-mhu006/a/A.hs - + testsuite/tests/ghci/prog-mhu006/all.T - + testsuite/tests/ghci/prog-mhu006/b/B.hs - + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script - + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout - + testsuite/tests/ghci/prog-mhu006/unitA - + testsuite/tests/ghci/prog-mhu006/unitB - + testsuite/tests/ghci/prog025/Makefile - + testsuite/tests/ghci/prog025/a/A.hs - + testsuite/tests/ghci/prog025/all.T - + testsuite/tests/ghci/prog025/prog025a.script - + testsuite/tests/ghci/prog025/prog025a.stdout - + testsuite/tests/ghci/prog025/prog025b.script - + testsuite/tests/ghci/prog025/prog025b.stdout - + testsuite/tests/ghci/prog025/testpkg/Test.hs - + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg - + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg - + testsuite/tests/ghci/prog025/unitA Changes: ===================================== changelog.d/T27202 ===================================== @@ -1,9 +1,13 @@ section: ghci -synopsis: Fix regression to allow loading modules into the GHCi after startup. +synopsis: Fix regression to honour module targets in nested directories into GHCi after startup. issues: #27202 mrs: !15980 description: { Fix a regression that made it impossible to import modules using `:load <Mod>` and `:add <Mod>` after GHCi startup. GHCi wasn't honouring the `-i<directory>` argument if given via `ghci -i<directory>`. + + Further, we fix a bug while setting up package database stacks for GHCi that was uncovered during this fix. + By underspecifying the version of dependencies, import modules from dependencies were ambiguous, even though + they shouldn't have been! } ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -37,6 +37,7 @@ module GHC.Driver.DynFlags ( packageFlagsChanged, IgnorePackageFlag(..), TrustFlag(..), PackageDBFlag(..), PkgDbRef(..), + isPackageDbRef, Option(..), showOpt, DynLibLoader(..), positionIndependent, @@ -881,7 +882,7 @@ isNoLink _ = False data PackageArg = PackageArg String -- ^ @-package@, by 'PackageName' | UnitIdArg Unit -- ^ @-package-id@, by 'Unit' - deriving (Eq, Show) + deriving (Eq, Ord, Show) instance Outputable PackageArg where ppr (PackageArg pn) = text "package" <+> text pn @@ -902,7 +903,7 @@ data ModRenaming = ModRenaming { modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope? modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope -- under name @n@. - } deriving (Eq) + } deriving (Eq, Ord) instance Outputable ModRenaming where ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns) @@ -920,14 +921,21 @@ data TrustFlag data PackageFlag = ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@ | HidePackage String -- ^ @-hide-package@ - deriving (Eq) -- NB: equality instance is used by packageFlagsChanged + deriving (Eq, Ord) -- NB: equality instance is used by packageFlagsChanged data PackageDBFlag = PackageDB PkgDbRef | NoUserPackageDB | NoGlobalPackageDB | ClearPackageDBs - deriving (Eq) + deriving (Eq, Ord) + +isPackageDbRef :: PackageDBFlag -> Maybe PkgDbRef +isPackageDbRef = \ case + PackageDB ref -> Just ref + NoUserPackageDB -> Nothing + NoGlobalPackageDB -> Nothing + ClearPackageDBs -> Nothing packageFlagsChanged :: DynFlags -> DynFlags -> Bool packageFlagsChanged idflags1 idflags0 = @@ -1009,7 +1017,7 @@ data PkgDbRef = GlobalPkgDb | UserPkgDb | PkgDbPath OsPath - deriving Eq + deriving (Eq, Ord) ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -68,7 +68,9 @@ module GHC.Unit.State ( pprRawUnitIds, -- * Utils - unwireUnit) + unwireUnit, + selectHptFlag, + ) where import GHC.Prelude ===================================== ghc/GHCi/UI.hs ===================================== @@ -9,6 +9,7 @@ {-# OPTIONS -fno-warn-name-shadowing #-} -- This module does a lot of it +{-# OPTIONS -Wno-x-partial #-} ----------------------------------------------------------------------------- -- @@ -53,6 +54,7 @@ import GHC.Driver.Errors (printOrThrowDiagnostics) import GHC.Driver.Errors.Types import GHC.Driver.Phases import GHC.Driver.Session as DynFlags +import GHC.Driver.DynFlags as DynFlags import GHC.Driver.Ppr hiding (printForUser) import GHC.Utils.Error hiding (traceCmd) import GHC.Driver.Monad ( modifySession, modifySessionM ) @@ -131,6 +133,7 @@ import qualified Data.Foldable as Foldable import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) import Data.List ( find, intercalate, intersperse, isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) ) +import qualified Data.List as List import qualified Data.List.NonEmpty as NE import qualified Data.Set as S import Data.Maybe @@ -745,6 +748,48 @@ installInteractiveHomeUnits dflags = do sessionUnitExposedFlag = homeUnitPkgFlag interactiveSessionUnitId + -- Currently, we are in a somewhat awkward situation. + -- Users clearly want to control precisely which packages are available at the GHCi prompt, + -- but there is currently no way for the user to declaratively change the set of packages + -- available at the prompt. Thus, a bit of guessing is necessary to provide the reasonable + -- GHCi UX experience, but in the future, we might want to give the user more precise control. + -- + -- The prompt and session home unit may not have any package db specified, but we still want to + -- to import modules from our home unit dependencies. + -- To make this possible, the prompt and session home unit need to have a package db, but which one? + -- We decide, if a package db is given at the top level, e.g. @ghci -package-db ...@, + -- then we honour what the user requests and only use this @-package-db@. + -- However, in the case of multiple home units, initialised via @ghci -unit ... -unit ...@, there + -- are not @-package-db@ arguments in the base 'DynFlags'... + -- To fix this, we look at the home units and merge their package dbs stacks. + -- We assume, that many package db stacks look almost identical, and only differ in view elements. + -- Thus, we try to extract a common package db stack (i.e., longest common prefix), and then concat + -- the rest of the package db stacks. At last, we add the two result package db stacks. + -- This should work reliably with cabal and stack, but it is hacky. + -- A proper solution would be to teach cabal and other tooling to specify the correct package db + -- stacks for the prompt and session home unit. + ghciPackageDbStacks = + if all (isNothing . DynFlags.isPackageDbRef) (packageDBFlags dflags0) + then + HUG.unitEnv_assocs (hsc_HUG hsc_env) + & concatPackageDbStacksUsingLongestCommonPrefix . map (packageDBFlags . HUG.homeUnitEnv_dflags . snd) + else + packageDBFlags dflags0 + + -- Make sure the prompt and session home unit use the correct dependencies. + ghciPackageFlags = + if null (packageFlags dflags0) + then + HUG.unitEnv_assocs (hsc_HUG hsc_env) + & concatMap (packageFlags . HUG.homeUnitEnv_dflags . snd) + -- We don't want to add `-package-id` flags for home units. + -- This is mostly for a clear separation of concerns, + -- to indicate we only care about unit dependencies from package dbs. + & filter (not . selectHptFlag (HUG.allUnits $ hsc_HUG hsc_env)) + & ordNub + else + packageFlags dflags0 + -- Explicitly depends on all home units and 'sessionUnitExposedFlag'. -- Normalise the 'dflagsPrompt', as they will be used for 'ic_dflags' -- of the 'InteractiveContext'. @@ -759,8 +804,9 @@ installInteractiveHomeUnits dflags = do , [ homeUnitPkgFlag uid | uid <- S.toList $ HUG.allUnits $ hsc_HUG hsc_env ] - , packageFlags dflags0 + , ghciPackageFlags ] + , packageDBFlags = ghciPackageDbStacks , importPaths = [] } @@ -773,25 +819,19 @@ installInteractiveHomeUnits dflags = do [ [ homeUnitPkgFlag uid | uid <- S.toList $ HUG.allUnits $ hsc_HUG hsc_env ] - , packageFlags dflags + , ghciPackageFlags ] + , packageDBFlags = ghciPackageDbStacks } let - cached_unit_dbs = - concat - . catMaybes - . fmap homeUnitEnv_unit_dbs - $ Foldable.toList - $ hsc_HUG hsc_env - all_unit_ids = S.insert interactiveGhciUnitId $ S.insert interactiveSessionUnitId $ hsc_all_home_unit_ids hsc_env - ghciPromptUnit <- setupHomeUnitFor logger dflagsPrompt all_unit_ids cached_unit_dbs - ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids cached_unit_dbs + ghciPromptUnit <- setupHomeUnitFor logger dflagsPrompt all_unit_ids + ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids let -- Setup up the HUG, install the interactive home units withInteractiveUnits = @@ -813,13 +853,26 @@ installInteractiveHomeUnits dflags = do pure () where - setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> [UnitDatabase UnitId] -> m HomeUnitEnv - setupHomeUnitFor logger dflags all_home_units cached_unit_dbs = do + setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> m HomeUnitEnv + setupHomeUnitFor logger dflags all_home_units = do (dbs,unit_state,home_unit,_mconstants) <- - liftIO $ initUnits logger dflags (Just cached_unit_dbs) all_home_units + liftIO $ initUnits logger dflags Nothing all_home_units hpt <- liftIO emptyHomePackageTable pure (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags hpt (Just home_unit)) + concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag] + concatPackageDbStacksUsingLongestCommonPrefix stacks = + let + -- O (m * n) + -- m ... Number of PackageDBFlag stacks + -- n ... Size of the stacks + longestCommonPrefix = + map List.head . List.takeWhile ((List.all . (==) . List.head) <*> List.tail) . List.transpose + prefix = + longestCommonPrefix stacks + in + prefix ++ ordNub (concatMap (List.drop (length prefix)) stacks) + reportError :: GhciMonad m => GhciCommandMessage -> m () reportError err = do printError err ===================================== testsuite/tests/ghci/prog-mhu006/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: prog-mhu006a +prog-mhu006a: + '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \ + -no-user-package-db \ + -unit @unitA -unit @unitB < prog-mhu006a.script ===================================== testsuite/tests/ghci/prog-mhu006/a/A.hs ===================================== @@ -0,0 +1 @@ +module A where ===================================== testsuite/tests/ghci/prog-mhu006/all.T ===================================== @@ -0,0 +1,8 @@ + +proj_files = extra_files(['a/', 'b/', 'unitA', 'unitB']) + +test('prog-mhu006a', + [proj_files, + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), + req_interp], + makefile_test, ['prog-mhu006a']) ===================================== testsuite/tests/ghci/prog-mhu006/b/B.hs ===================================== @@ -0,0 +1 @@ +module B where ===================================== testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script ===================================== @@ -0,0 +1,4 @@ +"Can import modules from dependencies" +:m + Data.ByteString +:m + Data.Text +"Imported Data.ByteString and Data.Text" ===================================== testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout ===================================== @@ -0,0 +1,2 @@ +"Can import modules from dependencies" +"Imported Data.ByteString and Data.Text" ===================================== testsuite/tests/ghci/prog-mhu006/unitA ===================================== @@ -0,0 +1,9 @@ +-i +-ia/ +A +-this-unit-id a-0.0.0 +-this-package-name a +-global-package-db +-package base +-package-id b-0.0.0 +-package containers ===================================== testsuite/tests/ghci/prog-mhu006/unitB ===================================== @@ -0,0 +1,8 @@ +-i +-ib/ +B +-this-unit-id b-0.0.0 +-this-package-name b +-global-package-db +-package base +-package bytestring ===================================== testsuite/tests/ghci/prog025/Makefile ===================================== @@ -0,0 +1,54 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +PKGCONF01=local01.package.conf +LOCAL_GHC_PKG01 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF01) + +# When the user package databases are cleared, the GHCi prompt still needs to be able to find +# modules from home unit dependencies. +# Moreover, it needs to find the correct dependency unit, not just any. +.PHONY: prog025a +prog025a: + cd testpkg && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.1.0.0 -this-unit-id testpkg-0.1.0.0-XXX \ + -i. Test + cd testpkg && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.2.0.0 -this-unit-id testpkg-0.2.0.0-XXX \ + -i. Test + + $(LOCAL_GHC_PKG01) init $(PKGCONF01) 2>/dev/null + $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.1.0.0.pkg 2>/dev/null + $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.2.0.0.pkg 2>/dev/null + $(LOCAL_GHC_PKG01) hide testpkg-0.1.0.0 + $(LOCAL_GHC_PKG01) hide testpkg-0.2.0.0 + $(LOCAL_GHC_PKG01) list + + '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \ + -no-user-package-db -fno-code -unit @unitA < prog025a.script + +# Same as prog025a, but the home unit arguments are not provided using a response file +.PHONY: prog025b +prog025b: + cd testpkg && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.1.0.0 -this-unit-id testpkg-0.1.0.0-XXX \ + -i. Test + cd testpkg && \ + '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \ + -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.2.0.0 -this-unit-id testpkg-0.2.0.0-XXX \ + -i. Test + + $(LOCAL_GHC_PKG01) init $(PKGCONF01) 2>/dev/null + $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.1.0.0.pkg 2>/dev/null + $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.2.0.0.pkg 2>/dev/null + $(LOCAL_GHC_PKG01) hide testpkg-0.1.0.0 + $(LOCAL_GHC_PKG01) hide testpkg-0.2.0.0 + $(LOCAL_GHC_PKG01) list + + # Uses response file for argument, doesn't use it as a -unit argument + '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \ + -no-user-package-db -fno-code \ + @unitA < prog025b.script ===================================== testsuite/tests/ghci/prog025/a/A.hs ===================================== @@ -0,0 +1,3 @@ +module A where + +import Test ===================================== testsuite/tests/ghci/prog025/all.T ===================================== @@ -0,0 +1,14 @@ + +proj_files = extra_files(['a/', 'unitA', 'testpkg/']) + +test('prog025a', + [proj_files, + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), + req_interp], + makefile_test, ['prog025a']) + +test('prog025b', + [proj_files, + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), + req_interp], + makefile_test, ['prog025b']) ===================================== testsuite/tests/ghci/prog025/prog025a.script ===================================== @@ -0,0 +1,2 @@ +:m + Test +"Imported package dependency module with multiple installed versions" ===================================== testsuite/tests/ghci/prog025/prog025a.stdout ===================================== @@ -0,0 +1,7 @@ +Reading package info from "testpkg/testpkg-0.1.0.0.pkg" ... done. +Reading package info from "testpkg/testpkg-0.2.0.0.pkg" ... done. +local01.package.conf + (testpkg-0.1.0.0) + (testpkg-0.2.0.0) + +"Imported package dependency module with multiple installed versions" ===================================== testsuite/tests/ghci/prog025/prog025b.script ===================================== @@ -0,0 +1,2 @@ +:m + Test +"Imported package dependency module with multiple installed versions" ===================================== testsuite/tests/ghci/prog025/prog025b.stdout ===================================== @@ -0,0 +1,7 @@ +Reading package info from "testpkg/testpkg-0.1.0.0.pkg" ... done. +Reading package info from "testpkg/testpkg-0.2.0.0.pkg" ... done. +local01.package.conf + (testpkg-0.1.0.0) + (testpkg-0.2.0.0) + +"Imported package dependency module with multiple installed versions" ===================================== testsuite/tests/ghci/prog025/testpkg/Test.hs ===================================== @@ -0,0 +1 @@ +module Test where ===================================== testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg ===================================== @@ -0,0 +1,11 @@ +name: testpkg +version: 0.1.0.0 +id: testpkg-0.1.0.0-XXX +key: testpkg-0.1.0.0-XXX +exposed: True +exposed-modules: Test +hidden-modules: +import-dirs: ${pkgroot}/dist-testpkg-0.1.0.0 +library-dirs: +include-dirs: +hs-libraries: ===================================== testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg ===================================== @@ -0,0 +1,11 @@ +name: testpkg +version: 0.2.0.0 +id: testpkg-0.2.0.0-XXX +key: testpkg-0.2.0.0-XXX +exposed: True +exposed-modules: Test +hidden-modules: +import-dirs: ${pkgroot}/testpkg/dist-testpkg-0.2.0.0 +library-dirs: +include-dirs: +hs-libraries: ===================================== testsuite/tests/ghci/prog025/unitA ===================================== @@ -0,0 +1,11 @@ +-i +-ia/ +A +-this-unit-id a-0.0.0 +-this-package-name a +-clear-package-db +-global-package-db +-no-user-package-db +-package-db local01.package.conf +-package base +-package-id testpkg-0.2.0.0-XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9894df286c1aa592208c790de893d8f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9894df286c1aa592208c790de893d8f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/davide/windows-dlls] WIP static CAFs
by David Eichmann (＠DavidEichmann) 15 May '26

15 May '26

David Eichmann pushed to branch wip/davide/windows-dlls at Glasgow Haskell Compiler / GHC Commits: 0a20aafc by David Eichmann at 2026-05-15T14:51:49+01:00 WIP static CAFs - - - - - 1 changed file: - compiler/GHC/Stg/Utils.hs Changes: ===================================== compiler/GHC/Stg/Utils.hs ===================================== @@ -148,7 +148,7 @@ allowTopLevelConApp platform ext_dyn_refs this_mod con args -- can be incompatible with some security restrictions, but note that -- ghc-internal and everything would need to be rebuilt. Note also that -- dynamic top level con apps increases symbol exports a lot. - | platformOS platform == OSMinGW32 = True + | platformOS platform == OSMinGW32 = False -- otherwise, allowed -- Sylvain: shouldn't this be False when (ext_dyn_refs && is_external_con_app)? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a20aafc703697ef14cb3db01c382e0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a20aafc703697ef14cb3db01c382e0… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/wenkokke/trace-ipe] 4 commits: ghc-internal: Add TraceFlags.traceIPE
by Wen Kokke (＠wenkokke) 15 May '26

15 May '26

Wen Kokke pushed to branch wip/wenkokke/trace-ipe at Glasgow Haskell Compiler / GHC Commits: 52931c90 by Wen Kokke at 2026-05-15T13:46:50+01:00 ghc-internal: Add TraceFlags.traceIPE - - - - - ef98f62d by Wen Kokke at 2026-05-15T13:46:53+01:00 testsuite: Add test for TraceFlags.traceIpe - - - - - 4a6a58bb by Wen Kokke at 2026-05-15T13:46:54+01:00 ghc-internal: Add DebugFlags.ipe - - - - - 91deab48 by Wen Kokke at 2026-05-15T13:46:58+01:00 testsuite: Add test for DebugFlags.ipe - - - - - 9 changed files: - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - + testsuite/tests/rts/T25275/DebugIpe.hs - + testsuite/tests/rts/T25275/T25275_A.stdout - + testsuite/tests/rts/T25275/T25275_B.stdout - + testsuite/tests/rts/T25275/T25275_C.stdout - + testsuite/tests/rts/T25275/T25275_D.stdout - + testsuite/tests/rts/T25275/TraceIpe.hs - + testsuite/tests/rts/T25275/all.T Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc ===================================== @@ -211,6 +211,8 @@ data DebugFlags = DebugFlags , squeeze :: Bool -- ^ @z@ stack squeezing & lazy blackholing , hpc :: Bool -- ^ @c@ coverage , sparks :: Bool -- ^ @r@ + , ipe :: Bool -- ^ @I@ + -- @since ghc-experimental-10.0.0 } deriving ( Show -- ^ @since base-4.8.0.0 , Generic -- ^ @since base-4.15.0.0 ) @@ -359,6 +361,8 @@ data TraceFlags = TraceFlags , sparksSampled :: Bool -- ^ trace spark events by a sampled method , sparksFull :: Bool -- ^ trace spark events 100% accurately , user :: Bool -- ^ trace user events (emitted from Haskell code) + , traceIpe :: Bool -- ^ trace IPE events + -- @since ghc-experimental-10.0.0 } deriving ( Show -- ^ @since base-4.8.0.0 , Generic -- ^ @since base-4.15.0.0 ) @@ -588,6 +592,8 @@ getDebugFlags = do (#{peek DEBUG_FLAGS, hpc} ptr :: IO CBool)) <*> (toBool <$> (#{peek DEBUG_FLAGS, sparks} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek DEBUG_FLAGS, ipe} ptr :: IO CBool)) getCCFlags :: IO CCFlags getCCFlags = do @@ -647,6 +653,8 @@ getTraceFlags = do (#{peek TRACE_FLAGS, sparks_full} ptr :: IO CBool)) <*> (toBool <$> (#{peek TRACE_FLAGS, user} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek TRACE_FLAGS, ipe} ptr :: IO CBool)) #endif getTickyFlags :: IO TickyFlags ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -6428,7 +6428,7 @@ module GHC.RTS.Flags.Experimental where type ConcFlags :: * data ConcFlags = ConcFlags {ctxtSwitchTime :: RtsTime, ctxtSwitchTicks :: GHC.Internal.Types.Int} type DebugFlags :: * - data DebugFlags = DebugFlags {scheduler :: GHC.Internal.Types.Bool, interpreter :: GHC.Internal.Types.Bool, weak :: GHC.Internal.Types.Bool, gccafs :: GHC.Internal.Types.Bool, gc :: GHC.Internal.Types.Bool, nonmoving_gc :: GHC.Internal.Types.Bool, block_alloc :: GHC.Internal.Types.Bool, sanity :: GHC.Internal.Types.Bool, stable :: GHC.Internal.Types.Bool, prof :: GHC.Internal.Types.Bool, linker :: GHC.Internal.Types.Bool, apply :: GHC.Internal.Types.Bool, stm :: GHC.Internal.Types.Bool, squeeze :: GHC.Internal.Types.Bool, hpc :: GHC.Internal.Types.Bool, sparks :: GHC.Internal.Types.Bool} + data DebugFlags = DebugFlags {scheduler :: GHC.Internal.Types.Bool, interpreter :: GHC.Internal.Types.Bool, weak :: GHC.Internal.Types.Bool, gccafs :: GHC.Internal.Types.Bool, gc :: GHC.Internal.Types.Bool, nonmoving_gc :: GHC.Internal.Types.Bool, block_alloc :: GHC.Internal.Types.Bool, sanity :: GHC.Internal.Types.Bool, stable :: GHC.Internal.Types.Bool, prof :: GHC.Internal.Types.Bool, linker :: GHC.Internal.Types.Bool, apply :: GHC.Internal.Types.Bool, stm :: GHC.Internal.Types.Bool, squeeze :: GHC.Internal.Types.Bool, hpc :: GHC.Internal.Types.Bool, sparks :: GHC.Internal.Types.Bool, ipe :: GHC.Internal.Types.Bool} type DoCostCentres :: * data DoCostCentres = CostCentresNone | CostCentresSummary | CostCentresVerbose | CostCentresAll | CostCentresJSON type DoHeapProfile :: * @@ -6505,7 +6505,7 @@ module GHC.RTS.Flags.Experimental where type TickyFlags :: * data TickyFlags = TickyFlags {showTickyStats :: GHC.Internal.Types.Bool, tickyFile :: GHC.Internal.Maybe.Maybe GHC.Internal.IO.FilePath} type TraceFlags :: * - data TraceFlags = TraceFlags {tracing :: DoTrace, timestamp :: GHC.Internal.Types.Bool, traceScheduler :: GHC.Internal.Types.Bool, traceGc :: GHC.Internal.Types.Bool, traceNonmovingGc :: GHC.Internal.Types.Bool, sparksSampled :: GHC.Internal.Types.Bool, sparksFull :: GHC.Internal.Types.Bool, user :: GHC.Internal.Types.Bool} + data TraceFlags = TraceFlags {tracing :: DoTrace, timestamp :: GHC.Internal.Types.Bool, traceScheduler :: GHC.Internal.Types.Bool, traceGc :: GHC.Internal.Types.Bool, traceNonmovingGc :: GHC.Internal.Types.Bool, sparksSampled :: GHC.Internal.Types.Bool, sparksFull :: GHC.Internal.Types.Bool, user :: GHC.Internal.Types.Bool, traceIpe :: GHC.Internal.Types.Bool} getCCFlags :: GHC.Internal.Types.IO CCFlags getConcFlags :: GHC.Internal.Types.IO ConcFlags getDebugFlags :: GHC.Internal.Types.IO DebugFlags ===================================== testsuite/tests/rts/T25275/DebugIpe.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import GHC.RTS.Flags.Experimental (DebugFlags (..), getDebugFlags) + +main :: IO () +main = print . ipe =<< getDebugFlags ===================================== testsuite/tests/rts/T25275/T25275_A.stdout ===================================== @@ -0,0 +1 @@ +False \ No newline at end of file ===================================== testsuite/tests/rts/T25275/T25275_B.stdout ===================================== @@ -0,0 +1 @@ +True \ No newline at end of file ===================================== testsuite/tests/rts/T25275/T25275_C.stdout ===================================== @@ -0,0 +1 @@ +False \ No newline at end of file ===================================== testsuite/tests/rts/T25275/T25275_D.stdout ===================================== @@ -0,0 +1 @@ +True \ No newline at end of file ===================================== testsuite/tests/rts/T25275/TraceIpe.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import GHC.RTS.Flags.Experimental (TraceFlags (..), getTraceFlags) + +main :: IO () +main = print . traceIpe =<< getTraceFlags ===================================== testsuite/tests/rts/T25275/all.T ===================================== @@ -0,0 +1,43 @@ +# Compile and run with default RTS options +test( + 'T25275_A', + [ + extra_files(['TraceIpe.hs']), + ], + multimod_compile_and_run, + ['TraceIpe', ''], +) + +# Compile and run with -lI +test( + 'T25275_B', + [ + extra_files(['TraceIpe.hs']), + extra_run_opts('+RTS -lI -RTS'), + ], + multimod_compile_and_run, + ['TraceIpe', ''], +) + +# Compile and run with default RTS options +test( + 'T25275_C', + [ + only_ways(['debug']), + extra_files(['DebugIpe.hs']), + ], + multimod_compile_and_run, + ['DebugIpe', ''], +) + +# Compile and run with -DI +test( + 'T25275_D', + [ + only_ways(['debug']), + extra_files(['DebugIpe.hs']), + extra_run_opts('+RTS -DI -RTS'), + ], + multimod_compile_and_run, + ['DebugIpe', ''], +) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29a60e7b6aeb1e0de76860a77d0ae9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/29a60e7b6aeb1e0de76860a77d0ae9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/mangoiv/ghc-9.12-bp] 2 commits: Fix race condition between flushEventLog and start/endEventLogging.
by Magnus (＠MangoIV) 15 May '26

15 May '26

Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC Commits: 693428b4 by Wen Kokke at 2026-05-14T17:10:28+02:00 Fix race condition between flushEventLog and start/endEventLogging. This commit changes `flushEventLog` to acquire/release the `state_change` mutex to prevent interleaving with `startEventLogging` and `endEventLogging`. In the current RTS, `flushEventLog` _does not_ acquire this mutex, which may lead to eventlog corruption on the following interleaving: - `startEventLogging` writes the new `EventLogWriter` to `event_log_writer`. - `flushEventLog` flushes some events to `event_log_writer`. - `startEventLogging` writes the eventlog header to `event_log_writer`. This causes the eventlog to be written out in an unreadable state, with one or more events preceding the eventlog header. This commit renames the old function to `flushEventLog_` and defines `flushEventLog` simply as: ```c void flushEventLog(Capability **cap USED_IF_THREADS) { ACQUIRE_LOCK(&state_change_mutex); flushEventLog_(cap); RELEASE_LOCK(&state_change_mutex); } ``` The old function is still needed internally within the compilation unit, where it is used in `endEventLogging` in a context where the `state_change` mutex has already been acquired. I've chosen to mark `flushEventLog_` as static and let other uses of `flushEventLog` within the RTS refer to the new version. There is one use in `hs_init_ghc` via `flushTrace`, where the new locking behaviour should be harmless, and one use in `handle_tick`, which I believe was likely vulnerable to the same race condition, so the new locking behaviour is desirable. I have not added a test. The behaviour is highly non-deterministic and requires a program that concurrently calls `flushEventLog` and `startEventLogging`/`endEventLogging`. I encountered the issue while developing `eventlog-socket` and within that context have verified that my patch likely addresses the issue: a test that used to fail within the first dozen or so runs now has been running on repeat for several hours. (cherry picked from commit 3d6492ce311611707e80b2594103ddbe93fc6c76) - - - - - eb7e1e0f by Luite Stegeman at 2026-05-15T09:49:36+02:00 Windows: remove StgAsyncIOResult and fix crash/leaks In stg_block_async{_void}, a stack slot was reserved for an StgAsyncIOResult. This slot would be filled by the IO manager upon completion of the async call. However, if the blocked thread was interrupted by an async exception, we would end up in an invalid state: - If the blocked computation was never re-entered, the StgAsyncIOResult would never be freed. - If the blocked computation was re-entered, the thread would find an unitialized stack slot for the StgAsyncIOResult, leading to a crash reading its fields, or freeing the pointer. We fix this by removing the StgAsyncIOResult altogether and writing the result directly to the stack. Fixes #26341 (cherry picked from commit fcf092dda534cc38637d1f7920aa0dae58fe5273) - - - - - 18 changed files: - rts/HeapStackCheck.cmm - rts/IOManager.c - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/Threads.c - rts/eventlog/EventLog.c - rts/include/rts/storage/TSO.h - rts/include/stg/MiscClosures.h - rts/win32/AsyncMIO.c - rts/win32/AsyncMIO.h - + testsuite/tests/concurrent/should_run/T26341.hs - + testsuite/tests/concurrent/should_run/T26341.stdout - + testsuite/tests/concurrent/should_run/T26341a.hs - + testsuite/tests/concurrent/should_run/T26341a.stdout - + testsuite/tests/concurrent/should_run/T26341b.hs - + testsuite/tests/concurrent/should_run/T26341b.stdout - testsuite/tests/concurrent/should_run/all.T - utils/deriveConstants/Main.hs Changes: ===================================== rts/HeapStackCheck.cmm ===================================== @@ -706,38 +706,24 @@ stg_block_throwto (P_ tso, P_ exception) } #if defined(mingw32_HOST_OS) -INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ ares ) +INFO_TABLE_RET ( stg_block_async, RET_SMALL, W_ info_ptr, W_ len, W_ errCode ) return () { - W_ len, errC; - - len = TO_W_(StgAsyncIOResult_len(ares)); - errC = TO_W_(StgAsyncIOResult_errCode(ares)); - ccall free(ares "ptr"); - return (len, errC); + return (len, errCode); } stg_block_async { - Sp_adj(-2); - Sp(0) = stg_block_async_info; - BLOCK_GENERIC; -} + W_ eintr; + (eintr) = ccall rts_EINTR(); -/* Used by threadDelay implementation; it would be desirable to get rid of - * this free()'ing void return continuation. - */ -INFO_TABLE_RET ( stg_block_async_void, RET_SMALL, W_ info_ptr, W_ ares ) - return () -{ - ccall free(ares "ptr"); - return (); -} - -stg_block_async_void -{ - Sp_adj(-2); - Sp(0) = stg_block_async_void_info; + // Fill the stack frame with values that indicate that the operation + // has been interrupted. The IO manager will overwrite these with the + // actual results if the async operation completes. + Sp_adj(-3); + Sp(0) = stg_block_async_info; + Sp(1) = -1; // len: -1 indicates error + Sp(2) = eintr; // errCode: interrupted BLOCK_GENERIC; } ===================================== rts/IOManager.c ===================================== @@ -561,10 +561,8 @@ void scavengeTSOIOManager(StgTSO *tso) */ /* case IO_MANAGER_WIN32_LEGACY: - * BlockedOn{Read,Write,DoProc} uses block_info.async_result - * The StgAsyncIOResult async_result is allocated on the C heap. - * It'd probably be better if it used the GC heap. If it did we'd - * scavenge it here. + * BlockedOn{Read,Write,DoProc} uses block_info.async_reqID + * which is a plain integer, so nothing to scavenge. */ default: @@ -747,7 +745,7 @@ void syncIOCancel(Capability *cap, StgTSO *tso) case IO_MANAGER_WIN32_LEGACY: removeThreadFromDeQueue(cap, &cap->iomgr->blocked_queue_hd, &cap->iomgr->blocked_queue_tl, tso); - abandonWorkRequest(tso->block_info.async_result->reqID); + abandonWorkRequest(tso->block_info.async_reqID); break; #endif default: @@ -782,12 +780,7 @@ void syncDelay(Capability *cap, StgTSO *tso, HsInt us_delay) * would make the primops more consistent. */ { - StgAsyncIOResult *ares = stgMallocBytes(sizeof(StgAsyncIOResult), - "syncDelay"); - ares->reqID = addDelayRequest(us_delay); - ares->len = 0; - ares->errCode = 0; - tso->block_info.async_result = ares; + tso->block_info.async_reqID = addDelayRequest(us_delay); /* Having all async-blocked threads reside on the blocked_queue * simplifies matters, so set the status to OnDoProc and put the ===================================== rts/PrimOps.cmm ===================================== @@ -2575,40 +2575,29 @@ stg_waitWritezh ( W_ fd ) stg_delayzh ( W_ us_delay ) { - ccall syncDelay(MyCapability() "ptr", CurrentTSO "ptr", us_delay); + CBool ok; - /* Annoyingly, we cannot be consistent with how we wait and resume the - * blocked thread. The reason is that the win32 legacy I/O manager - * allocates a StgAsyncIOResult struct on the C heap which has to be - * freed when the thread resumes. It's a bit awkward to arrange to - * allocate it on the GC heap instead, so that's how it is for now. Sigh. - */ -#if defined(mingw32_HOST_OS) - jump stg_block_async_void(); -#else - jump stg_block_noregs(); -#endif + (ok) = ccall syncDelay(MyCapability() "ptr", CurrentTSO "ptr", us_delay); + + if (ok != 0::CBool) (likely: True) { + jump stg_block_noregs(); + } else { + jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface])); + } } #if defined(mingw32_HOST_OS) stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) { - W_ ares; CInt reqID; #if defined(THREADED_RTS) ccall barf("asyncRead# on threaded RTS") never returns; #else - /* could probably allocate this on the heap instead */ - ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - "stg_asyncReadzh"); (reqID) = ccall addIORequest(fd, 0/*FALSE*/,is_sock,len,buf "ptr"); - StgAsyncIOResult_reqID(ares) = reqID; - StgAsyncIOResult_len(ares) = 0; - StgAsyncIOResult_errCode(ares) = 0; - StgTSO_block_info(CurrentTSO) = ares; + StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); %release StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I32; @@ -2620,21 +2609,14 @@ stg_asyncReadzh ( W_ fd, W_ is_sock, W_ len, W_ buf ) stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) { - W_ ares; CInt reqID; #if defined(THREADED_RTS) ccall barf("asyncWrite# on threaded RTS") never returns; #else - ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - "stg_asyncWritezh"); (reqID) = ccall addIORequest(fd, 1/*TRUE*/,is_sock,len,buf "ptr"); - - StgAsyncIOResult_reqID(ares) = reqID; - StgAsyncIOResult_len(ares) = 0; - StgAsyncIOResult_errCode(ares) = 0; - StgTSO_block_info(CurrentTSO) = ares; + StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); %release StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I32; @@ -2646,21 +2628,14 @@ stg_asyncWritezh ( W_ fd, W_ is_sock, W_ len, W_ buf ) stg_asyncDoProczh ( W_ proc, W_ param ) { - W_ ares; CInt reqID; #if defined(THREADED_RTS) ccall barf("asyncDoProc# on threaded RTS") never returns; #else - /* could probably allocate this on the heap instead */ - ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult, - "stg_asyncDoProczh"); (reqID) = ccall addDoProcRequest(proc "ptr",param "ptr"); - StgAsyncIOResult_reqID(ares) = reqID; - StgAsyncIOResult_len(ares) = 0; - StgAsyncIOResult_errCode(ares) = 0; - StgTSO_block_info(CurrentTSO) = ares; + StgTSO_block_info(CurrentTSO) = reqID; ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I32); %release StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I32; ===================================== rts/RtsSymbols.c ===================================== @@ -30,6 +30,7 @@ #include <shfolder.h> /* SHGetFolderPathW */ #include "IOManager.h" #include "win32/AsyncWinIO.h" +#include "win32/AsyncMIO.h" #endif #if defined(openbsd_HOST_OS) @@ -168,6 +169,7 @@ extern char **environ; SymI_HasProto(__stdio_common_vswprintf_s) \ SymI_HasProto(__stdio_common_vswprintf) \ SymI_HasProto(_errno) \ + SymI_HasProto(rts_EINTR) \ /* see Note [Symbols for MinGW's printf] */ \ SymI_HasProto(_lock_file) \ SymI_HasProto(_unlock_file) \ ===================================== rts/Threads.c ===================================== @@ -928,7 +928,7 @@ printThreadBlockage(StgTSO *tso) switch (ACQUIRE_LOAD(&tso->why_blocked)) { #if defined(mingw32_HOST_OS) case BlockedOnDoProc: - debugBelch("is blocked on proc (request: %u)", tso->block_info.async_result->reqID); + debugBelch("is blocked on proc (request: %" FMT_Word ")", tso->block_info.async_reqID); break; #endif #if !defined(THREADED_RTS) ===================================== rts/eventlog/EventLog.c ===================================== @@ -154,6 +154,8 @@ static void freeEventLoggingBuffer(void); static void ensureRoomForEvent(EventsBuf *eb, EventTypeNum tag); static int ensureRoomForVariableEvent(EventsBuf *eb, StgWord size); +static void flushEventLog_(Capability **cap USED_IF_THREADS); + static inline void postWord8(EventsBuf *eb, StgWord8 i) { *(eb->pos++) = i; @@ -484,7 +486,7 @@ endEventLogging(void) eventlog_enabled = false; - flushEventLog(NULL); + flushEventLog_(NULL); ACQUIRE_LOCK(&eventBufMutex); @@ -1607,6 +1609,17 @@ void flushAllCapsEventsBufs(void) } void flushEventLog(Capability **cap USED_IF_THREADS) +{ + ACQUIRE_LOCK(&state_change_mutex); + flushEventLog_(cap); + RELEASE_LOCK(&state_change_mutex); +} + +// This is an unsafe version of flushEventLog that does not acquire/release the +// state_change mutex. It is for internal use only and should only be used when +// (1) you're sure that there's no chance of racing with start/endEventLogging, +// and (2) there is an event_log_writer. +static void flushEventLog_(Capability **cap USED_IF_THREADS) { if (!event_log_writer) { return; @@ -1636,7 +1649,7 @@ void flushEventLog(Capability **cap USED_IF_THREADS) flushEventLogWriter(); } -#else +#else /*!TRACING*/ enum EventLogStatus eventLogStatus(void) { ===================================== rts/include/rts/storage/TSO.h ===================================== @@ -37,15 +37,6 @@ typedef StgWord64 StgThreadID; */ typedef unsigned int StgThreadReturnCode; -#if defined(mingw32_HOST_OS) -/* results from an async I/O request + its request ID. */ -typedef struct { - unsigned int reqID; - int len; - int errCode; -} StgAsyncIOResult; -#endif - /* Reason for thread being blocked. See comment above struct StgTso_. */ typedef union { StgClosure *closure; @@ -55,7 +46,7 @@ typedef union { struct MessageWakeup_ *wakeup; StgInt fd; /* StgInt instead of int, so that it's the same size as the ptrs */ #if defined(mingw32_HOST_OS) - StgAsyncIOResult *async_result; + StgWord async_reqID; #endif #if !defined(THREADED_RTS) StgWord target; ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -430,8 +430,6 @@ RTS_RET(stg_block_putmvar); #if defined(mingw32_HOST_OS) RTS_FUN_DECL(stg_block_async); RTS_RET(stg_block_async); -RTS_FUN_DECL(stg_block_async_void); -RTS_RET(stg_block_async_void); #endif RTS_FUN_DECL(stg_block_stmwait); RTS_FUN_DECL(stg_block_throwto); ===================================== rts/win32/AsyncMIO.c ===================================== @@ -8,16 +8,19 @@ * For the WINIO manager see base in the GHC.Event modules. */ -#if !defined(THREADED_RTS) #include "Rts.h" +#include <errno.h> +#include "win32/AsyncMIO.h" + +#if !defined(THREADED_RTS) + #include "RtsUtils.h" #include <windows.h> #include <stdio.h> #include "Schedule.h" #include "Capability.h" #include "IOManagerInternals.h" -#include "win32/AsyncMIO.h" #include "win32/MIOManager.h" /* @@ -299,14 +302,9 @@ start: case BlockedOnRead: case BlockedOnWrite: case BlockedOnDoProc: - if (tso->block_info.async_result->reqID == rID) { - // Found the thread blocked waiting on request; - // stodgily fill - // in its result block. - tso->block_info.async_result->len = - completedTable[i].len; - tso->block_info.async_result->errCode = - completedTable[i].errCode; + if (tso->block_info.async_reqID == rID) { + HsInt len = completedTable[i].len; + HsInt errCode = completedTable[i].errCode; // Drop the matched TSO from blocked_queue if (prev) { @@ -322,11 +320,14 @@ start: // Terminates the run queue + this inner for-loop. tso->_link = END_TSO_QUEUE; tso->why_blocked = NotBlocked; - // save the StgAsyncIOResult in the - // stg_block_async_info stack frame, because - // the block_info field will be overwritten by - // pushOnRunQueue(). - tso->stackobj->sp[1] = (W_)tso->block_info.async_result; + // For stg_block_async frames (read/write/doProc), + // write len and errCode directly to the stack. + // For stg_block_noregs frames (delay), nothing + // to write. + if (tso->stackobj->sp[0] == (W_)&stg_block_async_info) { + tso->stackobj->sp[1] = (W_)len; + tso->stackobj->sp[2] = (W_)errCode; + } pushOnRunQueue(&MainCapability, tso); break; } @@ -389,3 +390,8 @@ resetAbandonRequestWait( void ) } #endif /* !defined(THREADED_RTS) */ + +HsInt rts_EINTR(void) +{ + return EINTR; +} ===================================== rts/win32/AsyncMIO.h ===================================== @@ -27,3 +27,4 @@ extern int awaitRequests(bool wait); extern void abandonRequestWait(void); extern void resetAbandonRequestWait(void); +extern HsInt rts_EINTR(void); ===================================== testsuite/tests/concurrent/should_run/T26341.hs ===================================== @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O -fno-full-laziness #-} + +import Control.Concurrent (threadDelay, myThreadId, forkIO, killThread) +import System.IO.Unsafe (unsafePerformIO) +import Control.Exception +import GHC.Exts + +compute :: Int +compute = noinline unsafePerformIO $ do + mainThreadID <- myThreadId + _ <- forkIO $ do + threadDelay 500000 + killThread mainThreadID + threadDelay 1000000 + return 0 + +main = do + catch (print compute) (\(e :: AsyncException) -> print $ "1:" ++ show e) + catch (print compute) (\(e :: AsyncException) -> print $ "2:" ++ show e) + print "done" ===================================== testsuite/tests/concurrent/should_run/T26341.stdout ===================================== @@ -0,0 +1,3 @@ +"1:thread killed" +0 +"done" ===================================== testsuite/tests/concurrent/should_run/T26341a.hs ===================================== @@ -0,0 +1,75 @@ +-- Test that re-evaluating an AP_STACK from an interrupted async I/O call +-- does not crash. On Windows non-threaded RTS, re-entry returns EINTR +-- which readRawBufferPtr converts to IOException Interrupted. On the +-- threaded RTS (any platform), the blocking read is re-attempted and +-- succeeds because we write a byte to the pipe between evaluations. +-- +-- Before the fix for #26341, re-evaluation on Windows would crash or read +-- uninitialized memory from a freed StgAsyncIOResult. +{-# OPTIONS_GHC -O -fno-full-laziness #-} + +import Control.Concurrent (threadDelay, myThreadId, forkIO, killThread, rtsSupportsBoundThreads) +import Control.Exception +import Data.IORef +import Foreign +import Foreign.C +import GHC.Exts +import GHC.IO.Exception (IOErrorType(..), IOException(..)) +import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr) +import System.Info (os) +import System.IO.Unsafe (unsafePerformIO) +import System.Process (createPipeFd) + +-- Store the write fd so main can feed data into the pipe between +-- evaluations. On Unix this unblocks the re-entered read; on Windows +-- stg_block_async returns EINTR regardless. +{-# NOINLINE writeFdRef #-} +writeFdRef :: IORef CInt +writeFdRef = unsafePerformIO $ newIORef (-1) + +-- | A thunk whose unsafePerformIO blocks on a pipe read. A forked +-- thread kills the main thread after 200ms, which creates an AP_STACK. +{-# NOINLINE blockedRead #-} +blockedRead :: () +blockedRead = noinline unsafePerformIO $ do + (readFd, writeFd) <- createPipeFd + writeIORef writeFdRef writeFd + buf <- mallocBytes 1 + mainTid <- myThreadId + _ <- forkIO $ do + threadDelay 200000 -- 200ms + killThread mainTid + -- readRawBufferPtr dispatches to asyncReadRawBufferPtr on Windows + -- non-threaded RTS; on Unix it uses threadWaitRead + read(). + _ <- readRawBufferPtr "blockedRead" (FD readFd 0) buf 0 1 + return () + +main :: IO () +main = do + -- First evaluation: the thunk blocks on the pipe read, gets killed. + catch (evaluate blockedRead) + (\(e :: AsyncException) -> putStrLn $ "caught: " ++ show e) + + -- Write a byte so the re-entered read can complete on Unix. + wfd <- readIORef writeFdRef + buf <- mallocBytes 1 + poke buf 0 + _ <- writeRawBufferPtr "unblock" (FD wfd 0) buf 0 1 + + -- Second evaluation: AP_STACK re-enters. + -- Non-threaded Windows: asyncRead returns (-1, EINTR) → IOException + -- Threaded / Unix: read succeeds → returns normally + let expectEINTR = os == "mingw32" && not rtsSupportsBoundThreads + result <- try (evaluate blockedRead) + case result of + Left e + | Just ioe <- fromException e + , ioe_type (ioe :: IOException) == Interrupted + -> putStrLn "re-evaluated ok" + | otherwise + -> putStrLn $ "unexpected: " ++ show e + Right () + | expectEINTR -> putStrLn "unexpected: expected EINTR" + | otherwise -> putStrLn "re-evaluated ok" + + putStrLn "done" ===================================== testsuite/tests/concurrent/should_run/T26341a.stdout ===================================== @@ -0,0 +1,3 @@ +caught: thread killed +re-evaluated ok +done ===================================== testsuite/tests/concurrent/should_run/T26341b.hs ===================================== @@ -0,0 +1,101 @@ +-- Stress test for #26341: repeatedly interrupt async-blocked threads and +-- re-enter their AP_STACKs. Before the fix, re-entering a thunk whose +-- unsafePerformIO was blocked on an async I/O call (Windows non-threaded +-- RTS) would read uninitialized memory or free a dangling pointer, +-- because stg_block_async reserved a stack slot for a heap-allocated +-- StgAsyncIOResult that became invalid after an async exception. +-- +-- This test spawns many concurrent workers, each of which: +-- 1. Creates a pipe. +-- 2. Builds a thunk that blocks on a pipe read via unsafePerformIO. +-- 3. Evaluates the thunk and kills it with an async exception. +-- 4. Re-evaluates the thunk (AP_STACK re-entry). +-- 5. Repeats many times. +-- +-- On threaded RTS / Unix the re-entered read succeeds (we write a byte +-- first). On Windows non-threaded RTS the re-entered async call returns +-- EINTR. Both paths exercise the fixed stack-frame layout. +{-# OPTIONS_GHC -O -fno-full-laziness #-} + +import Control.Concurrent +import Control.Exception +import Foreign +import Foreign.C +import GHC.Exts +import GHC.IO.Exception (IOErrorType(..), IOException(..)) +import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr) +import System.IO (hFlush, stdout) +import System.IO.Unsafe (unsafePerformIO) +import System.Posix.Internals (c_close) +import System.Process (createPipeFd) + +iterations :: Int +iterations = 200 + +workers :: Int +workers = 4 + +-- Each worker independently performs `iterations` rounds of: +-- block on pipe read → interrupt → re-evaluate the AP_STACK. +worker :: Int -> MVar () -> IO () +worker wid done = do + buf <- mallocBytes 1 + let go 0 = return () + go n = do + (readFd, writeFd) <- createPipeFd + + -- Build a fresh thunk each iteration so we get a new AP_STACK. + let {-# NOINLINE blockedThunk #-} + blockedThunk :: () + blockedThunk = noinline unsafePerformIO $ do + tid <- myThreadId + _ <- forkIO $ do + threadDelay 1000 -- 1ms: tight window + killThread tid + _ <- readRawBufferPtr "stress" (FD readFd 0) buf 0 1 + return () + + -- First evaluation: block and get killed. + catch (evaluate blockedThunk) + (\(_ :: SomeException) -> return ()) + + -- Write a byte so the re-entered read can complete on + -- threaded RTS / Unix. + poke buf 0 + _ <- writeRawBufferPtr "unblock" (FD writeFd 0) buf 0 1 + + -- Second evaluation: AP_STACK re-entry. + result <- try (evaluate blockedThunk) + case result of + Left e + | Just ioe <- fromException e + , ioe_type (ioe :: IOException) == Interrupted + -> return () -- expected on Windows non-threaded + | otherwise + -> throwIO (userError $ + "worker " ++ show wid ++ " iteration " ++ show n ++ + ": unexpected exception: " ++ show e) + Right () -> return () -- expected on threaded / Unix + + -- Close the pipe fds. + _ <- c_close readFd + _ <- c_close writeFd + + go (n - 1) + + go iterations + putMVar done () + +main :: IO () +main = do + dones <- mapM (\wid -> do + done <- newEmptyMVar + _ <- forkIO (worker wid done) + return done + ) [1..workers] + + -- Wait for all workers to finish. + mapM_ takeMVar dones + + putStrLn "stress test passed" + hFlush stdout ===================================== testsuite/tests/concurrent/should_run/T26341b.stdout ===================================== @@ -0,0 +1 @@ +stress test passed ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -298,3 +298,19 @@ test('hs_try_putmvar003', # Check forkIO exception determinism under optimization test('T13330', normal, compile_and_run, ['-O']) + +test('T26341', normal, compile_and_run, ['']) + +# Test EINTR for async I/O interrupted by an exception (#26341) +test('T26341a' + # test uses pipe operations which are not supported by the JS/wasm backends + , when(arch('wasm32') or arch('javascript'), skip) + , compile_and_run, ['-package process']) + +# Stress test: many threads repeatedly interrupt and re-enter async-blocked +# thunks (#26341). Before the fix, this would crash due to dangling +# StgAsyncIOResult pointers on the stack. +test('T26341b' + # test uses pipe operations which are not supported by the JS/wasm backends + , when(arch('wasm32') or arch('javascript'), skip) + , compile_and_run, ['-package process']) ===================================== utils/deriveConstants/Main.hs ===================================== @@ -646,12 +646,7 @@ wanteds os = concat -- Note that this conditional part only affects the C headers. -- That's important, as it means we get the same PlatformConstants -- type on all platforms. - ,if os == Just Windows - then concat [structSize C "StgAsyncIOResult" - ,structField C "StgAsyncIOResult" "reqID" - ,structField C "StgAsyncIOResult" "len" - ,structField C "StgAsyncIOResult" "errCode"] - else [] + ,[] -- struct HsIface ,structField C "HsIface" "processRemoteCompletion_closure" @@ -814,9 +809,6 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram "", "#define PROFILING", "#define THREADED_RTS", - -- We need to define this if we want StgAsyncIOResult - -- struct to be present after CPP - -- -- FIXME: rts/PosixSource.h should include ghcplatform.h -- which should set this. There is a mismatch host/target -- again... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f20f0e9f5009557f9ef0c3268ef42… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f20f0e9f5009557f9ef0c3268ef42… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/wenkokke/trace-ipe] 4 commits: ghc-internal: Add TraceFlags.traceIPE
by Wen Kokke (＠wenkokke) 15 May '26

15 May '26

Wen Kokke pushed to branch wip/wenkokke/trace-ipe at Glasgow Haskell Compiler / GHC Commits: 5ea23e15 by Wen Kokke at 2026-05-15T13:14:21+01:00 ghc-internal: Add TraceFlags.traceIPE - - - - - 192db68a by Wen Kokke at 2026-05-15T13:14:24+01:00 testsuite: Add test for TraceFlags.traceIpe - - - - - 44e39625 by Wen Kokke at 2026-05-15T13:14:24+01:00 ghc-internal: Add DebugFlags.ipe - - - - - 29a60e7b by Wen Kokke at 2026-05-15T13:14:26+01:00 testsuite: Add test for DebugFlags.ipe - - - - - 9 changed files: - libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - + testsuite/tests/rts/T25275/DebugIpe.hs - + testsuite/tests/rts/T25275/T25275_A.stdout - + testsuite/tests/rts/T25275/T25275_B.stdout - + testsuite/tests/rts/T25275/T25275_C.stdout - + testsuite/tests/rts/T25275/T25275_D.stdout - + testsuite/tests/rts/T25275/TraceIpe.hs - + testsuite/tests/rts/T25275/all.T Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc ===================================== @@ -211,6 +211,8 @@ data DebugFlags = DebugFlags , squeeze :: Bool -- ^ @z@ stack squeezing & lazy blackholing , hpc :: Bool -- ^ @c@ coverage , sparks :: Bool -- ^ @r@ + , ipe :: Bool -- ^ @I@ + -- @since ghc-experimental-10.100.0 } deriving ( Show -- ^ @since base-4.8.0.0 , Generic -- ^ @since base-4.15.0.0 ) @@ -359,6 +361,8 @@ data TraceFlags = TraceFlags , sparksSampled :: Bool -- ^ trace spark events by a sampled method , sparksFull :: Bool -- ^ trace spark events 100% accurately , user :: Bool -- ^ trace user events (emitted from Haskell code) + , traceIpe :: Bool -- ^ trace IPE events + -- @since ghc-experimental-10.100.0 } deriving ( Show -- ^ @since base-4.8.0.0 , Generic -- ^ @since base-4.15.0.0 ) @@ -588,6 +592,8 @@ getDebugFlags = do (#{peek DEBUG_FLAGS, hpc} ptr :: IO CBool)) <*> (toBool <$> (#{peek DEBUG_FLAGS, sparks} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek DEBUG_FLAGS, ipe} ptr :: IO CBool)) getCCFlags :: IO CCFlags getCCFlags = do @@ -647,6 +653,8 @@ getTraceFlags = do (#{peek TRACE_FLAGS, sparks_full} ptr :: IO CBool)) <*> (toBool <$> (#{peek TRACE_FLAGS, user} ptr :: IO CBool)) + <*> (toBool <$> + (#{peek TRACE_FLAGS, ipe} ptr :: IO CBool)) #endif getTickyFlags :: IO TickyFlags ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -6428,7 +6428,7 @@ module GHC.RTS.Flags.Experimental where type ConcFlags :: * data ConcFlags = ConcFlags {ctxtSwitchTime :: RtsTime, ctxtSwitchTicks :: GHC.Internal.Types.Int} type DebugFlags :: * - data DebugFlags = DebugFlags {scheduler :: GHC.Internal.Types.Bool, interpreter :: GHC.Internal.Types.Bool, weak :: GHC.Internal.Types.Bool, gccafs :: GHC.Internal.Types.Bool, gc :: GHC.Internal.Types.Bool, nonmoving_gc :: GHC.Internal.Types.Bool, block_alloc :: GHC.Internal.Types.Bool, sanity :: GHC.Internal.Types.Bool, stable :: GHC.Internal.Types.Bool, prof :: GHC.Internal.Types.Bool, linker :: GHC.Internal.Types.Bool, apply :: GHC.Internal.Types.Bool, stm :: GHC.Internal.Types.Bool, squeeze :: GHC.Internal.Types.Bool, hpc :: GHC.Internal.Types.Bool, sparks :: GHC.Internal.Types.Bool} + data DebugFlags = DebugFlags {scheduler :: GHC.Internal.Types.Bool, interpreter :: GHC.Internal.Types.Bool, weak :: GHC.Internal.Types.Bool, gccafs :: GHC.Internal.Types.Bool, gc :: GHC.Internal.Types.Bool, nonmoving_gc :: GHC.Internal.Types.Bool, block_alloc :: GHC.Internal.Types.Bool, sanity :: GHC.Internal.Types.Bool, stable :: GHC.Internal.Types.Bool, prof :: GHC.Internal.Types.Bool, linker :: GHC.Internal.Types.Bool, apply :: GHC.Internal.Types.Bool, stm :: GHC.Internal.Types.Bool, squeeze :: GHC.Internal.Types.Bool, hpc :: GHC.Internal.Types.Bool, sparks :: GHC.Internal.Types.Bool, ipe :: GHC.Internal.Types.Bool} type DoCostCentres :: * data DoCostCentres = CostCentresNone | CostCentresSummary | CostCentresVerbose | CostCentresAll | CostCentresJSON type DoHeapProfile :: * @@ -6505,7 +6505,7 @@ module GHC.RTS.Flags.Experimental where type TickyFlags :: * data TickyFlags = TickyFlags {showTickyStats :: GHC.Internal.Types.Bool, tickyFile :: GHC.Internal.Maybe.Maybe GHC.Internal.IO.FilePath} type TraceFlags :: * - data TraceFlags = TraceFlags {tracing :: DoTrace, timestamp :: GHC.Internal.Types.Bool, traceScheduler :: GHC.Internal.Types.Bool, traceGc :: GHC.Internal.Types.Bool, traceNonmovingGc :: GHC.Internal.Types.Bool, sparksSampled :: GHC.Internal.Types.Bool, sparksFull :: GHC.Internal.Types.Bool, user :: GHC.Internal.Types.Bool} + data TraceFlags = TraceFlags {tracing :: DoTrace, timestamp :: GHC.Internal.Types.Bool, traceScheduler :: GHC.Internal.Types.Bool, traceGc :: GHC.Internal.Types.Bool, traceNonmovingGc :: GHC.Internal.Types.Bool, sparksSampled :: GHC.Internal.Types.Bool, sparksFull :: GHC.Internal.Types.Bool, user :: GHC.Internal.Types.Bool, traceIpe :: GHC.Internal.Types.Bool} getCCFlags :: GHC.Internal.Types.IO CCFlags getConcFlags :: GHC.Internal.Types.IO ConcFlags getDebugFlags :: GHC.Internal.Types.IO DebugFlags ===================================== testsuite/tests/rts/T25275/DebugIpe.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import GHC.RTS.Flags.Experimental (DebugFlags (..), getDebugFlags) + +main :: IO () +main = print . ipe =<< getDebugFlags ===================================== testsuite/tests/rts/T25275/T25275_A.stdout ===================================== @@ -0,0 +1 @@ +False \ No newline at end of file ===================================== testsuite/tests/rts/T25275/T25275_B.stdout ===================================== @@ -0,0 +1 @@ +True \ No newline at end of file ===================================== testsuite/tests/rts/T25275/T25275_C.stdout ===================================== @@ -0,0 +1 @@ +False \ No newline at end of file ===================================== testsuite/tests/rts/T25275/T25275_D.stdout ===================================== @@ -0,0 +1 @@ +True \ No newline at end of file ===================================== testsuite/tests/rts/T25275/TraceIpe.hs ===================================== @@ -0,0 +1,6 @@ +module Main where + +import GHC.RTS.Flags.Experimental (TraceFlags (..), getTraceFlags) + +main :: IO () +main = print . traceIpe =<< getTraceFlags ===================================== testsuite/tests/rts/T25275/all.T ===================================== @@ -0,0 +1,43 @@ +# Compile and run with default RTS options +test( + 'T25275_A', + [ + extra_files(['TraceIpe.hs']), + ], + multimod_compile_and_run, + ['TraceIpe', ''], +) + +# Compile and run with -lI +test( + 'T25275_B', + [ + extra_files(['TraceIpe.hs']), + extra_run_opts('+RTS -lI -RTS'), + ], + multimod_compile_and_run, + ['TraceIpe', ''], +) + +# Compile and run with default RTS options +test( + 'T25275_C', + [ + only_ways(['debug']), + extra_files(['DebugIpe.hs']), + ], + multimod_compile_and_run, + ['DebugIpe', ''], +) + +# Compile and run with -DI +test( + 'T25275_D', + [ + only_ways(['debug']), + extra_files(['DebugIpe.hs']), + extra_run_opts('+RTS -DI -RTS'), + ], + multimod_compile_and_run, + ['DebugIpe', ''], +) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e3f01e2fb7b2a2c4c5796a9710967… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e3f01e2fb7b2a2c4c5796a9710967… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Do not use mkCast during typechecking
by Marge Bot (＠marge-bot) 15 May '26

15 May '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 22e2080c by Simon Peyton Jones at 2026-05-15T08:12:31-04:00 Do not use mkCast during typechecking This commit fixes #27219. The problem was that the typechecker was using `mkCast`, whose assertion checks legitimately fail when applied to types that contain unification variables. - - - - - 068890af by Simon Peyton Jones at 2026-05-15T08:12:31-04:00 Major refactor of the Simplifier The main payload of this patch is to refactor the Simplifer to avoid repeated simplification when using Plan (AFTER) for rule rewrites. The need for this was shown up by #26989. See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration. Related refactoring: * Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`. Reason: the envt is irrelevant in the "simplified" case, so the data type describes the possiblitiies much more accurately now. * Some refactoring in `knownCon` to split off `wrapDataConFloats`. * Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`, a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule. This RuleMatch returns fragments of the target in rm_args and rm_floats, leaving `rm_rhs` to be the stuff from the RULE itself. Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes there but all routine. * When doing occurrence analysis on RULEs, make the occ-info on the rule binders relate just to the RHS, not the LHS. See (OUR1) in Note Note [OccInfo in unfoldings and rules] This means that Lint must not complain about the fact that the patterns in the RULE mentions binders that are marked dead. See Note [Dead occurrences] in GHC.Core.Lint. I changed the Core pretty-printer so that it didn't suppress dead binders, else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles. * Refactor FloatBinds, so that it is used both by `exprIsConApp_mabye` and by `lookupRule` * Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core. * Add FloatTick as an extra constructor. * Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`. This refactor just shares more code. (Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious name clash with GHC.Core.FloatBinds.) Corecion optimisation * In simpleOpt, when composing coercions, call new function `optTransCo`. This is much lighter weight than full blown coercion optimisation. * Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the coercionLKind of the coercion. This saves recomputing that coercionLKind at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast. * Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`. * In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`. I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal]. * Don't optimise coercions if the type-substitution is empty. See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration. The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have Compiler allocs: Before: 7,363M After: 688M Compile time goes down generally. Here are compiler-alloc changes over 0.5%: CoOpt_Read(normal) 729,184,920 -0.7% CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD LargeRecord(normal) 1,227,056,876 +1.1% T12227(normal) 256,827,604 -4.6% GOOD T12425(optasm) 76,879,410 -0.8% T12545(normal) 787,826,918 -10.8% GOOD T12707(normal) 775,186,464 -0.9% T13253(normal) 318,599,596 -0.8% T14766(normal) 685,857,320 -1.0% T15304(normal) 1,123,333,422 -2.2% T15630(normal) 123,142,330 -2.6% T15630a(normal) 123,092,100 -2.6% T15703(normal) 299,751,682 -2.9% GOOD T17516(normal) 964,072,280 +1.0% T18223(normal) 367,016,820 -6.2% GOOD T18730(optasm) 130,643,770 -3.3% GOOD T20261(normal) 535,608,584 -0.7% T21839c(normal) 340,340,436 -0.9% T24984(normal) 85,568,392 -1.9% T3064(normal) 174,631,992 -1.2% T3294(normal) 1,215,886,432 -0.7% T5030(normal) 141,449,704 -17.2% GOOD T5321Fun(normal) 258,484,744 -1.9% T8095(normal) 770,532,232 -2.7% T9630(normal) 858,423,408 -14.5% GOOD T9872c(normal) 1,591,709,448 +0.7% info_table_map_perf(normal) 19,700,614,458 -1.3% geo. mean -0.7% minimum -17.2% maximum +1.1% Metric Decrease: CoOpt_Singletons T12227 T12545 T12707 T15703 T18223 T18730 T21839c T5030 T9630 - - - - - 0401d4ab by Duncan Coutts at 2026-05-15T08:12:32-04:00 Document removal of the signal-based interval timer Update mentions within the RTS section of the users guide. Add a changelog entry. - - - - - 2521299b by Duncan Coutts at 2026-05-15T08:12:32-04:00 Fix section for an recent changelog entry - - - - - 60 changed files: - changelog.d/dynamic-trace-flags - + changelog.d/no-more-timer-signal - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Types/Id/Make.hs - docs/users_guide/profiling.rst - docs/users_guide/runtime_control.rst - testsuite/tests/codeGen/should_compile/T25177.stderr - testsuite/tests/deSugar/should_compile/T13208.stdout - testsuite/tests/linters/notes.stdout - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/numeric/should_compile/T20347.stderr - testsuite/tests/numeric/should_compile/T20374.stderr - testsuite/tests/numeric/should_compile/T20376.stderr - + testsuite/tests/perf/compiler/T26989.hs - + testsuite/tests/perf/compiler/T26989a.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr - testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr - testsuite/tests/simplCore/should_compile/T15205.stderr - testsuite/tests/simplCore/should_compile/T18668.stderr - testsuite/tests/simplCore/should_compile/T19246.stderr - testsuite/tests/simplCore/should_compile/T19599.stderr - testsuite/tests/simplCore/should_compile/T19599a.stderr - testsuite/tests/simplCore/should_compile/T21917.stderr - testsuite/tests/simplCore/should_compile/T23074.stderr - testsuite/tests/simplCore/should_compile/T24359a.stderr - testsuite/tests/simplCore/should_compile/T25160.stderr - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32 - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64 - testsuite/tests/simplCore/should_compile/T26051.stderr - testsuite/tests/simplCore/should_compile/T26116.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/T8848a.stderr - testsuite/tests/simplCore/should_compile/spec004.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc7ec61a99a64c2bbdab64263b8c31… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc7ec61a99a64c2bbdab64263b8c31… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Do not use mkCast during typechecking
by Marge Bot (＠marge-bot) 15 May '26

15 May '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 04f83764 by Simon Peyton Jones at 2026-05-15T08:04:32-04:00 Do not use mkCast during typechecking This commit fixes #27219. The problem was that the typechecker was using `mkCast`, whose assertion checks legitimately fail when applied to types that contain unification variables. - - - - - 3c897662 by Simon Peyton Jones at 2026-05-15T08:04:32-04:00 Major refactor of the Simplifier The main payload of this patch is to refactor the Simplifer to avoid repeated simplification when using Plan (AFTER) for rule rewrites. The need for this was shown up by #26989. See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration. Related refactoring: * Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`. Reason: the envt is irrelevant in the "simplified" case, so the data type describes the possiblitiies much more accurately now. * Some refactoring in `knownCon` to split off `wrapDataConFloats`. * Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`, a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule. This RuleMatch returns fragments of the target in rm_args and rm_floats, leaving `rm_rhs` to be the stuff from the RULE itself. Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes there but all routine. * When doing occurrence analysis on RULEs, make the occ-info on the rule binders relate just to the RHS, not the LHS. See (OUR1) in Note Note [OccInfo in unfoldings and rules] This means that Lint must not complain about the fact that the patterns in the RULE mentions binders that are marked dead. See Note [Dead occurrences] in GHC.Core.Lint. I changed the Core pretty-printer so that it didn't suppress dead binders, else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles. * Refactor FloatBinds, so that it is used both by `exprIsConApp_mabye` and by `lookupRule` * Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core. * Add FloatTick as an extra constructor. * Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`. This refactor just shares more code. (Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious name clash with GHC.Core.FloatBinds.) Corecion optimisation * In simpleOpt, when composing coercions, call new function `optTransCo`. This is much lighter weight than full blown coercion optimisation. * Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the coercionLKind of the coercion. This saves recomputing that coercionLKind at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast. * Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`. * In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`. I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal]. * Don't optimise coercions if the type-substitution is empty. See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration. The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have Compiler allocs: Before: 7,363M After: 688M Compile time goes down generally. Here are compiler-alloc changes over 0.5%: CoOpt_Read(normal) 729,184,920 -0.7% CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD LargeRecord(normal) 1,227,056,876 +1.1% T12227(normal) 256,827,604 -4.6% GOOD T12425(optasm) 76,879,410 -0.8% T12545(normal) 787,826,918 -10.8% GOOD T12707(normal) 775,186,464 -0.9% T13253(normal) 318,599,596 -0.8% T14766(normal) 685,857,320 -1.0% T15304(normal) 1,123,333,422 -2.2% T15630(normal) 123,142,330 -2.6% T15630a(normal) 123,092,100 -2.6% T15703(normal) 299,751,682 -2.9% GOOD T17516(normal) 964,072,280 +1.0% T18223(normal) 367,016,820 -6.2% GOOD T18730(optasm) 130,643,770 -3.3% GOOD T20261(normal) 535,608,584 -0.7% T21839c(normal) 340,340,436 -0.9% T24984(normal) 85,568,392 -1.9% T3064(normal) 174,631,992 -1.2% T3294(normal) 1,215,886,432 -0.7% T5030(normal) 141,449,704 -17.2% GOOD T5321Fun(normal) 258,484,744 -1.9% T8095(normal) 770,532,232 -2.7% T9630(normal) 858,423,408 -14.5% GOOD T9872c(normal) 1,591,709,448 +0.7% info_table_map_perf(normal) 19,700,614,458 -1.3% geo. mean -0.7% minimum -17.2% maximum +1.1% Metric Decrease: CoOpt_Singletons T12227 T12545 T12707 T15703 T18223 T18730 T21839c T5030 T9630 - - - - - 38766082 by Duncan Coutts at 2026-05-15T08:04:33-04:00 Document removal of the signal-based interval timer Update mentions within the RTS section of the users guide. Add a changelog entry. - - - - - fc7ec61a by Duncan Coutts at 2026-05-15T08:04:33-04:00 Fix section for an recent changelog entry - - - - - 60 changed files: - changelog.d/dynamic-trace-flags - + changelog.d/no-more-timer-signal - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Types/Id/Make.hs - docs/users_guide/profiling.rst - docs/users_guide/runtime_control.rst - testsuite/tests/codeGen/should_compile/T25177.stderr - testsuite/tests/deSugar/should_compile/T13208.stdout - testsuite/tests/linters/notes.stdout - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/numeric/should_compile/T20347.stderr - testsuite/tests/numeric/should_compile/T20374.stderr - testsuite/tests/numeric/should_compile/T20376.stderr - + testsuite/tests/perf/compiler/T26989.hs - + testsuite/tests/perf/compiler/T26989a.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr - testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr - testsuite/tests/simplCore/should_compile/T15205.stderr - testsuite/tests/simplCore/should_compile/T18668.stderr - testsuite/tests/simplCore/should_compile/T19246.stderr - testsuite/tests/simplCore/should_compile/T19599.stderr - testsuite/tests/simplCore/should_compile/T19599a.stderr - testsuite/tests/simplCore/should_compile/T21917.stderr - testsuite/tests/simplCore/should_compile/T23074.stderr - testsuite/tests/simplCore/should_compile/T24359a.stderr - testsuite/tests/simplCore/should_compile/T25160.stderr - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32 - testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64 - testsuite/tests/simplCore/should_compile/T26051.stderr - testsuite/tests/simplCore/should_compile/T26116.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/T8848a.stderr - testsuite/tests/simplCore/should_compile/spec004.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b68d5bbd165393973db281a88646a4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b68d5bbd165393973db281a88646a4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/dcoutts/issue-27105-stopTicker] Try disabling haddock build for temporary CI debugging
by Duncan Coutts (＠dcoutts) 15 May '26

15 May '26

Duncan Coutts pushed to branch wip/dcoutts/issue-27105-stopTicker at Glasgow Haskell Compiler / GHC Commits: f51bed08 by Duncan Coutts at 2026-05-15T09:30:06+01:00 Try disabling haddock build for temporary CI debugging On OSX, the build is failing on this branch but the failure is a timeout of haddock. This is impractical to debug. Instead we need to run the testsuite rather than building docs. Then we have a chance to see more specific failures. - - - - - 1 changed file: - hadrian/src/Rules/Documentation.hs Changes: ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# OPTIONS_GHC -Wno-error=unused-top-binds #-} module Rules.Documentation ( -- * Rules @@ -81,21 +82,26 @@ needDocDeps = do -- | Build all documentation documentationRules :: Rules () documentationRules = do +{- buildDocumentationArchives buildHtmlDocumentation buildManPage buildPdfDocumentation buildSphinxInfoGuide - +-} -- a phony rule that runs Haddock for "Haskell Hierarchical Libraries" and -- the "GHC-API" "docs-haddock" ~> do + return () +{- root <- buildRoot need [ root -/- pathIndex "libraries" ] - +-} -- a phony rule that runs Haddock, builds the User's guide, builds -- Haddock's manual, and builds man pages "docs" ~> do + return () +{- root <- buildRoot doctargets <- ghcDocs =<< flavour @@ -128,6 +134,7 @@ documentationRules = do where archiveTarget "libraries" = Haddocks archiveTarget _ = SphinxHTML +-} -- | Check Sphinx log for undefined reference target errors. Ideally we would -- use sphinx's @-W@ flag here but unfortunately it also turns syntax View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f51bed08926666ffbd4639b3deb67e6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f51bed08926666ffbd4639b3deb67e6… You're receiving this email because of your account on gitlab.haskell.org.

1 0