July 2026 - ghc-commits

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] Introduce UnitIndex for global external unit caching
by Hannes Siebenhandl (＠fendor) 22 Jul '26

22 Jul '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: c9d5e531 by fendor at 2026-07-22T14:07:38+02:00 Introduce UnitIndex for global external unit caching `UnitInfo`s have been observed to cause a lot of memory usage in #27500. Especially with multiple home units, as the same (external) units are processed from scratch, even though most of the time we end up with exactly the same `UnitInfo`. We introduce a `UnitEnv` global cache that allows us to store external unit information that is used across all `HomeUnitEnv`s. The most important change in this commit is the introduction of the `UnitIndex`. It stores a global mapping of `UnitId` -> `UnitInfo`, and `initUnits` always uses the cached `UnitInfo` entry to populate each `HomeUnitEnv`'s `UnitState`. This allows us to ensure the following property: > Each `UnitInfo` should be alive exactly once in GHC. In addition, the `ExternalUnitDatabaseCache` may also hold a reference to each on-disk representation of `UnitInfo`. This means, we impose an hard upper bound on the number of `UnitInfo`s alive in the GHC session: > The number of alive `UnitInfo`s closure objects must be the > sum of all loaded unit database times two. We add performance regression tests that make sure the number of live `UnitInfo` cannot exceed this threshold. Closes #27500 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiComponentModulesRecomp100 mhu-perf ------------------------- These metrics increases are especially notable, as we are not even sharing anything big but merely the global package database with 50 entries. It shows how careful sharing of `UnitInfo` can improve memory usage. We expect this to be much more notable when the whole cabal package database is shared across multiple home units. --- Technical details To share the `UnitInfo`s correctly, it is important that we extract the `WireMap` into the `UnitIndex`. At the moment of writing, `WireMap` must be globally the same for all `HomeUnitEnv`s. This is important, as we could otherwise not cache the "fully-resolved" `UnitInfo`. We consider a `UnitInfo` fully-resolved, if wired-in units have been updated, the `UnitInfo` has been validated and variables in the unit config, such as `${pkgroot}` have been resolved. Updating the wired-in units requires the `WireMap` to be globally the same. - - - - - 35 changed files: - + changelog.d/unit-index - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/External/Database.hs - + compiler/GHC/Unit/External/Index.hs - + compiler/GHC/Unit/External/ModuleOrigin.hs - + compiler/GHC/Unit/External/Providers.hs - + compiler/GHC/Unit/External/Query.hs - + compiler/GHC/Unit/External/Substitution.hs - + compiler/GHC/Unit/External/Validate.hs - + compiler/GHC/Unit/External/Visibility.hs - + compiler/GHC/Unit/External/Wired.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/State.hs-boot - compiler/GHC/Unit/Types.hs - compiler/ghc.cabal.in - ghc/GHCi/UI.hs - hadrian/src/Rules/Generate.hs - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/driver/TUnitInfo/Foo.hs - + testsuite/tests/driver/TUnitInfo/Makefile - + testsuite/tests/driver/TUnitInfo/all.T - + testsuite/tests/driver/TUnitInfo/genMhu.sh - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-mhu.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-single.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space.stdout - utils/haddock/haddock-api/src/Haddock.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c9d5e5318b4c9c1a2652b27fb079f4a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c9d5e5318b4c9c1a2652b27fb079f4a… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/sjakobi/T27534] testsuite: Make T17088 an effective reproducer
by Simon Jakobi (＠sjakobi2) 22 Jul '26

22 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/T27534 at Glasgow Haskell Compiler / GHC Commits: 45299507 by Simon Jakobi at 2026-07-22T13:25:09+02:00 testsuite: Make T17088 an effective reproducer Initialize each byte array so that the test does not depend on allocator contents. Run the test only with the compacting collector and restore the compiler and RTS settings that trigger #17088. Disable STG lambda lifting because it removes the closure shape needed to reproduce the original pointer-tagging failure. Closes #27534. Assisted-by: gpt-5.6-sol via Codex CLI - - - - - 2 changed files: - testsuite/tests/rts/T17088.hs - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/T17088.hs ===================================== @@ -2,6 +2,9 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +-- Lambda lifting removes the closure shape needed to reproduce #17088. +{-# OPTIONS_GHC -fno-stg-lift-lams #-} + module Main (main) where import Data.Word @@ -27,7 +30,9 @@ instance Show Bytes where bytesAllocRet :: Int -> IO Bytes bytesAllocRet (I# sz) = IO $ \s -> case newAlignedPinnedByteArray# sz 8# s of - (# s', mba #) -> (# s', Bytes mba #) + (# s', mba #) -> + case writeWord8Array# mba 0# (wordToWord8# 0##) s' of + s'' -> (# s'', Bytes mba #) ------------------------------------------------------------------------ ===================================== testsuite/tests/rts/all.T ===================================== @@ -540,8 +540,11 @@ test('RestartEventLogging', compile_and_run, ['RestartEventLogging_c.c']) test('T17088', - [extra_ways(['compacting_gc']), extra_run_opts('+RTS -A256k -RTS')], - compile_and_run, ['-rtsopts -O2']) + [ only_ways(['compacting_gc']) + , extra_ways(['compacting_gc']) + , extra_run_opts('+RTS -A128k -RTS') + ], + compile_and_run, ['-rtsopts -O1']) test('T15427', js_broken(22374), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45299507219dc7bc69db7c0b25563d4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45299507219dc7bc69db7c0b25563d4… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/sjakobi/T27534] testsuite: Make T17088 an effective reproducer
by Simon Jakobi (＠sjakobi2) 22 Jul '26

22 Jul '26

Simon Jakobi pushed to branch wip/sjakobi/T27534 at Glasgow Haskell Compiler / GHC Commits: 688b520f by Simon Jakobi at 2026-07-22T13:21:21+02:00 testsuite: Make T17088 an effective reproducer Initialize each byte array so that the test does not depend on allocator contents. Run the test only with the compacting collector and restore the compiler and RTS settings that trigger #17088. Disable STG lambda lifting because it removes the closure shape needed to reproduce the original pointer-tagging failure. Assisted-by: gpt-5.6-sol via Codex CLI - - - - - 2 changed files: - testsuite/tests/rts/T17088.hs - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/T17088.hs ===================================== @@ -2,6 +2,9 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +-- Lambda lifting removes the closure shape needed to reproduce #17088. +{-# OPTIONS_GHC -fno-stg-lift-lams #-} + module Main (main) where import Data.Word @@ -27,7 +30,9 @@ instance Show Bytes where bytesAllocRet :: Int -> IO Bytes bytesAllocRet (I# sz) = IO $ \s -> case newAlignedPinnedByteArray# sz 8# s of - (# s', mba #) -> (# s', Bytes mba #) + (# s', mba #) -> + case writeWord8Array# mba 0# (wordToWord8# 0##) s' of + s'' -> (# s'', Bytes mba #) ------------------------------------------------------------------------ ===================================== testsuite/tests/rts/all.T ===================================== @@ -540,8 +540,11 @@ test('RestartEventLogging', compile_and_run, ['RestartEventLogging_c.c']) test('T17088', - [extra_ways(['compacting_gc']), extra_run_opts('+RTS -A256k -RTS')], - compile_and_run, ['-rtsopts -O2']) + [ only_ways(['compacting_gc']) + , extra_ways(['compacting_gc']) + , extra_run_opts('+RTS -A128k -RTS') + ], + compile_and_run, ['-rtsopts -O1']) test('T15427', js_broken(22374), compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/688b520f88f6f739431d7ba173124db… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/688b520f88f6f739431d7ba173124db… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] Add test for multiple home units to show that the number of UnitInfo's doesn't increase
by Hannes Siebenhandl (＠fendor) 22 Jul '26

22 Jul '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: 85ec1752 by fendor at 2026-07-22T13:18:01+02:00 Add test for multiple home units to show that the number of UnitInfo's doesn't increase - - - - - 16 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/External/Database.hs - compiler/GHC/Unit/External/Index.hs - compiler/GHC/Unit/External/ModuleOrigin.hs - compiler/GHC/Unit/State.hs - ghc/GHCi/UI.hs - testsuite/tests/driver/TUnitInfo/Makefile - testsuite/tests/driver/TUnitInfo/all.T - + testsuite/tests/driver/TUnitInfo/genMhu.sh - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-mhu.stdout - + testsuite/tests/driver/TUnitInfo/generic-unit-info-space-single.stdout - testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -671,7 +671,7 @@ setUnitDynFlagsNoCheck uid dflags1 = do logger <- getLogger hsc_env <- getSession - (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (hscUIC hsc_env) (hscEUDC hsc_env) (hsc_all_home_unit_ids hsc_env) + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (hscUIC hsc_env) (hsc_all_home_unit_ids hsc_env) updated_dflags <- liftIO $ updatePlatformConstants dflags1 mconstants let upd hue = @@ -760,7 +760,7 @@ setProgramDynFlags_ invalidate_needed dflags = do old_hpt = homeUnitEnv_hpt homeUnitEnv home_units = HUG.allUnits (ue_home_unit_graph old_unit_env) - (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_uic old_unit_env) (ue_eud old_unit_env) home_units + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_uic old_unit_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags0 mconstants pure HomeUnitEnv @@ -778,7 +778,6 @@ setProgramDynFlags_ invalidate_needed dflags = do , ue_current_unit = ue_currentUnit old_unit_env , ue_module_graph = ue_module_graph old_unit_env , ue_eps = ue_eps old_unit_env - , ue_eud = ue_eud old_unit_env , ue_uic = ue_uic old_unit_env } modifySession $ \h -> hscSetFlags dflags1 h{ hsc_unit_env = unit_env } @@ -837,7 +836,6 @@ setProgramHUG_ invalidate_needed new_hug0 = do , ue_current_unit = ue_currentUnit unit_env0 , ue_eps = ue_eps unit_env0 , ue_module_graph = ue_module_graph unit_env0 - , ue_eud = ue_eud unit_env0 , ue_uic = ue_uic unit_env0 } modifySession $ \h -> @@ -886,7 +884,7 @@ setProgramHUG_ invalidate_needed new_hug0 = do old_hpt = homeUnitEnv_hpt homeUnitEnv home_units = HUG.allUnits (ue_home_unit_graph unit_env) - (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_uic unit_env) (ue_eud unit_env) home_units + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_uic unit_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants pure HomeUnitEnv ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -92,7 +92,7 @@ import GHC.Types.Error (mkUnknownDiagnostic) import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.Home.ModInfo import GHC.Unit.Home.PackageTable -import GHC.Unit.External.Database (cacheExternalUnitDatabase) +import GHC.Unit.External.Index (cacheExternalUnitDatabase) -- | Entry point to compile a Backpack file. doBackpack :: [FilePath] -> Ghc () @@ -442,8 +442,8 @@ addInMemoryDatabase dflags u = do { unitDatabasePath = unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags (ppr (unitId u)) ++ ")" , unitDatabaseUnits = [u] } - let eud = hscEUDC hsc_env - liftIO $ cacheExternalUnitDatabase eud newdb + let uic = hscUIC hsc_env + liftIO $ cacheExternalUnitDatabase uic newdb -- added at the end because ordering matters pure dflags { packageDBFlags = packageDBFlags dflags ++ [PackageDB (PkgDbPath (unitDatabasePath newdb))] @@ -456,11 +456,10 @@ addUnit u = do logger <- getLogger let dflags0 = hsc_dflags hsc_env let old_unit_env = hsc_unit_env hsc_env - let eud = hscEUDC hsc_env dflags1 <- addInMemoryDatabase dflags0 u - (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (ue_uic old_unit_env) eud (hsc_all_home_unit_ids hsc_env) + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (ue_uic old_unit_env) (hsc_all_home_unit_ids hsc_env) -- update platform constants @@ -477,7 +476,6 @@ addUnit u = do (HUG.mkHomeUnitEnv unit_state dflags (ue_hpt old_unit_env) (Just home_unit)) , ue_eps = ue_eps old_unit_env , ue_module_graph = ue_module_graph old_unit_env - , ue_eud = ue_eud old_unit_env , ue_uic = ue_uic old_unit_env } setSession $ hscSetFlags dflags $ hsc_env { hsc_unit_env = unit_env } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -14,7 +14,6 @@ module GHC.Driver.Env , hsc_HUG , hsc_all_home_unit_ids , hscUnitIndex - , hscUIC , hscUpdateLoggerFlags , hscUpdateHUG , hscInsertHPT @@ -27,7 +26,7 @@ module GHC.Driver.Env , runInteractiveHsc , hscEPS , hscEUD - , hscEUDC + , hscUIC , hscInterp , prepareAnnotations , discardIC @@ -228,10 +227,7 @@ hscEPS :: HscEnv -> IO ExternalPackageState hscEPS hsc_env = readIORef (euc_eps (ue_eps (hsc_unit_env hsc_env))) hscEUD :: HscEnv -> IO (ExternalUnitDatabases UnitId) -hscEUD = readExternalUnitDatabases . hscEUDC - -hscEUDC :: HscEnv -> ExternalUnitDatabaseCache UnitId -hscEUDC hsc_env = ue_eud (hsc_unit_env hsc_env) +hscEUD = readExternalUnitDatabases . hscUIC hscUnitIndex :: HscEnv -> IO UnitIndex hscUnitIndex hsc_env = ueUI (hsc_unit_env hsc_env) ===================================== compiler/GHC/Driver/Session/Units.hs ===================================== @@ -131,7 +131,7 @@ initMulti unitArgsFiles lintDynFlagsAndSrcs = do home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do let hue_flags = homeUnitEnv_dflags homeUnitEnv dflags = homeUnitEnv_dflags homeUnitEnv - (unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags (hscUIC hsc_env) (hscEUDC hsc_env) home_units + (unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags (hscUIC hsc_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants emptyHpt <- liftIO $ emptyHomePackageTable ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -178,19 +178,21 @@ data UnitEnv = UnitEnv , ue_namever :: !GhcNameVersion -- ^ GHC name/version (used for dynamic library suffix) - , ue_eud :: {-# UNPACK #-} !(ExternalUnitDatabaseCache UnitId) - -- ^ Global cache of already read package databases - , ue_uic :: {-# UNPACK #-} !UnitIndexCache - -- ^ Index of already processed 'UnitInfo's. - -- Shares state over all 'UnitState' in the 'HomeUnitGraph'. + -- ^ Global index of already processed external units. + -- Shares state over all 'UnitState's in the 'HomeUnitGraph'. + -- + -- Allows sharing of 'UnitInfo's, ensuring each individual 'UnitInfo' + -- is retained a constant number of times. + -- + -- See Note [Sharing 'UnitInfo's across the 'UnitEnv'] for details. } ueEPS :: UnitEnv -> IO ExternalPackageState ueEPS = eucEPS . ue_eps ueEUD :: UnitEnv -> IO (ExternalUnitDatabases UnitId) -ueEUD = readExternalUnitDatabases . ue_eud +ueEUD = readExternalUnitDatabases . ue_uic ueUI :: UnitEnv -> IO UnitIndex ueUI = readUnitIndex . ue_uic @@ -199,7 +201,6 @@ ueUI = readUnitIndex . ue_uic initUnitEnv :: UnitId -> HomeUnitGraph -> GhcNameVersion -> Platform -> IO UnitEnv initUnitEnv cur_unit hug namever platform = do eps <- initExternalUnitCache - eud <- initExternalUnitDatabaseCache uic <- initUnitIndexCache return $ UnitEnv { ue_eps = eps @@ -208,7 +209,6 @@ initUnitEnv cur_unit hug namever platform = do , ue_current_unit = cur_unit , ue_platform = platform , ue_namever = namever - , ue_eud = eud , ue_uic = uic } ===================================== compiler/GHC/Unit/External/Database.hs ===================================== @@ -1,18 +1,11 @@ module GHC.Unit.External.Database ( - -- * Mutable cache for 'ExternalUnitDatabases' - ExternalUnitDatabaseCache (..), - initExternalUnitDatabaseCache, - readExternalUnitDatabases, - readExternalUnitDatabase, - cacheExternalUnitDatabase, - clearExternalUnitDatabaseCache, -- * 'ExternalUnitDatabases' ExternalUnitDatabases, emptyExternalUnitDatabases, insertExternalUnitDatabases, deleteExternalUnitDatabases, lookupExternalUnitDatabases, - -- * 'UnitDatabase' + -- * 'UnitDatabase' and how to merge them. UnitDatabase (..), mergeDatabases, UnitPrecedenceMap, @@ -20,8 +13,6 @@ module GHC.Unit.External.Database ( compareByPreference, -- * Reading packages from disk. UnitDbConfig (..), - readOrGetUnitDatabase, - readUnitDatabases, readUnitDatabase, getUnitDbRefs, resolveUnitDatabase, @@ -48,8 +39,6 @@ import GHC.Utils.Panic import Control.Monad import Data.Char -import Data.IORef -import Data.IORef qualified as IORef import Data.List (sortBy) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map @@ -60,40 +49,6 @@ import System.Directory import System.Environment (getEnv) import System.FilePath as FilePath --- ---------------------------------------------------------------------------- --- ExternalUnitDatabaseCache --- ---------------------------------------------------------------------------- - --- | Mutable wrapper around 'ExternalUnitDatabases'. -newtype ExternalUnitDatabaseCache unit = ExternalUnitDatabaseCache - { eudc_databases :: IORef (ExternalUnitDatabases unit) - } - -initExternalUnitDatabaseCache :: IO (ExternalUnitDatabaseCache unit) -initExternalUnitDatabaseCache = - ExternalUnitDatabaseCache <$> IORef.newIORef emptyExternalUnitDatabases - -readExternalUnitDatabases :: ExternalUnitDatabaseCache unit -> IO (ExternalUnitDatabases unit) -readExternalUnitDatabases eudc = - IORef.readIORef (eudc_databases eudc) - -modifyExternalUnitDatabaseCache :: ExternalUnitDatabaseCache unit -> (ExternalUnitDatabases unit -> ExternalUnitDatabases unit) -> IO () -modifyExternalUnitDatabaseCache eudc f = - IORef.modifyIORef' (eudc_databases eudc) f - -readExternalUnitDatabase :: ExternalUnitDatabaseCache unit -> OsPath -> IO (Maybe (UnitDatabase unit)) -readExternalUnitDatabase eudc path = do - dbs <- readExternalUnitDatabases eudc - pure $ lookupExternalUnitDatabases path dbs - -cacheExternalUnitDatabase :: ExternalUnitDatabaseCache unit -> UnitDatabase unit -> IO () -cacheExternalUnitDatabase eudc db = - modifyExternalUnitDatabaseCache eudc (insertExternalUnitDatabases db) - -clearExternalUnitDatabaseCache :: ExternalUnitDatabaseCache unit -> IO () -clearExternalUnitDatabaseCache eudc = - modifyExternalUnitDatabaseCache eudc (const emptyExternalUnitDatabases) - -- ---------------------------------------------------------------------------- -- ExternalUnitDatabases -- ---------------------------------------------------------------------------- @@ -230,12 +185,6 @@ data UnitDbConfig = UnitDbConfig , unitDbConfigGHCDir :: FilePath } -readUnitDatabases :: Logger -> ExternalUnitDatabaseCache UnitId -> UnitDbConfig -> IO [UnitDatabase UnitId] -readUnitDatabases logger db_cache cfg = do - conf_refs <- getUnitDbRefs cfg - confs <- liftM catMaybes $ mapM (resolveUnitDatabase cfg) conf_refs - mapM (readOrGetUnitDatabase logger db_cache cfg) confs - getUnitDbRefs :: UnitDbConfig -> IO [PkgDbRef] getUnitDbRefs cfg = do let system_conf_refs = [UserPkgDb, GlobalPkgDb] @@ -285,17 +234,6 @@ resolveUnitDatabase cfg UserPkgDb = runMaybeT $ do if exist then return (OsPath.unsafeEncodeUtf pkgconf) else mzero resolveUnitDatabase _ (PkgDbPath name) = return $ Just name --- | Get the cached 'UnitDatabase' or read the 'UnitDatabase' at the given location. -readOrGetUnitDatabase :: Logger -> ExternalUnitDatabaseCache UnitId -> UnitDbConfig -> OsPath -> IO (UnitDatabase UnitId) -readOrGetUnitDatabase logger db_cache cfg conf_file = - readExternalUnitDatabase db_cache conf_file >>= \ case - Nothing -> do - new_db <- readUnitDatabase logger cfg conf_file - cacheExternalUnitDatabase db_cache new_db - pure new_db - Just db -> - pure db - -- | Read the 'UnitDatabase' at the given location. readUnitDatabase :: Logger -> UnitDbConfig -> OsPath -> IO (UnitDatabase UnitId) readUnitDatabase logger cfg conf_file = do ===================================== compiler/GHC/Unit/External/Index.hs ===================================== @@ -1,3 +1,45 @@ +-- | The 'UnitIndex' is a 'UnitEnv' wide data structure that shares +-- external unit information across the 'UnitState' of all home units +-- (e.g., 'HomeUnitEnv') in a particular 'UnitEnv'. +-- +-- It caches already read unit databases, all processed 'UnitInfo's and +-- the 'WireMap'. +-- +-- This module is meant to be imported as @Index@. +-- +-- A short overview of how the different types here related to 'UnitState', 'UnitEnv' +-- and the 'HomeUnitEnv'. +-- +-- ┌─────────┐ +-- │ UnitEnv │ +-- └────┬────┘ +-- ├───────────────────────┐ +-- │ │ +-- ┌────▼──────┐ ┌─────▼─────┐ +-- │HomeUnitEnv│ │ UnitIndex ├────────────────┐ +-- └────┬──────┘ └───────────┘ │ +-- │ │ +-- │ Reads cached unit DBs │ +-- ┌────▼──────┐ ┌─────────────────────┐ │ +-- │ UnitState ├──────────>ExternalUnitDatabases◄──────┤ +-- └────┬──┬───┘ └─────────────────────┘ │ +-- │ └───────────────────────┐ │ +-- │ Writes new UnitInfos │ │ +-- │ during initialisation │ │ +-- ┌────▼────────┐ ┌────────v──────────┐ │ +-- │ UnitInfoMap │ │ GlobalUnitInfoMap ◄────────┘ +-- └────┬────────┘ └────────^──────────┘ +-- │ │ +-- └──────────────────────────┘ +-- UnitInfoMap references +-- GlobalUnitInfoMap values +-- (All UnitInfos are shared) +-- +-- Open arrow @A ───> B@: A uses B. +-- Closed arrow @A ◄─── B@: A is a field of B. +-- +-- Also, see Note [Sharing 'UnitInfo's across the 'UnitEnv'] for more technical discussion +-- about sharing 'UnitInfo's. module GHC.Unit.External.Index ( -- * The 'UnitIndexCache'. -- A mutable wrapper around 'UnitIndex' @@ -6,12 +48,16 @@ module GHC.Unit.External.Index ( readUnitIndex, modifyUnitIndexCache, clearUnitIndexCache, + cacheExternalUnitDatabase, + readExternalUnitDatabases, + readExternalUnitDatabase, -- * 'UnitIndex' UnitIndex, emptyUnitIndex, wiringMap, unwiringMap, globalUnits, + externalUnitDatabases, setWireMap, wireMapExists, addUnitInfoMap, @@ -32,10 +78,14 @@ module GHC.Unit.External.Index ( updateWiredInUnits, updateWiredInUnitsInUnitInfo, updateWiredInUnitIdInModule, + -- * Reading external unit databases into the 'UnitIndexCache' + readOrGetUnitDatabase, + readUnitDatabases, ) where import GHC.Prelude +import GHC.Data.OsPath import GHC.Data.ShortText qualified as ST import GHC.Types.Unique.Map import GHC.Unit.Database @@ -46,17 +96,36 @@ import GHC.Unit.Info import GHC.Unit.Types import GHC.Utils.Logger +import Control.Monad (liftM) import Data.Either import Data.IORef (IORef) import Data.IORef qualified as IORef import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map +import Data.Maybe (catMaybes) -- ---------------------------------------------------------------------------- -- UnitIndex -- ---------------------------------------------------------------------------- -- | Mutable version of 'UnitIndex'. +-- +-- The 'UnitIndexCache' ensures that all calls to 'initUnits' will +-- share the 'UnitInfo' if it is possible. +-- +-- To share the 'UnitInfo', the 'UnitInfo' needs to be fully-resolved, i.e., its wired-in +-- dependencies and modules need to be replaced with the 'UnitId' of the wired-in unit. +-- Thus, the 'UnitIndexCache' caches both the global 'WireMap' and the 'UnitInfoMap'. +-- +-- The 'WireMap' is globally valid, as other parts of the compiler rely on the fact +-- that only one instance of wired-in units is used. +-- +-- Memory Invariant: The 'UnitIndexCache' is the root object for retaining fully-resolved +-- 'UnitInfo'. 'UnitState' is expected to reference only 'UnitInfo's from the 'UnitIndexCache'. +-- There is exactly one fully-resolved 'UnitInfo' alive for each external unit per unit database. +-- +-- A second instance may or may not be stored in the 'externalUnitDatabases', which represent the +-- in-memory cache of the on-disk unit databases. newtype UnitIndexCache = UnitIndexCache { uic_index :: IORef UnitIndex } @@ -66,21 +135,41 @@ initUnitIndexCache = UnitIndexCache <$> IORef.newIORef emptyUnitIndex readUnitIndex :: UnitIndexCache -> IO UnitIndex -readUnitIndex eudc = - IORef.readIORef (uic_index eudc) +readUnitIndex uic = + IORef.readIORef (uic_index uic) modifyUnitIndexCache :: UnitIndexCache -> (UnitIndex -> UnitIndex) -> IO () -modifyUnitIndexCache eudc f = - IORef.modifyIORef' (uic_index eudc) f +modifyUnitIndexCache uic f = + IORef.modifyIORef' (uic_index uic) f clearUnitIndexCache :: UnitIndexCache -> IO () -clearUnitIndexCache eudc = - modifyUnitIndexCache eudc (const emptyUnitIndex) +clearUnitIndexCache uic = + modifyUnitIndexCache uic (const emptyUnitIndex) + +cacheExternalUnitDatabase :: UnitIndexCache -> UnitDatabase UnitId -> IO () +cacheExternalUnitDatabase uic db = + modifyUnitIndexCache uic + (\ ui -> + ui + { ui_externalUnitDatabases = insertExternalUnitDatabases db (ui_externalUnitDatabases ui) + } + ) + +readExternalUnitDatabases :: UnitIndexCache -> IO (ExternalUnitDatabases UnitId) +readExternalUnitDatabases uic = + externalUnitDatabases <$> readUnitIndex uic + +readExternalUnitDatabase :: UnitIndexCache -> OsPath -> IO (Maybe (UnitDatabase UnitId)) +readExternalUnitDatabase uic path = do + dbs <- readExternalUnitDatabases uic + pure $ lookupExternalUnitDatabases path dbs -- | Global index for external units that can be shared across multiple 'HomeUnitEnv's. -- -- Allows sharing of the 'WireMap' and 'UnitInfo's that are stored in the 'UnitState' -- of each 'HomeUnitEnv'. +-- +-- See Note [Sharing 'UnitInfo's across the 'UnitEnv'] for details about memory usage. data UnitIndex = UnitIndex { ui_wireMap :: !WireMap -- ^ A mapping from database unit keys to wired in unit ids. @@ -95,10 +184,13 @@ data UnitIndex = UnitIndex , ui_unitInfoMap :: !GlobalUnitInfoMap -- ^ A global map for all fully-resolved 'UnitInfo's. -- - -- A 'UnitInfo' is fully-resolved, if its dependencies were updated to reference the - -- wired-in packages (e.g., 'wiringMap') and the wired-in packages are updated. - -- Further, the 'UnitInfo' is based on the 'ExternalUnitDatabases' results, resolving - -- variables such as @${pkgroot}@ in paths. + -- See Note [Sharing 'UnitInfo's across the 'UnitEnv'] for more details + -- what we use this for and what a fully-resolved 'UnitInfo' is. + , ui_externalUnitDatabases :: !(ExternalUnitDatabases UnitId) + -- ^ Cache the already processed unit databases in-memory. + -- + -- These 'GenericUnitInfo's have their paths resolved, e.g., no @${pkgroot}@ is + -- present any more. } -- | Get the 'WireMap'. @@ -115,7 +207,18 @@ wiringMap = ui_wireMap unwiringMap :: UnitIndex -> UnwireMap unwiringMap = ui_unwireMap +-- | Access the already processed unit databases. +externalUnitDatabases :: UnitIndex -> ExternalUnitDatabases UnitId +externalUnitDatabases = ui_externalUnitDatabases + -- | Access the global map of fully-resolved 'UnitInfo's. +-- +-- A 'UnitInfo' is fully-resolved, if its dependencies were updated to reference the +-- wired-in packages (e.g., 'wiringMap') and the wired-in packages are updated. +-- Further, the 'UnitInfo' is based on the 'ExternalUnitDatabases' results, resolving +-- variables such as @${pkgroot}@ in paths. +-- +-- See Note [Sharing 'UnitInfo's across the 'UnitEnv'] for why this is helpful. globalUnits :: UnitIndex -> GlobalUnitInfoMap globalUnits = ui_unitInfoMap @@ -124,6 +227,7 @@ emptyUnitIndex = UnitIndex { ui_wireMap = emptyWireMap , ui_unwireMap = emptyUnwireMap , ui_unitInfoMap = emptyGlobalUnitInfoMap + , ui_externalUnitDatabases = emptyExternalUnitDatabases } -- | Set the 'WireMap' of 'UnitIndex'. @@ -167,7 +271,8 @@ type UnitAbiHash = ST.ShortText -- -- However, a user can choose a conflicting 'UnitId', causing a conflict after all. -- We use the 'UnitAbiHash' for disambiguation. If both 'UnitId' and 'UnitAbiHash' are --- identical in separate unit databases, we can assume they are the same unit. +-- identical in separate unit databases, we can assume they are the same unit, according +-- to the documentation of GHC. newtype GlobalUnitInfoMap = GlobalUnitInfoMap (UniqMap UnitId (Map UnitAbiHash UnitInfo)) -- | Lookup the 'UnitInfo' in the 'GlobalUnitInfoMap'. @@ -238,7 +343,10 @@ updateWiredInUnitIndex wired_map pkgs unit_index = do ui <- readUnitIndex unit_index let all_pkgs = updateWiredInUnits wired_map (ui_unitInfoMap ui) pkgs - (new_pkgs, _pkgs_set) = partitionEithers all_pkgs + (new_pkgs', _pkgs_set) = partitionEithers all_pkgs + -- Make sure we force the 'UnitInfo' here. + -- Otherwise, we will retain a reference to the old 'UnitInfo' + new_pkgs <- traverse evaluateUnitInfoLists new_pkgs' modifyUnitIndexCache unit_index (addUnitInfoMap $ mkUnitInfoMap new_pkgs) pure (map (either id id) all_pkgs) @@ -310,3 +418,23 @@ upd_wired_in :: WireMap -> UnitId -> UnitId upd_wired_in wiredInMap key | Just key' <- lookupWireMap key wiredInMap = key' | otherwise = key + +-- ----------------------------------------------------------------------------- +-- Reading the unit database(s) into the 'UnitIndexCache' + +readUnitDatabases :: Logger -> UnitIndexCache -> UnitDbConfig -> IO [UnitDatabase UnitId] +readUnitDatabases logger db_cache cfg = do + conf_refs <- getUnitDbRefs cfg + confs <- liftM catMaybes $ mapM (resolveUnitDatabase cfg) conf_refs + mapM (readOrGetUnitDatabase logger db_cache cfg) confs + +-- | Get the cached 'UnitDatabase' or read the 'UnitDatabase' at the given location. +readOrGetUnitDatabase :: Logger -> UnitIndexCache -> UnitDbConfig -> OsPath -> IO (UnitDatabase UnitId) +readOrGetUnitDatabase logger db_cache cfg conf_file = + readExternalUnitDatabase db_cache conf_file >>= \ case + Nothing -> do + new_db <- readUnitDatabase logger cfg conf_file + cacheExternalUnitDatabase db_cache new_db + pure new_db + Just db -> + pure db ===================================== compiler/GHC/Unit/External/ModuleOrigin.hs ===================================== @@ -7,12 +7,12 @@ module GHC.Unit.External.ModuleOrigin ( originEmpty, ) where +import Data.Semigroup qualified as Semigroup import GHC.Prelude import GHC.Unit.External.Validate import GHC.Unit.Info import GHC.Utils.Outputable import GHC.Utils.Panic -import qualified Data.Semigroup as Semigroup -- | Given a module name, there may be multiple ways it came into scope, -- possibly simultaneously. This data type tracks all the possible ways ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -6,7 +6,6 @@ module GHC.Unit.State ( module GHC.Unit.Info, -- * Reading the package config, and processing cmdline args UnitState(..), - TrustOverlay(..), UnitDatabase (..), UnitErr (..), emptyUnitState, @@ -16,6 +15,13 @@ module GHC.Unit.State ( getUnitDbRefs, resolveUnitDatabase, listUnitInfo, + -- * Overlays over the unit set + TrustOverlay, + IsTrusted(..), + lookupTrustOverlay, + distrustUnits, + trustUnits, + emptyTrustOverlay, -- * Querying the package config lookupUnit, lookupUnit', @@ -252,12 +258,19 @@ data IsTrusted | Distrusted deriving ( Eq, Ord ) +-- | The 'TrustOverlay' stores user overwrites of the on-disk 'unitIsTrusted' status. +-- +-- The user can overwrite this value via flags such as @-distrust-all-packages@. +-- We do not modify the 'UnitInfo' directory, but rather store this user selection +-- in the 'TrustOverlay'. +-- +-- This allows us to share the 'UnitInfo' completely and saves us memory. newtype TrustOverlay = TrustOverlay { trustOverlay :: UniqMap UnitId IsTrusted } lookupTrustOverlay :: TrustOverlay -> UnitId -> Maybe IsTrusted -lookupTrustOverlay (TrustOverlay to) = lookupUniqMap to +lookupTrustOverlay to = lookupUniqMap (trustOverlay to) distrustUnits :: [UnitId] -> TrustOverlay -> TrustOverlay distrustUnits elements (TrustOverlay to) = TrustOverlay $ foldl' (\ acc uid -> addToUniqMap acc uid Distrusted) to elements @@ -268,6 +281,57 @@ trustUnits elements (TrustOverlay to) = TrustOverlay $ foldl' (\ acc uid -> addT emptyTrustOverlay :: TrustOverlay emptyTrustOverlay = TrustOverlay emptyUniqMap +{- +Note [Sharing 'UnitInfo's across the 'UnitEnv'] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The 'UnitState' and 'UnitIndex' are closely related. + +The 'UnitState' stores all information about the external units referenced by +a single 'HomeUnitEnv'. +As a reminder, the 'HomeUnitEnv' stores all information specific to a single home unit, +such as the 'HomePackageTable', 'DynFlags' and the 'UnitState'. +The 'UnitState' retains the 'unitInfoMap', an in-memory representation of +the unit databases that a 'HomeUnitEnv' depends on. +Multiple home units can depend on the same unit database, and reference the same +'UnitInfo's across the GHC session. +We share all 'UnitInfo's across multiple 'HomeUnitEnv's, saving a lot of +duplication of the same 'UnitInfo'. +This what the 'UnitIndex' takes care of. + +The 'UnitIndex' stores all fully-resolved 'UnitInfo's that can be referenced +by the 'UnitState'.'unitInfoMap'. +We consider a 'UnitInfo' as fully-resolved, if its dependencies were updated to reference the +wired-in units (e.g., 'wiringMap') and the wired-in units are updated as well. +See Note [Wired-in units] for more details on wired-in units. +Further, the 'UnitInfo' is based on the 'ExternalUnitDatabases' results, resolving +variables such as @${pkgroot}@ in paths. + +As such, we can consider the 'UnitIndex' to be global data that is referenced by +the 'UnitState' for better sharing of 'UnitInfo's. + +In fact, using the 'UnitIndex', we can impose a hard upper bound on the number +of live 'UnitInfo's in a GHC session: + +> For each on-disk 'GenericUnitInfo', there are at most two objects alive. + +One instance is stored in 'ExternalUnitDatabases' where variables are resolved, +but the wired-in units haven't been resolved. + +The second instance is the fully-resolved 'UnitInfo' stored in the 'UnitIndex'. + +See the module documentation for 'GHC.Unit.External.Index' for an overview +of how the types relate to each other. +-} + +-- | The 'UnitState' contains a plethora of information local to a single 'HomeUnitEnv'. +-- +-- It stores module visibilities, unit trust for @SafeHaskell@, available units for error messages, +-- explicit unit dependencies and knows how to instantiate backpack signature and holes +-- on demand. +-- +-- A 'HomeUnitEnv' should rarely/never have to look into the 'UnitIndex', all external +-- unit related information is stored in the 'UnitState'. +-- data UnitState = UnitState { -- | A mapping of 'Unit' to 'UnitInfo'. This list is adjusted -- so that only valid units are here. 'UnitInfo' reflects @@ -276,6 +340,7 @@ data UnitState = UnitState { -- may have the 'exposed' flag be 'False'.) -- -- All values are shared with 'UnitIndex'.'globalUnits'. + -- See Note [Sharing 'UnitInfo's across the 'UnitEnv'] for details. unitInfoMap :: UnitInfoMap, -- | Set of units that we trust. @@ -283,7 +348,10 @@ data UnitState = UnitState { -- Local overlay of 'UnitInfo'. -- This avoids modifying the 'UnitInfo' directly, potentially saving -- a lot of duplication. - trustedUnits :: TrustOverlay, + -- + -- We keep this in WHNF as it is relatively cheap but could easily retain + -- references to bigger structures. + trustedUnits :: !TrustOverlay, -- | A mapping of 'PackageName' to 'UnitId'. If several units have the same -- package name (e.g. different instantiations), then we return one of them... @@ -333,8 +401,6 @@ emptyUnitState = UnitState { unitInfoMap = emptyUniqMap, trustedUnits = emptyTrustOverlay, packageNameMap = emptyUFM, - -- wireMap = emptyUniqMap, - -- unwireMap = emptyUniqMap, preloadUnits = [], explicitUnits = [], homeUnitDepends = Set.empty, @@ -439,14 +505,16 @@ isUnitInfoTrusted ue u = -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' and 'packageDBFlags' fields of the 'DynFlags', and it will -- update the 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> UnitIndexCache -> ExternalUnitDatabaseCache UnitId -> Set.Set UnitId -> IO (UnitState, HomeUnit, Maybe PlatformConstants) -initUnits logger dflags unit_index cached_dbs home_units = do +-- +-- Also, see Note [Sharing 'UnitInfo's across the 'UnitEnv'] for implementation details. +initUnits :: Logger -> DynFlags -> UnitIndexCache -> Set.Set UnitId -> IO (UnitState, HomeUnit, Maybe PlatformConstants) +initUnits logger dflags unit_index home_units = do let forceUnitInfoMap state = unitInfoMap state `seq` () unit_state <- withTiming logger (text "initializing unit database") forceUnitInfoMap - $ mkUnitState logger unit_index cached_dbs (initUnitConfig dflags home_units) + $ mkUnitState logger unit_index (initUnitConfig dflags home_units) putDumpFileMaybe logger Opt_D_dump_mod_map "Module Map" FormatText (updSDocContext (\ctx -> ctx {sdocLineLength = 200}) @@ -638,10 +706,9 @@ reportCycles logger sccs = when (logVerbAtLeast logger 2) $ mapM_ report sccs mkUnitState :: Logger -> UnitIndexCache - -> ExternalUnitDatabaseCache UnitId -> UnitConfig -> IO UnitState -mkUnitState logger unit_index db_cache cfg = do +mkUnitState logger unit_index cfg = do {- Plan. @@ -695,7 +762,7 @@ mkUnitState logger unit_index db_cache cfg = do we build a mapping saying what every in scope module name points to. -} - dbs <- readUnitDatabases logger db_cache (initUnitDbConfig cfg) + dbs <- readUnitDatabases logger unit_index (initUnitDbConfig cfg) -- distrust all units if the flag is set let distrustUnitsOfDb overlay db = foldl' (\ acc ui -> distrustUnits [unitId ui] acc) overlay (unitDatabaseUnits db) @@ -713,7 +780,7 @@ mkUnitState logger unit_index db_cache cfg = do debugTraceMsg logger 2 $ text "package flags" <+> ppr other_flags - let !home_unit_deps = selectHomeUnits (unitConfigHomeUnits cfg) hpt_flags + let home_unit_deps = selectHomeUnits (unitConfigHomeUnits cfg) hpt_flags -- Merge databases together, without checking validity (pkg_map1, prec_map) <- mergeDatabases logger dbs @@ -727,7 +794,7 @@ mkUnitState logger unit_index db_cache cfg = do -- Compute trust flags (these flags apply regardless of whether -- or not packages are visible or not) - !trustUnitsOverlay <- mayThrowUnitErr + trustUnitsOverlay <- mayThrowUnitErr $ foldM (applyTrustFlag prec_map unusable (nonDetEltsUniqMap pkg_map2)) distrustedUnitsOverlay (reverse (unitConfigFlagsTrusted cfg)) let pkgs1 = nonDetEltsUniqMap pkg_map2 @@ -769,12 +836,12 @@ mkUnitState logger unit_index db_cache cfg = do -- Note: we NEVER expose indefinite packages by -- default, because it's almost assuredly not -- what you want (no mix-in linking has occurred). - let !x = fsPackageName p in if unitIsExposed p && unitIsDefinite (mkUnit p) && mostPreferable p + if unitIsExposed p && unitIsDefinite (mkUnit p) && mostPreferable p then addToUniqMap vm (mkUnit p) UnitVisibility { uv_expose_all = True, uv_renamings = [], - uv_package_name = First (Just x), + uv_package_name = First (Just $ fsPackageName p), uv_requirements = emptyUniqMap, uv_explicit = Nothing } ===================================== ghc/GHCi/UI.hs ===================================== @@ -857,7 +857,7 @@ installInteractiveHomeUnits dflags = do env <- GHC.getSession let unit_index = hscUIC env (unit_state,home_unit,_mconstants) <- - liftIO $ initUnits logger dflags unit_index (hscEUDC env) all_home_units + liftIO $ initUnits logger dflags unit_index all_home_units hpt <- liftIO emptyHomePackageTable pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit)) ===================================== testsuite/tests/driver/TUnitInfo/Makefile ===================================== @@ -2,17 +2,38 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk -.PHONY: generic-unit-info-space_Prep -generic-unit-info-space_Prep: +.PHONY: generic-unit-info-space-single_Prep +generic-unit-info-space-single_Prep: -.PHONY: generic-unit-info-space -generic-unit-info-space: +.PHONY: generic-unit-info-space-single +generic-unit-info-space-single: "$(TEST_HC)" $(TEST_HC_OPTS) -Wall -v0 generic-unit-info-space.hs -rtsopts \ -package ghc -package base -package ghc-internal -threaded ./generic-unit-info-space$(exeext) \ "`'$(TEST_HC)' --print-libdir | tr -d '\r'`" \ "`'$(GHC_PKG)' --no-user-package-db list --simple-output | wc -w`" \ + -clear-package-db -global-package-db -no-user-package-db \ + +RTS -hT --no-automatic-heap-samples -RTS + +# Generate 50 trivial home units. The number of 'UnitInfo's must not increase +# linearly in the number of home units +HOME_UNITS_01 := 50 +UNITS := $(foreach p,$(shell seq 0 $$(( $(HOME_UNITS_01) - 1 ))),-unit @unitp$(p)) +.PHONY: generic-unit-info-space-mhu_Prep +generic-unit-info-space-mhu_Prep: + ./genMhu.sh $(HOME_UNITS_01) + + +.PHONY: generic-unit-info-space-mhu +generic-unit-info-space-mhu: + "$(TEST_HC)" $(TEST_HC_OPTS) -Wall -v0 generic-unit-info-space.hs -rtsopts \ + -package ghc -package base -package ghc-internal -threaded + + ./generic-unit-info-space$(exeext) \ + "`'$(TEST_HC)' --print-libdir | tr -d '\r'`" \ + "`'$(GHC_PKG)' --global list --simple-output | wc -w`" \ + $(UNITS) \ +RTS -hT --no-automatic-heap-samples -RTS ===================================== testsuite/tests/driver/TUnitInfo/all.T ===================================== @@ -1,7 +1,15 @@ # A test for checking the number of live GenericUnitInfo objects -test('generic-unit-info-space' - , [ extra_files(['Foo.hs']) - , pre_cmd('$MAKE -s --no-print-directory generic-unit-info-space_Prep') +test('generic-unit-info-space-single' + , [ extra_files(['Foo.hs', 'generic-unit-info-space.hs']) + , pre_cmd('$MAKE -s --no-print-directory generic-unit-info-space-single_Prep') ] , makefile_test - , ['generic-unit-info-space']) + , ['generic-unit-info-space-single']) + +# A test for checking the number of live GenericUnitInfo objects +test('generic-unit-info-space-mhu' + , [ extra_files(['genMhu.sh', 'generic-unit-info-space.hs']) + , pre_cmd('$MAKE -s --no-print-directory generic-unit-info-space-mhu_Prep') + ] + , makefile_test + , ['generic-unit-info-space-mhu']) ===================================== testsuite/tests/driver/TUnitInfo/genMhu.sh ===================================== @@ -0,0 +1,26 @@ +#! /usr/bin/env bash + +set -euo pipefail + +HOME_UNITS=${1:-50} + +unit_dir() { echo "p$1"; } +unit_fname(){ echo "unitp$1"; } +mod_name() { echo "Mod$1"; } + +mk_unit_file() { + local p=$1 + echo "-clear-package-db -global-package-db -no-user-package-db -working-dir $(unit_dir "$p") -this-unit-id $(unit_dir "$p") $(mod_name "$p") ${deps[*]}" \ + > "$(unit_fname "$p")" +} + +mk_top_mod() { + local p=$1 + echo "module $(mod_name "$p") where" > "$(unit_dir "$p")/$(mod_name "$p").hs" +} + +for ((p = 0; p < HOME_UNITS; p++)); do + mkdir "$(unit_dir "$p")" + mk_unit_file "$p" + mk_top_mod "$p" +done ===================================== testsuite/tests/driver/TUnitInfo/generic-unit-info-space-mhu.stdout ===================================== @@ -0,0 +1,2 @@ +### Heap Census +There are exactly two GenericUnitInfo closures alive per on-disk package ===================================== testsuite/tests/driver/TUnitInfo/generic-unit-info-space-single.stdout ===================================== @@ -0,0 +1,2 @@ +### Heap Census +There are exactly two GenericUnitInfo closures alive per on-disk package ===================================== testsuite/tests/driver/TUnitInfo/generic-unit-info-space.hs ===================================== @@ -6,6 +6,7 @@ import GHC.Data.FastString (mkFastStringByteString) import qualified GHC.Data.ShortText as ST import GHC.Driver.Monad import GHC.Driver.Env.Types +import GHC.Driver.Session.Units import GHC.Internal.Heap.Closures (closureSize, asBox) import GHC.Platform import GHC.Profiling @@ -14,6 +15,7 @@ import GHC.Unit.Types (stringToUnitId) import Control.Monad (guard, when) import Data.Version (makeVersion) +import qualified Data.List.NonEmpty as NE import qualified Data.Maybe as Maybe import qualified Data.List as List import System.Environment @@ -24,19 +26,32 @@ main :: IO () main = do libdir:numberOfGlobalPkgsStr:restArgs <- getArgs runGhc (Just libdir) $ do - initGhcM (read numberOfGlobalPkgsStr) $ ["-clear-package-db", "-global-package-db", "-no-user-package-db"] ++ restArgs - + initGhcM (read numberOfGlobalPkgsStr) restArgs initGhcM :: Int -> [String] -> Ghc () initGhcM numOfPkgs xs = do session <- getSession df1 <- getSessionDynFlags - let cmdOpts = ["-fforce-recomp"] ++ xs + let (units, args) = extractUnits xs + let cmdOpts = ["-fforce-recomp"] ++ args + (df2, leftovers, _) <- parseDynamicFlags (hsc_logger session) df1 (map noLoc cmdOpts) setSessionDynFlags df2 - ts <- mapM (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers - setTargets ts - _ <- load LoadAllTargets + + targets <- case NE.nonEmpty units of + Nothing -> + traverse (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers + Just mhu -> do + ts <- initMulti mhu (\ _ _ _ _ -> pure ()) + traverse (\(n, mu, mp) -> guessTarget n mu mp) ts + + setTargets targets + success <- load LoadAllTargets + + liftIO $ when (failed success) $ do + putStrLn "Failed to load targets" + Exit.exitFailure + liftIO $ do requestHeapCensus performGC @@ -64,15 +79,17 @@ initGhcM numOfPkgs xs = do -- The output should be: -- -- @ - -- 2 * number of packages in global unit db * 8 * word_size * sizeof(struct GenericUnitInfo) + -- 2 * number of packages in global unit db * word_size * sizeof(struct GenericUnitInfo) -- @ -- - -- This test simply assures, that in a single home unit case, we don't leak 'UnitInfo's + -- This test simply assures, that when we load a session, we don't leak 'UnitInfo's -- - -- If this number changes for any reason, DO NOT ACCEPT THE CHANGES, you have introduced a space leak. - when (num /= expectedSizeInBytes) $ do + -- If this number changes without a good reason, DO NOT ACCEPT THE CHANGES, you have introduced a space leak. + -- We say less than the expected size is accepted, because in the multiple-home-units case, we don't force the second + -- UnitInfo closure enough after initial processing. + when (num > expectedSizeInBytes) $ do putStrLn "Space leak detected by generic-unit-info-space test:" - putStrLn $ (show (num `div` genericUnitInfoSizeInBytes)) ++ " live GenericUnitInfo when == (" ++ show expectedNumberOfUnitInfos ++ ") are expected" + putStrLn $ (show (num `div` genericUnitInfoSizeInBytes)) ++ " live GenericUnitInfo when <= (" ++ show expectedNumberOfUnitInfos ++ ") are expected" readFile hpFile >>= putStrLn Exit.exitFailure return () @@ -135,3 +152,11 @@ minimalUnitInfo = GenericUnitInfo , unitIsExposed = True , unitIsTrusted = False } + +extractUnits :: [String] -> ([String], [String]) +extractUnits = go [] [] + where + -- TODO: we should likely use the 'processCmdLineP' instead + go units rest ("-unit" : x : xs) = go (x : units) rest xs + go units rest (x : xs) = go units (x : rest) xs + go units rest [] = (reverse units, reverse rest) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85ec1752a307b199cfecc40e63fe2e0… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85ec1752a307b199cfecc40e63fe2e0… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Resolving many TTG related orphan type-class instances
by Marge Bot (＠marge-bot) 22 Jul '26

22 Jul '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 43dd2b15 by Recursion Ninja at 2026-07-21T17:09:53-04:00 Resolving many TTG related orphan type-class instances This is part a technical debt removal effort made possible now that separating out the AST via TTG has come to a close. As the AST in 'L.H.S' has been incrementally separated from the GHC internals, there are many accumulated orphan instance of 'Binary', 'NFData', 'Outputable', and 'Uniquable'. The orphan instance of data-types from within 'L.H.S' have had their orphan instances moved to either: 1. The module which defines the data-type 2. The module which defines the type-class; i.e. moving an orphan 'Binary' instance to 'GHC.Utils.Binary' Orphan instances resolved (37): | Data-type | Resolved instance(s) | Former orphan module(s) | | -------------------- | -------------------------- | ------------------------- | | Role | Binary, NFData, Outputable | GHC.Core.Coercion.Axiom | | SrcStrictness | Binary, NFData, Outputable | GHC.Core.DataCon | | SrcUnpackedness | Binary, NFData, Outputable | GHC.Core.DataCon | | Fixity | Binary, Outputable | GHC.Hs.Basic | | FixityDirection | Binary, Outputable | GHC.Hs.Basic | | LexicalFixity | Outputable | GHC.Hs.Basic | | CCallTarget | NFData | GHC.Hs.Decls.Foreign | | CType | NFData | GHC.Hs.Decls.Foreign | | Header | NFData | GHC.Hs.Decls.Foreign | | OverlapMode | Binary, NFData | GHC.Hs.Decls.Overlap | | WithHsDocIdentifiers | NFData, Outputable | GHC.Hs.Doc | | HsDocString | NFData | GHC.Hs.DocString | | HsDocStringChunk | Binary, Outputable | GHC.Hs.DocString | | HsDocStringDecorator | Binary, Outputable | GHC.Hs.DocString | | NamespaceSpecifier | Outputable | GHC.Hs.ImpExp | | ForAllTyFlag | Binary, NFData, Outputable | GHC.Hs.Specificity | | Specificity | Binary, NFData | GHC.Hs.Specificity | | PromotionFlag | Binary, Outputable | GHC.Types.Basic | | FieldLabelString | Outputable, Uniquable | GHC.Types.FieldLabel | | InlinePragma | Binary | GHC.Types.InlinePragma | ------------------------- Metric Decrease: hard_hole_fits ------------------------- Closes #21262, #27469 - - - - - ab9ab895 by Cheng Shao at 2026-07-21T17:10:53-04:00 rts: always use StgInt to represent cost center id Currently cost center id is modeled as `Int` and it should be `StgInt` uniformly in the RTS, hence this patch. Fixes #27524. - - - - - 034c515c by Cheng Shao at 2026-07-22T07:00:21-04:00 hadrian: clean up stale cabal package flags in the tree This patch cleans up stale cabal package flags in the tree and related hadrian/autoconf logic. Closes #27474. Co-authored-by: Codex <codex(a)openai.com> - - - - - b4e8470a by Sasha Bogicevic at 2026-07-22T07:00:21-04:00 parser: don't suggest ImportQualifiedPost when it is already enabled -Wprepositive-qualified-module unconditionally attached a hint to enable ImportQualifiedPost, even when the extension was already on (as it is by default under GHC2021). Record the extension's state in the PsWarnImportPreQualified diagnostic and drop the hint when it is already enabled. Fixes #27380 - - - - - 47 changed files: - + changelog.d/27380 - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/ImpExp.hs - − compiler/GHC/Hs/Specificity.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Doc.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Specificity.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - hadrian/cfg/system.config.host.in - hadrian/cfg/system.config.target.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Packages.hs - m4/fp_check_pthreads.m4 - rts/Profiling.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/rts.cabal - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/module/T27380.hs - + testsuite/tests/module/T27380.stderr - testsuite/tests/module/all.T - testsuite/tests/module/mod184.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8ef4cb458d8cae1d6a4a314a78e8a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8ef4cb458d8cae1d6a4a314a78e8a… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/andreask/arm-ffi] 7 commits: Improve error messages for invalid record wildcards
by Andreas Klebinger (＠AndreasK) 22 Jul '26

22 Jul '26

Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC Commits: c2f6dcd4 by Sasha Bogicevic at 2026-07-20T10:31:56+02:00 Improve error messages for invalid record wildcards Record wildcard hints are now shown in more contexts and include constructor arity; matching with `..` on a fieldless constructor now produces a dedicated error message. Fixes #21101 - - - - - 4c02e76b by Duncan Coutts at 2026-07-21T10:37:21-04:00 Mark test T27105 as fragile, citing issue #27522 Scheduler fairness is fine, except when it isn't. And it isn't on CI machines surprisingly often! See the issue for details. - - - - - 43dd2b15 by Recursion Ninja at 2026-07-21T17:09:53-04:00 Resolving many TTG related orphan type-class instances This is part a technical debt removal effort made possible now that separating out the AST via TTG has come to a close. As the AST in 'L.H.S' has been incrementally separated from the GHC internals, there are many accumulated orphan instance of 'Binary', 'NFData', 'Outputable', and 'Uniquable'. The orphan instance of data-types from within 'L.H.S' have had their orphan instances moved to either: 1. The module which defines the data-type 2. The module which defines the type-class; i.e. moving an orphan 'Binary' instance to 'GHC.Utils.Binary' Orphan instances resolved (37): | Data-type | Resolved instance(s) | Former orphan module(s) | | -------------------- | -------------------------- | ------------------------- | | Role | Binary, NFData, Outputable | GHC.Core.Coercion.Axiom | | SrcStrictness | Binary, NFData, Outputable | GHC.Core.DataCon | | SrcUnpackedness | Binary, NFData, Outputable | GHC.Core.DataCon | | Fixity | Binary, Outputable | GHC.Hs.Basic | | FixityDirection | Binary, Outputable | GHC.Hs.Basic | | LexicalFixity | Outputable | GHC.Hs.Basic | | CCallTarget | NFData | GHC.Hs.Decls.Foreign | | CType | NFData | GHC.Hs.Decls.Foreign | | Header | NFData | GHC.Hs.Decls.Foreign | | OverlapMode | Binary, NFData | GHC.Hs.Decls.Overlap | | WithHsDocIdentifiers | NFData, Outputable | GHC.Hs.Doc | | HsDocString | NFData | GHC.Hs.DocString | | HsDocStringChunk | Binary, Outputable | GHC.Hs.DocString | | HsDocStringDecorator | Binary, Outputable | GHC.Hs.DocString | | NamespaceSpecifier | Outputable | GHC.Hs.ImpExp | | ForAllTyFlag | Binary, NFData, Outputable | GHC.Hs.Specificity | | Specificity | Binary, NFData | GHC.Hs.Specificity | | PromotionFlag | Binary, Outputable | GHC.Types.Basic | | FieldLabelString | Outputable, Uniquable | GHC.Types.FieldLabel | | InlinePragma | Binary | GHC.Types.InlinePragma | ------------------------- Metric Decrease: hard_hole_fits ------------------------- Closes #21262, #27469 - - - - - ab9ab895 by Cheng Shao at 2026-07-21T17:10:53-04:00 rts: always use StgInt to represent cost center id Currently cost center id is modeled as `Int` and it should be `StgInt` uniformly in the RTS, hence this patch. Fixes #27524. - - - - - 2bbd4edf by Andreas Klebinger at 2026-07-22T12:39:45+02:00 cmm: Add machop width info with -dppr-debug for infix ops. - - - - - 1d093afe by Andreas Klebinger at 2026-07-22T12:39:45+02:00 Add test for #27430. - - - - - 36b23456 by Andreas Klebinger at 2026-07-22T12:39:45+02:00 arm64 ncg: Fix subword handling of ffi calls. Our invariants require us to clear the high bits for subword results. We now do so both for unspecified bit casts (MO_CONV_XX) and when taking in results from ffi calls. I also renamed truncateReg to make it clear it changes the register. - - - - - 57 changed files: - + changelog.d/21101 - + changelog.d/T27430 - compiler/GHC/Cmm/Expr.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/ImpExp.hs - − compiler/GHC/Hs/Specificity.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Fixity.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/GREInfo.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Decls/Foreign.hs - compiler/Language/Haskell/Syntax/Doc.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - compiler/Language/Haskell/Syntax/Specificity.hs - compiler/ghc.cabal.in - rts/Profiling.c - rts/Trace.c - rts/Trace.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - + testsuite/tests/codeGen/should_run/T27430.hs - + testsuite/tests/codeGen/should_run/T27430.stdout - + testsuite/tests/codeGen/should_run/T27430_c.c - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/T27105.hs - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/rename/should_fail/T21101.hs - + testsuite/tests/rename/should_fail/T21101.stderr - testsuite/tests/rename/should_fail/T9815.stderr - testsuite/tests/rename/should_fail/T9815b.stderr - testsuite/tests/rename/should_fail/T9815bghci.stderr - testsuite/tests/rename/should_fail/T9815ghci.stderr - testsuite/tests/rename/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28318419db7ac06675ea6eb450113f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28318419db7ac06675ea6eb450113f… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/io-manager-deadlock-detection] 2 commits: FIXUP Make signal handling be a respondibility of the I/O manager(s)
by Duncan Coutts (＠dcoutts) 22 Jul '26

22 Jul '26

Duncan Coutts pushed to branch wip/io-manager-deadlock-detection at Glasgow Haskell Compiler / GHC Commits: 11004739 by Duncan Coutts at 2026-07-22T10:39:13+01:00 FIXUP Make signal handling be a respondibility of the I/O manager(s) In select, we need to check for signals when we poll for I/O, as well as when select itself gets interupted by a signal. This matches what we do in the poll I/O manager. - - - - - 46bb53d6 by Duncan Coutts at 2026-07-22T10:55:06+01:00 FIXUP: Clean up the RTS internal signal handling API - - - - - 2 changed files: - rts/posix/Select.c - rts/posix/Signals.c Changes: ===================================== rts/posix/Select.c ===================================== @@ -277,8 +277,16 @@ awaitCompletedTimeoutsOrIOSelect(CapIOManager *iomgr, bool wait) do { now = getLowResTimeOfDay(); - if (wakeUpSleepingThreads(iomgr, now)) { - return true; + wakeUpSleepingThreads(iomgr, now); +#if defined(RTS_USER_SIGNALS) + startPendingSignalHandlers(iomgr->cap); +#endif + /* If either of the above (checking for timers or signal) caused threads + * to be started (or if the run queue was non-empty in the first place), + * then poll for I/O but don't block waiting. + */ + if (!emptyRunQueue(iomgr->cap)) { + wait = false; } /* ===================================== rts/posix/Signals.c ===================================== @@ -340,6 +340,9 @@ startPendingSignalHandlers(Capability *cap) // freed by runHandler memcpy(info, next_pending_handler, sizeof(siginfo_t)); + debugTrace(DEBUG_iomanager, + "Handling pending signal, no %d", info->si_signo); + StgTSO *t = createIOThread(cap, RtsFlags.GcFlags.initialStkSize, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c458d21e0f9406160c6d278a77777… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c458d21e0f9406160c6d278a77777… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/hadrian-uncompressed-tar] hadrian: allow building binary dist tar without compression
by Magnus (＠MangoIV) 22 Jul '26

22 Jul '26

Magnus pushed to branch wip/mangoiv/hadrian-uncompressed-tar at Glasgow Haskell Compiler / GHC Commits: 62f729b9 by mangoiv at 2026-07-22T11:29:08+02:00 hadrian: allow building binary dist tar without compression - - - - - 2 changed files: - + changelog.d/hadrian-uncompressed-tar - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== changelog.d/hadrian-uncompressed-tar ===================================== @@ -0,0 +1,5 @@ +section: packaging +synopsis: Hadrian can now create an uncompressed tar as the release artifact + by building the target binary-dist-tar +issues: #27510 +mrs: !16349 ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -365,16 +365,17 @@ bindistRules = do -- Finally, we create the archive <root>/bindist/ghc-X.Y.Z-platform.tar.xz tarPath <- builderPath (Tar Create) - cmd [Cwd $ root -/- bindist_folder] tarPath - [ "-c", compressorTarFlag compressor, "-f" - , ghcVersionPretty <.> "tar" <.> compressorExtension compressor - , ghcVersionPretty ] + cmd [Cwd $ root -/- bindist_folder] tarPath $ + [ "-c" + , "-f" , applyCompressorExtension compressor $ ghcVersionPretty <.> "tar" + , ghcVersionPretty ] <> compressorTarFlags compressor forM_ [("binary", buildBinDist), ("reloc-binary", buildBinDistReloc)] $ \(name, mk_bindist) -> do phony (name <> "-dist") $ mk_bindist Xz phony (name <> "-dist-gzip") $ mk_bindist Gzip phony (name <> "-dist-bzip2") $ mk_bindist Bzip2 phony (name <> "-dist-xz") $ mk_bindist Xz + phony (name <> "-dist-tar") $ mk_bindist NoCompressor phony "binary-dist-cross" $ buildBinDistX "binary-dist-dir-cross" "bindist" Xz phony "binary-dist-stage3" $ buildBinDistX "binary-dist-dir-stage3" "bindist" Xz @@ -430,7 +431,7 @@ bindistRules = do fixup f | f `elem` ["INSTALL", "README"] = "distrib" -/- f | otherwise = f -data Compressor = Gzip | Bzip2 | Xz +data Compressor = Gzip | Bzip2 | Xz | NoCompressor deriving (Eq, Ord, Show) @@ -447,17 +448,19 @@ generateBuildMk BindistConfig{..} = do where a =. b = a ++ " = " ++ b --- | Flag to pass to tar to use the given 'Compressor'. -compressorTarFlag :: Compressor -> String -compressorTarFlag Gzip = "--gzip" -compressorTarFlag Xz = "--xz" -compressorTarFlag Bzip2 = "--bzip" - --- | File extension to use for archives compressed with the given 'Compressor'. -compressorExtension :: Compressor -> String -compressorExtension Gzip = "gz" -compressorExtension Xz = "xz" -compressorExtension Bzip2 = "bz2" +-- | Flags to pass to @tar@ to use the given 'Compressor'. +compressorTarFlags :: Compressor -> [String] +compressorTarFlags Gzip = ["--gzip"] +compressorTarFlags Xz = ["--xz" ] +compressorTarFlags Bzip2 = ["--bzip"] +compressorTarFlags NoCompressor = [] + +-- | File extension to use for archives @p@ compressed with the given 'Compressor'. +applyCompressorExtension :: Compressor -> String -> String +applyCompressorExtension Gzip p = p <.> "gz" +applyCompressorExtension Xz p = p <.> "xz" +applyCompressorExtension Bzip2 p = p <.> "bz2" +applyCompressorExtension NoCompressor p = p -- | A list of files that allow us to support a simple -- @./configure [...] && make install@ workflow. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62f729b9aad719a933b9dadb0139d4d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62f729b9aad719a933b9dadb0139d4d… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/hadrian-uncompressed-tar] hadrian: allow building binary dist tar without compression
by Magnus (＠MangoIV) 22 Jul '26

22 Jul '26

Magnus pushed to branch wip/mangoiv/hadrian-uncompressed-tar at Glasgow Haskell Compiler / GHC Commits: fdb6e961 by mangoiv at 2026-07-22T11:25:58+02:00 hadrian: allow building binary dist tar without compression - - - - - 1 changed file: - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -365,16 +365,17 @@ bindistRules = do -- Finally, we create the archive <root>/bindist/ghc-X.Y.Z-platform.tar.xz tarPath <- builderPath (Tar Create) - cmd [Cwd $ root -/- bindist_folder] tarPath - [ "-c", compressorTarFlag compressor, "-f" - , ghcVersionPretty <.> "tar" <.> compressorExtension compressor - , ghcVersionPretty ] + cmd [Cwd $ root -/- bindist_folder] tarPath $ + [ "-c" + , "-f" , applyCompressorExtension compressor $ ghcVersionPretty <.> "tar" + , ghcVersionPretty ] <> compressorTarFlags compressor forM_ [("binary", buildBinDist), ("reloc-binary", buildBinDistReloc)] $ \(name, mk_bindist) -> do phony (name <> "-dist") $ mk_bindist Xz phony (name <> "-dist-gzip") $ mk_bindist Gzip phony (name <> "-dist-bzip2") $ mk_bindist Bzip2 phony (name <> "-dist-xz") $ mk_bindist Xz + phony (name <> "-dist-tar") $ mk_bindist NoCompressor phony "binary-dist-cross" $ buildBinDistX "binary-dist-dir-cross" "bindist" Xz phony "binary-dist-stage3" $ buildBinDistX "binary-dist-dir-stage3" "bindist" Xz @@ -430,7 +431,7 @@ bindistRules = do fixup f | f `elem` ["INSTALL", "README"] = "distrib" -/- f | otherwise = f -data Compressor = Gzip | Bzip2 | Xz +data Compressor = Gzip | Bzip2 | Xz | NoCompressor deriving (Eq, Ord, Show) @@ -447,17 +448,19 @@ generateBuildMk BindistConfig{..} = do where a =. b = a ++ " = " ++ b --- | Flag to pass to tar to use the given 'Compressor'. -compressorTarFlag :: Compressor -> String -compressorTarFlag Gzip = "--gzip" -compressorTarFlag Xz = "--xz" -compressorTarFlag Bzip2 = "--bzip" - --- | File extension to use for archives compressed with the given 'Compressor'. -compressorExtension :: Compressor -> String -compressorExtension Gzip = "gz" -compressorExtension Xz = "xz" -compressorExtension Bzip2 = "bz2" +-- | Flags to pass to @tar@ to use the given 'Compressor'. +compressorTarFlags :: Compressor -> [String] +compressorTarFlags Gzip = ["--gzip"] +compressorTarFlags Xz = ["--xz" ] +compressorTarFlags Bzip2 = ["--bzip"] +compressorTarFlags NoCompressor = [] + +-- | File extension to use for archives @p@ compressed with the given 'Compressor'. +applyCompressorExtension :: Compressor -> String -> String +applyCompressorExtension Gzip p = p <.> "gz" +applyCompressorExtension Xz p = p <.> "xz" +applyCompressorExtension Bzip2 p = p <.> "bz2" +applyCompressorExtension NoCompressor p = p -- | A list of files that allow us to support a simple -- @./configure [...] && make install@ workflow. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fdb6e961d404674c772bd19530f57c1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fdb6e961d404674c772bd19530f57c1… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0

[Git][ghc/ghc][wip/mangoiv/hadrian-uncompressed-tar] hadrian: allow building binary dist tar without compression
by Magnus (＠MangoIV) 22 Jul '26

22 Jul '26

Magnus pushed to branch wip/mangoiv/hadrian-uncompressed-tar at Glasgow Haskell Compiler / GHC Commits: 95f27356 by mangoiv at 2026-07-22T11:25:02+02:00 hadrian: allow building binary dist tar without compression - - - - - 1 changed file: - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -365,16 +365,17 @@ bindistRules = do -- Finally, we create the archive <root>/bindist/ghc-X.Y.Z-platform.tar.xz tarPath <- builderPath (Tar Create) - cmd [Cwd $ root -/- bindist_folder] tarPath - [ "-c", compressorTarFlag compressor, "-f" - , ghcVersionPretty <.> "tar" <.> compressorExtension compressor - , ghcVersionPretty ] + cmd [Cwd $ root -/- bindist_folder] tarPath $ + [ "-c" + , "-f" , applyCompressorExtension compressor $ ghcVersionPretty <.> "tar" + , ghcVersionPretty ] <> compressorTarFlags compressor forM_ [("binary", buildBinDist), ("reloc-binary", buildBinDistReloc)] $ \(name, mk_bindist) -> do phony (name <> "-dist") $ mk_bindist Xz phony (name <> "-dist-gzip") $ mk_bindist Gzip phony (name <> "-dist-bzip2") $ mk_bindist Bzip2 phony (name <> "-dist-xz") $ mk_bindist Xz + phony (name <> "-dist-uncompressed") $ mk_bindist NoCompressor phony "binary-dist-cross" $ buildBinDistX "binary-dist-dir-cross" "bindist" Xz phony "binary-dist-stage3" $ buildBinDistX "binary-dist-dir-stage3" "bindist" Xz @@ -430,7 +431,7 @@ bindistRules = do fixup f | f `elem` ["INSTALL", "README"] = "distrib" -/- f | otherwise = f -data Compressor = Gzip | Bzip2 | Xz +data Compressor = Gzip | Bzip2 | Xz | NoCompressor deriving (Eq, Ord, Show) @@ -447,17 +448,19 @@ generateBuildMk BindistConfig{..} = do where a =. b = a ++ " = " ++ b --- | Flag to pass to tar to use the given 'Compressor'. -compressorTarFlag :: Compressor -> String -compressorTarFlag Gzip = "--gzip" -compressorTarFlag Xz = "--xz" -compressorTarFlag Bzip2 = "--bzip" - --- | File extension to use for archives compressed with the given 'Compressor'. -compressorExtension :: Compressor -> String -compressorExtension Gzip = "gz" -compressorExtension Xz = "xz" -compressorExtension Bzip2 = "bz2" +-- | Flags to pass to @tar@ to use the given 'Compressor'. +compressorTarFlags :: Compressor -> [String] +compressorTarFlags Gzip = ["--gzip"] +compressorTarFlags Xz = ["--xz" ] +compressorTarFlags Bzip2 = ["--bzip"] +compressorTarFlags NoCompressor = [] + +-- | File extension to use for archives @p@ compressed with the given 'Compressor'. +applyCompressorExtension :: Compressor -> String -> String +applyCompressorExtension Gzip p = p <.> "gz" +applyCompressorExtension Xz p = p <.> "xz" +applyCompressorExtension Bzip2 p = p <.> "bz2" +applyCompressorExtension NoCompressor p = p -- | A list of files that allow us to support a simple -- @./configure [...] && make install@ workflow. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95f273568998f5f0cdff7ab60908157… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95f273568998f5f0cdff7ab60908157… You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

1 0