- ghc-commits - Haskell.org

[Git][ghc/ghc] Deleted branch wip/wasm-command-jsval
by Cheng Shao (＠TerrorJack) 30 Nov '25

30 Nov '25

Cheng Shao deleted branch wip/wasm-command-jsval at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED] Do not genererate ghcLibDeps for >=Stage2 when cross-compiling
by Sven Tennie (＠supersven) 30 Nov '25

30 Nov '25

Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FIXED at Glasgow Haskell Compiler / GHC Commits: aa97891e by Sven Tennie at 2025-11-30T12:42:13+01:00 Do not genererate ghcLibDeps for >=Stage2 when cross-compiling Otherwise, the build fails trying to get the `succStage(Stage2)`. - - - - - 1 changed file: - hadrian/src/Rules/Register.hs Changes: ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -11,7 +11,7 @@ import Oracles.Setting import Hadrian.BuildPath import Hadrian.Expression import Hadrian.Haskell.Cabal -import Oracles.Flag (targetSupportsGhciObjects) +import Oracles.Flag (targetSupportsGhciObjects, Flag (..)) import Packages import Rules.Rts import Settings @@ -34,6 +34,7 @@ import qualified Distribution.Compat.CharParsing as CabalCharParsing import qualified Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO +import Settings.Builders.Common (flag) -- * Configuring @@ -118,7 +119,11 @@ registerPackageRules rs stage iplace = do pkgName <- getPackageNameFromConfFile conf let pkg = unsafeFindPackageByName pkgName - when (pkg == compiler) $ need =<< ghcLibDeps stage iplace + -- Cross-compilers have only libraries in their 2nd stage. So, we don't + -- need config files for binaries there. + cross <- flag CrossCompiling + when (pkg == compiler && (not cross || stage <= Stage1)) $ do + need =<< ghcLibDeps stage iplace -- Only used in guard when Stage0 {} but can be GlobalLibs or InTreeLibs isBoot <- (pkg `notElem`) <$> stagePackages stage View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa97891e8d5215c995366d2fdb75fbf… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa97891e8d5215c995366d2fdb75fbf… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T26519
by Peter Trommler (＠trommler) 30 Nov '25

30 Nov '25

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

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: gitlab-ci: Run ghcup-metadata jobs on OpenCape runners
by Marge Bot (＠marge-bot) 30 Nov '25

30 Nov '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ff3f0d09 by Ben Gamari at 2025-11-29T18:34:28-05:00 gitlab-ci: Run ghcup-metadata jobs on OpenCape runners This significantly reduces our egress traffic and makes the jobs significantly faster. - - - - - ef0dc33b by Matthew Pickering at 2025-11-29T18:35:10-05:00 Use 'OsPath' in getModificationTimeIfExists This part of the compiler is quite hot during recompilation checking in particular since the filepaths will be translated to a string. It is better to use the 'OsPath' native function, which turns out to be easy to do. - - - - - fa3bd0a6 by Georgios Karachalias at 2025-11-29T18:36:05-05:00 Use OsPath in PkgDbRef and UnitDatabase, not FilePath - - - - - 92fe4538 by Ben Gamari at 2025-11-29T23:12:18-05:00 hadrian: Place user options after package arguments This makes it easier for the user to override the default package arguments with `UserSettings.hs`. Fixes #25821. ------------------------- Metric Decrease: T14697 ------------------------- - - - - - cb92b30f by Vladislav Zavialov at 2025-11-29T23:12:19-05:00 Namespace-specified wildcards in import/export lists (#25901) This change adds support for top-level namespace-specified wildcards `type ..` and `data ..` to import and export lists. Examples: import M (type ..) -- imports all type and class constructors from M import M (data ..) -- imports all data constructors and terms from M module M (type .., f) where -- exports all type and class constructors defined in M, -- plus the function 'f' The primary intended usage of this feature is in combination with module aliases, allowing namespace disambiguation: import Data.Proxy as T (type ..) -- T.Proxy is unambiguously the type constructor import Data.Proxy as D (data ..) -- D.Proxy is unambiguously the data constructor The patch accounts for the interactions of wildcards with: * Imports with `hiding` clauses * Import warnings -Wunused-imports, -Wdodgy-imports * Export warnings -Wduplicate-exports, -Wdodgy-exports Summary of the changes: 1. Move the NamespaceSpecifier type from GHC.Hs.Binds to GHC.Hs.Basic, making it possible to use it in more places in the AST. 2. Extend the AST (type: IE) with a representation of `..`, `type ..`, and `data ..` (constructor: IEWholeNamespace). Per the proposal, the plain `..` is always rejected with a dedicated error message. 3. Extend the grammar in Parser.y with productions for `..`, `type ..`, and `data ..` in both import and export lists. 4. Implement wildcard imports by updating the `filterImports` function in GHC.Rename.Names; the logic for IEWholeNamespace is roughly modeled after the Nothing (no explicit import list) case. 5. Implement wildcard exports by updating the `exports_from_avail` function in GHC.Tc.Gen.Export; the logic for IEWholeNamespace is closely modeled after the IEModuleContents case. 6. Refactor and extend diagnostics to report the new warnings and errors. See PsErrPlainWildcardImport, DodgyImportsWildcard, PsErrPlainWildcardExport, DodgyExportsWildcard, TcRnDupeWildcardExport. Note that this patch is specifically about top-level import/export items. Subordinate import/export items are left unchanged. - - - - - 96 changed files: - .gitlab-ci.yml - compiler/GHC/Data/OsPath.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - docs/users_guide/9.16.1-notes.rst - docs/users_guide/exts/explicit_namespaces.rst - hadrian/src/Settings.hs - + testsuite/tests/module/T25901_exp_plain_wc.hs - + testsuite/tests/module/T25901_exp_plain_wc.stderr - + testsuite/tests/module/T25901_imp_plain_wc.hs - + testsuite/tests/module/T25901_imp_plain_wc.stderr - testsuite/tests/module/all.T - + testsuite/tests/rename/should_compile/T25901_exp_1.hs - + testsuite/tests/rename/should_compile/T25901_exp_1_helper.hs - + testsuite/tests/rename/should_compile/T25901_exp_2.hs - + testsuite/tests/rename/should_compile/T25901_exp_2_helper.hs - + testsuite/tests/rename/should_compile/T25901_imp_hq.hs - + testsuite/tests/rename/should_compile/T25901_imp_hu.hs - + testsuite/tests/rename/should_compile/T25901_imp_sq.hs - + testsuite/tests/rename/should_compile/T25901_imp_su.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T25901_exp_fail_1.hs - + testsuite/tests/rename/should_fail/T25901_exp_fail_1.stderr - + testsuite/tests/rename/should_fail/T25901_exp_fail_1_helper.hs - + testsuite/tests/rename/should_fail/T25901_exp_fail_2.hs - + testsuite/tests/rename/should_fail/T25901_exp_fail_2.stderr - + testsuite/tests/rename/should_fail/T25901_exp_fail_2_helper.hs - + testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.hs - + testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.stderr - + testsuite/tests/rename/should_fail/T25901_imp_hq_fail_6.hs - + testsuite/tests/rename/should_fail/T25901_imp_hq_fail_6.stderr - + testsuite/tests/rename/should_fail/T25901_imp_hu_fail_4.hs - + testsuite/tests/rename/should_fail/T25901_imp_hu_fail_4.stderr - + testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.hs - + testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.stderr - + testsuite/tests/rename/should_fail/T25901_imp_sq_fail_3.hs - + testsuite/tests/rename/should_fail/T25901_imp_sq_fail_3.stderr - + testsuite/tests/rename/should_fail/T25901_imp_su_fail_1.hs - + testsuite/tests/rename/should_fail/T25901_imp_su_fail_1.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/warnings/should_compile/T25901_exp_dodgy.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dodgy.stderr - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_1.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_1.stderr - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_2.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_2.stderr - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_3.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_3.stderr - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_4.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_4.stderr - + testsuite/tests/warnings/should_compile/T25901_helper_1.hs - + testsuite/tests/warnings/should_compile/T25901_helper_2.hs - + testsuite/tests/warnings/should_compile/T25901_helper_3.hs - + testsuite/tests/warnings/should_compile/T25901_imp_dodgy_1.hs - + testsuite/tests/warnings/should_compile/T25901_imp_dodgy_1.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_dodgy_2.hs - + testsuite/tests/warnings/should_compile/T25901_imp_dodgy_2.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_unused_1.hs - + testsuite/tests/warnings/should_compile/T25901_imp_unused_1.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_unused_2.hs - + testsuite/tests/warnings/should_compile/T25901_imp_unused_2.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_unused_3.hs - + testsuite/tests/warnings/should_compile/T25901_imp_unused_3.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_unused_4.hs - + testsuite/tests/warnings/should_compile/T25901_imp_unused_4.stderr - testsuite/tests/warnings/should_compile/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87667775cd558317aaa584e1602254… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87667775cd558317aaa584e1602254… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Use OsPath in PkgDbRef and UnitDatabase, not FilePath
by Marge Bot (＠marge-bot) 29 Nov '25

29 Nov '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fa3bd0a6 by Georgios Karachalias at 2025-11-29T18:36:05-05:00 Use OsPath in PkgDbRef and UnitDatabase, not FilePath - - - - - 8 changed files: - compiler/GHC/Data/OsPath.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== compiler/GHC/Data/OsPath.hs ===================================== @@ -11,6 +11,15 @@ module GHC.Data.OsPath -- * Common utility functions , (</>) , (<.>) + , splitSearchPath + , isRelative + , dropTrailingPathSeparator + , takeDirectory + , isSuffixOf + , doesDirectoryExist + , doesFileExist + , getDirectoryContents + , createDirectoryIfMissing ) where @@ -20,6 +29,8 @@ import GHC.Utils.Misc (HasCallStack) import GHC.Utils.Panic (panic) import System.OsPath +import System.OsString (isSuffixOf) +import System.Directory.OsPath (doesDirectoryExist, doesFileExist, getDirectoryContents, createDirectoryIfMissing) import System.Directory.Internal (os) -- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed. ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -441,7 +441,7 @@ addUnit u = do Nothing -> panic "addUnit: called too early" Just dbs -> let newdb = UnitDatabase - { unitDatabasePath = "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" + { unitDatabasePath = unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" , unitDatabaseUnits = [u] } in return (dbs ++ [newdb]) -- added at the end because ordering matters ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache) import GHC.Driver.Ppr import GHC.Driver.Backend -import GHC.Data.OsPath +import GHC.Data.OsPath qualified as OsPath import qualified GHC.Data.ShortText as ST import GHC.Data.Stream ( liftIO ) import qualified GHC.Data.Stream as Stream @@ -61,8 +61,6 @@ import GHC.Types.ForeignStubs import GHC.Types.Unique.DSM import GHC.Types.Unique.Supply ( UniqueTag(..) ) -import System.Directory -import System.FilePath import System.IO import Data.Set (Set) import qualified Data.Set as Set @@ -321,10 +319,9 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs stub_h_file_exists <- case mkStubPaths (initFinderOpts dflags) (moduleName mod) location of Nothing -> pure False - Just path -> do - let stub_h = unsafeDecodeUtf path - createDirectoryIfMissing True (takeDirectory stub_h) - outputForeignStubs_help stub_h stub_h_output_w + Just stub_h -> do + OsPath.createDirectoryIfMissing True (OsPath.takeDirectory stub_h) + outputForeignStubs_help (OsPath.unsafeDecodeUtf stub_h) stub_h_output_w ("#include <HsFFI.h>\n" ++ cplusplus_hdr) cplusplus_ftr putDumpFileMaybe logger Opt_D_dump_foreign ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -101,6 +101,7 @@ import GHC.Core.Unfold import GHC.Data.Bool import GHC.Data.EnumSet (EnumSet) import GHC.Data.Maybe +import GHC.Data.OsPath ( OsPath ) import GHC.Builtin.Names ( mAIN_NAME ) import GHC.Driver.Backend import GHC.Driver.Flags @@ -953,7 +954,7 @@ setDynamicNow dflags0 = data PkgDbRef = GlobalPkgDb | UserPkgDb - | PkgDbPath FilePath + | PkgDbPath OsPath deriving Eq ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -300,6 +300,8 @@ import qualified Data.Set as Set import GHC.Types.Unique.Set import Data.Word import System.FilePath +import qualified GHC.Data.OsPath as OsPath + import Text.ParserCombinators.ReadP hiding (char) import Text.ParserCombinators.ReadP as R @@ -2071,7 +2073,7 @@ package_flags_deps :: [(Deprecation, Flag (CmdLineP DynFlags))] package_flags_deps = [ ------- Packages ---------------------------------------------------- make_ord_flag defFlag "package-db" - (HasArg (addPkgDbRef . PkgDbPath)) + (HasArg (addPkgDbRef . PkgDbPath . OsPath.unsafeEncodeUtf)) , make_ord_flag defFlag "clear-package-db" (NoArg clearPkgDb) , make_ord_flag defFlag "no-global-package-db" (NoArg removeGlobalPkgDb) , make_ord_flag defFlag "no-user-package-db" (NoArg removeUserPkgDb) @@ -2081,7 +2083,7 @@ package_flags_deps = [ (NoArg (addPkgDbRef UserPkgDb)) -- backwards compat with GHC<=7.4 : , make_dep_flag defFlag "package-conf" - (HasArg $ addPkgDbRef . PkgDbPath) "Use -package-db instead" + (HasArg $ addPkgDbRef . PkgDbPath . OsPath.unsafeEncodeUtf) "Use -package-db instead" , make_dep_flag defFlag "no-user-package-conf" (NoArg removeUserPkgDb) "Use -no-user-package-db instead" , make_ord_flag defGhcFlag "package-name" (HasArg $ \name -> @@ -3307,7 +3309,7 @@ parseEnvFile :: FilePath -> String -> DynP () parseEnvFile envfile = mapM_ parseEntry . lines where parseEntry str = case words str of - ("package-db": _) -> addPkgDbRef (PkgDbPath (envdir </> db)) + ("package-db": _) -> addPkgDbRef (PkgDbPath (OsPath.unsafeEncodeUtf (envdir </> db))) -- relative package dbs are interpreted relative to the env file where envdir = takeDirectory envfile db = drop 11 str ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -63,7 +63,6 @@ import GHC.Types.SourceFile import GHC.Fingerprint import Data.IORef -import System.Directory.OsPath import Control.Applicative ((<|>)) import Control.Monad import Data.Time ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -101,6 +101,8 @@ import GHC.Data.Maybe import System.Environment ( getEnv ) import GHC.Data.FastString +import GHC.Data.OsPath ( OsPath ) +import qualified GHC.Data.OsPath as OsPath import qualified GHC.Data.ShortText as ST import GHC.Utils.Logger import GHC.Utils.Error @@ -111,7 +113,7 @@ import System.FilePath as FilePath import Control.Monad import Data.Graph (stronglyConnComp, SCC(..)) import Data.Char ( toUpper ) -import Data.List ( intersperse, partition, sortBy, isSuffixOf, sortOn ) +import Data.List ( intersperse, partition, sortBy, sortOn ) import Data.Set (Set) import Data.Monoid (First(..)) import qualified Data.Semigroup as Semigroup @@ -407,7 +409,7 @@ initUnitConfig dflags cached_dbs home_units = where offsetPackageDb :: Maybe FilePath -> PackageDBFlag -> PackageDBFlag - offsetPackageDb (Just offset) (PackageDB (PkgDbPath p)) | isRelative p = PackageDB (PkgDbPath (offset </> p)) + offsetPackageDb (Just offset) (PackageDB (PkgDbPath p)) | OsPath.isRelative p = PackageDB (PkgDbPath (OsPath.unsafeEncodeUtf offset OsPath.</> p)) offsetPackageDb _ p = p @@ -502,12 +504,12 @@ emptyUnitState = UnitState { -- | Unit database data UnitDatabase unit = UnitDatabase - { unitDatabasePath :: FilePath + { unitDatabasePath :: OsPath , unitDatabaseUnits :: [GenUnitInfo unit] } instance Outputable u => Outputable (UnitDatabase u) where - ppr (UnitDatabase fp _u) = text "DB:" <+> text fp + ppr (UnitDatabase fp _u) = text "DB:" <+> ppr fp type UnitInfoMap = UniqMap UnitId UnitInfo @@ -722,9 +724,9 @@ getUnitDbRefs cfg = do Left _ -> system_conf_refs Right path | Just (xs, x) <- snocView path, isSearchPathSeparator x - -> map PkgDbPath (splitSearchPath xs) ++ system_conf_refs + -> map PkgDbPath (OsPath.splitSearchPath (OsPath.unsafeEncodeUtf xs)) ++ system_conf_refs | otherwise - -> map PkgDbPath (splitSearchPath path) + -> map PkgDbPath (OsPath.splitSearchPath (OsPath.unsafeEncodeUtf path)) -- Apply the package DB-related flags from the command line to get the -- final list of package DBs. @@ -753,24 +755,24 @@ getUnitDbRefs cfg = do -- NB: This logic is reimplemented in Cabal, so if you change it, -- make sure you update Cabal. (Or, better yet, dump it in the -- compiler info so Cabal can use the info.) -resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe FilePath) -resolveUnitDatabase cfg GlobalPkgDb = return $ Just (unitConfigGlobalDB cfg) +resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe OsPath) +resolveUnitDatabase cfg GlobalPkgDb = return $ Just $ OsPath.unsafeEncodeUtf $ unitConfigGlobalDB cfg resolveUnitDatabase cfg UserPkgDb = runMaybeT $ do dir <- versionedAppDir (unitConfigProgramName cfg) (unitConfigPlatformArchOS cfg) let pkgconf = dir </> unitConfigDBName cfg exist <- tryMaybeT $ doesDirectoryExist pkgconf - if exist then return pkgconf else mzero + if exist then return (OsPath.unsafeEncodeUtf pkgconf) else mzero resolveUnitDatabase _ (PkgDbPath name) = return $ Just name -readUnitDatabase :: Logger -> UnitConfig -> FilePath -> IO (UnitDatabase UnitId) +readUnitDatabase :: Logger -> UnitConfig -> OsPath -> IO (UnitDatabase UnitId) readUnitDatabase logger cfg conf_file = do - isdir <- doesDirectoryExist conf_file + isdir <- OsPath.doesDirectoryExist conf_file proto_pkg_configs <- if isdir then readDirStyleUnitInfo conf_file else do - isfile <- doesFileExist conf_file + isfile <- OsPath.doesFileExist conf_file if isfile then do mpkgs <- tryReadOldFileStyleUnitInfo @@ -778,48 +780,49 @@ readUnitDatabase logger cfg conf_file = do Just pkgs -> return pkgs Nothing -> throwGhcExceptionIO $ InstallationError $ "ghc no longer supports single-file style package " ++ - "databases (" ++ conf_file ++ + "databases (" ++ show conf_file ++ ") use 'ghc-pkg init' to create the database with " ++ "the correct format." else throwGhcExceptionIO $ InstallationError $ - "can't find a package database at " ++ conf_file + "can't find a package database at " ++ show conf_file let -- Fix #16360: remove trailing slash from conf_file before calculating pkgroot - conf_file' = dropTrailingPathSeparator conf_file - top_dir = unitConfigGHCDir cfg - pkgroot = takeDirectory conf_file' + conf_file' = OsPath.dropTrailingPathSeparator conf_file + top_dir = OsPath.unsafeEncodeUtf (unitConfigGHCDir cfg) + pkgroot = OsPath.takeDirectory conf_file' pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . mapUnitInfo (\(UnitKey x) -> UnitId x) . mkUnitKeyInfo) proto_pkg_configs -- return $ UnitDatabase conf_file' pkg_configs1 where + readDirStyleUnitInfo :: OsPath -> IO [DbUnitInfo] readDirStyleUnitInfo conf_dir = do - let filename = conf_dir </> "package.cache" - cache_exists <- doesFileExist filename + let filename = conf_dir OsPath.</> (OsPath.unsafeEncodeUtf "package.cache") + cache_exists <- OsPath.doesFileExist filename if cache_exists then do - debugTraceMsg logger 2 $ text "Using binary package database:" <+> text filename - readPackageDbForGhc filename + debugTraceMsg logger 2 $ text "Using binary package database:" <+> ppr filename + readPackageDbForGhc (OsPath.unsafeDecodeUtf filename) else do -- If there is no package.cache file, we check if the database is not -- empty by inspecting if the directory contains any .conf file. If it -- does, something is wrong and we fail. Otherwise we assume that the -- database is empty. debugTraceMsg logger 2 $ text "There is no package.cache in" - <+> text conf_dir + <+> ppr conf_dir <> text ", checking if the database is empty" - db_empty <- all (not . isSuffixOf ".conf") - <$> getDirectoryContents conf_dir + db_empty <- all (not . OsPath.isSuffixOf (OsPath.unsafeEncodeUtf ".conf")) + <$> OsPath.getDirectoryContents conf_dir if db_empty then do debugTraceMsg logger 3 $ text "There are no .conf files in" - <+> text conf_dir <> text ", treating" + <+> ppr conf_dir <> text ", treating" <+> text "package database as empty" return [] else throwGhcExceptionIO $ InstallationError $ - "there is no package.cache in " ++ conf_dir ++ + "there is no package.cache in " ++ show conf_dir ++ " even though package database is not empty" @@ -832,13 +835,13 @@ readUnitDatabase logger cfg conf_file = do -- assumes it's a file and tries to overwrite with 'writeFile'. -- ghc-pkg also cooperates with this workaround. tryReadOldFileStyleUnitInfo = do - content <- readFile conf_file `catchIO` \_ -> return "" + content <- readFile (OsPath.unsafeDecodeUtf conf_file) `catchIO` \_ -> return "" if take 2 content == "[]" then do - let conf_dir = conf_file <.> "d" - direxists <- doesDirectoryExist conf_dir + let conf_dir = conf_file OsPath.<.> OsPath.unsafeEncodeUtf "d" + direxists <- OsPath.doesDirectoryExist conf_dir if direxists - then do debugTraceMsg logger 2 (text "Ignoring old file-style db and trying:" <+> text conf_dir) + then do debugTraceMsg logger 2 (text "Ignoring old file-style db and trying:" <+> ppr conf_dir) liftM Just (readDirStyleUnitInfo conf_dir) else return (Just []) -- ghc-pkg will create it when it's updated else return Nothing @@ -848,11 +851,11 @@ distrustAllUnits pkgs = map distrust pkgs where distrust pkg = pkg{ unitIsTrusted = False } -mungeUnitInfo :: FilePath -> FilePath +mungeUnitInfo :: OsPath -> OsPath -> UnitInfo -> UnitInfo mungeUnitInfo top_dir pkgroot = mungeDynLibFields - . mungeUnitInfoPaths (ST.pack top_dir) (ST.pack pkgroot) + . mungeUnitInfoPaths (ST.pack (OsPath.unsafeDecodeUtf top_dir)) (ST.pack (OsPath.unsafeDecodeUtf pkgroot)) mungeDynLibFields :: UnitInfo -> UnitInfo mungeDynLibFields pkg = @@ -1373,7 +1376,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] where merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ - text "loading package database" <+> text db_path + text "loading package database" <+> ppr db_path forM_ (Set.toList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -149,6 +149,7 @@ import Data.String import Data.Word import System.IO ( Handle ) import System.FilePath +import System.OsPath (OsPath, decodeUtf) import Text.Printf import Numeric (showFFloat) import Numeric.Natural (Natural) @@ -1101,6 +1102,8 @@ instance Outputable Extension where instance Outputable ModuleName where ppr = pprModuleName +instance Outputable OsPath where + ppr p = text $ either show id (decodeUtf p) pprModuleName :: IsLine doc => ModuleName -> doc pprModuleName (ModuleName nm) = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa3bd0a67eea13701d1b50053636f96… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa3bd0a67eea13701d1b50053636f96… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Use 'OsPath' in getModificationTimeIfExists
by Marge Bot (＠marge-bot) 29 Nov '25

29 Nov '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ef0dc33b by Matthew Pickering at 2025-11-29T18:35:10-05:00 Use 'OsPath' in getModificationTimeIfExists This part of the compiler is quite hot during recompilation checking in particular since the filepaths will be translated to a string. It is better to use the 'OsPath' native function, which turns out to be easy to do. - - - - - 7 changed files: - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Utils/Misc.hs Changes: ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -789,8 +789,8 @@ summariseRequirement pn mod_name = do env <- getBkpEnv src_hash <- liftIO $ getFileHash (bkp_filename env) - hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location) - hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location) + hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file_ospath location) + hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file_ospath location) let loc = srcLocSpan (mkSrcLoc (mkFastString (bkp_filename env)) 1 1) let fc = hsc_FC hsc_env @@ -875,8 +875,8 @@ hsModuleToModSummary home_keys pn hsc_src modname HsSrcFile -> os "hs") hsc_src -- This duplicates a pile of logic in GHC.Driver.Make - hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location) - hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location) + hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file_ospath location) + hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file_ospath location) -- Also copied from 'getImports' let (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -1265,7 +1265,7 @@ checkSummaryHash | ms_hs_hash old_summary == src_hash && not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do -- update the object-file timestamp - obj_timestamp <- modificationTimeIfExists (ml_obj_file location) + obj_timestamp <- modificationTimeIfExists (ml_obj_file_ospath location) -- We have to repopulate the Finder's cache for file targets -- because the file might not even be on the regular search path @@ -1277,8 +1277,8 @@ checkSummaryHash hsc_src = ms_hsc_src old_summary addModuleToFinder fc mod location hsc_src - hi_timestamp <- modificationTimeIfExists (ml_hi_file location) - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) + hi_timestamp <- modificationTimeIfExists (ml_hi_file_ospath location) + hie_timestamp <- modificationTimeIfExists (ml_hie_file_ospath location) return $ Right ( old_summary @@ -1482,11 +1482,11 @@ data MakeNewModSummary makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary makeNewModSummary hsc_env MakeNewModSummary{..} = do let PreprocessedImports{..} = nms_preimps - obj_timestamp <- modificationTimeIfExists (ml_obj_file nms_location) - dyn_obj_timestamp <- modificationTimeIfExists (ml_dyn_obj_file nms_location) - hi_timestamp <- modificationTimeIfExists (ml_hi_file nms_location) - hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location) - bytecode_timestamp <- modificationTimeIfExists (ml_bytecode_file nms_location) + obj_timestamp <- modificationTimeIfExists (ml_obj_file_ospath nms_location) + dyn_obj_timestamp <- modificationTimeIfExists (ml_dyn_obj_file_ospath nms_location) + hi_timestamp <- modificationTimeIfExists (ml_hi_file_ospath nms_location) + hie_timestamp <- modificationTimeIfExists (ml_hie_file_ospath nms_location) + bytecode_timestamp <- modificationTimeIfExists (ml_bytecode_file_ospath nms_location) extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name (implicit_sigs, _inst_deps) <- implicitRequirementsShallow (hscSetActiveUnitId (moduleUnitId nms_mod) hsc_env) pi_theimps ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1091,7 +1091,7 @@ loadIfaceByteCode hsc_env iface location type_env = linkable $ pure $ DotGBC bco linkable parts = do - if_time <- modificationTimeIfExists (ml_hi_file location) + if_time <- modificationTimeIfExists (ml_hi_file_ospath location) time <- maybe getCurrentTime pure if_time return $! Linkable time (mi_module iface) parts @@ -1112,7 +1112,7 @@ loadIfaceByteCodeLazy hsc_env iface location type_env = linkable $ NE.singleton (DotGBC bco) linkable parts = do - if_time <- modificationTimeIfExists (ml_hi_file location) + if_time <- modificationTimeIfExists (ml_hi_file_ospath location) time <- maybe getCurrentTime pure if_time return $!Linkable time (mi_module iface) parts @@ -2240,7 +2240,7 @@ generateAndWriteByteCodeLinkable hsc_env cgguts mod_location = do -- Either, get the same time as the .gbc file if it exists, or just the current time. -- It's important the time of the linkable matches the time of the .gbc file for recompilation -- checking. - bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file mod_location) + bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file_ospath mod_location) return $ mkModuleByteCodeLinkable bco_time bco_object mkModuleByteCode :: HscEnv -> Module -> ModLocation -> CgInteractiveGuts -> IO ModuleByteCode ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -730,17 +730,17 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do -- the object file for one module.) -- Note the nasty duplication with the same computation in compileFile above location <- mkOneShotModLocation pipe_env dflags src_flavour mod_name - let o_file = ml_obj_file location -- The real object file - hi_file = ml_hi_file location - hie_file = ml_hie_file location - dyn_o_file = ml_dyn_obj_file location + let o_file = ml_obj_file_ospath location -- The real object file + hi_file = ml_hi_file_ospath location + hie_file = ml_hie_file_ospath location + dyn_o_file = ml_dyn_obj_file_ospath location src_hash <- getFileHash (basename <.> suff) hi_date <- modificationTimeIfExists hi_file hie_date <- modificationTimeIfExists hie_file o_mod <- modificationTimeIfExists o_file dyn_o_mod <- modificationTimeIfExists dyn_o_file - bytecode_date <- modificationTimeIfExists (ml_bytecode_file location) + bytecode_date <- modificationTimeIfExists (ml_bytecode_file_ospath location) -- Tell the finder cache about this module mod <- do ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -658,8 +658,9 @@ findWholeCoreBindings hsc_env mod = do findBytecodeLinkableMaybe :: HscEnv -> Module -> ModLocation -> IO (Maybe Linkable) findBytecodeLinkableMaybe hsc_env mod locn = do - let bytecode_fn = ml_bytecode_file locn - maybe_bytecode_time <- modificationTimeIfExists bytecode_fn + let bytecode_fn = ml_bytecode_file locn + bytecode_fn_os = ml_bytecode_file_ospath locn + maybe_bytecode_time <- modificationTimeIfExists bytecode_fn_os case maybe_bytecode_time of Nothing -> return Nothing Just bytecode_time -> do ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -826,7 +826,7 @@ mkStubPaths fopts mod location = do findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable) findObjectLinkableMaybe mod locn = do let obj_fn = ml_obj_file locn - maybe_obj_time <- modificationTimeIfExists obj_fn + maybe_obj_time <- modificationTimeIfExists (ml_obj_file_ospath locn) case maybe_obj_time of Nothing -> return Nothing Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time) ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -137,6 +137,8 @@ import Control.Monad ( guard ) import Control.Monad.IO.Class ( MonadIO, liftIO ) import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, getModificationTime, renameFile ) +import qualified System.Directory.OsPath as OsPath +import System.OsPath (OsPath) import System.FilePath import Data.Bifunctor ( first, second ) @@ -1248,9 +1250,9 @@ getModificationUTCTime = getModificationTime -- -------------------------------------------------------------- -- check existence & modification time at the same time -modificationTimeIfExists :: FilePath -> IO (Maybe UTCTime) +modificationTimeIfExists :: OsPath -> IO (Maybe UTCTime) modificationTimeIfExists f = - (do t <- getModificationUTCTime f; return (Just t)) + (do t <- OsPath.getModificationTime f; return (Just t)) `catchIO` \e -> if isDoesNotExistError e then return Nothing else ioError e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef0dc33b2034fd91e11950751264e8b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef0dc33b2034fd91e11950751264e8b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] gitlab-ci: Run ghcup-metadata jobs on OpenCape runners
by Marge Bot (＠marge-bot) 29 Nov '25

29 Nov '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ff3f0d09 by Ben Gamari at 2025-11-29T18:34:28-05:00 gitlab-ci: Run ghcup-metadata jobs on OpenCape runners This significantly reduces our egress traffic and makes the jobs significantly faster. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1184,6 +1184,10 @@ project-version: image: nixos/nix:2.25.2 dependencies: null tags: + # N.B. we use the OpenCape runners here since this job involves a significant + # amount of artifact fetching. This is much more efficient on these runners + # as they are near the GitLab box. + - opencape - x86_64-linux variables: BUILD_FLAVOUR: default View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff3f0d09bce1c261638b572af2bac1d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff3f0d09bce1c261638b572af2bac1d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26615] Add better case merging
by Simon Peyton Jones (＠simonpj) 29 Nov '25

29 Nov '25

Simon Peyton Jones pushed to branch wip/T26615 at Glasgow Haskell Compiler / GHC Commits: 0e70ef52 by Simon Peyton Jones at 2025-11-29T23:21:57+00:00 Add better case merging - - - - - 6 changed files: - compiler/GHC/Core/Opt/OccurAnal.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/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -28,7 +28,7 @@ core expression with (hopefully) improved usage information. module GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr, - zapLambdaBndrs, BinderSwapDecision(..), scrutOkForBinderSwap + zapLambdaBndrs ) where import GHC.Prelude hiding ( head, init, last, tail ) @@ -36,7 +36,7 @@ import GHC.Prelude hiding ( head, init, last, tail ) import GHC.Core import GHC.Core.FVs import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, - mkCastMCo, mkTicks ) + mkCastMCo, mkTicks, BinderSwapDecision(..), scrutOkForBinderSwap ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion import GHC.Core.Type @@ -3446,6 +3446,7 @@ doesn't use it. So this is only to satisfy the perhaps-over-picky Lint. -} addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv +-- See Note [Binder swap] -- See Note [The binder-swap substitution] addBndrSwap scrut case_bndr env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) @@ -3463,27 +3464,6 @@ addBndrSwap scrut case_bndr case_bndr' = zapIdOccInfo case_bndr -- See Note [Zap case binders in proxy bindings] --- | See bBinderSwaOk. -data BinderSwapDecision - = NoBinderSwap - | DoBinderSwap OutVar MCoercion - -scrutOkForBinderSwap :: OutExpr -> BinderSwapDecision --- If (scrutOkForBinderSwap e = DoBinderSwap v mco, then --- v = e |> mco --- See Note [Case of cast] --- See Historical Note [Care with binder-swap on dictionaries] --- --- We use this same function in SpecConstr, and Simplify.Iteration, --- when something binder-swap-like is happening -scrutOkForBinderSwap e - = case e of - Tick _ e -> scrutOkForBinderSwap e -- Drop ticks - Var v -> DoBinderSwap v MRefl - Cast (Var v) co -> DoBinderSwap v (MCo (mkSymCo co)) - -- Cast: see Note [Case of cast] - _ -> NoBinderSwap - lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) -- See Note [The binder-swap substitution] -- Returns an expression of the same type as Id ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Inline import GHC.Core.Opt.Simplify.Utils -import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBinderSwap, BinderSwapDecision (..) ) +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs ) import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2693,7 +2693,7 @@ mkCase, mkCase1, mkCase2, mkCase3 mkCase mode scrut outer_bndr alts_ty alts | sm_case_merge mode - , Just (joins, alts') <- mergeCaseAlts outer_bndr alts + , Just (joins, alts') <- mergeCaseAlts scrut outer_bndr alts = do { tick (CaseMerge outer_bndr) ; case_expr <- mkCase1 mode scrut outer_bndr alts_ty alts' ; return (mkLets joins case_expr) } ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -30,7 +30,6 @@ import GHC.Core.Opt.Simplify.Inline import GHC.Core.FVs ( exprsFreeVarsList, exprFreeVars ) import GHC.Core.Opt.Monad import GHC.Core.Opt.WorkWrap.Utils -import GHC.Core.Opt.OccurAnal( BinderSwapDecision(..), scrutOkForBinderSwap ) import GHC.Core.DataCon import GHC.Core.Class( classTyVars ) import GHC.Core.Coercion hiding( substCo ) @@ -2026,9 +2025,9 @@ spec_one env fn arg_bndrs body (call_pat, rule_number) -- , text "spec_call_args" <+> ppr spec_call_args -- , text "rule_rhs" <+> ppr rule_rhs -- , text "adds_void_worker_arg" <+> ppr add_void_arg ----- , text "body" <+> ppr body ----- , text "spec_rhs" <+> ppr spec_rhs ----- , text "how_bound" <+> ppr (sc_how_bound env) ] +-- , text "body" <+> ppr body +-- , text "spec_rhs" <+> ppr spec_rhs +-- , text "how_bound" <+> ppr (sc_how_bound env) ] -- ] ; return (spec_usg, OS { os_pat = call_pat, os_rule = rule , os_id = spec_id ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1798,8 +1798,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , text "rule_act" <+> ppr rule_act ] - ; pprTrace "spec_call: rule" _rule_trace_doc - return ( spec_rule : rules_acc + ; return ( spec_rule : rules_acc , (spec_fn, spec_rhs1) : pairs_acc , rhs_uds2 `thenUDs` uds_acc ) } } ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Core.Utils ( mergeAlts, mergeCaseAlts, trimConArgs, filterAlts, combineIdenticalAlts, refineDefaultAlt, scaleAltsBy, + BinderSwapDecision(..), scrutOkForBinderSwap, -- * Properties of expressions exprType, coreAltType, coreAltsType, @@ -117,7 +118,6 @@ import Data.Function ( on ) import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL ) import qualified Data.List as Partial ( init, last ) import Data.Ord ( comparing ) -import Control.Monad ( guard ) import qualified Data.Set as Set {- @@ -591,6 +591,28 @@ The default alternative must be first, if it exists at all. This makes it easy to find, though it makes matching marginally harder. -} +data BinderSwapDecision + = NoBinderSwap + | DoBinderSwap OutVar MCoercion + +scrutOkForBinderSwap :: OutExpr -> BinderSwapDecision +-- If (scrutOkForBinderSwap e = DoBinderSwap v mco, then +-- v = e |> mco +-- See Note [Case of cast] +-- See Historical Note [Care with binder-swap on dictionaries] +-- +-- We use this same function in SpecConstr, and Simplify.Iteration, +-- when something binder-swap-like is happening +-- +-- See Note [Binder swap] in GHC.Core.Opt.OccurAnal +scrutOkForBinderSwap e + = case e of + Tick _ e -> scrutOkForBinderSwap e -- Drop ticks + Var v -> DoBinderSwap v MRefl + Cast (Var v) co -> DoBinderSwap v (MCo (mkSymCo co)) + -- Cast: see Note [Case of cast] + _ -> NoBinderSwap + -- | Extract the default case alternative findDefault :: [Alt b] -> ([Alt b], Maybe (Expr b)) findDefault (Alt DEFAULT args rhs : alts) = assert (null args) (alts, Just rhs) @@ -652,9 +674,9 @@ filters down the matching alternatives in GHC.Core.Opt.Simplify.rebuildCase. -} --------------------------------- -mergeCaseAlts :: Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt]) +mergeCaseAlts :: CoreExpr -> Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt]) -- See Note [Merge Nested Cases] -mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts) +mergeCaseAlts scrut outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts) | Just (joins, inner_alts) <- go deflt_rhs = Just (joins, mergeAlts outer_alts inner_alts) -- NB: mergeAlts gives priority to the left @@ -666,6 +688,9 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts) -- When we merge, we must ensure that e1 takes -- precedence over e2 as the value for A! where + bndr_swap :: BinderSwapDecision + bndr_swap = scrutOkForBinderSwap scrut + go :: CoreExpr -> Maybe ([CoreBind], [CoreAlt]) -- Whizzo: we can merge! @@ -704,16 +729,9 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts) -- Check for capture; but only if we could otherwise do a merge -- (i.e. the recursive `go` succeeds) - -- "Capture" means - -- (a) case x of r { DEFAULT -> join r = ... in ...r... } - -- (b) case x of r { DEFAULT -> join j = ...r.. in ... } - -- In both cases we can't float the join point out - -- because r changes its meaning - ; let capture = outer_bndr `elem` bindersOf bind -- (a) - || outer_bndr `elemVarSet` bindFreeVars bind -- (b) - ; guard (not capture) - - ; return (bind:joins, alts ) } + ; fix_up_binds <- okToFloatJoin bndr_swap outer_bndr bind + + ; return (fix_up_binds ++ (bind : joins), alts ) } | otherwise = Nothing @@ -725,7 +743,25 @@ mergeCaseAlts outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts) go _ = Nothing -mergeCaseAlts _ _ = Nothing +mergeCaseAlts _ _ _ = Nothing + +okToFloatJoin :: BinderSwapDecision -> Id -> CoreBind -> Maybe [CoreBind] +-- Check a join-point binding to see if it can be floated out of +-- the DEFAULT branch of a `case`. A Just result means "yes", +-- and the [CoreBInd] are the extra fix-up bindings to add. +-- See Note [Floating join points out of DEFAULT alternatives] +okToFloatJoin bndr_swap outer_bndr bind + | outer_bndr `elem` bindersOf bind -- (a) + = Nothing + | outer_bndr `elemVarSet` bindFreeVars bind -- (b) + = case bndr_swap of + DoBinderSwap scrut_var mco + | scrut_var /= outer_bndr + -> Just [ NonRec outer_bndr (mkCastMCo (Var scrut_var) mco) ] + _ -> Nothing + | otherwise + = Just [] + --------------------------------- mergeAlts :: [Alt a] -> [Alt a] -> [Alt a] @@ -934,10 +970,43 @@ Wrinkles non-join-points unless the /outer/ case has just one alternative; doing so would risk more allocation + Floating out join points isn't entirely straightforward. + See Note [Floating join points out of DEFAULT alternatives] + (MC5) See Note [Cascading case merge] See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils +Note [Floating join points out of DEFAULT alternatives] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this, from (MC4) of Note [Merge Nested Cases] + case x of r + DEFAULT -> join j = rhs in case r of ... + alts + +We want to float that join point out to give this + join j = rhs + case x of r + DEFAULT -> case r of ... + alts + +But doing so is flat-out wrong if the scoping gets messed up: + (a) case x of r { DEFAULT -> join r = ... in ...r... } + (b) case x of r { DEFAULT -> join j = ...r.. in ... } +In both cases we can't float the join point out because r changes its meaning. + +BUT we can fix up case (b) by adding an extra binding, like this + let r = x in + join j = rhs[r] + case x of r + DEFAULT -> ...r... + ...other alts... + +This extra binding is figured out by `okToFloatJoin`. + +Note that the cases that still don't work (e.g. (a)) will probably work fine the +next iteration of the Simplifier, because they involve shadowing, and the Simplifier +generally eliminates shadowing. Note [Cascading case merge] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e70ef52af7368cc12525e4502904b3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e70ef52af7368cc12525e4502904b3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/clear-block-info] rts: Clear block_info when unblocking
by Cheng Shao (＠TerrorJack) 29 Nov '25

29 Nov '25

Cheng Shao pushed to branch wip/clear-block-info at Glasgow Haskell Compiler / GHC Commits: b4b1720d by Ben Gamari at 2025-11-29T23:35:57+01:00 rts: Clear block_info when unblocking Otherwise we may end up with dangling pointers which may complicate debugging. Also, introduce more strict checking of block_info in checkTSO. Co-authored-by: Cheng Shao <terrorjack(a)type.dance> - - - - - 9 changed files: - rts/RaiseAsync.c - rts/Schedule.c - rts/Threads.c - rts/include/rts/storage/TSO.h - rts/posix/Poll.c - rts/posix/Select.c - rts/posix/Timeout.c - rts/sm/Sanity.c - rts/win32/AsyncMIO.c Changes: ===================================== rts/RaiseAsync.c ===================================== @@ -716,12 +716,13 @@ removeFromQueues(Capability *cap, StgTSO *tso) syncDelayCancel(cap, tso); goto done; - default: + default: barf("removeFromQueues: %d", tso->why_blocked); } done: RELAXED_STORE(&tso->why_blocked, NotBlocked); + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap, tso); } @@ -1087,6 +1088,7 @@ done: // wake it up if (tso->why_blocked != NotBlocked) { tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); } ===================================== rts/Schedule.c ===================================== @@ -2589,7 +2589,8 @@ resumeThread (void *task_) traceEventRunThread(cap, tso); /* Reset blocking status */ - tso->why_blocked = NotBlocked; + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; if ((tso->flags & TSO_BLOCKEX) == 0) { // avoid locking the TSO if we don't have to ===================================== rts/Threads.c ===================================== @@ -338,6 +338,7 @@ unblock: // just run the thread now, if the BH is not really available, // we'll block again. tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; appendToRunQueue(cap,tso); // We used to set the context switch flag here, which would ===================================== rts/include/rts/storage/TSO.h ===================================== @@ -297,8 +297,8 @@ void setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target); void dirty_STACK (Capability *cap, StgStack *stack); /* ----------------------------------------------------------------------------- - Invariants: - + Note [TSO invariants] + ~~~~~~~~~~~~~~~~~~~~~ An active thread has the following properties: tso->stack < tso->sp < tso->stack+tso->stack_size @@ -313,7 +313,8 @@ void dirty_STACK (Capability *cap, StgStack *stack); tso->why_blocked tso->block_info location ---------------------------------------------------------------------- - NotBlocked END_TSO_QUEUE runnable_queue, or running + NotBlocked END_TSO_QUEUE running + NotBlocked prev TSO runnable_queue (block_info.prev back-link) BlockedOnBlackHole MessageBlackHole * TSO->bq ===================================== rts/posix/Poll.c ===================================== @@ -261,6 +261,7 @@ static void notifyIOCompletion(Capability *cap, StgAsyncIOOp *aiop) */ StgTSO *tso = aiop->notify.tso; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap, tso); } ===================================== rts/posix/Select.c ===================================== @@ -106,6 +106,7 @@ static bool wakeUpSleepingThreads (Capability *cap, LowResTime now) } iomgr->sleeping_queue = tso->_link; RELAXED_STORE(&tso->why_blocked, NotBlocked); + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %" FMT_StgThreadID "\n", tso->id)); @@ -437,6 +438,7 @@ awaitCompletedTimeoutsOrIOSelect(Capability *cap, bool wait) debugBelch("Waking up blocked thread %" FMT_StgThreadID "\n", tso->id)); tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap,tso); break; ===================================== rts/posix/Timeout.c ===================================== @@ -122,6 +122,7 @@ static void notifyTimeoutCompletion(Capability *cap, StgTimeout *timeout) { StgTSO *tso = timeout->notify.tso; tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; tso->_link = END_TSO_QUEUE; pushOnRunQueue(cap, tso); break; @@ -226,4 +227,3 @@ struct timespec *timeoutInNanoseconds(CapIOManager *iomgr, bool wait, #endif #endif // defined(IOMGR_ENABLED_POLL) - ===================================== rts/sm/Sanity.c ===================================== @@ -767,7 +767,6 @@ checkSTACK (StgStack *stack) * * See #19146. */ - void checkTSO(StgTSO *tso) { @@ -788,6 +787,14 @@ checkTSO(StgTSO *tso) ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->block_info.closure)); } + /* See Note [TSO invariants] in TSO.h */ + if (tso->why_blocked == NotBlocked) { + // When on a run queue we use block_info.prev as the back-link. + // Otherwise (running) we expect END_TSO_QUEUE. + ASSERT(tso->block_info.closure == (StgClosure *)END_TSO_QUEUE || + get_itbl(tso->block_info.closure)->type == TSO); + } + ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->bq)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->blocked_exceptions)); ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso->stackobj)); ===================================== rts/win32/AsyncMIO.c ===================================== @@ -319,14 +319,16 @@ start: : END_TSO_QUEUE; } - // 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; + + tso->why_blocked = NotBlocked; + tso->block_info.closure = (StgClosure *)END_TSO_QUEUE; + // Terminates the run queue + this inner for-loop. + tso->_link = END_TSO_QUEUE; pushOnRunQueue(&MainCapability, tso); break; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4b1720da1fb6e7792dc7779f3d02ad… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4b1720da1fb6e7792dc7779f3d02ad… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/int-index/imp-exp-whole-namespace] Namespace-specified wildcards in import/export lists (#25901)
by Vladislav Zavialov (＠int-index) 29 Nov '25

29 Nov '25

Vladislav Zavialov pushed to branch wip/int-index/imp-exp-whole-namespace at Glasgow Haskell Compiler / GHC Commits: 4eb4ff24 by Vladislav Zavialov at 2025-11-29T23:56:35+03:00 Namespace-specified wildcards in import/export lists (#25901) This change adds support for top-level namespace-specified wildcards `type ..` and `data ..` to import and export lists. Examples: import M (type ..) -- imports all type and class constructors from M import M (data ..) -- imports all data constructors and terms from M module M (type .., f) where -- exports all type and class constructors defined in M, -- plus the function 'f' The primary intended usage of this feature is in combination with module aliases, allowing namespace disambiguation: import Data.Proxy as T (type ..) -- T.Proxy is unambiguously the type constructor import Data.Proxy as D (data ..) -- D.Proxy is unambiguously the data constructor The patch accounts for the interactions of wildcards with: * Imports with `hiding` clauses * Import warnings -Wunused-imports, -Wdodgy-imports * Export warnings -Wduplicate-exports, -Wdodgy-exports Summary of the changes: 1. Move the NamespaceSpecifier type from GHC.Hs.Binds to GHC.Hs.Basic, making it possible to use it in more places in the AST. 2. Extend the AST (type: IE) with a representation of `..`, `type ..`, and `data ..` (constructor: IEWholeNamespace). Per the proposal, the plain `..` is always rejected with a dedicated error message. 3. Extend the grammar in Parser.y with productions for `..`, `type ..`, and `data ..` in both import and export lists. 4. Implement wildcard imports by updating the `filterImports` function in GHC.Rename.Names; the logic for IEWholeNamespace is roughly modeled after the Nothing (no explicit import list) case. 5. Implement wildcard exports by updating the `exports_from_avail` function in GHC.Tc.Gen.Export; the logic for IEWholeNamespace is closely modeled after the IEModuleContents case. 6. Refactor and extend diagnostics to report the new warnings and errors. See PsErrPlainWildcardImport, DodgyImportsWildcard, PsErrPlainWildcardExport, DodgyExportsWildcard, TcRnDupeWildcardExport. Note that this patch is specifically about top-level import/export items. Subordinate import/export items are left unchanged. - - - - - 81 changed files: - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Docs.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/PostProcess.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - docs/users_guide/9.16.1-notes.rst - docs/users_guide/exts/explicit_namespaces.rst - + testsuite/tests/module/T25901_exp_plain_wc.hs - + testsuite/tests/module/T25901_exp_plain_wc.stderr - + testsuite/tests/module/T25901_imp_plain_wc.hs - + testsuite/tests/module/T25901_imp_plain_wc.stderr - testsuite/tests/module/all.T - + testsuite/tests/rename/should_compile/T25901_exp_1.hs - + testsuite/tests/rename/should_compile/T25901_exp_1_helper.hs - + testsuite/tests/rename/should_compile/T25901_exp_2.hs - + testsuite/tests/rename/should_compile/T25901_exp_2_helper.hs - + testsuite/tests/rename/should_compile/T25901_imp_hq.hs - + testsuite/tests/rename/should_compile/T25901_imp_hu.hs - + testsuite/tests/rename/should_compile/T25901_imp_sq.hs - + testsuite/tests/rename/should_compile/T25901_imp_su.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T25901_exp_fail_1.hs - + testsuite/tests/rename/should_fail/T25901_exp_fail_1.stderr - + testsuite/tests/rename/should_fail/T25901_exp_fail_1_helper.hs - + testsuite/tests/rename/should_fail/T25901_exp_fail_2.hs - + testsuite/tests/rename/should_fail/T25901_exp_fail_2.stderr - + testsuite/tests/rename/should_fail/T25901_exp_fail_2_helper.hs - + testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.hs - + testsuite/tests/rename/should_fail/T25901_imp_hq_fail_5.stderr - + testsuite/tests/rename/should_fail/T25901_imp_hq_fail_6.hs - + testsuite/tests/rename/should_fail/T25901_imp_hq_fail_6.stderr - + testsuite/tests/rename/should_fail/T25901_imp_hu_fail_4.hs - + testsuite/tests/rename/should_fail/T25901_imp_hu_fail_4.stderr - + testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.hs - + testsuite/tests/rename/should_fail/T25901_imp_sq_fail_2.stderr - + testsuite/tests/rename/should_fail/T25901_imp_sq_fail_3.hs - + testsuite/tests/rename/should_fail/T25901_imp_sq_fail_3.stderr - + testsuite/tests/rename/should_fail/T25901_imp_su_fail_1.hs - + testsuite/tests/rename/should_fail/T25901_imp_su_fail_1.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/warnings/should_compile/T25901_exp_dodgy.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dodgy.stderr - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_1.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_1.stderr - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_2.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_2.stderr - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_3.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_3.stderr - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_4.hs - + testsuite/tests/warnings/should_compile/T25901_exp_dup_wc_4.stderr - + testsuite/tests/warnings/should_compile/T25901_helper_1.hs - + testsuite/tests/warnings/should_compile/T25901_helper_2.hs - + testsuite/tests/warnings/should_compile/T25901_helper_3.hs - + testsuite/tests/warnings/should_compile/T25901_imp_dodgy_1.hs - + testsuite/tests/warnings/should_compile/T25901_imp_dodgy_1.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_dodgy_2.hs - + testsuite/tests/warnings/should_compile/T25901_imp_dodgy_2.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_unused_1.hs - + testsuite/tests/warnings/should_compile/T25901_imp_unused_1.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_unused_2.hs - + testsuite/tests/warnings/should_compile/T25901_imp_unused_2.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_unused_3.hs - + testsuite/tests/warnings/should_compile/T25901_imp_unused_3.stderr - + testsuite/tests/warnings/should_compile/T25901_imp_unused_4.hs - + testsuite/tests/warnings/should_compile/T25901_imp_unused_4.stderr - testsuite/tests/warnings/should_compile/all.T - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4eb4ff240abafc905b75ceeee812183… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4eb4ff240abafc905b75ceeee812183… You're receiving this email because of your account on gitlab.haskell.org.

1 0