- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/26635] hadrian: Don't include the package hash in the haddock directory
by Zubin (＠wz1000) 10 Feb '26

10 Feb '26

Zubin pushed to branch wip/26635 at Glasgow Haskell Compiler / GHC Commits: c9c71f73 by Zubin Duggal at 2026-02-10T17:05:14+05:30 hadrian: Don't include the package hash in the haddock directory Since GHC 9.8 and hash_unit_ids, haddock urls have looked like`ghc-9.10.3/doc/html/libraries/base-4.20.2.0-39f9/**/*.html` The inclusion of the hash makes it hard for downstream non-boot packages to properly link to these files, as the hash is not part of a standard cabal substitution. Since we only build one version of each package, we don't need the hash to disambiguate anything, we can just remove it. Fixes #26635 - - - - - 4 changed files: - hadrian/bindist/Makefile - hadrian/src/CommandLine.hs - hadrian/src/Context.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== hadrian/bindist/Makefile ===================================== @@ -205,7 +205,7 @@ update_package_db: install_bin install_lib $(INSTALL_DATA) mk/system-cxx-std-lib-1.0.conf "$(DESTDIR)$(ActualLibsDir)/package.conf.d" @echo "Updating the package DB" $(foreach p, $(PKG_CONFS),\ - $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-[0-9.]*-[0-9a-zA-Z]*\.conf//g'),$(shell echo "$p" | sed 's:\0xxx\0: :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)"),$(shell echo $(notdir $p) | sed 's/.conf//g'))) + $(call patchpackageconf,$(shell echo $(notdir $p) | sed 's/-[0-9.]*-[0-9a-zA-Z]*\.conf//g'),$(shell echo "$p" | sed 's:\0xxx\0: :g'),$(docdir),$(shell mk/relpath.sh "$(ActualLibsDir)" "$(docdir)"),$(shell echo $(notdir $p) | sed 's/-[0-9a-zA-Z]*\.conf$//'))) '$(DESTDIR)$(ActualBinsDir)/$(CrossCompilePrefix)ghc-pkg' --global-package-db "$(DESTDIR)$(ActualLibsDir)/package.conf.d" recache .PHONY: install_mingw ===================================== hadrian/src/CommandLine.hs ===================================== @@ -114,7 +114,7 @@ data DocArgs = DocArgs } deriving (Eq, Show) defaultDocArgs :: DocArgs -defaultDocArgs = DocArgs { docsBaseUrl = "../%pkgid%" } +defaultDocArgs = DocArgs { docsBaseUrl = "../%pkg%" } readConfigure :: Either String (CommandLineArgs -> CommandLineArgs) readConfigure = Left "hadrian --configure has been deprecated (see #20167). Please run ./boot; ./configure manually" ===================================== hadrian/src/Context.hs ===================================== @@ -120,7 +120,9 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") pkgHaddockFile :: Context -> Action FilePath pkgHaddockFile Context {..} = do root <- buildRoot - version <- pkgUnitId stage package + -- We don't want to use the hash in the html documentation because it + -- makes it harder for non-boot packages to link to boot packages, see #26635 + version <- pkgSimpleIdentifier package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.: ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -83,6 +83,9 @@ commonCabalArgs :: Stage -> Args commonCabalArgs stage = do pkg <- getPackage package_id <- expr $ pkgUnitId stage pkg + -- We don't want to use the hash in the html documentation because it + -- makes it harder for non-boot packages to link to boot packages, see #26635 + package_simple_id <- expr $ pkgSimpleIdentifier pkg let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..") mconcat [ -- Don't strip libraries when cross compiling. -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@, @@ -110,7 +113,7 @@ commonCabalArgs stage = do -- -- This doesn't hold if we move the @doc@ folder anywhere else. , arg "--htmldir" - , arg $ "${pkgroot}/../../doc/html/libraries/" ++ package_id + , arg $ "${pkgroot}/../../doc/html/libraries/" ++ package_simple_id -- These trigger a need on each dependency, so every important to need -- them in parallel or it linearises the build of Ghc and GhcPkg View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c9c71f737bf03d8b6f2c5adffb82545… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c9c71f737bf03d8b6f2c5adffb82545… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T24464] 9 commits: NCG/LA64: adjust register usage to avoid src-register being clobbered
by Simon Peyton Jones (＠simonpj) 10 Feb '26

10 Feb '26

Simon Peyton Jones pushed to branch wip/T24464 at Glasgow Haskell Compiler / GHC Commits: 2e39a340 by Peng Fan at 2026-02-07T03:42:01-05:00 NCG/LA64: adjust register usage to avoid src-register being clobbered - - - - - 9faf1b35 by Teo Camarasu at 2026-02-07T03:42:43-05:00 ghc-internal: Delete unnecessary GHC.Internal.Data.Ix This module merely re-exports GHC.Internal.Ix. It was copied from `base` when `ghc-internal` was split, but there is no reason to have this now. So, let's delete it. Resolves #26848 - - - - - d112b440 by Sven Tennie at 2026-02-07T10:47:56-05:00 Add cabal.project file to generate-ci This fixes the HLS setup for our CI code generation script (generate-ci). The project file simply makes `generate-ci` of the cabal file discoverable. - - - - - 5339f6f0 by Andreas Klebinger at 2026-02-07T10:48:40-05:00 CI: Don't collapse test results. This puts test output back into the primary test log instead of a subsection removing the need to expand a section to see test results. While the intention was good in practice the old behaviour mostly wastes time by requiring expansion of the section. Fixes #26882 - - - - - 0e1cd2e0 by Evan Piro at 2026-02-08T10:35:16-08:00 Linker.MacOS reduce dynflags import - - - - - 1c79a4cd by Michael Alan Dorman at 2026-02-09T08:11:51-05:00 Remove `extra_src_files` variable from `testsuite/driver/testlib.py` While reading through the test harness code, I noticed this variable with a TODO attached that referenced #12223. Although that bug is closed, it strongly implied that this special-case variable that only affected a single test was expected to be removed at some point. I also looked at 3415bcaa0b1903b5e12dfaadb5b774718e406eab---where it was added---whose commit message suggested that it would have been desirable to remove it, but that there were special circumstances that meant it had to remain (though it doesn't elucidate what those special circumstances are). However, the special circumstances were mentioned as if the test was in a different location than is currently is, so I decided to try changing the test to use the standard `extra_files` mechanism, which works in local testing. This also seems like a reasonable time to remove the script that was originally used in the transition, since it doesn't really serve a purpose anymore. - - - - - 0020e38a by Matthew Pickering at 2026-02-09T17:29:14-05:00 determinism: Use a stable sort in WithHsDocIdentifiers binary instance `WithHsDocIdentifiers` is defined as ``` 71 data WithHsDocIdentifiers a pass = WithHsDocIdentifiers 72 { hsDocString :: !a 73 , hsDocIdentifiers :: ![Located (IdP pass)] 74 } ``` This list of names is populated from `rnHsDocIdentifiers`, which calls `lookupGRE`, which calls `lookupOccEnv_AllNameSpaces`, which calls `nonDetEltsUFM` and returns the results in an order depending on uniques. Sorting the list with a stable sort before returning the interface makes the output deterministic and follows the approach taken by other fields in `Docs`. Fixes #26858 - - - - - 89898ce6 by echoumcp1 at 2026-02-09T17:30:01-05:00 Replace putstrln with logMsg in handleSeqHValueStatus Fixes #26549 - - - - - 318ee13b by Simon Peyton Jones at 2026-02-10T10:21:26+00:00 Simplify the treatment of static forms This MR implements GHC proposal 732: simplify static forms, https://github.com/ghc-proposals/ghc-proposals/pull/732 thereby addressing #26556. See `Note [Grand plan for static forms]` in GHC.Iface.Tidy.StaticPtrTable The main changes are: * There is a new, simple rule for (static e), namely that the free term variables of `e` must be bound at top level. The check is done in the `HsStatic` case of `GHC.Rename.Expr.rnExpr` * That in turn substantially simplifies the info that the typechecker carries around in its type environment. Hooray. * The desugarer emits static bindings to top level directly; see the `HsStatic` case of `dsExpr`. * There is no longer any special static-related magic in the FloatOut pass. And the main Simplifier pipeline no longer needs a special case to run FloatOut even with -O0. Hooray. All this forced an unexpected change to the pattern match checker. It recursively invokes the main Hs desugarer when it wants to take a look at a term to spot some special cases (notably constructor applications). We don't want to emit any nested (static e) bindings to top level a second time! Yikes. That forced a modest refactor in GHC.HsToCore.Pmc: * The `dsl_nablas` field of `DsLclEnv` now has a `NoPmc` case, which says "I'm desugaring just for pattern-match checking purposes". * When that flag is set we don't emit static binds. That in turn forces a cascade of refactoring, but the net effect is an improvement; less risk of duplicated (even exponential?) work. See Note [Desugaring HsExpr during pattern-match checking]. 10% metric decrease, on some architectures, of compile-time max-bytes-used on T15304. Metric Decrease: T15304 - - - - - 80 changed files: - .gitlab/ci.sh - + .gitlab/generate-ci/cabal.project - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/CoreToStg/AddImplicitBinds.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - − compiler/GHC/Tc/Utils/TcMType.hs-boot - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Id/Make.hs - libraries/base/src/Data/Ix.hs - libraries/ghc-internal/ghc-internal.cabal.in - − libraries/ghc-internal/src/GHC/Internal/Data/Ix.hs - − testsuite/driver/kill_extra_files.py - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/CgStaticPointers.hs - testsuite/tests/codeGen/should_run/CgStaticPointersNoFullLazyness.hs - testsuite/tests/ghci/scripts/T20150.stdout - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/process/all.T - testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr - testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/HaddockSpanIssueT24378.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d491dbbf9a38186c10f5ab89382e69… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d491dbbf9a38186c10f5ab89382e69… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/hadrian_race] ghc-pkg: Rework locking to make it more stable under concurrent accesses.
by Andreas Klebinger (＠AndreasK) 10 Feb '26

10 Feb '26

Andreas Klebinger pushed to branch wip/andreask/hadrian_race at Glasgow Haskell Compiler / GHC Commits: 5c20ba7d by Andreas Klebinger at 2026-02-10T11:34:23+01:00 ghc-pkg: Rework locking to make it more stable under concurrent accesses. ghc-pkg will now keep a database locked while reading it. See Note [ghc-pkg database locking] for details. I also killed of the remaining workarounds for single file package databases. This should fix #22870. - - - - - 4 changed files: - docs/users_guide/9.16.1-notes.rst - libraries/ghc-boot/GHC/Unit/Database.hs - testsuite/tests/ghci/linking/dyn/all.T - utils/ghc-pkg/Main.hs Changes: ===================================== docs/users_guide/9.16.1-notes.rst ===================================== @@ -160,6 +160,15 @@ Cmm the recompilation checker will look at to determine if a module needs to be recompiled. +``ghc-pkg`` utility +~~~~~~~~~~~~~~~~~~~ + +- A slight rework how package databases are being locked should make ghc-pkg more + reliable when multiple invocations try to read/modify a package database at the + same time. + +- Support for single-file package dbs has been eliminated. + Included libraries ~~~~~~~~~~~~~~~~~~ ===================================== libraries/ghc-boot/GHC/Unit/Database.hs ===================================== @@ -58,6 +58,9 @@ module GHC.Unit.Database , DbMode(..) , DbOpenMode(..) , isDbOpenReadMode + , dbMode + , modeWithLock + , readPackageDbForGhc , readPackageDbForGhcPkg , writePackageDb @@ -65,6 +68,7 @@ module GHC.Unit.Database , PackageDbLock , lockPackageDb , unlockPackageDb + , withLockedPackageDb -- * Misc , mkMungePathUrl , mungeUnitInfoPaths @@ -313,6 +317,22 @@ data DbInstUnitId -- | Represents a lock of a package db. newtype PackageDbLock = PackageDbLock Handle +-- | Run the action under a lock, then return the result. +-- If the mode is R/W the *caller* needs to either free the lock or pass it +-- on to code that will. +-- +-- If an exception is raised the lock is released. +withLockedPackageDb :: DbOpenMode m t -> FilePath -> (PackageDbLock -> IO a) -> IO a +withLockedPackageDb mode file act = do + lock <- lockPackageDbWith (lock_mode mode) file + r <- act lock `onException` unlockPackageDb lock + when (isDbOpenReadMode mode ) $ unlockPackageDb lock + pure r + where + lock_mode :: DbOpenMode m t -> LockMode + lock_mode DbOpenReadOnly = SharedLock + lock_mode DbOpenReadWrite{} = ExclusiveLock + -- | Acquire an exclusive lock related to package DB under given location. lockPackageDb :: FilePath -> IO PackageDbLock @@ -362,12 +382,13 @@ lockPackageDbWith mode file = do return $ PackageDbLock hnd lockPackageDb = lockPackageDbWith ExclusiveLock + unlockPackageDb (PackageDbLock hnd) = do hUnlock hnd hClose hnd -- | Mode to open a package db in. -data DbMode = DbReadOnly | DbReadWrite +data DbMode = DbReadOnly | DbReadWrite deriving Eq -- | 'DbOpenMode' holds a value of type @t@ but only in 'DbReadWrite' mode. So -- it is like 'Maybe' but with a type argument for the mode to enforce that the @@ -380,6 +401,14 @@ deriving instance Functor (DbOpenMode mode) deriving instance F.Foldable (DbOpenMode mode) deriving instance F.Traversable (DbOpenMode mode) +dbMode :: DbOpenMode m t -> DbMode +dbMode DbOpenReadOnly = DbReadOnly +dbMode DbOpenReadWrite{} = DbReadWrite + +modeWithLock :: PackageDbLock -> DbOpenMode m t -> DbOpenMode m PackageDbLock +modeWithLock _ DbOpenReadOnly = DbOpenReadOnly +modeWithLock l DbOpenReadWrite{} = DbOpenReadWrite l + isDbOpenReadMode :: DbOpenMode mode t -> Bool isDbOpenReadMode = \case DbOpenReadOnly -> True @@ -388,9 +417,11 @@ isDbOpenReadMode = \case -- | Read the part of the package DB that GHC is interested in. -- readPackageDbForGhc :: FilePath -> IO [DbUnitInfo] -readPackageDbForGhc file = - decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case - (pkgs, DbOpenReadOnly) -> return pkgs +readPackageDbForGhc file = do + hPutStrLn stderr $ "readPackageDbForGhc:" ++ show file + withLockedPackageDb DbOpenReadOnly file $ \_ -> do + decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case + (pkgs, DbOpenReadOnly) -> return pkgs where getDbForGhc = do _version <- getHeader @@ -405,11 +436,13 @@ readPackageDbForGhc file = -- is not defined in this package. This is because ghc-pkg uses Cabal types -- (and Binary instances for these) which this package does not depend on. -- +-- The incoming mode carries the exclusive lock if we are in R/W mode. +-- -- If we open the package db in read only mode, we get its contents. Otherwise -- we additionally receive a PackageDbLock that represents a lock on the -- database, so that we can safely update it later. -- -readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t -> +readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode PackageDbLock -> IO (pkgs, DbOpenMode mode PackageDbLock) readPackageDbForGhcPkg file mode = decodeFromFile file mode getDbForGhcPkg @@ -496,26 +529,20 @@ headerMagic = BS.Char8.pack "\0ghcpkg\0" -- | Feed a 'Get' decoder with data chunks from a file. -- -decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs -> +-- The file is already locked when we call this. We only need to pass it on +-- if we are in R/W mode. +decodeFromFile :: FilePath -> DbOpenMode mode PackageDbLock -> Get pkgs -> IO (pkgs, DbOpenMode mode PackageDbLock) decodeFromFile file mode decoder = case mode of + -- DB is locked with shared access already, we just do the read. DbOpenReadOnly -> do - -- Note [Locking package database on Windows] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- When we open the package db in read only mode, there is no need to acquire - -- shared lock on non-Windows platform because we update the database with an - -- atomic rename, so readers will always see the database in a consistent - -- state. -#if defined(mingw32_HOST_OS) - bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \_ -> do -#endif (, DbOpenReadOnly) <$> decodeFileContents DbOpenReadWrite{} -> do - -- When we open the package db in read/write mode, acquire an exclusive lock - -- on the database and return it so we can keep it for the duration of the + -- When we open the package db in read/write mode, we receive an exclusive lock + -- on the database via the mode and return it so we can keep it for the duration of the -- update. - bracketOnError (lockPackageDb file) unlockPackageDb $ \lock -> do - (, DbOpenReadWrite lock) <$> decodeFileContents + -- If an exception is raised the caller releases the lock. + (, mode) <$> decodeFileContents where decodeFileContents = withBinaryFile file ReadMode $ \hnd -> feed hnd (runGetIncremental decoder) ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -61,8 +61,13 @@ test('T3372', req_process, extra_run_opts('"' + config.libdir + '"'), unless(config.have_RTS_linker, skip), - # Concurrent GHC sessions is fragile on Windows since we must lock the - # package database even for read-only access. - # See Note [Locking package database on Windows] in GHC.Unit.Database - when(opsys('mingw32'), fragile(16773))], + # Concurrent GHC sessions have some history with being fragile. + # #16773 indicated this is because we *did* lock the db on windows. + # After an refactor to fix another concurrent access bug #22870 + # I'm optimistically removing the fragile tag from this. If + # this causes failures in CI feel free to re-instate it but do open + # a ticket. See Note [ghc-pkg database locking] for some info. + + # when(opsys('mingw32'), fragile(16773)) + ], compile_and_run, ['-package ghc']) ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -8,6 +8,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -Wno-orphans -Wno-x-partial #-} -- Fine if this comes from make/Hadrian or the pre-built base. @@ -872,6 +873,34 @@ lookForPackageDBIn dir = do exists_file <- doesFileExist path_file if exists_file then return (Just path_file) else return Nothing +{- Note [ghc-pkg database locking] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's important for ghc-pkg, GHC and hadrian to always see a consistent state for +package databases. To ensure this we generally tacke a lock both for reading and +writing to the package database. + +The general idea is we use `withLockedPackageDb` to lock an already existing +database in both modes. Which behaves differently for reads and modify. + +In read mode we take a shared lock before we start reading, run the argument to +withLockedPackageDb and simply unlock the DB after. We need to lock it to avoid +concurrent invocations from deleting files from the db before we managed to read +them. This occasionally happened in #22870. Not that historically we only used +to lock the package db during reads on windows, for reasons that seem to have been +bogus given the existence of #22870. And it was partially discussed in #16773. + +When modifying a package database we also use withLockedPackageDb but we take +an *exclusive* lock and most importantly we don't unlock the DB after the action +has run unless an exception occurs. +Instead the action we are must ensure the lock is either freed, or returned +as part of the result to be freed later by the caller of withLockedPackageDB. +Typically by storing it inside either a `DbOpenMode` or `PackageDB`. + +While this setup is a bit cumbersome it seemed to be the easiest way to ensure +that locks are consistently held over reads/modifications of a database without +engaging in a larger refactor of the ghc-pkg code. + +-} readParseDatabase :: forall mode t. Verbosity -> Maybe (FilePath,Bool) -> GhcPkg.DbOpenMode mode t @@ -889,83 +918,79 @@ readParseDatabase verbosity mb_user_conf mode use_cache path = do e <- tryIO $ getDirectoryContents path case e of Left err - | ioeGetErrorType err == InappropriateType -> do - -- We provide a limited degree of backwards compatibility for - -- old single-file style db: - mdb <- tryReadParseOldFileStyleDatabase verbosity - mb_user_conf mode use_cache path - case mdb of - Just db -> return db - Nothing -> - die $ "ghc no longer supports single-file style package " - ++ "databases (" ++ path ++ ") use 'ghc-pkg init'" - ++ "to create the database with the correct format." - + | ioeGetErrorType err == InappropriateType -> dieOnSingleFileDb path | otherwise -> ioError err - Right fs - | not use_cache -> ignore_cache (const $ return ()) - | otherwise -> do - e_tcache <- tryIO $ getModificationTime cache - case e_tcache of - Left ex -> do - whenReportCacheErrors $ - if isDoesNotExistError ex - then - -- It's fine if the cache is not there as long as the - -- database is empty. - when (not $ null confs) $ do - warn ("WARNING: cache does not exist: " ++ cache) - warn ("ghc will fail to read this package db. " ++ - recacheAdvice) - else do - warn ("WARNING: cache cannot be read: " ++ show ex) - warn "ghc will fail to read this package db." - ignore_cache (const $ return ()) - Right tcache -> do - when (verbosity >= Verbose) $ do - warn ("Timestamp " ++ show tcache ++ " for " ++ cache) - -- If any of the .conf files is newer than package.cache, we - -- assume that cache is out of date. - cache_outdated <- (`anyM` confs) $ \conf -> - (tcache <) <$> getModificationTime conf - if not cache_outdated - then do - when (verbosity > Normal) $ - infoLn ("using cache: " ++ cache) - GhcPkg.readPackageDbForGhcPkg cache mode - >>= uncurry mkPackageDB - else do - whenReportCacheErrors $ do - warn ("WARNING: cache is out of date: " ++ cache) - warn ("ghc will see an old view of this " ++ - "package db. " ++ recacheAdvice) - ignore_cache $ \file -> do - when (verbosity >= Verbose) $ do - tFile <- getModificationTime file - let rel = case tcache `compare` tFile of - LT -> " (NEWER than cache)" - GT -> " (older than cache)" - EQ -> " (same as cache)" - warn ("Timestamp " ++ show tFile - ++ " for " ++ file ++ rel) - where - confs = map (path </>) $ filter (".conf" `isSuffixOf`) fs - - ignore_cache :: (FilePath -> IO ()) -> IO (PackageDB mode) - ignore_cache checkTime = do - -- If we're opening for modification, we need to acquire a - -- lock even if we don't open the cache now, because we are - -- going to modify it later. - lock <- F.mapM (const $ GhcPkg.lockPackageDb cache) mode - let doFile f = do checkTime f - parseSingletonPackageConf verbosity f - pkgs <- mapM doFile confs - mkPackageDB pkgs lock - - -- We normally report cache errors for read-only commands, - -- since modify commands will usually fix the cache. - whenReportCacheErrors = when $ verbosity > Normal - || verbosity >= Normal && GhcPkg.isDbOpenReadMode mode + -- Take a lock to use while we read the DB + Right fs -> withLockedPackageDb mode cache $ \lock -> do + if not use_cache + then ignore_cache (lock) (const $ return ()) + else do + e_tcache <- tryIO $ getModificationTime cache + case e_tcache of + Left ex -> do + whenReportCacheErrors $ + if isDoesNotExistError ex + then + -- It's fine if the cache is not there as long as the + -- database is empty. + when (not $ null confs) $ do + warn ("WARNING: cache does not exist: " ++ cache) + warn ("ghc will fail to read this package db. " ++ + recacheAdvice) + else do + warn ("WARNING: cache cannot be read: " ++ show ex) + warn "ghc will fail to read this package db." + ignore_cache (lock) (const $ return ()) + Right tcache -> do + when (verbosity >= Verbose) $ do + warn ("Timestamp " ++ show tcache ++ " for " ++ cache) + -- If any of the .conf files is newer than package.cache, we + -- assume that cache is out of date. + cache_outdated <- (`anyM` confs) $ \conf -> + (tcache <) <$> getModificationTime conf + if not cache_outdated + then do + when (verbosity > Normal) $ + infoLn ("using cache: " ++ cache) + GhcPkg.readPackageDbForGhcPkg cache (modeWithLock lock mode) + >>= uncurry mkPackageDB + else do + whenReportCacheErrors $ do + warn ("WARNING: cache is out of date: " ++ cache) + warn ("ghc will see an old view of this " ++ + "package db. " ++ recacheAdvice) + ignore_cache (lock) $ \file -> do + when (verbosity >= Verbose) $ do + tFile <- getModificationTime file + let rel = case tcache `compare` tFile of + LT -> " (NEWER than cache)" + GT -> " (older than cache)" + EQ -> " (same as cache)" + warn ("Timestamp " ++ show tFile + ++ " for " ++ file ++ rel) + where + confs = map (path </>) $ filter (".conf" `isSuffixOf`) fs + + -- Read the package db, potentially locking the .cache file for r/w mode. + ignore_cache :: PackageDbLock -> (FilePath -> IO ()) -> IO (PackageDB mode) + ignore_cache lock checkTime = do + -- If we're opening for modification, we need to acquire a + -- lock even if we don't open the cache now, because we are + -- going to modify it later. + + -- mode' <- F.mapM (const $ GhcPkg.lockPackageDb cache) mode + + let doFile f = do checkTime f + parseSingletonPackageConf verbosity f + pkgs <- mapM doFile confs + + -- mkPackageDB pkgs mode' + mkPackageDB pkgs (modeWithLock lock mode) + + -- We normally report cache errors for read-only commands, + -- since modify commands will usually fix the cache. + whenReportCacheErrors = when $ verbosity > Normal + || verbosity >= Normal && GhcPkg.isDbOpenReadMode mode where cache = path </> cachefilename @@ -1060,75 +1085,16 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url) Just cs@(c : _) | isPathSeparator c -> Just cs _ -> Nothing --- ----------------------------------------------------------------------------- --- Workaround for old single-file style package dbs - --- Single-file style package dbs have been deprecated for some time, but --- it turns out that Cabal was using them in one place. So this code is for a --- workaround to allow older Cabal versions to use this newer ghc. - --- We check if the file db contains just "[]" and if so, we look for a new --- dir-style db in path.d/, ie in a dir next to the given file. --- We cannot just replace the file with a new dir style since Cabal still --- assumes it's a file and tries to overwrite with 'writeFile'. - --- ghc itself also cooperates in this workaround - -tryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (FilePath, Bool) - -> GhcPkg.DbOpenMode mode t -> Bool -> FilePath - -> IO (Maybe (PackageDB mode)) -tryReadParseOldFileStyleDatabase verbosity mb_user_conf - mode use_cache path = do - -- assumes we've already established that path exists and is not a dir - content <- readFile path `catchIO` \_ -> return "" - if take 2 content == "[]" - then do - path_abs <- absolutePath path - let path_dir = adjustOldDatabasePath path - warn $ "Warning: ignoring old file-style db and trying " ++ path_dir - direxists <- doesDirectoryExist path_dir - if direxists - then do - db <- readParseDatabase verbosity mb_user_conf mode use_cache path_dir - -- but pretend it was at the original location - return $ Just db { - location = path, - locationAbsolute = path_abs - } - else do - lock <- F.forM mode $ \_ -> do - createDirectoryIfMissing True path_dir - GhcPkg.lockPackageDb $ path_dir </> cachefilename - return $ Just PackageDB { - location = path, - locationAbsolute = path_abs, - packageDbLock = lock, - packages = [] - } - - -- if the path is not a file, or is not an empty db then we fail - else return Nothing - +-- | Just preserved to give a more informative error adjustOldFileStylePackageDB :: PackageDB mode -> IO (PackageDB mode) adjustOldFileStylePackageDB db = do -- assumes we have not yet established if it's an old style or not mcontent <- liftM Just (readFile (location db)) `catchIO` \_ -> return Nothing - case fmap (take 2) mcontent of + case mcontent of -- it is an old style and empty db, so look for a dir kind in location.d/ - Just "[]" -> return db { - location = adjustOldDatabasePath $ location db, - locationAbsolute = adjustOldDatabasePath $ locationAbsolute db - } - -- it is old style but not empty, we have to bail - Just _ -> die $ "ghc no longer supports single-file style package " - ++ "databases (" ++ location db ++ ") use 'ghc-pkg init'" - ++ "to create the database with the correct format." - -- probably not old style, carry on as normal + Just _ -> dieOnSingleFileDb (location db) Nothing -> return db -adjustOldDatabasePath :: FilePath -> FilePath -adjustOldDatabasePath = (<.> "d") - -- ----------------------------------------------------------------------------- -- Creating a new package DB @@ -2289,3 +2255,9 @@ removeFileSafe fn = -- absolute path. absolutePath :: FilePath -> IO FilePath absolutePath path = return . normalise . (</> path) =<< getCurrentDirectory + +dieOnSingleFileDb :: FilePath -> IO a +dieOnSingleFileDb path = + die $ "ghc no longer supports single-file style package " + ++ "databases (" ++ path ++ ") use 'ghc-pkg init'" + ++ "to create the database with the correct format." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c20ba7d5cc320aa28d73bb80bf6f02… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c20ba7d5cc320aa28d73bb80bf6f02… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26416] 4 commits: disable absence
by Zubin (＠wz1000) 10 Feb '26

10 Feb '26

Zubin pushed to branch wip/26416 at Glasgow Haskell Compiler / GHC Commits: c7831beb by Zubin Duggal at 2026-02-10T16:03:05+05:30 disable absence - - - - - 3af454f3 by Zubin Duggal at 2026-02-10T16:03:05+05:30 DmdAnal: Don't give an absent demand signature to an argument if the argument doesn't also have an absent demand signature in its unfolding. Otherwise, in some cases we might mark an argument as absent and generate a LitRubbish for it, but then the function might inline and turn out to actually use this argument, resulting in a run time crash. Partially addresses #26416. There may still be cases where an absent argument turns out to be used due to a rule firing. - - - - - d3d265ad by Zubin Duggal at 2026-02-10T16:03:05+05:30 wip - - - - - c40d2ae3 by Zubin Duggal at 2026-02-10T16:03:21+05:30 Revert "disable absence" This reverts commit c7831beb636df350d0fabb728bb0d11df555ad1e. - - - - - 5 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Types/Demand.hs - + testsuite/tests/dmdanal/should_run/M1.hs - + testsuite/tests/dmdanal/should_run/T26416.hs - testsuite/tests/dmdanal/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Core.DataCon import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) +import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds, idRuleVars ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) @@ -1106,8 +1106,18 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs WithDmdType rhs_dmd_ty rhs' = dmdAnal env rhs_sd rhs DmdType rhs_env rhs_dmds = rhs_dmd_ty + + -- See Note [Absence analysis for stable unfoldings and RULES] + -- If there's a stable unfolding, we need to combine argument demands + -- from the unfolding with those from the RHS, because the unfolding + -- might use arguments that the (optimised) RHS doesn't. + -- Any argument with a demand absent in one but not the other can + -- be problematic, see #26416 + -- Also combine the DmdEnv (free variables) from the unfolding + (unf_fv_env, combined_rhs_dmds) = combineUnfoldingDmds env rhs_sd id rhs_env rhs_dmds + (final_rhs_dmds, final_rhs) = finaliseArgBoxities env id ww_arity - rhs_dmds (de_div rhs_env) rhs' + combined_rhs_dmds (de_div rhs_env) rhs' dmd_sig_arity = ww_arity + strictCallArity body_sd sig = mkDmdSigForArity dmd_sig_arity (DmdType sig_env final_rhs_dmds) @@ -1135,7 +1145,10 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs NonRecursive -> rhs_env -- See Note [Absence analysis for stable unfoldings and RULES] - rhs_env2 = rhs_env1 `plusDmdEnv` demandRootSet env (bndrRuleAndUnfoldingIds id) + -- The unfolding FVs are handled via unf_fv_env from combineUnfoldingDmds. + -- Here we only need demandRoots for RULES. + rhs_env2 = rhs_env1 `plusDmdEnv` unf_fv_env + `plusDmdEnv` demandRootSet env (idRuleVars id) -- See Note [Lazy and unleashable free variables] !(!sig_env, !weak_fvs) = splitWeakDmds rhs_env2 @@ -1144,6 +1157,31 @@ splitWeakDmds :: DmdEnv -> (DmdEnv, WeakDmds) splitWeakDmds (DE fvs div) = (DE sig_fvs div, weak_fvs) where (!weak_fvs, !sig_fvs) = partitionVarEnv isWeakDmd fvs +-- | If there is a stable unfolding, combine argument demands and free variable +-- demands from the unfolding with those from the RHS. +-- See Note [Absence analysis for stable unfoldings and RULES], Wrinkle (W3). +-- +-- Returns (combined DmdEnv for free variables, combined arg demands) +-- The DmdEnv is nopDmdEnv if there's no stable unfolding. +combineUnfoldingDmds :: AnalEnv -> SubDemand -> Id -> DmdEnv -> [Demand] -> (DmdEnv, [Demand]) +combineUnfoldingDmds env rhs_sd id rhs_fv_env rhs_dmds + | not (isStableUnfolding unf) + = (nopDmdEnv, rhs_dmds) -- No stable unfolding, nothing to do + + | Just unf_body <- maybeUnfoldingTemplate unf + , let WithDmdType (DmdType unf_fv_env unf_dmds) _ = dmdAnal env rhs_sd unf_body + , let combined_dmds = go rhs_dmds unf_dmds + -- Lub the free variable demands from unfolding with RHS + combined_fv_env = lubDmdEnv rhs_fv_env unf_fv_env + = -- pprTrace "combineUnfoldingDmds" (ppr id $$ ppr rhs_dmds $$ ppr unf_dmds $$ ppr combined_dmds) $ + (combined_fv_env, combined_dmds) + | otherwise = (nopDmdEnv, rhs_dmds) + where + unf = realIdUnfolding id + go rhs [] = rhs + go [] _ = [] + go (r:rhs) (u:unfs) = lubUBglbLBDmd r u : go rhs unfs + -- | The result type after applying 'idArity' many arguments. Returns 'Nothing' -- when the type doesn't have exactly 'idArity' many arrows. resultType_maybe :: Id -> Maybe Type @@ -1523,6 +1561,34 @@ Wrinkles: for `sg`, failing to unleash the signature and hence observed an absent error instead of the `really important message`. + (W3) The SOLUTION above handles /free variables/ of stable unfoldings, but + what about /arguments/? Consider (#26416) + + fromVector :: (Storable a, KnownNat n) => Vector a -> Vector a + fromVector v = ... (uses Storable dictionary) ... + {-# INLINABLE fromVector #-} + + Suppose that the optimised RHS of `fromVector` somehow discards the use of + the Storable dictionary, but the stable unfolding still uses it. Then the + demand signature will say that the Storable dictionary argument is absent, + and worker/wrapper will replace it with `LitRubbish`. But when the + worker's unfolding is inlined, it will use that rubbish value as a real + dictionary, leading to a segfault! + + SOLUTION: in `dmdAnalRhsSig`, if the function has a stable unfolding, + analyse it with `dmdAnal` and combine the resulting `DmdType` with the + RHS's `DmdType`. This is done by `combineUnfoldingDmds`, which: + + * For argument demands: combines them using `lubUBglbLBDmd`, which takes + the glb (max) of lower bounds (strictness) and lub (max) of upper + bounds (usage). See Note [Combining demands for stable unfoldings]. + This ensures that if the unfolding uses an argument, it won't be + marked as absent, while preserving any strictness the RHS reveals. + + * For free variable demands: combines them using `lubDmdEnv`. This + replaces the `demandRoots` approach for stable unfoldings (though + we still use `demandRoots` for RULES via `idRuleVars`). + Note [DmdAnal for DataCon wrappers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We give DataCon wrappers a (necessarily flat) demand signature in @@ -2046,8 +2112,11 @@ finaliseArgBoxities env fn ww_arity arg_dmds div rhs arg_triples :: [(Type, StrictnessMark, Demand)] arg_triples = take ww_arity $ - [ (idType bndr, NotMarkedStrict, get_dmd bndr) - | bndr <- bndrs, isRuntimeVar bndr ] + zipWith mk_triple + [ bndr | bndr <- bndrs, isRuntimeVar bndr ] + arg_dmds + where + mk_triple bndr dmd = (idType bndr, NotMarkedStrict, get_dmd dmd) arg_dmds' = ww_arg_dmds ++ map trimBoxity (drop ww_arity arg_dmds) -- If ww_arity < length arg_dmds, the leftover ones @@ -2063,12 +2132,10 @@ finaliseArgBoxities env fn ww_arity arg_dmds div rhs -- This is the budget initialisation step of -- Note [Worker argument budget] - get_dmd :: Id -> Demand - get_dmd bndr + get_dmd :: Demand -> Demand + get_dmd dmd | is_bot_fn = unboxDeeplyDmd dmd -- See Note [Boxity for bottoming functions], | otherwise = dmd -- case (B) - where - dmd = idDemandInfo bndr -- is_bot_fn: see Note [Boxity for bottoming functions] is_bot_fn = div == botDiv ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -23,6 +23,8 @@ module GHC.Types.Demand ( lubCard, lubDmd, lubSubDmd, -- *** Greatest lower bound glbCard, + -- *** Unfolding combination (glb on strictness, lub on usage) + lubUBglbLBDmd, -- *** Plus plusCard, plusDmd, plusSubDmd, -- *** Multiply @@ -49,7 +51,7 @@ module GHC.Types.Demand ( -- * Demand environments DmdEnv(..), addVarDmdEnv, mkTermDmdEnv, nopDmdEnv, plusDmdEnv, plusDmdEnvs, - multDmdEnv, reuseEnv, + lubDmdEnv, multDmdEnv, reuseEnv, -- * Demand types DmdType(..), dmdTypeDepth, @@ -864,6 +866,77 @@ lubSubDmd sd1@Poly{} sd2 = lubSubDmd sd2 sd1 -- Otherwise (Call `lub` Prod) return Top lubSubDmd _ _ = topSubDmd +{- Note [Combining demands for stable unfoldings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When a function has a stable unfolding, the optimised RHS and the unfolding +may have different demand signatures for the same arguments. This can happen +because: + + * The optimised RHS may have had transformations applied that reveal + strictness (e.g., inlining exposes a case on an argument). + + * The optimised RHS may have had transformations applied that drop usage + (e.g., a rewrite rule fires that doesn't use an argument, or a seq on + a dictionary is dropped because dictionaries are known to terminate). + +When we inline the stable unfolding at a call site, we get the unfolding's +behaviour, not the RHS's. So we must be conservative and combine the demands: + + * For strictness (lower bounds): we can take the MAXIMUM (glb). + If the RHS reveals that an argument is strict, that strictness was + always there semantically - the analysis just couldn't see it in the + unfolding. Sound optimisations never make lazy code strict. + + * For usage (upper bounds): we must take the MAXIMUM (lub). + If the unfolding uses an argument but the RHS doesn't, we must not + mark it absent, or we'll replace it with rubbish that the unfolding + will then try to use, causing a segfault. See #26416. + +So for cardinality bounds [l1..u1] from RHS and [l2..u2] from unfolding, +we compute [max(l1,l2)..max(u1,u2)]. + +See Note [Absence analysis for stable unfoldings and RULES] in GHC.Core.Opt.DmdAnal +for the broader context. +-} + +-- | Combine demands for stable unfolding analysis. +-- See Note [Combining demands for stable unfoldings]. +lubUBglbLBCard :: Card -> Card -> Card +-- Given Note [Bit vector representation for Card]: +-- * bit 0 (strictness): take AND (glb) - 0 means strict, so 0 wins +-- * bits 1,2 (usage): take OR (lub) - if either uses, result uses +lubUBglbLBCard (Card a) (Card b) = Card ((a .&. b .&. 0b001) .|. ((a .|. b) .&. 0b110)) + +-- | See Note [Combining demands for stable unfoldings]. +lubUBglbLBDmd :: Demand -> Demand -> Demand +lubUBglbLBDmd BotDmd dmd2 = dmd2 +lubUBglbLBDmd dmd1 BotDmd = dmd1 +lubUBglbLBDmd (n1 :* sd1) (n2 :* sd2) = + lubUBglbLBCard n1 n2 :* lubUBglbLBSubDmd sd1 sd2 + +lubUBglbLBSubDmd :: SubDemand -> SubDemand -> SubDemand +-- Shortcuts for neutral and absorbing elements. +lubUBglbLBSubDmd (Poly Unboxed C_10) sd = sd +lubUBglbLBSubDmd sd (Poly Unboxed C_10) = sd +lubUBglbLBSubDmd sd@(Poly Boxed C_0N) _ = sd +lubUBglbLBSubDmd _ sd@(Poly Boxed C_0N) = sd +-- Prod +lubUBglbLBSubDmd (Prod b1 ds1) (Poly b2 n2) + | let !d = polyFieldDmd b2 n2 + = mkProd (lubBoxity b1 b2) (strictMap (lubUBglbLBDmd d) ds1) +lubUBglbLBSubDmd (Prod b1 ds1) (Prod b2 ds2) + | equalLength ds1 ds2 + = mkProd (lubBoxity b1 b2) (strictZipWith lubUBglbLBDmd ds1 ds2) +-- Handle Call +lubUBglbLBSubDmd (Call n1 sd1) (viewCall -> Just (n2, sd2)) = + mkCall (lubUBglbLBCard n1 n2) (lubUBglbLBSubDmd sd1 sd2) +-- Handle Poly +lubUBglbLBSubDmd (Poly b1 n1) (Poly b2 n2) = Poly (lubBoxity b1 b2) (lubUBglbLBCard n1 n2) +-- Other Poly case by commutativity +lubUBglbLBSubDmd sd1@Poly{} sd2 = lubUBglbLBSubDmd sd2 sd1 +-- Otherwise (Call `lubUBglbLB` Prod) return Top +lubUBglbLBSubDmd _ _ = topSubDmd + -- | Denotes '+' on 'Demand'. plusDmd :: Demand -> Demand -> Demand plusDmd AbsDmd dmd2 = dmd2 ===================================== testsuite/tests/dmdanal/should_run/M1.hs ===================================== @@ -0,0 +1,17 @@ +-- Short module name is essential, or else f doesn't inline +module M1 where +{-# INLINABLE [2] f #-} +f :: Int -> Int -> Float +f !dummy x = if times dummy 0 x == 1 + then 3.0 else 4.0 + +{-# INLINE [0] times #-} +times :: Int -> Int -> Int -> Int +times dummy 0 x = x `seq` ( 0 + big dummy ) +times _ a b = a * b + +{-# RULES "times" [1] forall dummy x. times dummy 0 x = 0 + big dummy #-} + +big :: Int -> Int +big x = succ . succ . succ . succ . succ . succ . succ . succ . succ $ x +{-# INLINE big #-} ===================================== testsuite/tests/dmdanal/should_run/T26416.hs ===================================== @@ -0,0 +1,3 @@ +module Main where +import M1 ( f ) +main = print (f 19 12) ===================================== testsuite/tests/dmdanal/should_run/all.T ===================================== @@ -34,3 +34,4 @@ test('T22475b', normal, compile_and_run, ['']) test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise']) test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208']) test('T25439', normal, compile_and_run, ['']) +test('T26416', normal, multimod_compile_and_run, ['T26416','M1.hs']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b5979c2091d736c2f49f6520d85ca… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b5979c2091d736c2f49f6520d85ca… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26416] wip
by Zubin (＠wz1000) 10 Feb '26

10 Feb '26

Zubin pushed to branch wip/26416 at Glasgow Haskell Compiler / GHC Commits: 8b5979c2 by Zubin Duggal at 2026-02-10T16:01:32+05:30 wip - - - - - 2 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Types/Demand.hs Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Core.DataCon import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) +import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds, idRuleVars ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) import GHC.Core.TyCo.Compare ( eqType ) @@ -1113,7 +1113,8 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs -- might use arguments that the (optimised) RHS doesn't. -- Any argument with a demand absent in one but not the other can -- be problematic, see #26416 - combined_rhs_dmds = combineUnfoldingDmds env rhs_sd id rhs_dmds + -- Also combine the DmdEnv (free variables) from the unfolding + (unf_fv_env, combined_rhs_dmds) = combineUnfoldingDmds env rhs_sd id rhs_env rhs_dmds (final_rhs_dmds, final_rhs) = finaliseArgBoxities env id ww_arity combined_rhs_dmds (de_div rhs_env) rhs' @@ -1144,7 +1145,10 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs NonRecursive -> rhs_env -- See Note [Absence analysis for stable unfoldings and RULES] - rhs_env2 = rhs_env1 `plusDmdEnv` demandRootSet env (bndrRuleAndUnfoldingIds id) + -- The unfolding FVs are handled via unf_fv_env from combineUnfoldingDmds. + -- Here we only need demandRoots for RULES. + rhs_env2 = rhs_env1 `plusDmdEnv` unf_fv_env + `plusDmdEnv` demandRootSet env (idRuleVars id) -- See Note [Lazy and unleashable free variables] !(!sig_env, !weak_fvs) = splitWeakDmds rhs_env2 @@ -1153,27 +1157,30 @@ splitWeakDmds :: DmdEnv -> (DmdEnv, WeakDmds) splitWeakDmds (DE fvs div) = (DE sig_fvs div, weak_fvs) where (!weak_fvs, !sig_fvs) = partitionVarEnv isWeakDmd fvs --- | If there is a stable unfolding, don't let any demand be absent that --- is also not absent in the unfolding +-- | If there is a stable unfolding, combine argument demands and free variable +-- demands from the unfolding with those from the RHS. -- See Note [Absence analysis for stable unfoldings and RULES], Wrinkle (W3). -combineUnfoldingDmds :: AnalEnv -> SubDemand -> Id -> [Demand] -> [Demand] -combineUnfoldingDmds env rhs_sd id rhs_dmds +-- +-- Returns (combined DmdEnv for free variables, combined arg demands) +-- The DmdEnv is nopDmdEnv if there's no stable unfolding. +combineUnfoldingDmds :: AnalEnv -> SubDemand -> Id -> DmdEnv -> [Demand] -> (DmdEnv, [Demand]) +combineUnfoldingDmds env rhs_sd id rhs_fv_env rhs_dmds | not (isStableUnfolding unf) - = rhs_dmds -- No stable unfolding, nothing to do + = (nopDmdEnv, rhs_dmds) -- No stable unfolding, nothing to do | Just unf_body <- maybeUnfoldingTemplate unf - , let WithDmdType (DmdType _ unf_dmds) _ = dmdAnal env rhs_sd unf_body - , let result = go rhs_dmds unf_dmds - = -- pprTrace "lubUnfoldingDmds" (ppr id $$ ppr rhs_dmds $$ ppr unf_dmds $$ ppr result) $ - result - | otherwise = rhs_dmds + , let WithDmdType (DmdType unf_fv_env unf_dmds) _ = dmdAnal env rhs_sd unf_body + , let combined_dmds = go rhs_dmds unf_dmds + -- Lub the free variable demands from unfolding with RHS + combined_fv_env = lubDmdEnv rhs_fv_env unf_fv_env + = -- pprTrace "combineUnfoldingDmds" (ppr id $$ ppr rhs_dmds $$ ppr unf_dmds $$ ppr combined_dmds) $ + (combined_fv_env, combined_dmds) + | otherwise = (nopDmdEnv, rhs_dmds) where unf = realIdUnfolding id go rhs [] = rhs go [] _ = [] - go (AbsDmd:rhs) (u:unfs) = u : go rhs unfs - go (r:rhs) (AbsDmd:unfs) = r : go rhs unfs - go (r:rhs) (_:unfs) = r : go rhs unfs + go (r:rhs) (u:unfs) = lubUBglbLBDmd r u : go rhs unfs -- | The result type after applying 'idArity' many arguments. Returns 'Nothing' -- when the type doesn't have exactly 'idArity' many arrows. @@ -1555,7 +1562,7 @@ Wrinkles: error instead of the `really important message`. (W3) The SOLUTION above handles /free variables/ of stable unfoldings, but - what about /arguments/? Consider (#25965) + what about /arguments/? Consider (#26416) fromVector :: (Storable a, KnownNat n) => Vector a -> Vector a fromVector v = ... (uses Storable dictionary) ... @@ -1569,9 +1576,18 @@ Wrinkles: dictionary, leading to a segfault! SOLUTION: in `dmdAnalRhsSig`, if the function has a stable unfolding, - analyse it and drop any AbsDmds which are not absent in the unfolding. - This is done by `combineUnfoldingDmds`. This ensures that if the unfolding - uses an argument, it won't be marked as absent. + analyse it with `dmdAnal` and combine the resulting `DmdType` with the + RHS's `DmdType`. This is done by `combineUnfoldingDmds`, which: + + * For argument demands: combines them using `lubUBglbLBDmd`, which takes + the glb (max) of lower bounds (strictness) and lub (max) of upper + bounds (usage). See Note [Combining demands for stable unfoldings]. + This ensures that if the unfolding uses an argument, it won't be + marked as absent, while preserving any strictness the RHS reveals. + + * For free variable demands: combines them using `lubDmdEnv`. This + replaces the `demandRoots` approach for stable unfoldings (though + we still use `demandRoots` for RULES via `idRuleVars`). Note [DmdAnal for DataCon wrappers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -23,6 +23,8 @@ module GHC.Types.Demand ( lubCard, lubDmd, lubSubDmd, -- *** Greatest lower bound glbCard, + -- *** Unfolding combination (glb on strictness, lub on usage) + lubUBglbLBDmd, -- *** Plus plusCard, plusDmd, plusSubDmd, -- *** Multiply @@ -49,7 +51,7 @@ module GHC.Types.Demand ( -- * Demand environments DmdEnv(..), addVarDmdEnv, mkTermDmdEnv, nopDmdEnv, plusDmdEnv, plusDmdEnvs, - multDmdEnv, reuseEnv, + lubDmdEnv, multDmdEnv, reuseEnv, -- * Demand types DmdType(..), dmdTypeDepth, @@ -864,6 +866,77 @@ lubSubDmd sd1@Poly{} sd2 = lubSubDmd sd2 sd1 -- Otherwise (Call `lub` Prod) return Top lubSubDmd _ _ = topSubDmd +{- Note [Combining demands for stable unfoldings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When a function has a stable unfolding, the optimised RHS and the unfolding +may have different demand signatures for the same arguments. This can happen +because: + + * The optimised RHS may have had transformations applied that reveal + strictness (e.g., inlining exposes a case on an argument). + + * The optimised RHS may have had transformations applied that drop usage + (e.g., a rewrite rule fires that doesn't use an argument, or a seq on + a dictionary is dropped because dictionaries are known to terminate). + +When we inline the stable unfolding at a call site, we get the unfolding's +behaviour, not the RHS's. So we must be conservative and combine the demands: + + * For strictness (lower bounds): we can take the MAXIMUM (glb). + If the RHS reveals that an argument is strict, that strictness was + always there semantically - the analysis just couldn't see it in the + unfolding. Sound optimisations never make lazy code strict. + + * For usage (upper bounds): we must take the MAXIMUM (lub). + If the unfolding uses an argument but the RHS doesn't, we must not + mark it absent, or we'll replace it with rubbish that the unfolding + will then try to use, causing a segfault. See #26416. + +So for cardinality bounds [l1..u1] from RHS and [l2..u2] from unfolding, +we compute [max(l1,l2)..max(u1,u2)]. + +See Note [Absence analysis for stable unfoldings and RULES] in GHC.Core.Opt.DmdAnal +for the broader context. +-} + +-- | Combine demands for stable unfolding analysis. +-- See Note [Combining demands for stable unfoldings]. +lubUBglbLBCard :: Card -> Card -> Card +-- Given Note [Bit vector representation for Card]: +-- * bit 0 (strictness): take AND (glb) - 0 means strict, so 0 wins +-- * bits 1,2 (usage): take OR (lub) - if either uses, result uses +lubUBglbLBCard (Card a) (Card b) = Card ((a .&. b .&. 0b001) .|. ((a .|. b) .&. 0b110)) + +-- | See Note [Combining demands for stable unfoldings]. +lubUBglbLBDmd :: Demand -> Demand -> Demand +lubUBglbLBDmd BotDmd dmd2 = dmd2 +lubUBglbLBDmd dmd1 BotDmd = dmd1 +lubUBglbLBDmd (n1 :* sd1) (n2 :* sd2) = + lubUBglbLBCard n1 n2 :* lubUBglbLBSubDmd sd1 sd2 + +lubUBglbLBSubDmd :: SubDemand -> SubDemand -> SubDemand +-- Shortcuts for neutral and absorbing elements. +lubUBglbLBSubDmd (Poly Unboxed C_10) sd = sd +lubUBglbLBSubDmd sd (Poly Unboxed C_10) = sd +lubUBglbLBSubDmd sd@(Poly Boxed C_0N) _ = sd +lubUBglbLBSubDmd _ sd@(Poly Boxed C_0N) = sd +-- Prod +lubUBglbLBSubDmd (Prod b1 ds1) (Poly b2 n2) + | let !d = polyFieldDmd b2 n2 + = mkProd (lubBoxity b1 b2) (strictMap (lubUBglbLBDmd d) ds1) +lubUBglbLBSubDmd (Prod b1 ds1) (Prod b2 ds2) + | equalLength ds1 ds2 + = mkProd (lubBoxity b1 b2) (strictZipWith lubUBglbLBDmd ds1 ds2) +-- Handle Call +lubUBglbLBSubDmd (Call n1 sd1) (viewCall -> Just (n2, sd2)) = + mkCall (lubUBglbLBCard n1 n2) (lubUBglbLBSubDmd sd1 sd2) +-- Handle Poly +lubUBglbLBSubDmd (Poly b1 n1) (Poly b2 n2) = Poly (lubBoxity b1 b2) (lubUBglbLBCard n1 n2) +-- Other Poly case by commutativity +lubUBglbLBSubDmd sd1@Poly{} sd2 = lubUBglbLBSubDmd sd2 sd1 +-- Otherwise (Call `lubUBglbLB` Prod) return Top +lubUBglbLBSubDmd _ _ = topSubDmd + -- | Denotes '+' on 'Demand'. plusDmd :: Demand -> Demand -> Demand plusDmd AbsDmd dmd2 = dmd2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b5979c2091d736c2f49f6520d85cab… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b5979c2091d736c2f49f6520d85cab… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26700] Decoupling L.H.S.Decls from GHC.Types.ForeignCall
by recursion-ninja (＠recursion-ninja) 10 Feb '26

10 Feb '26

recursion-ninja pushed to branch wip/fix-26700 at Glasgow Haskell Compiler / GHC Commits: 4652e93a by Recursion Ninja at 2026-02-09T20:18:33-05:00 Decoupling L.H.S.Decls from GHC.Types.ForeignCall - Adding TTG extension point for 'CCallTarget' - Adding TTG extension point for 'CType' - Adding TTG extension point for 'Header' - Moving ForeignCall types that do not need extension to new L.H.S.Decls.Foreign module - Replacing 'Bool' parameters with descriptive data-types to increase clairty and prevent "Boolean Blindness" - - - - - 37 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Utils.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Foreign.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/ForeignCall.hs - compiler/Language/Haskell/Syntax/Decls.hs - + compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4652e93aa2e1d8c99327705a024ef95… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4652e93aa2e1d8c99327705a024ef95… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26503] Implement QualifiedStrings (#26503)
by Brandon Chinn (＠brandonchinn178) 10 Feb '26

10 Feb '26

Brandon Chinn pushed to branch wip/T26503 at Glasgow Haskell Compiler / GHC Commits: 1cb47b6d by Brandon Chinn at 2026-02-09T17:16:19-08:00 Implement QualifiedStrings (#26503) See Note [Implementation of QualifiedStrings] - - - - - 67 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - + compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - + docs/users_guide/exts/qualified_strings.rst - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/annotations-literals/literals.stdout - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/qualified-strings/Makefile - + testsuite/tests/qualified-strings/should_compile/Example/Length.hs - + testsuite/tests/qualified-strings/should_compile/all.T - + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.hs - + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.stderr - + testsuite/tests/qualified-strings/should_fail/Example/Length.hs - + testsuite/tests/qualified-strings/should_fail/Makefile - + testsuite/tests/qualified-strings/should_fail/all.T - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr - + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.stderr - + testsuite/tests/qualified-strings/should_run/Example/ByteStringAscii.hs - + testsuite/tests/qualified-strings/should_run/Example/ByteStringUtf8.hs - + testsuite/tests/qualified-strings/should_run/Example/Text.hs - + testsuite/tests/qualified-strings/should_run/Makefile - + testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_expr.hs - + testsuite/tests/qualified-strings/should_run/qstrings_expr.stdout - + testsuite/tests/qualified-strings/should_run/qstrings_pat.hs - + testsuite/tests/qualified-strings/should_run/qstrings_pat.stdout - + testsuite/tests/qualified-strings/should_run/qstrings_th.hs - + testsuite/tests/qualified-strings/should_run/qstrings_th.stdout - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cb47b6d07c34006ec64be7c364d19a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cb47b6d07c34006ec64be7c364d19a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/dcoutts/issue-26717
by Duncan Coutts (＠dcoutts) 10 Feb '26

10 Feb '26

Duncan Coutts pushed new branch wip/dcoutts/issue-26717 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/dcoutts/issue-26717 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26503] Implement QualifiedStrings (#26503)
by Brandon Chinn (＠brandonchinn178) 10 Feb '26

10 Feb '26

Brandon Chinn pushed to branch wip/T26503 at Glasgow Haskell Compiler / GHC Commits: a0b1a4be by Brandon Chinn at 2026-02-09T16:02:27-08:00 Implement QualifiedStrings (#26503) See Note [Implementation of QualifiedStrings] - - - - - 67 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - + compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - + docs/users_guide/exts/qualified_strings.rst - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/annotations-literals/literals.stdout - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/qualified-strings/Makefile - + testsuite/tests/qualified-strings/should_compile/Example/Length.hs - + testsuite/tests/qualified-strings/should_compile/all.T - + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.hs - + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.stderr - + testsuite/tests/qualified-strings/should_fail/Example/Length.hs - + testsuite/tests/qualified-strings/should_fail/Makefile - + testsuite/tests/qualified-strings/should_fail/all.T - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr - + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.stderr - + testsuite/tests/qualified-strings/should_run/Example/ByteStringAscii.hs - + testsuite/tests/qualified-strings/should_run/Example/ByteStringUtf8.hs - + testsuite/tests/qualified-strings/should_run/Example/Text.hs - + testsuite/tests/qualified-strings/should_run/Makefile - + testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_expr.hs - + testsuite/tests/qualified-strings/should_run/qstrings_expr.stdout - + testsuite/tests/qualified-strings/should_run/qstrings_pat.hs - + testsuite/tests/qualified-strings/should_run/qstrings_pat.stdout - + testsuite/tests/qualified-strings/should_run/qstrings_th.hs - + testsuite/tests/qualified-strings/should_run/qstrings_th.stdout - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0b1a4beb3c281d5e6105acd914415c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0b1a4beb3c281d5e6105acd914415c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Replace putstrln with logMsg in handleSeqHValueStatus
by Marge Bot (＠marge-bot) 09 Feb '26

09 Feb '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 89898ce6 by echoumcp1 at 2026-02-09T17:30:01-05:00 Replace putstrln with logMsg in handleSeqHValueStatus Fixes #26549 - - - - - 2 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Runtime/Interpreter.hs Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -788,6 +788,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do where interp = hscInterp hsc_env unit_env = hsc_unit_env hsc_env + logger = hsc_logger hsc_env go :: Int -> Type -> Type -> ForeignHValue -> TcM Term -- [SPJ May 11] I don't understand the difference between my_ty and old_ty @@ -812,7 +813,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do -- Thunks we may want to force t | isThunk t && force -> do traceTR (text "Forcing a " <> text (show (fmap (const ()) t))) - evalRslt <- liftIO $ GHCi.seqHValue interp unit_env a + evalRslt <- liftIO $ GHCi.seqHValue interp unit_env logger a case evalRslt of -- #2950 EvalSuccess _ -> go (pred max_depth) my_ty old_ty a EvalException ex -> do ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -85,11 +85,13 @@ import GHC.Data.FastString import GHC.Types.SrcLoc import GHC.Types.Basic +import GHC.Types.Error import GHC.Utils.Panic import GHC.Utils.Exception as Ex -import GHC.Utils.Outputable(brackets, ppr, showSDocUnsafe) +import GHC.Utils.Outputable import GHC.Utils.Fingerprint +import GHC.Utils.Logger (Logger, logMsg) import GHC.Unit.Module import GHC.Unit.Home.ModInfo @@ -401,11 +403,11 @@ whereFrom interp ref = interpCmd interp (WhereFrom hval) -- | Send a Seq message to the iserv process to force a value #2950 -seqHValue :: Interp -> UnitEnv -> ForeignHValue -> IO (EvalResult ()) -seqHValue interp unit_env ref = +seqHValue :: Interp -> UnitEnv -> Logger -> ForeignHValue -> IO (EvalResult ()) +seqHValue interp unit_env logger ref = withForeignRef ref $ \hval -> do status <- interpCmd interp (Seq hval) - handleSeqHValueStatus interp unit_env status + handleSeqHValueStatus interp unit_env logger status evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId evalBreakpointToId eval_break = @@ -419,16 +421,15 @@ evalBreakpointToId eval_break = } -- | Process the result of a Seq or ResumeSeq message. #2950 -handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ()) -handleSeqHValueStatus interp unit_env eval_status = +handleSeqHValueStatus :: Interp -> UnitEnv -> Logger -> EvalStatus () -> IO (EvalResult ()) +handleSeqHValueStatus interp unit_env logger eval_status = case eval_status of (EvalBreak _ maybe_break resume_ctxt _) -> do -- A breakpoint was hit; inform the user and tell them -- which breakpoint was hit. resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt - - let put x = putStrLn ("*** Ignoring breakpoint " ++ (showSDocUnsafe x)) - let nothing_case = put $ brackets . ppr $ mkGeneralSrcSpan (fsLit "<unknown>") + let put loc = logMsg logger MCOutput loc ("*** Ignoring breakpoint" <+> brackets (ppr loc)) + let nothing_case = put noSrcSpan case maybe_break of Nothing -> nothing_case -- Nothing case - should not occur! @@ -445,13 +446,12 @@ handleSeqHValueStatus interp unit_env eval_status = -- Nothing case - should not occur! We should have the appropriate -- breakpoint information Nothing -> nothing_case - Just modbreaks -> put . brackets . ppr =<< - getBreakLoc (readIModModBreaks hug) ibi modbreaks + Just modbreaks -> put =<< getBreakLoc (readIModModBreaks hug) ibi modbreaks -- resume the seq (:force) processing in the iserv process withForeignRef resume_ctxt_fhv $ \hval -> do status <- interpCmd interp (ResumeSeq hval) - handleSeqHValueStatus interp unit_env status + handleSeqHValueStatus interp unit_env logger status (EvalComplete _ r) -> return r View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89898ce6706e5a5e92081cea60f3eea… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89898ce6706e5a5e92081cea60f3eea… You're receiving this email because of your account on gitlab.haskell.org.

1 0