- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/sjakobi/T16720] 2 commits: testsuite: Reorder and bound the repeated failure output
by Simon Jakobi (＠sjakobi2) 17 Jun '26

17 Jun '26

Simon Jakobi pushed to branch wip/sjakobi/T16720 at Glasgow Haskell Compiler / GHC Commits: 1d2672c0 by Simon Jakobi at 2026-06-16T19:31:45+02:00 testsuite: Reorder and bound the repeated failure output Address review feedback on !16166: - Print the repeated failure output first, so the TEST= list, counts and failure lists stay at the very end of the log where readers look for them. - Skip the output entirely above MAX_SUMMARY_OUTPUT_TESTS unexpected failures, where the dump would drown out the summary and junit.xml is the better tool. Co-Authored-By: Claude Opus 4.8 <noreply(a)anthropic.com> - - - - - e538a384 by Simon Jakobi at 2026-06-16T19:31:45+02:00 DO NOT MERGE: Break some tests to exercise the failure summary Deliberately break three tests, one per failure mode, to see the new end-of-run failure output in CI: * cgrun001: wrong expected stdout -> bad stdout (diff in summary) * T18619: wrong expected stderr -> bad stderr (diff in summary) * cgrun002: program now exits 3 and writes to stderr -> bad exit code, exercising the newly captured run stdout/stderr in simple_run Co-Authored-By: Claude Fable 5 <noreply(a)anthropic.com> - - - - - 5 changed files: - testsuite/driver/runtests.py - testsuite/driver/testlib.py - testsuite/tests/codeGen/should_run/cgrun001.stdout - testsuite/tests/codeGen/should_run/cgrun002.hs - testsuite/tests/numeric/should_run/T18619.stderr Changes: ===================================== testsuite/driver/runtests.py ===================================== @@ -591,7 +591,7 @@ else: print(Perf.allow_changes_string([(m.change, m.stat) for m in t.metrics])) print('-' * 25) - summary(t, sys.stdout, color=term_color.enable_color) + summary(t, sys.stdout, color=term_color.enable_color, junit_path=args.junit) # Write perf stats if any exist or if a metrics file is specified. stats_metrics = [stat for (_, stat, __) in t.metrics] # type: List[PerfStat] ===================================== testsuite/driver/testlib.py ===================================== @@ -3527,9 +3527,22 @@ def findTFiles(roots: List[str]) -> Iterator[str]: # ----------------------------------------------------------------------------- # Output a test summary to the specified file object -def summary(t: TestRun, file: TextIO, color=False) -> None: +def summary(t: TestRun, file: TextIO, color=False, junit_path: Optional[Path]=None) -> None: file.write('\n') + + if t.unexpected_failures: + if len(t.unexpected_failures) > MAX_SUMMARY_OUTPUT_TESTS: + # junit.xml only exists when a path was requested (e.g. in CI); don't + # point at a file that a local run never wrote. + where = 'see {}'.format(junit_path) if junit_path \ + else 'rerun them individually' + file.write('Output of {} unexpected failures omitted (limit {}); {}.\n\n' + .format(len(t.unexpected_failures), MAX_SUMMARY_OUTPUT_TESTS, where)) + else: + file.write('Output of unexpected failures:\n\n') + printTestOutputSummary(file, t.unexpected_failures, color, junit_path) + printUnexpectedTests(file, [t.unexpected_passes, t.unexpected_failures, t.unexpected_stat_failures, t.framework_failures]) @@ -3596,10 +3609,6 @@ def summary(t: TestRun, file: TextIO, color=False) -> None: file.write('Framework warnings:\n') printTestInfosSummary(file, t.framework_warnings) - if t.unexpected_failures: - file.write('Output of unexpected failures:\n\n') - printTestOutputSummary(file, t.unexpected_failures, color) - if stopping(): file.write('WARNING: Testsuite run was terminated early\n') @@ -3616,9 +3625,15 @@ def printUnexpectedTests(file: TextIO, testInfoss): # Per-stream cap on a failing test's output repeated in the final summary. MAX_SUMMARY_OUTPUT_LINES = 100 -def printTestOutputSummary(file: TextIO, testInfos, color: bool=False) -> None: +# Above this many unexpected failures, skip repeating output entirely: the +# dump would drown out the summary. +MAX_SUMMARY_OUTPUT_TESTS = 20 + +def printTestOutputSummary(file: TextIO, testInfos, color: bool=False, + junit_path: Optional[Path]=None) -> None: # Repeat failing tests' captured output in the summary, so one needn't # hunt for it earlier in a possibly very long log; see #16720. + where = ', see {}'.format(junit_path) if junit_path else '' for result in sorted(testInfos, key=lambda r: (r.testname.lower(), r.way, r.directory)): header = '=====> {}({}) [{}]'.format(result.testname, result.way, result.reason) if color: @@ -3633,7 +3648,7 @@ def printTestOutputSummary(file: TextIO, testInfos, color: bool=False) -> None: if len(lines) > MAX_SUMMARY_OUTPUT_LINES: omitted = len(lines) - MAX_SUMMARY_OUTPUT_LINES lines = lines[:MAX_SUMMARY_OUTPUT_LINES] \ - + ['... ({} more lines omitted, see junit.xml)'.format(omitted)] + + ['... ({} more lines omitted{})'.format(omitted, where)] s = label + '\n' + ''.join(l + '\n' for l in lines) # Test output can contain characters that file's encoding # cannot represent; replace rather than crash (cf safe_print). ===================================== testsuite/tests/codeGen/should_run/cgrun001.stdout ===================================== @@ -1 +1 @@ --42 +-43 ===================================== testsuite/tests/codeGen/should_run/cgrun002.hs ===================================== @@ -1,4 +1,10 @@ -main = print ((f id2) (10 + thirty_two)) +import System.Exit +import System.IO + +main = do + print ((f id2) (10 + thirty_two)) + hPutStrLn stderr "deliberate breakage to test summary output" + exitWith (ExitFailure 3) where f x = g x where ===================================== testsuite/tests/numeric/should_run/T18619.stderr ===================================== @@ -1,3 +1,3 @@ T18619: Uncaught exception ghc-internal:GHC.Internal.Exception.Type.ArithException: -arithmetic overflow +arithmetic underflow View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18e8c673894f55b7eb06cd9ec2fc3f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18e8c673894f55b7eb06cd9ec2fc3f… 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: Hadrian: fix ghc-internal .def file name
by Marge Bot (＠marge-bot) 16 Jun '26

16 Jun '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1314f2fd by David Eichmann at 2026-06-16T05:46:52-04:00 Hadrian: fix ghc-internal .def file name - - - - - 7f72bcb3 by mangoiv at 2026-06-16T05:47:39-04:00 compiler: ignore camelCase and Eta reduce hlint hints These do not cohere with the style used in GHC. After disabling them, hlint lints are much less noisy again. - - - - - 842bef9f by Alan Zimmerman at 2026-06-16T05:48:25-04:00 EPA: Use standard type family declaration for Anno - - - - - 38b3e94d by Wolfgang Jeltsch at 2026-06-16T11:32:09-04:00 Fix two issues in the documentation of pipeline interruption One issue is a typo (“interreuptible”), the other one the lack of an end of a sentence, which has been reconstructed from the message of 633bbc1fd4762a2bb73ba1c5b9e0c279f1dd3c40, the commit that introduced said documentation. - - - - - 678ee355 by Christian Georgii at 2026-06-16T11:32:13-04:00 Find plugins in sibling home units in multiple-home-unit sessions In a multiple-home-unit session (e.g. `cabal repl --enable-multi-repl` or HLS), enabling a plugin with -fplugin that is defined in (or reexported by) another home unit failed with a "hidden package" error. The plugin module finder only searched the current home unit and the registered external packages, never the sibling home units. findPluginModuleNoHsc now searches the home units that the current home unit depends on, following module reexports and respecting hidden modules, exactly as ordinary import resolution does in findImportedModuleNoHsc. To avoid two divergent copies of this logic, the shared home-unit search (the current home unit first, then its dependencies in priority order, with the accompanying ordering invariant) is extracted into findHomeModuleAmongDeps, which both findImportedModuleNoHsc and findPluginModuleNoHsc now call. Add testsuite/tests/driver/multipleHomeUnits/plugin01, which loads a plugin as byte-code from a sibling home unit, and plugin02, in which the consumer enables a plugin reexported by a sibling home unit without depending on the plugin's own home unit directly. Fixes #27349 - - - - - 18 changed files: - .gitlab-ci.yml - + changelog.d/fix-plugin-finder-multi-home-unit.md - compiler/.hlint.yaml - compiler/GHC/Unit/Finder.hs - compiler/Language/Haskell/Syntax/Extension.hs - hadrian/src/Rules/Rts.hs - + testsuite/tests/driver/multipleHomeUnits/plugin01/all.T - + testsuite/tests/driver/multipleHomeUnits/plugin01/appunit - + testsuite/tests/driver/multipleHomeUnits/plugin01/p/MyPlugin.hs - + testsuite/tests/driver/multipleHomeUnits/plugin01/pluginunit - + testsuite/tests/driver/multipleHomeUnits/plugin01/q/App.hs - + testsuite/tests/driver/multipleHomeUnits/plugin02/all.T - + testsuite/tests/driver/multipleHomeUnits/plugin02/appunit - + testsuite/tests/driver/multipleHomeUnits/plugin02/p/MyPlugin.hs - + testsuite/tests/driver/multipleHomeUnits/plugin02/pluginunit - + testsuite/tests/driver/multipleHomeUnits/plugin02/q/App.hs - + testsuite/tests/driver/multipleHomeUnits/plugin02/r/RexLib.hs - + testsuite/tests/driver/multipleHomeUnits/plugin02/reexportunit Changes: ===================================== .gitlab-ci.yml ===================================== @@ -194,8 +194,9 @@ workflow: # https://gitlab.com/gitlab-org/gitlab/-/issues/32837) This leads to the # hack in this MR where by default all jobs are `interruptible: True`, but # for pipelines we definitely want to run, there is a dummy job which -# happens first, which is `interreuptible: False`. This has the effect of -# dirtying the whole pipeline and +# happens first, which is `interruptible: False`. This has the effect of +# dirtying the whole pipeline and preventing another push to master from +# cancelling it. # # For now, this patch solves the immediate problem of making sure nightly # jobs are not cancelled. ===================================== changelog.d/fix-plugin-finder-multi-home-unit.md ===================================== @@ -0,0 +1,7 @@ +section: compiler +synopsis: Find plugins defined in sibling home units in multiple-home-unit sessions +issues: #27349 +mrs: !16156 +description: { + In a multiple-home-unit session (e.g. ``cabal repl --enable-multi-repl`` or HLS), the plugin finder now also searches the home units that the current home unit depends on, following module reexports along the way, so a ``-fplugin`` defined in (or reexported by) a sibling home unit is found and loaded instead of failing as a hidden package. +} ===================================== compiler/.hlint.yaml ===================================== @@ -3,6 +3,8 @@ ########################## - ignore: {} +- ignore: {name: Use camelCase} +- ignore: {name: Eta reduce} - warn: {name: Unused LANGUAGE pragma} - warn: {name: Use fewer LANGUAGE pragmas} - warn: {name: Redundant return} ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -231,36 +231,14 @@ findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit NoPackage (panic "findImportedModule: no home-unit") home_pkg_import :: (UnitId, FinderOpts) -> IO FindResult - home_pkg_import (uid, opts) - -- If the module is reexported, then look for it as if it was from the - -- perspective of that package which reexports it. - | Just real_mod_name - <- lookupUniqMap (finder_reexportedModules opts) mod_name - = findImportedModuleNoHsc fc opts ue home_module_name_providers_map - (Just $ DefiniteHomeUnit uid Nothing) - real_mod_name - NoPkgQual - | elementOfUniqSet mod_name (finder_hiddenModules opts) - = return (mkHomeHidden uid) - | otherwise - = findHomePackageModule fc opts uid mod_name - - any_home_import :: IO FindResult - any_home_import = foldr1 orIfNotFound $ - home_import :| map home_pkg_import other_fopts - -- Do not try to be smart and change this to `foldr orIfNotFound home_import - -- (map home_pkg_import other_fopts)`, as that would not be the same. - -- `home_import` is first because we need to first look within the current - -- unit before looking at the other units in order. + home_pkg_import = findHomeUnitDepModule fc ue home_module_name_providers_map mod_name pkg_import :: IO FindResult pkg_import = findExposedPackageModule fc fopts unit_state mod_name mb_pkg unqual_import :: IO FindResult - unqual_import - = any_home_import - `orIfNotFound` - findExposedPackageModule fc fopts unit_state mod_name NoPkgQual + unqual_import = findHomeOrRegularPackageModule fc fopts ue + home_module_name_providers_map mb_home_unit mod_name unit_state :: UnitState unit_state = case mb_home_unit_id of @@ -268,22 +246,44 @@ findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit Just home_unit_id -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv home_unit_id ue - home_unit_deps :: Set UnitId - home_unit_deps = homeUnitDepends unit_state + other_fopts :: [(UnitId, FinderOpts)] + other_fopts = homeUnitDepsFinderOpts ue home_module_name_providers_map + unit_state mod_name + +-- | Locate a plugin module requested by the user, for a compiler +-- plugin. This consults the same set of exposed packages as +-- 'findImportedModule', unless @-hide-all-plugin-packages@ or +-- @-plugin-package@ are specified. +findPluginModuleNoHsc + :: FinderCache + -> FinderOpts + -> UnitEnv + -> HomeModuleNameProvidersMap + -> Maybe HomeUnit + -> ModuleName + -> IO FindResult +findPluginModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit@(Just home_unit) mod_name = + findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map + mb_home_unit mod_name + `orIfNotFound` + findExposedPluginPackageModule fc fopts unit_state mod_name + where + unit_state = HUG.homeUnitEnv_units $ + ue_findHomeUnitEnv (homeUnitId home_unit) ue +findPluginModuleNoHsc fc fopts ue _ Nothing mod_name = + findExposedPluginPackageModule fc fopts (ue_homeUnitState ue) mod_name - ranked_home_unit_deps :: [UnitId] - ranked_home_unit_deps = rankedHomeUnitDeps home_module_name_providers_map - mod_name - home_unit_deps +findPluginModule :: HscEnv -> ModuleName -> IO FindResult +findPluginModule hsc_env mod_name = do + let fc = hsc_FC hsc_env + mb_home_unit = hsc_home_unit_maybe hsc_env + home_module_name_providers_map = + mgHomeModuleNameProvidersMap (hsc_mod_graph hsc_env) + findPluginModuleNoHsc fc (initFinderOpts (hsc_dflags hsc_env)) + (hsc_unit_env hsc_env) home_module_name_providers_map mb_home_unit mod_name - other_fopts :: [(UnitId, FinderOpts)] - other_fopts - = [ - (uid, opts) | - uid <- ranked_home_unit_deps, - let opts = initFinderOpts $ - homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue) - ] +-- ----------------------------------------------------------------------------- +-- Home Module Finder Helpers -- | Yields the unit IDs from the given set as a list with those that refer to -- providers of the given home module name coming first. This is to prioritize @@ -323,24 +323,93 @@ rankedHomeUnitDeps home_module_name_providers_map mod_name home_unit_deps uncached_deps :: Set UnitId uncached_deps = Set.difference home_unit_deps cached_providers --- | Locate a plugin module requested by the user, for a compiler --- plugin. This consults the same set of exposed packages as --- 'findImportedModule', unless @-hide-all-plugin-packages@ or --- @-plugin-package@ are specified. -findPluginModuleNoHsc :: FinderCache -> FinderOpts -> UnitState -> Maybe HomeUnit -> ModuleName -> IO FindResult -findPluginModuleNoHsc fc fopts units (Just home_unit) mod_name = - findHomeModule fc fopts home_unit mod_name - `orIfNotFound` - findExposedPluginPackageModule fc fopts units mod_name -findPluginModuleNoHsc fc fopts units Nothing mod_name = - findExposedPluginPackageModule fc fopts units mod_name +-- | The 'FinderOpts' of the home units that should be searched, sorted by +-- priority order specified by 'rankedHomeUnitDeps'. +homeUnitDepsFinderOpts + :: UnitEnv + -> HomeModuleNameProvidersMap + -> UnitState -- ^ unit state of the requesting home unit + -> ModuleName + -> [(UnitId, FinderOpts)] +homeUnitDepsFinderOpts ue home_module_name_providers_map unit_state mod_name = + [ (uid, initFinderOpts (ue_unitFlags uid ue)) + | uid <- rankedHomeUnitDeps home_module_name_providers_map mod_name + (homeUnitDepends unit_state) + ] + +-- | Search for @mod_name@ in the given home unit. +findHomeUnitDepModule + :: FinderCache + -> UnitEnv + -> HomeModuleNameProvidersMap + -> ModuleName + -> (UnitId, FinderOpts) + -> IO FindResult +findHomeUnitDepModule fc ue home_module_name_providers_map mod_name (uid, opts) + -- If the module is reexported, then look for it as if it was from the + -- perspective of the package which reexports it. + | Just real_mod_name + <- lookupUniqMap (finder_reexportedModules opts) mod_name + = findHomeOrRegularPackageModule fc opts ue home_module_name_providers_map + (Just $ DefiniteHomeUnit uid Nothing) + real_mod_name + | elementOfUniqSet mod_name (finder_hiddenModules opts) + = return (mkHomeHidden uid) + | otherwise + = findHomePackageModule fc opts uid mod_name + +-- | Search for @mod_name@ among the home units: first the current home unit, +-- then the home units it depends on, in priority order, following module +-- reexports along the way (see 'findHomeUnitDepModule'). Yields the first +-- successful result. +findHomeModuleAmongDeps + :: FinderCache + -> FinderOpts + -> UnitEnv + -> HomeModuleNameProvidersMap + -> Maybe HomeUnit + -> ModuleName + -> IO FindResult +findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map mb_home_unit mod_name = + foldr1 orIfNotFound (home_import :| map home_pkg_import other_fopts) + -- Do not try to be smart and change this to `foldr orIfNotFound home_import + -- (map home_pkg_import other_fopts)`, as that would not be the same. + -- `home_import` is first because we need to first look within the current + -- unit before looking at the other units in order. + where + home_import = case mb_home_unit of + Just home_unit -> findHomeModule fc fopts home_unit mod_name + Nothing -> pure $ + NoPackage (panic "findHomeModuleAmongDeps: no home-unit") + home_pkg_import = findHomeUnitDepModule fc ue home_module_name_providers_map mod_name -findPluginModule :: HscEnv -> ModuleName -> IO FindResult -findPluginModule hsc_env mod_name = do - let fc = hsc_FC hsc_env - let units = hsc_units hsc_env - let mb_home_unit = hsc_home_unit_maybe hsc_env - findPluginModuleNoHsc fc (initFinderOpts (hsc_dflags hsc_env)) units mb_home_unit mod_name + unit_state = case homeUnitId <$> mb_home_unit of + Nothing -> ue_homeUnitState ue + Just home_unit_id -> HUG.homeUnitEnv_units $ + ue_findHomeUnitEnv home_unit_id ue + other_fopts = homeUnitDepsFinderOpts ue home_module_name_providers_map + unit_state mod_name + +-- | Search the home-unit graph and otherwise the regular exposed package +-- database. +findHomeOrRegularPackageModule + :: FinderCache + -> FinderOpts + -> UnitEnv + -> HomeModuleNameProvidersMap + -> Maybe HomeUnit + -> ModuleName + -> IO FindResult +findHomeOrRegularPackageModule fc fopts ue home_module_name_providers_map mb_home_unit mod_name = + findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map + mb_home_unit mod_name + `orIfNotFound` + findExposedPackageModule fc fopts unit_state mod_name NoPkgQual + where + unit_state = case homeUnitId <$> mb_home_unit of + Nothing -> ue_homeUnitState ue + Just home_unit_id -> HUG.homeUnitEnv_units $ + ue_findHomeUnitEnv home_unit_id ue -- | A version of findExactModule which takes the exact parts of the HscEnv it needs ===================================== compiler/Language/Haskell/Syntax/Extension.hs ===================================== @@ -108,7 +108,7 @@ dataConCantHappen x = case x of {} -- See Note [XRec and SrcSpans in the AST] type family XRec p a = r | r -> a -type family Anno a = b -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation +type family Anno a -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation {- Note [XRec and SrcSpans in the AST] ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -25,7 +25,7 @@ buildGhcInternalImportDef target = do buildGhcInternalImportLib :: FilePath -> Action () buildGhcInternalImportLib target = do - let input = dropExtensions target <.> "def" -- the .def file + let input = dropExtension (dropExtension target) <.> "def" -- the .def file output = target -- the .dll.a import lib need [input] runBuilder Dlltool ["-d", input, "-l", output] [input] [output] ===================================== testsuite/tests/driver/multipleHomeUnits/plugin01/all.T ===================================== @@ -0,0 +1,14 @@ +# A plugin (MyPlugin, in home unit plugin-0) is enabled by a module (App, in +# home unit app-0) belonging to a *different* home unit in the same session. +# Resolving -fplugin must search sibling home units; previously the plugin +# finder only looked at the current home unit and registered external packages, +# so this failed with "Could not load module 'MyPlugin' ... hidden package". +# +# -fbyte-code-and-object-code -fprefer-byte-code makes the plugin load as +# byte-code from its (interpreted) home unit, mirroring how a multiple-home-unit +# session is driven by 'cabal repl --enable-multi-repl' and HLS. +test('multipleHomeUnits_plugin01', + [req_plugins, extra_files(['p/', 'q/', 'pluginunit', 'appunit'])], + multiunit_compile, + [['pluginunit', 'appunit'], + '-v0 -fbyte-code-and-object-code -fprefer-byte-code']) ===================================== testsuite/tests/driver/multipleHomeUnits/plugin01/appunit ===================================== @@ -0,0 +1 @@ +-working-dir q App -this-unit-id app-0 -this-package-name app -package-id plugin-0 ===================================== testsuite/tests/driver/multipleHomeUnits/plugin01/p/MyPlugin.hs ===================================== @@ -0,0 +1,8 @@ +module MyPlugin (plugin) where + +import GHC.Plugins + +-- A no-op plugin: it makes no changes to the program but, to run at all, it +-- must be found and loaded by the consumer module's compilation. +plugin :: Plugin +plugin = defaultPlugin { pluginRecompile = purePlugin } ===================================== testsuite/tests/driver/multipleHomeUnits/plugin01/pluginunit ===================================== @@ -0,0 +1 @@ +-working-dir p MyPlugin -this-unit-id plugin-0 -this-package-name plugin -package ghc ===================================== testsuite/tests/driver/multipleHomeUnits/plugin01/q/App.hs ===================================== @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fplugin=MyPlugin #-} +module App where + +-- The plugin 'MyPlugin' lives in a *sibling* home unit (plugin-0), not in a +-- registered package. Resolving -fplugin must therefore search sibling home +-- units, just like an ordinary import does. +app :: () +app = () ===================================== testsuite/tests/driver/multipleHomeUnits/plugin02/all.T ===================================== @@ -0,0 +1,16 @@ +# A plugin (MyPlugin) lives in home unit plugin-0 and is *reexported* by a +# second home unit, reexport-0 (via -reexported-module). The consumer module +# App, in home unit app-0, enables it with -fplugin=MyPlugin but depends only on +# reexport-0, not on plugin-0 directly. Resolving -fplugin must therefore follow +# the reexport through the sibling home unit, exactly as an ordinary import +# does. A home-unit search that ignores reexported-modules fails with +# "Could not load module 'MyPlugin' ... hidden package". +# +# -fbyte-code-and-object-code -fprefer-byte-code makes the plugin load as +# byte-code from its (interpreted) home unit, mirroring how a multiple-home-unit +# session is driven by 'cabal repl --enable-multi-repl' and HLS. +test('multipleHomeUnits_plugin02', + [req_plugins, extra_files(['p/', 'q/', 'r/', 'pluginunit', 'reexportunit', 'appunit'])], + multiunit_compile, + [['pluginunit', 'reexportunit', 'appunit'], + '-v0 -fbyte-code-and-object-code -fprefer-byte-code']) ===================================== testsuite/tests/driver/multipleHomeUnits/plugin02/appunit ===================================== @@ -0,0 +1 @@ +-working-dir q App -this-unit-id app-0 -this-package-name app -package-id reexport-0 ===================================== testsuite/tests/driver/multipleHomeUnits/plugin02/p/MyPlugin.hs ===================================== @@ -0,0 +1,8 @@ +module MyPlugin (plugin) where + +import GHC.Plugins + +-- A no-op plugin: it makes no changes to the program but, to run at all, it +-- must be found and loaded by the consumer module's compilation. +plugin :: Plugin +plugin = defaultPlugin { pluginRecompile = purePlugin } ===================================== testsuite/tests/driver/multipleHomeUnits/plugin02/pluginunit ===================================== @@ -0,0 +1 @@ +-working-dir p MyPlugin -this-unit-id plugin-0 -this-package-name plugin -package ghc ===================================== testsuite/tests/driver/multipleHomeUnits/plugin02/q/App.hs ===================================== @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fplugin=MyPlugin #-} +module App where + +-- The plugin 'MyPlugin' lives in home unit plugin-0, but this unit (app-0) +-- depends only on reexport-0, which *reexports* MyPlugin (it does not contain +-- MyPlugin itself). Resolving -fplugin must therefore follow the reexport into +-- the sibling home unit, exactly as an ordinary import does. +app :: () +app = () ===================================== testsuite/tests/driver/multipleHomeUnits/plugin02/r/RexLib.hs ===================================== @@ -0,0 +1,8 @@ +module RexLib where + +-- Home unit reexport-0 re-exports MyPlugin (from plugin-0) via the +-- -reexported-module flag; see the 'reexportunit' arguments. This module exists +-- only to make reexport-0 a non-empty home unit, mirroring a real library +-- package that reexports a module from one of its dependencies. +rexLib :: () +rexLib = () ===================================== testsuite/tests/driver/multipleHomeUnits/plugin02/reexportunit ===================================== @@ -0,0 +1 @@ +-working-dir r RexLib -this-unit-id reexport-0 -this-package-name reexport -package-id plugin-0 -reexported-module MyPlugin View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c3af523b8cd0900ae37d492648832… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c3af523b8cd0900ae37d492648832… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] WIP: Introduce UnitIndex for global data
by Hannes Siebenhandl (＠fendor) 16 Jun '26

16 Jun '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: 7f764864 by fendor at 2026-06-16T17:03:36+02:00 WIP: Introduce UnitIndex for global data - - - - - 9 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/State.hs - ghc/GHCi/UI.hs - libraries/ghc-boot/GHC/Unit/Database.hs - utils/haddock/haddock-api/src/Haddock.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 (hscEUDC hsc_env) (hsc_all_home_unit_ids hsc_env) + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (hsc_unit_index hsc_env) (hscEUDC 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_eud old_unit_env) home_units + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_unit_index old_unit_env) (ue_eud old_unit_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags0 mconstants pure HomeUnitEnv @@ -779,6 +779,7 @@ setProgramDynFlags_ invalidate_needed dflags = do , ue_module_graph = ue_module_graph old_unit_env , ue_eps = ue_eps old_unit_env , ue_eud = ue_eud old_unit_env + , ue_unit_index = ue_unit_index old_unit_env } modifySession $ \h -> hscSetFlags dflags1 h{ hsc_unit_env = unit_env } else modifySession (hscSetFlags dflags0) @@ -837,6 +838,7 @@ setProgramHUG_ invalidate_needed new_hug0 = do , ue_eps = ue_eps unit_env0 , ue_module_graph = ue_module_graph unit_env0 , ue_eud = ue_eud unit_env0 + , ue_unit_index = ue_unit_index unit_env0 } modifySession $ \h -> -- hscSetFlags takes care of updating the logger as well. @@ -884,7 +886,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_eud unit_env) home_units + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_unit_index unit_env) (ue_eud unit_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants pure HomeUnitEnv ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -175,6 +175,8 @@ withBkpSession :: UnitId -> BkpM a withBkpSession cid insts deps session_type do_this = do dflags <- getDynFlags + env <- getSession + unitIndex <- liftIO $ hscUnitIndex env let cid_fs = unitFS cid is_primary = False uid_str = unpackFS (mkInstantiatedUnitHash cid insts) @@ -194,8 +196,8 @@ withBkpSession cid insts deps session_type do_this = do | otherwise = sub_comp (key_base p) mk_temp_env hsc_env = - hscUpdateFlags (\dflags -> mk_temp_dflags (hsc_units hsc_env) dflags) hsc_env - mk_temp_dflags unit_state dflags = dflags + hscUpdateFlags (\dflags -> mk_temp_dflags unitIndex (hsc_units hsc_env) dflags) hsc_env + mk_temp_dflags unit_index unit_state dflags = dflags { backend = case session_type of TcSession -> noBackend _ -> backend dflags @@ -242,7 +244,7 @@ withBkpSession cid insts deps session_type do_this = do , importPaths = [] -- Synthesize the flags , packageFlags = packageFlags dflags ++ map (\(uid0, rn) -> - let uid = unwireUnit unit_state + let uid = unwireUnit unit_index $ renameHoleUnit unit_state (listToUFM insts) uid0 in ExposePackage (showSDoc dflags @@ -349,9 +351,9 @@ buildUnit session cid insts lunit = do | otherwise = [Nothing] linkables <- liftIO $ catMaybes <$> concatHpt takeLinkables (hsc_HPT hsc_env) + unit_index <- liftIO $ hscUnitIndex hsc_env let obj_files = concatMap linkableFiles linkables - state = hsc_units hsc_env compat_fs = unitIdFS cid compat_pn = PackageName compat_fs @@ -377,7 +379,7 @@ buildUnit session cid insts lunit = do -- really used for anything, so we leave it -- blank for now. TcSession -> [] - _ -> map (toUnitId . unwireUnit state) + _ -> map (toUnitId . unwireUnit unit_index) $ deps ++ [ moduleUnit mod | (_, mod) <- insts , not (isHoleModule mod) ], @@ -449,7 +451,7 @@ addUnit u = do { packageDBFlags = packageDBFlags dflags0 ++ [PackageDB (PkgDbPath (unitDatabasePath newdb))] } - (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 eud (hsc_all_home_unit_ids hsc_env) + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (ue_unit_index old_unit_env) eud (hsc_all_home_unit_ids hsc_env) -- update platform constants @@ -467,6 +469,7 @@ addUnit u = do , ue_eps = ue_eps old_unit_env , ue_module_graph = ue_module_graph old_unit_env , ue_eud = ue_eud old_unit_env + , ue_unit_index = ue_unit_index old_unit_env } setSession $ hscSetFlags dflags $ hsc_env { hsc_unit_env = unit_env } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -13,6 +13,8 @@ module GHC.Driver.Env , hsc_HUE , hsc_HUG , hsc_all_home_unit_ids + , hscUnitIndex + , hsc_unit_index , hscUpdateLoggerFlags , hscUpdateHUG , hscInsertHPT @@ -230,6 +232,12 @@ hscEUD = readExternalUnitDatabases . hscEUDC hscEUDC :: HscEnv -> ExternalUnitDatabaseCache UnitId hscEUDC hsc_env = ue_eud (hsc_unit_env hsc_env) +hscUnitIndex :: HscEnv -> IO UnitIndex +hscUnitIndex hsc_env = readIORef $ ue_unit_index (hsc_unit_env hsc_env) + +hsc_unit_index :: HscEnv -> IORef UnitIndex +hsc_unit_index hsc_env = ue_unit_index (hsc_unit_env hsc_env) + -------------------------------------------------------------------------------- -- * Queries on Transitive Closure -------------------------------------------------------------------------------- ===================================== 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 (hscEUDC hsc_env) home_units + (unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags (hsc_unit_index hsc_env) (hscEUDC hsc_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants emptyHpt <- liftIO $ emptyHomePackageTable ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -131,6 +131,7 @@ import GHC.Types.Annotations import GHC.Types.CompleteMatch import GHC.Core.InstEnv import GHC.Core.FamInstEnv +import Data.IORef -------------------------------------------------------------------------------- -- The hard queries @@ -177,6 +178,8 @@ data UnitEnv = UnitEnv , ue_eud :: {-# UNPACK #-} !(ExternalUnitDatabaseCache UnitId) -- TODO: @fendor Docs + , ue_unit_index :: {-# UNPACK #-} !(IORef UnitIndex) + -- TODO: @fendor Docs } ueEPS :: UnitEnv -> IO ExternalPackageState @@ -186,6 +189,7 @@ initUnitEnv :: UnitId -> HomeUnitGraph -> GhcNameVersion -> Platform -> IO UnitE initUnitEnv cur_unit hug namever platform = do eps <- initExternalUnitCache eud <- initExternalUnitDatabaseCache + unit_index <- newIORef (initUnitIndex) return $ UnitEnv { ue_eps = eps , ue_home_unit_graph = hug @@ -194,6 +198,7 @@ initUnitEnv cur_unit hug namever platform = do , ue_platform = platform , ue_namever = namever , ue_eud = eud + , ue_unit_index = unit_index } updateHug :: (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -435,16 +435,25 @@ type ModuleNameProvidersMap = data GlobalUnitKey = GlobalUnitKey - UnitId -- ^ Unit Id of the 'UnitInfo' - ST.ShortText + !UnitId -- ^ Unit Id of the 'UnitInfo' + !ST.ShortText + +instance Uniquable GlobalUnitKey where + getUnique :: GlobalUnitKey -> Unique + getUnique (GlobalUnitKey unitId abiHash) = getUnique unitId -- TODO @fendor: how to incorporate abiHash + +globalUnitKeyFromUnitInfo :: UnitInfo -> GlobalUnitKey +globalUnitKeyFromUnitInfo u = GlobalUnitKey (unitId u) (unitAbiHash u) + +type GlobalUnitInfoMap = UniqMap GlobalUnitKey UnitInfo data UnitIndex = UnitIndex - { ui_wireMap :: WiringMap + { ui_wireMap :: !WiringMap -- ^ TODO @fendor: document global property - , ui_unwireMap :: UnwiringMap + , ui_unwireMap :: !UnwiringMap -- ^ TODO @fendor: document global property - , ui_unitInfoMap :: UnitInfoMap - -- ^ TODO @fendor: This needs to be Map (UnitId, AbiHash) UnitInfo for absolut correctness + , ui_unitInfoMap :: !GlobalUnitInfoMap + -- ^ TODO @fendor: This needs to be UniqMap GlobalUnitKey UnitInfo for absolut correctness } initUnitIndex :: UnitIndex @@ -468,8 +477,10 @@ isWireMapEmpty unit_index = addUnitInfoMap :: UnitInfoMap -> UnitIndex -> UnitIndex addUnitInfoMap unit_info_map unit_index = unit_index - { ui_unitInfoMap = unit_info_map `plusUniqMap` ui_unitInfoMap unit_index + { ui_unitInfoMap = globalMap `plusUniqMap` ui_unitInfoMap unit_index } + where + globalMap = listToUniqMap . map (\(_, v) -> (globalUnitKeyFromUnitInfo v, v)) $ nonDetUniqMapToList unit_info_map -- lookupUnitInfoMap :: UnitIndex -> UnitId -> Maybe UnitInfo -- lookupUnitInfoMap unit_index unit_id = @@ -945,28 +956,23 @@ mungeBytecodeLibFields pkg = ds -> ds } +seqUnitInfo :: UnitInfo -> b -> b +seqUnitInfo ui b = + unitImportDirs ui `seqList` + unitIncludeDirs ui `seqList` + unitLibraryDirs ui `seqList` + unitLibraryBytecodeDirs ui `seqList` + unitExtDepFrameworkDirs ui `seq` + unitHaddockInterfaces ui `seq` + unitHaddockHTMLs ui `seqList` + unitLibraryDynDirs ui `seqList` + unitLibraryDirsStatic ui `seqList` + unitDepends ui `seqList` + unitExposedModules ui `seqList` + b + evaluateUnitInfo :: UnitInfo -> IO UnitInfo -evaluateUnitInfo ui = do - importDirs <- evaluate $ unitImportDirs ui - includeDirs <- evaluate $ unitIncludeDirs ui - libraryDirs <- evaluate $ unitLibraryDirs ui - libraryBytecodeDirs <- evaluate $ unitLibraryBytecodeDirs ui - extDepFrameworkDirs <- evaluate $ unitExtDepFrameworkDirs ui - haddockInterfaces <- evaluate $ unitHaddockInterfaces ui - haddockHTMLs <- evaluate $ unitHaddockHTMLs ui - libraryDynDirs <- evaluate $ unitLibraryDynDirs ui - libraryDirsStatic <- evaluate $ unitLibraryDirsStatic ui - evaluate ui - { unitImportDirs = importDirs - , unitIncludeDirs = includeDirs - , unitLibraryDirs = libraryDirs - , unitLibraryDynDirs = libraryDynDirs - , unitLibraryDirsStatic = libraryDirsStatic - , unitLibraryBytecodeDirs = libraryBytecodeDirs - , unitExtDepFrameworkDirs = extDepFrameworkDirs - , unitHaddockInterfaces = haddockInterfaces - , unitHaddockHTMLs = haddockHTMLs - } +evaluateUnitInfo ui = evaluate (seqUnitInfo ui ui) -- ----------------------------------------------------------------------------- -- Modify our copy of the unit database based on trust flags, @@ -1274,11 +1280,11 @@ findWiredInUnits logger prec_map pkgs vis_map = do return wiredInMap -updateWiredInUnits :: WiringMap -> UnitInfoMap -> [UnitInfo] -> [Either UnitInfo UnitInfo] +updateWiredInUnits :: WiringMap -> GlobalUnitInfoMap -> [UnitInfo] -> [Either UnitInfo UnitInfo] updateWiredInUnits wiredInMap knownInfos pkgs = map (updateWiredInUnitsInUnitInfo wiredInMap knownInfos) pkgs -updateWiredInUnitsInUnitInfo :: WiringMap -> UnitInfoMap -> UnitInfo -> Either UnitInfo UnitInfo +updateWiredInUnitsInUnitInfo :: WiringMap -> GlobalUnitInfoMap -> UnitInfo -> Either UnitInfo UnitInfo updateWiredInUnitsInUnitInfo wiredInMap knownInfos pkg = let upd_pkg pkg @@ -1299,14 +1305,14 @@ updateWiredInUnitsInUnitInfo wiredInMap knownInfos pkg = (unitExposedModules pkg) } in - case lookupUniqMap knownInfos (unitId pkg) of + case lookupUniqMap knownInfos (globalUnitKeyFromUnitInfo pkg) of Just ui -> Right ui Nothing -> let updated_pkg = upd_deps $ upd_pkg pkg in - Left updated_pkg + Left $ seqUnitInfo updated_pkg updated_pkg -- Helper functions for rewiring Module and Unit. These -- rewrite Units of modules in wired-in packages to the form known to the @@ -1725,12 +1731,12 @@ mkUnitState logger unit_index 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). - if unitIsExposed p && unitIsDefinite (mkUnit p) && mostPreferable p + let !x = fsPackageName p in 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 (fsPackageName p)), + uv_package_name = First (Just x), uv_requirements = emptyUniqMap, uv_explicit = Nothing } ===================================== ghc/GHCi/UI.hs ===================================== @@ -857,8 +857,9 @@ installInteractiveHomeUnits dflags = do setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> m HomeUnitEnv setupHomeUnitFor logger dflags all_home_units = do env <- GHC.getSession + let unit_index = hsc_unit_index env (unit_state,home_unit,_mconstants) <- - liftIO $ initUnits logger dflags (hscEUDC env) all_home_units + liftIO $ initUnits logger dflags unit_index (hscEUDC env) all_home_units hpt <- liftIO emptyHomePackageTable pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit)) ===================================== libraries/ghc-boot/GHC/Unit/Database.hs ===================================== @@ -746,11 +746,20 @@ mungeUnitInfoPaths top_dir pkgroot pkg = , unitHaddockHTMLs = munge_paths (munge_urls (unitHaddockHTMLs pkg)) } where - munge_paths = map munge_path - munge_urls = map munge_url + munge_paths = strictMap munge_path + munge_urls = strictMap munge_url (munge_path,munge_url) = mkMungePathUrl top_dir pkgroot -- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed. -- Prefer 'decodeUtf' and gracious error handling. unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath unsafeDecodeUtf = OsPath.Internal.so + +strictMap :: (a -> b) -> [a] -> [b] +strictMap _ [] = [] +strictMap f (x:xs) = + let + !x' = f x + !xs' = strictMap f xs + in + x' : xs' ===================================== utils/haddock/haddock-api/src/Haddock.hs ===================================== @@ -258,7 +258,9 @@ haddockWithGhc ghc args = handleTopExceptions $ do logger' <- getLogger let logger = setLogFlags logger' (initLogFlags dflags) let parserOpts = Parser.initParserOpts dflags - !unit_state <- hsc_units <$> getSession + env <- getSession + let !unit_state = hsc_units env + !unit_index <- liftIO $ hscUnitIndex env -- If any --show-interface was used, show the given interfaces forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do @@ -285,7 +287,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do } -- Render the interfaces. - liftIO $ renderStep dflags parserOpts logger unit_state flags sinceQual qual concSem packages ifaces + liftIO $ renderStep dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem packages ifaces -- If we were not given any input files, error if documentation was -- requested @@ -298,7 +300,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do packages <- liftIO $ readInterfaceFiles name_cache (readIfaceArgs flags) noChecks -- Render even though there are no input files (usually contents/index). - liftIO $ renderStep dflags parserOpts logger unit_state flags sinceQual qual concSem packages [] + liftIO $ renderStep dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem packages [] -- | Run the GHC action using a temporary output directory withTempOutputDir :: Ghc a -> Ghc a @@ -354,6 +356,7 @@ renderStep :: DynFlags -> ParserOpts -> Logger + -> UnitIndex -> UnitState -> [Flag] -> SinceQual @@ -362,7 +365,7 @@ renderStep -> [(DocPaths, Visibility, FilePath, InterfaceFile)] -> [Interface] -> IO () -renderStep dflags parserOpts logger unit_state flags sinceQual nameQual concSem pkgs interfaces = do +renderStep dflags parserOpts logger unit_index unit_state flags sinceQual nameQual concSem pkgs interfaces = do updateHTMLXRefs (map (\(docPath, _ifaceFilePath, _showModules, ifaceFile) -> ( case baseUrl flags of Nothing -> docPathsHtml docPath @@ -378,7 +381,7 @@ renderStep dflags parserOpts logger unit_state flags sinceQual nameQual concSem (DocPaths {docPathsSources=Just path}, _, _, ifile) <- pkgs iface <- ifInstalledIfaces ifile return (instMod iface, path) - render dflags parserOpts logger unit_state flags sinceQual nameQual concSem interfaces installedIfaces extSrcMap + render dflags parserOpts logger unit_index unit_state flags sinceQual nameQual concSem interfaces installedIfaces extSrcMap where -- get package name from unit-id packageName :: Unit -> String @@ -392,6 +395,7 @@ render :: DynFlags -> ParserOpts -> Logger + -> UnitIndex -> UnitState -> [Flag] -> SinceQual @@ -401,7 +405,7 @@ render -> [(FilePath, PackageInterfaces)] -> Map Module FilePath -> IO () -render dflags parserOpts logger unit_state flags sinceQual qual concSem ifaces packages extSrcMap = do +render dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem ifaces packages extSrcMap = do let packageInfo = PackageInfo { piPackageName = fromMaybe (PackageName mempty) $ optPackageName flags @@ -503,7 +507,7 @@ render dflags parserOpts logger unit_state flags sinceQual qual concSem ifaces p -- records the *wired in* identity base. So untranslate it -- so that we can service the request. unwire :: Module -> Module - unwire m = m { moduleUnit = unwireUnit unit_state (moduleUnit m) } + unwire m = m { moduleUnit = unwireUnit unit_index (moduleUnit m) } reexportedIfaces <- concat `fmap` (for (reexportFlags flags) $ \mod_str -> do let warn' = hPutStrLn stderr . ("Warning: " ++) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f7648642ce4f72585aa4c8bc2c0862… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f7648642ce4f72585aa4c8bc2c0862… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/T27374
by Simon Jakobi (＠sjakobi2) 16 Jun '26

16 Jun '26

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

1 0

[Git][ghc/ghc] Pushed new branch wip/elland/haddock-builds-under-10-1
by Igor Ranieri Elland (＠elland) 16 Jun '26

16 Jun '26

Igor Ranieri Elland pushed new branch wip/elland/haddock-builds-under-10-1 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/elland/haddock-builds-under-1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-reinstallable-base2] 4 commits: Fix handful more tests
by Rodrigo Mesquita (＠alt-romes) 16 Jun '26

16 Jun '26

Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: d90e4e76 by Rodrigo Mesquita at 2026-06-16T12:12:54+01:00 Fix handful more tests - - - - - c05644d8 by Rodrigo Mesquita at 2026-06-16T14:14:52+01:00 break006 new out - - - - - c4a4dfcb by Rodrigo Mesquita at 2026-06-16T15:06:04+01:00 upd callstack00{1,2} out - - - - - 7a4d1cf1 by Rodrigo Mesquita at 2026-06-16T15:09:53+01:00 Rebindable import in windows - - - - - 9 changed files: - libraries/ghc-internal/src/GHC/Internal/Conc/POSIX/Const.hsc - testsuite/tests/backpack/cabal/bkpcabal07/Makefile - testsuite/tests/driver/make-prim/Makefile - testsuite/tests/ghci.debugger/scripts/break006.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/package/all.T - testsuite/tests/profiling/should_run/callstack001.stdout - testsuite/tests/profiling/should_run/callstack002.stderr - testsuite/tests/profiling/should_run/callstack002.stdout Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Conc/POSIX/Const.hsc ===================================== @@ -21,6 +21,7 @@ module GHC.Internal.Conc.POSIX.Const where import GHC.Internal.Word +import qualified GHC.Internal.Num as Rebindable #include <Rts.h> ===================================== testsuite/tests/backpack/cabal/bkpcabal07/Makefile ===================================== @@ -3,7 +3,7 @@ include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk SETUP='$(PWD)/Setup' -v0 -CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' +CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --with-hc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --ghc-option=-frebindable-known-names --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' # This test checks that instantiating an indefinite package # with a wired in package works. ===================================== testsuite/tests/driver/make-prim/Makefile ===================================== @@ -5,7 +5,7 @@ include $(TOP)/mk/test.mk make-prim: # build once to test the substitution of the virtual interface in --make # mode with codegen - "$(TEST_HC)" $(TEST_HC_OPTS) --make Test.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) --make Test.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0 -frebindable-known-names # build a different module (Test2) in --make mode to test the reloading # of the GHC.Internal.Prim interface - "$(TEST_HC)" $(TEST_HC_OPTS) --make Test2.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0 + "$(TEST_HC)" $(TEST_HC_OPTS) --make Test2.hs -this-unit-id ghc-internal -hide-all-packages -dno-typeable-binds -v0 -frebindable-known-names ===================================== testsuite/tests/ghci.debugger/scripts/break006.stderr ===================================== @@ -4,8 +4,8 @@ Use :print or :force to determine these types Relevant bindings include it :: a (bound at <interactive>:4:1) Potentially matching instances: - instance Show Ordering -- Defined in ‘GHC.Internal.Show’ instance Show Integer -- Defined in ‘GHC.Internal.Show’ + instance Show a => Show (Maybe a) -- Defined in ‘GHC.Internal.Show’ ...plus 25 others ...plus 13 instances involving out-of-scope types (use -fprint-potential-instances to see them all) @@ -17,8 +17,8 @@ Use :print or :force to determine these types Relevant bindings include it :: a (bound at <interactive>:6:1) Potentially matching instances: - instance Show Ordering -- Defined in ‘GHC.Internal.Show’ instance Show Integer -- Defined in ‘GHC.Internal.Show’ + instance Show a => Show (Maybe a) -- Defined in ‘GHC.Internal.Show’ ...plus 25 others ...plus 13 instances involving out-of-scope types (use -fprint-potential-instances to see them all) ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -5638,6 +5638,8 @@ module GHC.Essentials where data RuleMatch = ConLike | FunLike type S1 :: forall {k}. Meta -> (k -> *) -> k -> * type S1 = M1 GHC.Internal.Generics.S + type SPEC :: * + data SPEC = SPEC | SPEC2 type Selector :: forall {k}. k -> Constraint class Selector s where selName :: forall k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *) (a :: k1). t s f a -> [GHC.Internal.Types.Char] @@ -6040,6 +6042,7 @@ module GHC.Essentials where roleAnnotD :: forall (m :: * -> *). Quote m => Name -> [Role] -> m Dec ruleVar :: forall (m :: * -> *). Quote m => Name -> m RuleBndr runMainIO :: forall a. IO a -> IO a + runRW# :: forall (r :: GHC.Internal.Types.RuntimeRep) (o :: TYPE r). (GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> o) -> o safe :: GHC.Internal.TH.Syntax.Safety sectionL :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp sectionR :: forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp ===================================== testsuite/tests/package/all.T ===================================== @@ -5,10 +5,10 @@ incr_ghc = '-package "ghc (GHC.Hs.Type as GHC.Hs.MyTypes, GHC.Hs.Utils)" ' inc_ghc = '-package ghc ' hide_ghc = '-hide-package ghc ' -test('package01', normal, compile, [hide_all + incr_containers]) +test('package01', normal, compile, [hide_all + incr_containers + '-frebindable-known-names']) test('package01e', normalise_version('containers'), compile_fail, [hide_all + incr_containers]) -test('package02', normal, compile, [hide_all + inc_containers + incr_containers]) -test('package03', normal, compile, [hide_all + incr_containers + inc_containers]) +test('package02', normal, compile, [hide_all + inc_containers + incr_containers + '-frebindable-known-names']) +test('package03', normal, compile, [hide_all + incr_containers + inc_containers + '-frebindable-known-names']) test('package04', normal, compile, [incr_containers]) test('package05', normal, compile, [incr_ghc + inc_ghc]) test('package06', normal, compile, [incr_ghc]) @@ -16,7 +16,7 @@ test('package06e', normalise_version('ghc'), compile_fail, [incr_ghc]) test('package07e', normalise_version('ghc'), compile_fail, [incr_ghc + inc_ghc + hide_ghc]) test('package08e', normalise_version('ghc'), compile_fail, [incr_ghc + hide_ghc]) test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, Data.Set as M)"']) -test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC.Types.Unique.FM as Prelude)" ']) +test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC.Types.Unique.FM as Prelude)" -frebindable-known-names']) test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers']) test('T4806a', normalise_version('deepseq', 'containers', 'template-haskell'), compile_fail, ['-ignore-package deepseq']) ===================================== testsuite/tests/profiling/should_run/callstack001.stdout ===================================== @@ -1,2 +1,2 @@ -["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:11-19)","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1347:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:129:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] -["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:11-19)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1347:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:129:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] \ No newline at end of file +["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:11-19)","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1368:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:128:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] +["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:11-19)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1368:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:128:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"] ===================================== testsuite/tests/profiling/should_run/callstack002.stderr ===================================== @@ -1,6 +1,6 @@ f: 42 CallStack (from -prof): - GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:243:1-10) + GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:241:1-10) Main.f (callstack002.hs:10:7-43) Main.map.go (callstack002.hs:15:21-23) Main.map.go (callstack002.hs:15:21-34) @@ -9,7 +9,7 @@ CallStack (from -prof): Main.CAF (<entire-module>) f: 43 CallStack (from -prof): - GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:243:1-10) + GHC.Internal.Debug.Trace.traceStack (libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs:241:1-10) Main.f (callstack002.hs:10:7-43) Main.map.go (callstack002.hs:15:21-23) Main.map.go (callstack002.hs:15:21-34) ===================================== testsuite/tests/profiling/should_run/callstack002.stdout ===================================== @@ -1,7 +1,7 @@ [84,86] CallStack (from -prof): - GHC.Internal.Num.$fNumInt_$c* (libraries/ghc-internal/src/GHC/Internal/Num.hs:114:10) - GHC.Internal.Num.* (libraries/ghc-internal/src/GHC/Internal/Num.hs:76:5-38) + GHC.Internal.Num.$fNumInt_$c* (libraries/ghc-internal/src/GHC/Internal/Num.hs:116:10) + GHC.Internal.Num.* (libraries/ghc-internal/src/GHC/Internal/Num.hs:78:5-38) Main.f (callstack002.hs:10:38-42) Main.f (callstack002.hs:10:7-43) Main.map.go (callstack002.hs:15:21-23) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a715d7d3ce7b591b9be53e5ddf3bf1… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a715d7d3ce7b591b9be53e5ddf3bf1… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/sjakobi/T27374-repro
by Simon Jakobi (＠sjakobi2) 16 Jun '26

16 Jun '26

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

1 0

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] 3 commits: WIP: introduce external unit database cache
by Hannes Siebenhandl (＠fendor) 16 Jun '26

16 Jun '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: e5ff4198 by fendor at 2026-06-16T15:01:30+02:00 WIP: introduce external unit database cache - - - - - 78f7f4a4 by fendor at 2026-06-16T15:02:50+02:00 Never modify UnitInfo for better sharing - - - - - fd08e959 by fendor at 2026-06-16T15:03:08+02:00 WIP: Introduce UnitIndex for global data - - - - - 15 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Hsc.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Unit/Env.hs - + compiler/GHC/Unit/External/Database.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/State.hs - compiler/ghc.cabal.in - ghc/GHCi/UI.hs - libraries/ghc-boot/GHC/Unit/Database.hs - utils/haddock/haddock-api/src/Haddock.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -671,15 +671,12 @@ setUnitDynFlagsNoCheck uid dflags1 = do logger <- getLogger hsc_env <- getSession - let old_hue = ue_findHomeUnitEnv uid (hsc_unit_env hsc_env) - let cached_unit_dbs = homeUnitEnv_unit_dbs old_hue - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 cached_unit_dbs (hsc_all_home_unit_ids hsc_env) + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (hsc_unit_index hsc_env) (hscEUDC hsc_env) (hsc_all_home_unit_ids hsc_env) updated_dflags <- liftIO $ updatePlatformConstants dflags1 mconstants let upd hue = hue { homeUnitEnv_units = unit_state - , homeUnitEnv_unit_dbs = Just dbs , homeUnitEnv_dflags = updated_dflags , homeUnitEnv_home_unit = Just home_unit } @@ -759,17 +756,15 @@ setProgramDynFlags_ invalidate_needed dflags = do old_unit_env <- ue_setFlags dflags0 . hsc_unit_env <$> getSession home_unit_graph <- forM (ue_home_unit_graph old_unit_env) $ \homeUnitEnv -> do - let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv - dflags = homeUnitEnv_dflags homeUnitEnv + let dflags = homeUnitEnv_dflags homeUnitEnv old_hpt = homeUnitEnv_hpt homeUnitEnv home_units = HUG.allUnits (ue_home_unit_graph old_unit_env) - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags cached_unit_dbs home_units + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_unit_index old_unit_env) (ue_eud old_unit_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags0 mconstants pure HomeUnitEnv { homeUnitEnv_units = unit_state - , homeUnitEnv_unit_dbs = Just dbs , homeUnitEnv_dflags = updated_dflags , homeUnitEnv_hpt = old_hpt , homeUnitEnv_home_unit = Just home_unit @@ -783,6 +778,8 @@ 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_unit_index = ue_unit_index old_unit_env } modifySession $ \h -> hscSetFlags dflags1 h{ hsc_unit_env = unit_env } else modifySession (hscSetFlags dflags0) @@ -840,6 +837,8 @@ 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_unit_index = ue_unit_index unit_env0 } modifySession $ \h -> -- hscSetFlags takes care of updating the logger as well. @@ -881,19 +880,17 @@ setProgramHUG_ invalidate_needed new_hug0 = do updateHomeUnit :: GhcMonad m => Logger -> UnitEnv -> HomeUnitGraph -> (UnitId -> HomeUnitEnv -> m HomeUnitEnv) updateHomeUnit logger unit_env updates = \uid homeUnitEnv -> do - let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv - dflags = case HUG.unitEnv_lookup_maybe uid updates of + let dflags = case HUG.unitEnv_lookup_maybe uid updates of Nothing -> homeUnitEnv_dflags homeUnitEnv Just env -> homeUnitEnv_dflags env old_hpt = homeUnitEnv_hpt homeUnitEnv home_units = HUG.allUnits (ue_home_unit_graph unit_env) - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags cached_unit_dbs home_units + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags (ue_unit_index unit_env) (ue_eud unit_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants pure HomeUnitEnv { homeUnitEnv_units = unit_state - , homeUnitEnv_unit_dbs = Just dbs , homeUnitEnv_dflags = updated_dflags , homeUnitEnv_hpt = old_hpt , homeUnitEnv_home_unit = Just home_unit ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -92,6 +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) -- | Entry point to compile a Backpack file. doBackpack :: [FilePath] -> Ghc () @@ -174,6 +175,8 @@ withBkpSession :: UnitId -> BkpM a withBkpSession cid insts deps session_type do_this = do dflags <- getDynFlags + env <- getSession + unitIndex <- liftIO $ hscUnitIndex env let cid_fs = unitFS cid is_primary = False uid_str = unpackFS (mkInstantiatedUnitHash cid insts) @@ -193,8 +196,8 @@ withBkpSession cid insts deps session_type do_this = do | otherwise = sub_comp (key_base p) mk_temp_env hsc_env = - hscUpdateFlags (\dflags -> mk_temp_dflags (hsc_units hsc_env) dflags) hsc_env - mk_temp_dflags unit_state dflags = dflags + hscUpdateFlags (\dflags -> mk_temp_dflags unitIndex (hsc_units hsc_env) dflags) hsc_env + mk_temp_dflags unit_index unit_state dflags = dflags { backend = case session_type of TcSession -> noBackend _ -> backend dflags @@ -241,7 +244,7 @@ withBkpSession cid insts deps session_type do_this = do , importPaths = [] -- Synthesize the flags , packageFlags = packageFlags dflags ++ map (\(uid0, rn) -> - let uid = unwireUnit unit_state + let uid = unwireUnit unit_index $ renameHoleUnit unit_state (listToUFM insts) uid0 in ExposePackage (showSDoc dflags @@ -348,9 +351,9 @@ buildUnit session cid insts lunit = do | otherwise = [Nothing] linkables <- liftIO $ catMaybes <$> concatHpt takeLinkables (hsc_HPT hsc_env) + unit_index <- liftIO $ hscUnitIndex hsc_env let obj_files = concatMap linkableFiles linkables - state = hsc_units hsc_env compat_fs = unitIdFS cid compat_pn = PackageName compat_fs @@ -376,7 +379,7 @@ buildUnit session cid insts lunit = do -- really used for anything, so we leave it -- blank for now. TcSession -> [] - _ -> map (toUnitId . unwireUnit state) + _ -> map (toUnitId . unwireUnit unit_index) $ deps ++ [ moduleUnit mod | (_, mod) <- insts , not (isHoleModule mod) ], @@ -435,18 +438,24 @@ addUnit u = do logger <- getLogger let dflags0 = hsc_dflags hsc_env let old_unit_env = hsc_unit_env hsc_env - newdbs <- case ue_unit_dbs old_unit_env of - Nothing -> panic "addUnit: called too early" - Just dbs -> - let newdb = UnitDatabase - { unitDatabasePath = unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" - , unitDatabaseUnits = [u] - } - in return (dbs ++ [newdb]) -- added at the end because ordering matters - (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags0 (Just newdbs) (hsc_all_home_unit_ids hsc_env) + + -- TODO @fendor: provide an API to programmatically add an in-memory DB + let newdb = UnitDatabase + { unitDatabasePath = unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags0 (ppr (unitId u)) ++ ")" + , unitDatabaseUnits = [u] + } + let eud = hscEUDC hsc_env + liftIO $ cacheExternalUnitDatabase eud newdb + -- added at the end because ordering matters + let dflags1 = dflags0 + { packageDBFlags = packageDBFlags dflags0 ++ [PackageDB (PkgDbPath (unitDatabasePath newdb))] + } + + (unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 (ue_unit_index old_unit_env) eud (hsc_all_home_unit_ids hsc_env) + -- update platform constants - dflags <- liftIO $ updatePlatformConstants dflags0 mconstants + dflags <- liftIO $ updatePlatformConstants dflags1 mconstants let unit_env = UnitEnv { ue_platform = targetPlatform dflags @@ -456,9 +465,11 @@ addUnit u = do , ue_home_unit_graph = HUG.unitEnv_singleton (homeUnitId home_unit) - (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags (ue_hpt old_unit_env) (Just home_unit)) + (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_unit_index = ue_unit_index old_unit_env } setSession $ hscSetFlags dflags $ hsc_env { hsc_unit_env = unit_env } ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -13,6 +13,8 @@ module GHC.Driver.Env , hsc_HUE , hsc_HUG , hsc_all_home_unit_ids + , hscUnitIndex + , hsc_unit_index , hscUpdateLoggerFlags , hscUpdateHUG , hscInsertHPT @@ -24,6 +26,8 @@ module GHC.Driver.Env , mkInteractiveHscEnv , runInteractiveHsc , hscEPS + , hscEUD + , hscEUDC , hscInterp , prepareAnnotations , discardIC @@ -89,6 +93,7 @@ import GHC.Builtin.Names import Data.IORef import qualified Data.Set as Set +import GHC.Unit.External.Database (ExternalUnitDatabaseCache, readExternalUnitDatabases, ExternalUnitDatabases) runHsc :: HscEnv -> Hsc a -> IO a runHsc hsc_env hsc = do @@ -221,6 +226,18 @@ configured via command-line flags (in `GHC.setTopSessionDynFlags`). 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) + +hscUnitIndex :: HscEnv -> IO UnitIndex +hscUnitIndex hsc_env = readIORef $ ue_unit_index (hsc_unit_env hsc_env) + +hsc_unit_index :: HscEnv -> IORef UnitIndex +hsc_unit_index hsc_env = ue_unit_index (hsc_unit_env hsc_env) + -------------------------------------------------------------------------------- -- * Queries on Transitive Closure -------------------------------------------------------------------------------- ===================================== compiler/GHC/Driver/Main/Hsc.hs ===================================== @@ -110,7 +110,7 @@ newHscEnv top_dir dflags = do where home_unit_graph hpt = HUG.unitEnv_singleton (homeUnitId_ dflags) - (HUG.mkHomeUnitEnv emptyUnitState Nothing dflags hpt Nothing) + (HUG.mkHomeUnitEnv emptyUnitState dflags hpt Nothing) newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do ===================================== compiler/GHC/Driver/Main/Interactive.hs ===================================== @@ -275,7 +275,7 @@ hscCheckSafe' m l = do Sf_Safe | not trust_own_pkg -> True Sf_SafeInferred | not trust_own_pkg -> True _ | isHomeModule home_unit mod -> True - _ -> unitIsTrusted $ unsafeLookupUnit unit_state (moduleUnit m) + _ -> isUnitTrusted unit_state (moduleUnit m) lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do @@ -297,7 +297,7 @@ checkPkgTrust pkgs = do errors = S.foldr go emptyBag pkgs state = hsc_units hsc_env go pkg acc - | unitIsTrusted $ unsafeLookupUnitId state pkg + | isUnitIdTrusted state pkg = acc | otherwise = (`consBag` acc) ===================================== compiler/GHC/Driver/Main/Passes.hs ===================================== @@ -1328,7 +1328,7 @@ hscCheckSafe' m l = do Sf_Safe | not trust_own_pkg -> True Sf_SafeInferred | not trust_own_pkg -> True _ | isHomeModule home_unit mod -> True - _ -> unitIsTrusted $ unsafeLookupUnit unit_state (moduleUnit m) + _ -> isUnitTrusted unit_state (moduleUnit m) lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do @@ -1350,7 +1350,7 @@ checkPkgTrust pkgs = do errors = S.foldr go emptyBag pkgs state = hsc_units hsc_env go pkg acc - | unitIsTrusted $ unsafeLookupUnitId state pkg + | isUnitIdTrusted state pkg = acc | otherwise = (`consBag` acc) ===================================== compiler/GHC/Driver/Session/Units.hs ===================================== @@ -129,16 +129,14 @@ initMulti unitArgsFiles lintDynFlagsAndSrcs = do let home_units = HUG.allUnits initial_home_graph home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do - let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv - hue_flags = homeUnitEnv_dflags homeUnitEnv + let hue_flags = homeUnitEnv_dflags homeUnitEnv dflags = homeUnitEnv_dflags homeUnitEnv - (dbs,unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags cached_unit_dbs home_units + (unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags (hsc_unit_index hsc_env) (hscEUDC hsc_env) home_units updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants emptyHpt <- liftIO $ emptyHomePackageTable pure $ HomeUnitEnv { homeUnitEnv_units = unit_state - , homeUnitEnv_unit_dbs = Just dbs , homeUnitEnv_dflags = updated_dflags , homeUnitEnv_hpt = emptyHpt , homeUnitEnv_home_unit = Just home_unit @@ -239,7 +237,7 @@ createUnitEnvFromFlags unitDflags = do unitEnvList <- forM unitDflags $ \dflags -> do emptyHpt <- emptyHomePackageTable let newInternalUnitEnv = - HUG.mkHomeUnitEnv emptyUnitState Nothing dflags emptyHpt Nothing + HUG.mkHomeUnitEnv emptyUnitState dflags emptyHpt Nothing return (homeUnitId_ dflags, newInternalUnitEnv) let activeUnit = fst $ NE.head unitEnvList return (HUG.hugFromList (NE.toList unitEnvList), activeUnit) ===================================== compiler/GHC/Unit/Env.hs ===================================== @@ -80,7 +80,6 @@ module GHC.Unit.Env -- ** Queries on the current active home unit , ue_homeUnitState - , ue_unit_dbs , ue_homeUnit , ue_unitFlags @@ -110,6 +109,7 @@ import GHC.Prelude import qualified Data.Set as Set import GHC.Unit.External +import GHC.Unit.External.Database import GHC.Unit.State import GHC.Unit.Home import GHC.Unit.Types @@ -131,6 +131,7 @@ import GHC.Types.Annotations import GHC.Types.CompleteMatch import GHC.Core.InstEnv import GHC.Core.FamInstEnv +import Data.IORef -------------------------------------------------------------------------------- -- The hard queries @@ -174,6 +175,11 @@ data UnitEnv = UnitEnv , ue_namever :: !GhcNameVersion -- ^ GHC name/version (used for dynamic library suffix) + + , ue_eud :: {-# UNPACK #-} !(ExternalUnitDatabaseCache UnitId) + -- TODO: @fendor Docs + , ue_unit_index :: {-# UNPACK #-} !(IORef UnitIndex) + -- TODO: @fendor Docs } ueEPS :: UnitEnv -> IO ExternalPackageState @@ -182,6 +188,8 @@ ueEPS = eucEPS . ue_eps initUnitEnv :: UnitId -> HomeUnitGraph -> GhcNameVersion -> Platform -> IO UnitEnv initUnitEnv cur_unit hug namever platform = do eps <- initExternalUnitCache + eud <- initExternalUnitDatabaseCache + unit_index <- newIORef (initUnitIndex) return $ UnitEnv { ue_eps = eps , ue_home_unit_graph = hug @@ -189,6 +197,8 @@ initUnitEnv cur_unit hug namever platform = do , ue_current_unit = cur_unit , ue_platform = platform , ue_namever = namever + , ue_eud = eud + , ue_unit_index = unit_index } updateHug :: (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv @@ -258,9 +268,6 @@ ue_findHomeUnitEnv uid e = case HUG.lookupHugUnitId uid (ue_home_unit_graph e) o ue_homeUnitState :: HasDebugCallStack => UnitEnv -> UnitState ue_homeUnitState = HUG.homeUnitEnv_units . ue_currentHomeUnitEnv -ue_unit_dbs :: UnitEnv -> Maybe [UnitDatabase UnitId] -ue_unit_dbs = HUG.homeUnitEnv_unit_dbs . ue_currentHomeUnitEnv - -- ------------------------------------------------------- -- Query and modify Home Package Table in HomeUnitEnv -- ------------------------------------------------------- ===================================== compiler/GHC/Unit/External/Database.hs ===================================== @@ -0,0 +1,104 @@ +module GHC.Unit.External.Database ( + -- * + ExternalUnitDatabaseCache (..), + initExternalUnitDatabaseCache, + readExternalUnitDatabases, + readExternalUnitDatabase, + cacheExternalUnitDatabase, + clearExternalUnitDatabaseCache, + -- * + ExternalUnitDatabases, + emptyExternalUnitDatabases, + insertExternalUnitDatabases, + deleteExternalUnitDatabases, + lookupExternalUnitDatabases, + -- * + UnitDatabase (..), +) where + +import GHC.Prelude + +import GHC.Data.OsPath +import GHC.Unit.Info +import GHC.Utils.Outputable + +import Data.IORef (IORef) +import Data.IORef qualified as IORef +import Data.Map.Strict +import Data.Map.Strict qualified as Map + +-- ---------------------------------------------------------------------------- +-- ExternalUnitDatabaseCache +-- ---------------------------------------------------------------------------- + +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 +-- ---------------------------------------------------------------------------- + +data ExternalUnitDatabases unit = ExternalUnitDatabases + { eud_cachedDatabases :: !(Map OsPath (UnitDatabase unit)) + } + +emptyExternalUnitDatabases :: ExternalUnitDatabases unit +emptyExternalUnitDatabases = + ExternalUnitDatabases + { eud_cachedDatabases = Map.empty + } + +insertExternalUnitDatabases :: UnitDatabase unit -> ExternalUnitDatabases unit -> ExternalUnitDatabases unit +insertExternalUnitDatabases unit_db eud = + ExternalUnitDatabases + { eud_cachedDatabases = Map.insert (unitDatabasePath unit_db) unit_db (eud_cachedDatabases eud) + } + +deleteExternalUnitDatabases :: OsPath -> ExternalUnitDatabases unit -> ExternalUnitDatabases unit +deleteExternalUnitDatabases unit_db_path eud = + ExternalUnitDatabases + { eud_cachedDatabases = Map.delete unit_db_path (eud_cachedDatabases eud) + } + +lookupExternalUnitDatabases :: OsPath -> ExternalUnitDatabases unit -> Maybe (UnitDatabase unit) +lookupExternalUnitDatabases key eud = + Map.lookup key (eud_cachedDatabases eud) + +-- ---------------------------------------------------------------------------- +-- UnitDatabase +-- ---------------------------------------------------------------------------- + +-- | Unit database +data UnitDatabase unit = UnitDatabase + { unitDatabasePath :: OsPath + , unitDatabaseUnits :: [GenUnitInfo unit] + } + +instance (Outputable u) => Outputable (UnitDatabase u) where + ppr (UnitDatabase fp _u) = text "DB:" <+> ppr fp ===================================== compiler/GHC/Unit/Home/Graph.hs ===================================== @@ -128,16 +128,6 @@ data HomeUnitEnv = HomeUnitEnv { homeUnitEnv_units :: !UnitState -- ^ External units - , homeUnitEnv_unit_dbs :: !(Maybe [UnitDatabase UnitId]) - -- ^ Stack of unit databases for the target platform. - -- - -- This field is populated with the result of `initUnits`. - -- - -- 'Nothing' means the databases have never been read from disk. - -- - -- Usually we don't reload the databases from disk if they are - -- cached, even if the database flags changed! - , homeUnitEnv_dflags :: DynFlags -- ^ The dynamic flag settings , homeUnitEnv_hpt :: HomePackageTable @@ -164,10 +154,9 @@ data HomeUnitEnv = HomeUnitEnv -- ^ Home-unit } -mkHomeUnitEnv :: UnitState -> Maybe [UnitDatabase UnitId] -> DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv -mkHomeUnitEnv us dbs dflags hpt home_unit = HomeUnitEnv +mkHomeUnitEnv :: UnitState -> DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv +mkHomeUnitEnv us dflags hpt home_unit = HomeUnitEnv { homeUnitEnv_units = us - , homeUnitEnv_unit_dbs = dbs , homeUnitEnv_dflags = dflags , homeUnitEnv_hpt = hpt , homeUnitEnv_home_unit = home_unit ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -5,12 +5,20 @@ module GHC.Unit.State ( module GHC.Unit.Info, + UnitIndex(..), + initUnitIndex, + setWireMap, + isWireMapEmpty, + addUnitInfoMap, + -- lookupUnitInfoMap, + -- * Reading the package config, and processing cmdline args UnitState(..), UnitDatabase (..), UnitErr (..), emptyUnitState, initUnits, + readOrGetUnitDatabase, readUnitDatabases, readUnitDatabase, getUnitDbRefs, @@ -25,6 +33,9 @@ module GHC.Unit.State ( lookupUnitId, lookupUnitId', unsafeLookupUnitId, + isUnitTrusted, + isUnitIdTrusted, + isUnitInfoTrusted, lookupPackageName, resolvePackageImport, @@ -118,6 +129,9 @@ import Data.Monoid (First(..)) import qualified Data.Semigroup as Semigroup import qualified Data.Set as Set import Control.Applicative +import GHC.Unit.External.Database +import Data.IORef +import Data.Either (partitionEithers) -- --------------------------------------------------------------------------- -- The Unit state @@ -342,7 +356,7 @@ data UnitConfig = UnitConfig , unitConfigHideAll :: !Bool -- ^ Hide all units by default , unitConfigHideAllPlugins :: !Bool -- ^ Hide all plugins units by default - , unitConfigDBCache :: Maybe [UnitDatabase UnitId] + , unitConfigDBCache :: !(ExternalUnitDatabaseCache UnitId) -- ^ Cache of databases to use, in the order they were specified on the -- command line (later databases shadow earlier ones). -- If Nothing, databases will be found using `unitConfigFlagsDB`. @@ -356,7 +370,7 @@ data UnitConfig = UnitConfig , unitConfigHomeUnits :: Set.Set UnitId } -initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig +initUnitConfig :: DynFlags -> ExternalUnitDatabaseCache UnitId -> Set.Set UnitId -> UnitConfig initUnitConfig dflags cached_dbs home_units = let !hu_id = homeUnitId_ dflags !hu_instanceof = homeUnitInstanceOf_ dflags @@ -419,25 +433,73 @@ initUnitConfig dflags cached_dbs home_units = type ModuleNameProvidersMap = UniqMap ModuleName (UniqMap Module ModuleOrigin) +data GlobalUnitKey = + GlobalUnitKey + UnitId -- ^ Unit Id of the 'UnitInfo' + ST.ShortText + +data UnitIndex = UnitIndex + { ui_wireMap :: WiringMap + -- ^ TODO @fendor: document global property + , ui_unwireMap :: UnwiringMap + -- ^ TODO @fendor: document global property + , ui_unitInfoMap :: UnitInfoMap + -- ^ TODO @fendor: This needs to be Map (UnitId, AbiHash) UnitInfo for absolut correctness + } + +initUnitIndex :: UnitIndex +initUnitIndex = UnitIndex + { ui_wireMap = emptyUniqMap + , ui_unwireMap = emptyUniqMap + , ui_unitInfoMap = emptyUniqMap + } + +setWireMap :: WiringMap -> UnitIndex -> UnitIndex +setWireMap wired_map unit_index = + unit_index + { ui_wireMap = wired_map + , ui_unwireMap = listToUniqMap [ (v,k) | (k,v) <- nonDetUniqMapToList wired_map ] + } + +isWireMapEmpty :: UnitIndex -> Bool +isWireMapEmpty unit_index = + isNullUniqMap (ui_wireMap unit_index) + +addUnitInfoMap :: UnitInfoMap -> UnitIndex -> UnitIndex +addUnitInfoMap unit_info_map unit_index = + unit_index + { ui_unitInfoMap = unit_info_map `plusUniqMap` ui_unitInfoMap unit_index + } + +-- lookupUnitInfoMap :: UnitIndex -> UnitId -> Maybe UnitInfo +-- lookupUnitInfoMap unit_index unit_id = +-- lookupUniqMap (ui_unitInfoMap unit_index) unit_id + data UnitState = UnitState { -- | A mapping of 'Unit' to 'UnitInfo'. This list is adjusted -- so that only valid units are here. 'UnitInfo' reflects -- what was stored *on disk*, except for the 'trusted' flag, which -- is adjusted at runtime. (In particular, some units in this map -- may have the 'exposed' flag be 'False'.) + -- + -- TODO @fendor: All values are shared with 'UnitIndex.ui_unitInfoMap'. unitInfoMap :: UnitInfoMap, + -- | Local overlay for the unit info so that sharing is more accurate + trustedUnits :: Set.Set UnitId, -- TODO @fendor: UniqSet + distrustedUnits :: Set.Set UnitId, -- TODO @fendor: UniqSet + -- | A mapping of 'PackageName' to 'UnitId'. If several units have the same -- package name (e.g. different instantiations), then we return one of them... -- This is used when users refer to packages in Backpack includes. -- And also to resolve package qualifiers with the PackageImports extension. packageNameMap :: UniqFM PackageName UnitId, - -- | A mapping from database unit keys to wired in unit ids. - wireMap :: UniqMap UnitId UnitId, + -- -- | A mapping from database unit keys to wired in unit ids. + -- wireMap :: WiringMap, - -- | A mapping from wired in unit ids to unit keys from the database. - unwireMap :: UniqMap UnitId UnitId, + -- -- | A mapping from wired in unit ids to unit keys from the database. + -- unwireMap :: UnwiringMap, -- | The units we're going to link in eagerly. This list -- should be in reverse dependency order; that is, a unit @@ -479,9 +541,11 @@ data UnitState = UnitState { emptyUnitState :: UnitState emptyUnitState = UnitState { unitInfoMap = emptyUniqMap, + trustedUnits = Set.empty, + distrustedUnits = Set.empty, packageNameMap = emptyUFM, - wireMap = emptyUniqMap, - unwireMap = emptyUniqMap, + -- wireMap = emptyUniqMap, + -- unwireMap = emptyUniqMap, preloadUnits = [], explicitUnits = [], homeUnitDepends = Set.empty, @@ -491,15 +555,6 @@ emptyUnitState = UnitState { allowVirtualUnits = False } --- | Unit database -data UnitDatabase unit = UnitDatabase - { unitDatabasePath :: OsPath - , unitDatabaseUnits :: [GenUnitInfo unit] - } - -instance Outputable u => Outputable (UnitDatabase u) where - ppr (UnitDatabase fp _u) = text "DB:" <+> ppr fp - type UnitInfoMap = UniqMap UnitId UnitInfo -- | Find the unit we know about with the given unit, if any @@ -618,6 +673,21 @@ mkUnitInfoMap infos = foldl' add emptyUniqMap infos listUnitInfo :: UnitState -> [UnitInfo] listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) +isUnitTrusted :: HasDebugCallStack => UnitState -> Unit -> Bool +isUnitTrusted ue u = + Set.member (toUnitId u) (trustedUnits ue) && (Set.notMember (toUnitId u) (distrustedUnits ue)) + || unitIsTrusted (unsafeLookupUnit ue u) + +isUnitIdTrusted :: HasDebugCallStack => UnitState -> UnitId -> Bool +isUnitIdTrusted ue u = + Set.member u (trustedUnits ue) && (Set.notMember u (distrustedUnits ue)) + || unitIsTrusted (unsafeLookupUnitId ue u) + +isUnitInfoTrusted :: HasDebugCallStack => UnitState -> UnitInfo -> Bool +isUnitInfoTrusted ue unit_info = + Set.member (unitId unit_info) (trustedUnits ue) && (Set.notMember (unitId unit_info) (distrustedUnits ue)) + || unitIsTrusted unit_info + -- ---------------------------------------------------------------------------- -- Loading the unit db files and building up the unit state @@ -628,20 +698,22 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) -initUnits logger dflags cached_dbs home_units = do +initUnits :: Logger -> DynFlags -> IORef UnitIndex -> ExternalUnitDatabaseCache UnitId -> Set.Set UnitId -> IO (UnitState, HomeUnit, Maybe PlatformConstants) +initUnits logger dflags unit_index cached_dbs home_units = do - let forceUnitInfoMap (state, _) = unitInfoMap state `seq` () + let forceUnitInfoMap state = unitInfoMap state `seq` () - (unit_state,dbs) <- withTiming logger (text "initializing unit database") + unit_state <- withTiming logger (text "initializing unit database") forceUnitInfoMap - $ mkUnitState logger (initUnitConfig dflags cached_dbs home_units) + $ mkUnitState logger unit_index (initUnitConfig dflags cached_dbs home_units) putDumpFileMaybe logger Opt_D_dump_mod_map "Module Map" FormatText (updSDocContext (\ctx -> ctx {sdocLineLength = 200}) $ pprModuleMap (moduleNameProvidersMap unit_state)) - let home_unit = mkHomeUnit unit_state + wireMap <- ui_wireMap <$> readIORef unit_index + + let home_unit = mkHomeUnit wireMap (homeUnitId_ dflags) (homeUnitInstanceOf_ dflags) (homeUnitInstantiations_ dflags) @@ -663,19 +735,18 @@ initUnits logger dflags cached_dbs home_units = do Nothing -> return Nothing Just info -> lookupPlatformConstants (fmap ST.unpack (unitIncludeDirs info)) - return (dbs,unit_state,home_unit,mconstants) + return (unit_state,home_unit,mconstants) mkHomeUnit - :: UnitState + :: WiringMap -> UnitId -- ^ Home unit id -> Maybe UnitId -- ^ Home unit instance of -> [(ModuleName, Module)] -- ^ Home unit instantiations -> HomeUnit -mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations_ = +mkHomeUnit wmap hu_id hu_instanceof hu_instantiations_ = let -- Some wired units can be used to instantiate the home unit. We need to -- replace their unit keys with their wired unit ids. - wmap = wireMap unit_state hu_instantiations = map (fmap (upd_wired_in_mod wmap)) hu_instantiations_ in case (hu_instanceof, hu_instantiations) of (Nothing,[]) -> DefiniteHomeUnit hu_id Nothing @@ -700,7 +771,7 @@ readUnitDatabases :: Logger -> UnitConfig -> IO [UnitDatabase UnitId] readUnitDatabases logger cfg = do conf_refs <- getUnitDbRefs cfg confs <- liftM catMaybes $ mapM (resolveUnitDatabase cfg) conf_refs - mapM (readUnitDatabase logger cfg) confs + mapM (readOrGetUnitDatabase logger cfg) confs getUnitDbRefs :: UnitConfig -> IO [PkgDbRef] @@ -752,6 +823,18 @@ 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 -> UnitConfig -> OsPath -> IO (UnitDatabase UnitId) +readOrGetUnitDatabase logger cfg conf_file = + readExternalUnitDatabase (unitConfigDBCache cfg) conf_file >>= \ case + Nothing -> do + new_db <- readUnitDatabase logger cfg conf_file + cacheExternalUnitDatabase (unitConfigDBCache cfg) new_db + pure new_db + Just db -> + pure db + +-- | Read the 'UnitDatabase' at the given location. readUnitDatabase :: Logger -> UnitConfig -> OsPath -> IO (UnitDatabase UnitId) readUnitDatabase logger cfg conf_file = do isdir <- OsPath.doesDirectoryExist conf_file @@ -782,7 +865,8 @@ readUnitDatabase logger cfg conf_file = do pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . mapUnitInfo (\(UnitKey x) -> UnitId x) . mkUnitKeyInfo) proto_pkg_configs -- - return $ UnitDatabase conf_file' pkg_configs1 + pkg_configs2 <- traverse evaluateUnitInfo pkg_configs1 + return $ pkg_configs2 `seqList` UnitDatabase conf_file' pkg_configs2 where readDirStyleUnitInfo :: OsPath -> IO [DbUnitInfo] readDirStyleUnitInfo conf_dir = do @@ -834,11 +918,6 @@ readUnitDatabase logger cfg conf_file = do else return (Just []) -- ghc-pkg will create it when it's updated else return Nothing -distrustAllUnits :: [UnitInfo] -> [UnitInfo] -distrustAllUnits pkgs = map distrust pkgs - where - distrust pkg = pkg{ unitIsTrusted = False } - mungeUnitInfo :: OsPath -> OsPath -> UnitInfo -> UnitInfo mungeUnitInfo top_dir pkgroot = @@ -866,6 +945,29 @@ mungeBytecodeLibFields pkg = ds -> ds } +evaluateUnitInfo :: UnitInfo -> IO UnitInfo +evaluateUnitInfo ui = do + importDirs <- evaluate $ unitImportDirs ui + includeDirs <- evaluate $ unitIncludeDirs ui + libraryDirs <- evaluate $ unitLibraryDirs ui + libraryBytecodeDirs <- evaluate $ unitLibraryBytecodeDirs ui + extDepFrameworkDirs <- evaluate $ unitExtDepFrameworkDirs ui + haddockInterfaces <- evaluate $ unitHaddockInterfaces ui + haddockHTMLs <- evaluate $ unitHaddockHTMLs ui + libraryDynDirs <- evaluate $ unitLibraryDynDirs ui + libraryDirsStatic <- evaluate $ unitLibraryDirsStatic ui + evaluate ui + { unitImportDirs = importDirs + , unitIncludeDirs = includeDirs + , unitLibraryDirs = libraryDirs + , unitLibraryDynDirs = libraryDynDirs + , unitLibraryDirsStatic = libraryDirsStatic + , unitLibraryBytecodeDirs = libraryBytecodeDirs + , unitExtDepFrameworkDirs = extDepFrameworkDirs + , unitHaddockInterfaces = haddockInterfaces + , unitHaddockHTMLs = haddockHTMLs + } + -- ----------------------------------------------------------------------------- -- Modify our copy of the unit database based on trust flags, -- -trust and -distrust. @@ -874,22 +976,28 @@ applyTrustFlag :: UnitPrecedenceMap -> UnusableUnits -> [UnitInfo] + -> (Set.Set UnitId, Set.Set UnitId) -> TrustFlag - -> MaybeErr UnitErr [UnitInfo] -applyTrustFlag prec_map unusable pkgs flag = + -> MaybeErr UnitErr (Set.Set UnitId, Set.Set UnitId) +applyTrustFlag prec_map unusable pkgs (trusted, distrusted) flag = case flag of -- we trust all matching packages. Maybe should only trust first one? -- and leave others the same or set them untrusted TrustPackage str -> case selectPackages prec_map (PackageArg str) pkgs unusable of Left ps -> Failed (TrustFlagErr flag ps) - Right (ps,qs) -> Succeeded (map trust ps ++ qs) - where trust p = p {unitIsTrusted=True} + Right (ps,_) -> Succeeded (insertAll ps trusted, removeAll ps distrusted) DistrustPackage str -> case selectPackages prec_map (PackageArg str) pkgs unusable of Left ps -> Failed (TrustFlagErr flag ps) - Right (ps,qs) -> Succeeded (distrustAllUnits ps ++ qs) + Right (ps,_) -> Succeeded (removeAll ps trusted, insertAll ps distrusted) + +insertAll :: [UnitInfo] -> Set UnitId -> Set UnitId +insertAll elements set = foldl' (\ acc -> flip Set.insert acc . unitId) set elements + +removeAll :: [UnitInfo] -> Set UnitId -> Set UnitId +removeAll elements set = foldl' (\ acc -> flip Set.delete acc . unitId) set elements applyPackageFlag :: UnitPrecedenceMap @@ -1093,6 +1201,7 @@ pprTrustFlag flag = case flag of -- See Note [Wired-in units] in GHC.Unit.Types type WiringMap = UniqMap UnitId UnitId +type UnwiringMap = UniqMap UnitId UnitId findWiredInUnits :: Logger @@ -1100,9 +1209,7 @@ findWiredInUnits -> [UnitInfo] -- database -> VisibilityMap -- info on what units are visible -- for wired in selection - -> IO ([UnitInfo], -- unit database updated for wired in - WiringMap) -- map from unit id to wired identity - + -> IO WiringMap -- map from unit id to wired identity findWiredInUnits logger prec_map pkgs vis_map = do -- Now we must find our wired-in units, and rename them to -- their canonical names (eg. base-1.0 ==> base), as described @@ -1165,27 +1272,41 @@ findWiredInUnits logger prec_map pkgs vis_map = do , not (unitIsIndefinite realUnitInfo) ] - updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs - where upd_pkg pkg - | Just wiredInUnitId <- lookupUniqMap wiredInMap (unitId pkg) - = pkg { unitId = wiredInUnitId - , unitInstanceOf = wiredInUnitId - -- every non instantiated unit is an instance of - -- itself (required by Backpack...) - -- - -- See Note [About units] in GHC.Unit - } - | otherwise - = pkg - upd_deps pkg = pkg { - unitDepends = map (upd_wired_in wiredInMap) (unitDepends pkg), - unitExposedModules - = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) - (unitExposedModules pkg) - } - - - return (updateWiredInDependencies pkgs, wiredInMap) + return wiredInMap + +updateWiredInUnits :: WiringMap -> UnitInfoMap -> [UnitInfo] -> [Either UnitInfo UnitInfo] +updateWiredInUnits wiredInMap knownInfos pkgs = + map (updateWiredInUnitsInUnitInfo wiredInMap knownInfos) pkgs + +updateWiredInUnitsInUnitInfo :: WiringMap -> UnitInfoMap -> UnitInfo -> Either UnitInfo UnitInfo +updateWiredInUnitsInUnitInfo wiredInMap knownInfos pkg = + let + upd_pkg pkg + | Just wiredInUnitId <- lookupUniqMap wiredInMap (unitId pkg) + = pkg { unitId = wiredInUnitId + , unitInstanceOf = wiredInUnitId + -- every non instantiated unit is an instance of + -- itself (required by Backpack...) + -- + -- See Note [About units] in GHC.Unit + } + | otherwise + = pkg + upd_deps pkg = pkg { + unitDepends = map (upd_wired_in wiredInMap) (unitDepends pkg), + unitExposedModules + = map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v)) + (unitExposedModules pkg) + } + in + case lookupUniqMap knownInfos (unitId pkg) of + Just ui -> + Right ui + Nothing -> + let + updated_pkg = upd_deps $ upd_pkg pkg + in + Left updated_pkg -- Helper functions for rewiring Module and Unit. These -- rewrite Units of modules in wired-in packages to the form known to the @@ -1468,9 +1589,10 @@ validateDatabase cfg pkg_map1 = mkUnitState :: Logger + -> IORef UnitIndex -> UnitConfig - -> IO (UnitState,[UnitDatabase UnitId]) -mkUnitState logger cfg = do + -> IO UnitState +mkUnitState logger unit_index cfg = do {- Plan. @@ -1524,15 +1646,19 @@ mkUnitState logger cfg = do we build a mapping saying what every in scope module name points to. -} - -- if databases have not been provided, read the database flags - raw_dbs <- case unitConfigDBCache cfg of - Nothing -> readUnitDatabases logger cfg - Just dbs -> return dbs + raw_dbs <- readUnitDatabases logger cfg -- distrust all units if the flag is set - let distrust_all db = db { unitDatabaseUnits = distrustAllUnits (unitDatabaseUnits db) } - dbs | unitConfigDistrustAll cfg = map distrust_all raw_dbs - | otherwise = raw_dbs + let unitsOf db = Set.fromList $ map unitId (unitDatabaseUnits db) + allUnits = Set.unions $ map unitsOf raw_dbs + + distrustedUnits + | unitConfigDistrustAll cfg = allUnits + | otherwise = Set.empty + + trustedUnits = Set.empty + + dbs = raw_dbs -- This, and the other reverse's that you will see, are due to the fact that @@ -1555,11 +1681,12 @@ mkUnitState logger cfg = do reportCycles logger sccs reportUnusable logger unusable - -- Apply trust flags (these flags apply regardless of whether + -- Compute trust flags (these flags apply regardless of whether -- or not packages are visible or not) - pkgs1 <- mayThrowUnitErr - $ foldM (applyTrustFlag prec_map unusable) - (nonDetEltsUniqMap pkg_map2) (reverse (unitConfigFlagsTrusted cfg)) + (!trusted, !distrusted) <- mayThrowUnitErr + $ foldM (applyTrustFlag prec_map unusable (nonDetEltsUniqMap pkg_map2)) + (trustedUnits, distrustedUnits) (reverse (unitConfigFlagsTrusted cfg)) + let pkgs1 = nonDetEltsUniqMap pkg_map2 let prelim_pkg_db = mkUnitInfoMap pkgs1 -- @@ -1625,7 +1752,21 @@ mkUnitState logger cfg = do -- it modifies the unit ids of wired in packages, but when we process -- package arguments we need to key against the old versions. -- - (pkgs2, wired_map) <- findWiredInUnits logger prec_map pkgs1 vis_map2 + ui <- readIORef unit_index + (wired_map, pkgs2) <- do + wireMap <- if isWireMapEmpty ui + then do + wmap <- findWiredInUnits logger prec_map pkgs1 vis_map2 + modifyIORef' unit_index (setWireMap wmap) + pure wmap + else do + pure $ ui_wireMap ui + + let all_pkgs = updateWiredInUnits wireMap (ui_unitInfoMap ui) pkgs1 + (new_pkgs, _pkgs_set) = partitionEithers all_pkgs + modifyIORef' unit_index (addUnitInfoMap $ mkUnitInfoMap new_pkgs) + pure (wireMap, map (either id id) all_pkgs) + let pkg_db = mkUnitInfoMap pkgs2 -- Update the visibility map, so we treat wired packages as visible. @@ -1707,15 +1848,17 @@ mkUnitState logger cfg = do , explicitUnits = explicit_pkgs , homeUnitDepends = home_unit_deps , unitInfoMap = pkg_db + , trustedUnits = trusted + , distrustedUnits = distrusted , moduleNameProvidersMap = mod_map , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger cfg pkg_db plugin_vis_map , packageNameMap = pkgname_map - , wireMap = wired_map - , unwireMap = listToUniqMap [ (v,k) | (k,v) <- nonDetUniqMapToList wired_map ] + -- , wireMap = wired_map + -- , unwireMap = listToUniqMap [ (v,k) | (k,v) <- nonDetUniqMapToList wired_map ] , requirementContext = req_ctx , allowVirtualUnits = unitConfigAllowVirtual cfg } - return (state, raw_dbs) + return state selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True @@ -1732,9 +1875,9 @@ selectHomeUnits home_units flags = foldl' go Set.empty flags -- | Given a wired-in 'Unit', "unwire" it into the 'Unit' -- that it was recorded as in the package database. -unwireUnit :: UnitState -> Unit -> Unit +unwireUnit :: UnitIndex -> Unit -> Unit unwireUnit state uid@(RealUnit (Definite def_uid)) = - maybe uid (RealUnit . Definite) (lookupUniqMap (unwireMap state) def_uid) + maybe uid (RealUnit . Definite) (lookupUniqMap (ui_unwireMap state) def_uid) unwireUnit _ uid = uid -- ----------------------------------------------------------------------------- @@ -2151,10 +2294,10 @@ pprUnitsWith pprIPI pkgstate = -- The idea is to only print package id, and any information that might -- be different from the package databases (exposure, trust) pprUnitsSimple :: UnitState -> SDoc -pprUnitsSimple = pprUnitsWith pprIPI +pprUnitsSimple ue = pprUnitsWith pprIPI ue where pprIPI ipi = let i = unitIdFS (unitId ipi) e = if unitIsExposed ipi then text "E" else text " " - t = if unitIsTrusted ipi then text "T" else text " " + t = if isUnitInfoTrusted ue ipi then text "T" else text " " in e <> t <> text " " <> ftext i -- | Show the mapping of modules to where they come from. ===================================== compiler/ghc.cabal.in ===================================== @@ -966,6 +966,7 @@ Library GHC.Unit GHC.Unit.Env GHC.Unit.External + GHC.Unit.External.Database GHC.Unit.Finder GHC.Unit.Finder.Types GHC.Unit.Home ===================================== ghc/GHCi/UI.hs ===================================== @@ -856,10 +856,12 @@ installInteractiveHomeUnits dflags = do where setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> m HomeUnitEnv setupHomeUnitFor logger dflags all_home_units = do - (dbs,unit_state,home_unit,_mconstants) <- - liftIO $ initUnits logger dflags Nothing all_home_units + env <- GHC.getSession + let unit_index = hsc_unit_index env + (unit_state,home_unit,_mconstants) <- + liftIO $ initUnits logger dflags unit_index (hscEUDC env) all_home_units hpt <- liftIO emptyHomePackageTable - pure (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags hpt (Just home_unit)) + pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit)) concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag] concatPackageDbStacksUsingLongestCommonPrefix stacks = @@ -2919,11 +2921,11 @@ isSafeModule m = do packageTrusted hsc_env md | isHomeModule (hsc_home_unit hsc_env) md = True - | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md) + | otherwise = isUnitTrusted (hsc_units hsc_env) (moduleUnit md) tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty) | otherwise = S.partition part deps - where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg + where part pkg = isUnitIdTrusted unit_state pkg unit_state = hsc_units hsc_env dflags = hsc_dflags hsc_env ===================================== libraries/ghc-boot/GHC/Unit/Database.hs ===================================== @@ -746,11 +746,20 @@ mungeUnitInfoPaths top_dir pkgroot pkg = , unitHaddockHTMLs = munge_paths (munge_urls (unitHaddockHTMLs pkg)) } where - munge_paths = map munge_path - munge_urls = map munge_url + munge_paths = strictMap munge_path + munge_urls = strictMap munge_url (munge_path,munge_url) = mkMungePathUrl top_dir pkgroot -- | Decode an 'OsPath' to 'FilePath', throwing an 'error' if decoding failed. -- Prefer 'decodeUtf' and gracious error handling. unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath unsafeDecodeUtf = OsPath.Internal.so + +strictMap :: (a -> b) -> [a] -> [b] +strictMap _ [] = [] +strictMap f (x:xs) = + let + !x' = f x + !xs' = strictMap f xs + in + x' : xs' ===================================== utils/haddock/haddock-api/src/Haddock.hs ===================================== @@ -258,7 +258,9 @@ haddockWithGhc ghc args = handleTopExceptions $ do logger' <- getLogger let logger = setLogFlags logger' (initLogFlags dflags) let parserOpts = Parser.initParserOpts dflags - !unit_state <- hsc_units <$> getSession + env <- getSession + let !unit_state = hsc_units env + !unit_index <- liftIO $ hscUnitIndex env -- If any --show-interface was used, show the given interfaces forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do @@ -285,7 +287,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do } -- Render the interfaces. - liftIO $ renderStep dflags parserOpts logger unit_state flags sinceQual qual concSem packages ifaces + liftIO $ renderStep dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem packages ifaces -- If we were not given any input files, error if documentation was -- requested @@ -298,7 +300,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do packages <- liftIO $ readInterfaceFiles name_cache (readIfaceArgs flags) noChecks -- Render even though there are no input files (usually contents/index). - liftIO $ renderStep dflags parserOpts logger unit_state flags sinceQual qual concSem packages [] + liftIO $ renderStep dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem packages [] -- | Run the GHC action using a temporary output directory withTempOutputDir :: Ghc a -> Ghc a @@ -354,6 +356,7 @@ renderStep :: DynFlags -> ParserOpts -> Logger + -> UnitIndex -> UnitState -> [Flag] -> SinceQual @@ -362,7 +365,7 @@ renderStep -> [(DocPaths, Visibility, FilePath, InterfaceFile)] -> [Interface] -> IO () -renderStep dflags parserOpts logger unit_state flags sinceQual nameQual concSem pkgs interfaces = do +renderStep dflags parserOpts logger unit_index unit_state flags sinceQual nameQual concSem pkgs interfaces = do updateHTMLXRefs (map (\(docPath, _ifaceFilePath, _showModules, ifaceFile) -> ( case baseUrl flags of Nothing -> docPathsHtml docPath @@ -378,7 +381,7 @@ renderStep dflags parserOpts logger unit_state flags sinceQual nameQual concSem (DocPaths {docPathsSources=Just path}, _, _, ifile) <- pkgs iface <- ifInstalledIfaces ifile return (instMod iface, path) - render dflags parserOpts logger unit_state flags sinceQual nameQual concSem interfaces installedIfaces extSrcMap + render dflags parserOpts logger unit_index unit_state flags sinceQual nameQual concSem interfaces installedIfaces extSrcMap where -- get package name from unit-id packageName :: Unit -> String @@ -392,6 +395,7 @@ render :: DynFlags -> ParserOpts -> Logger + -> UnitIndex -> UnitState -> [Flag] -> SinceQual @@ -401,7 +405,7 @@ render -> [(FilePath, PackageInterfaces)] -> Map Module FilePath -> IO () -render dflags parserOpts logger unit_state flags sinceQual qual concSem ifaces packages extSrcMap = do +render dflags parserOpts logger unit_index unit_state flags sinceQual qual concSem ifaces packages extSrcMap = do let packageInfo = PackageInfo { piPackageName = fromMaybe (PackageName mempty) $ optPackageName flags @@ -503,7 +507,7 @@ render dflags parserOpts logger unit_state flags sinceQual qual concSem ifaces p -- records the *wired in* identity base. So untranslate it -- so that we can service the request. unwire :: Module -> Module - unwire m = m { moduleUnit = unwireUnit unit_state (moduleUnit m) } + unwire m = m { moduleUnit = unwireUnit unit_index (moduleUnit m) } reexportedIfaces <- concat `fmap` (for (reexportFlags flags) $ \mod_str -> do let warn' = hPutStrLn stderr . ("Warning: " ++) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d499fe14e89d9e860eed142bc8db87… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d499fe14e89d9e860eed142bc8db87… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/external-unit-db-cache] 64 commits: Trim the continuation in mkDupableContWithDmds
by Hannes Siebenhandl (＠fendor) 16 Jun '26

16 Jun '26

Hannes Siebenhandl pushed to branch wip/fendor/external-unit-db-cache at Glasgow Haskell Compiler / GHC Commits: 4a645683 by Simon Peyton Jones at 2026-05-27T21:41:59-04:00 Trim the continuation in mkDupableContWithDmds When there are no remaining argument demands, it means the application is bottoming. In this case, we can trim the continuation to avoid the panic that was observed in #27261. See Note [Trimming the continuation for bottoming functions] in GHC.Core.Opt.Simplify.Iteration. - - - - - 8ab506ff by Cheng Shao at 2026-05-27T21:42:47-04:00 ghci: fix module name string lifetime in hs_hpc_module invocation This patch makes hpcAddModule pass a properly malloced module name string to hs_hpc_module, instead of using useAsCString which causes use-after-free of module name string. Fixes #27297. Co-authored-by: Codex <codex(a)openai.com> - - - - - b0233814 by sheaf at 2026-05-27T21:43:31-04:00 Relax acceptance threshold for T10421 As seen in #27289, the 1% acceptance threshold for this text was overly narrow, resulting in spurious test failures. This commit widens the acceptance threshold to 2%. Fixes #27289. - - - - - 63ce5770 by Luite Stegeman at 2026-05-28T12:23:35-04:00 Fixes for black holes - suspend duplicate work for eager black holes - detect eager black holes in checkBlockingQueues - don't overwrite existing black holes even if they're not in an eager blackhole frame - don't deadlock on self when thunk is already blackholed Fixes #26936 - - - - - 037a80dc by Tom McLaughlin at 2026-05-28T12:24:36-04:00 Event/Windows.hsc: rethrow exceptions in overlapped IO This prevents the WinIO manager from swallowing exceptions in overlapped IO. It was added to make WinIO support possible in the `network` library. See https://gitlab.haskell.org/ghc/ghc/-/issues/27283. We also bump __IO_MANAGER_WINIO__ to 2 so libraries can gate on this using CPP. - - - - - 2d53bcdb by Wolfgang Jeltsch at 2026-05-28T12:25:21-04:00 Allow `downsweep` to use nodes of an existing module graph To this end, `downsweep` has not been able to use the nodes of a module graph obtained from a previous downsweeping round. In some GHC API applications, downsweeping is performed somewhat incrementally and therefore could profit from reusing such existing results. This contribution makes this possible. Resolves #27054. Co-authored-by: Matthew Pickering <matthewtpickering(a)gmail.com> - - - - - f4fbb583 by Simon Jakobi at 2026-05-28T12:26:04-04:00 Add regression test for T11226 Closes #11226. - - - - - ed29a5e6 by Sven Tennie at 2026-05-28T17:30:36-04:00 Add optional config setting for LibDir (#19174) Previously, the `libDir` was derived from `topDir`. This won't work for inplace stage2 cross-compilers where binaries and libraries are in different stage dirs (`_build/stage1/` for executables and `_build/stage2` for libraries). `LibDir` is set in the inplace `settings` files. For bindists, we generate a new `settings` file with no `LibDir` entry. GHC then defaults to use `topDir` as `libDir` again. This keeps the bindist relocatable. If `LibDir` is a relative path, it is interpreted relatively to `topDir`. The global package db is part of the `lib/` folder. If we want to point for inplace cross-compilers to the succeeding stage's folder, this is done by setting `LibDir`. Thus, the global package db must be found relative to `libDir`` (which may default to `topDir` or be set by `LibDir`). The complexity of settings becomes scary. So, add a test to ensure `LibDir` works as expected. - - - - - 8339cf8f by Sven Tennie at 2026-05-28T17:30:36-04:00 Add Haddock to FileSettings Helping to understand the fields' meanings without deeper analyses. - - - - - 4ce251e4 by Sylvain Henry at 2026-05-28T17:31:39-04:00 foundation test: skip signed minBound `quot` (-1) (#27222) `minBound `quot` (-1)` for fixed-width signed integers is platform dependent: the mathematical result -minBound is not representable in the type. On x86, IDIV traps; LLVM's sdiv is undefined behaviour in this case; on AArch64/RISC-V, SDIV wraps to minBound. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - b8ba7e61 by Simon Jakobi at 2026-05-28T17:32:23-04:00 Prevent dictionary-passing in checkTyEqRhs ...by pre-specializing it to TcM. Previously, wherever checkTyEqRhs was used in other modules, the Core showed dictionary passing ($fMonadIOEnv). The added SPECIALIZE pragma prevents this. - - - - - d603477f by David Eichmann at 2026-05-29T13:17:12-04:00 Hadrian: create a ghc-internal .def file per ghc-internal dll The .def file generated from rts/win32/libHSghc-internal.def.in contains the name of the ghc-internal dll. The correct dll name differs based on if the dll is inplace/final and if using the Dynamic way. Previously, this was not accounted for and inconsistent dlls names where used. That led to failure when loading dlls at runtime in experiments with windows dynamic linking. - - - - - 1fc21753 by Sylvain Henry at 2026-05-29T13:18:14-04:00 ghc-bignum: copy backend interface haddocks to Native backend (#27305) The haddock comments documenting the BigNat backend interface (function contracts, expected MutableWordArray# sizes, return-value semantics, etc.) were attached to the FFI backend module. Copy them to the Native backend so they remain in tree once the FFI backend is removed. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - 717059df by Sylvain Henry at 2026-05-29T13:18:14-04:00 ghc-bignum: remove FFI backend (#27305) The FFI backend of ghc-bignum (now part of ghc-internal) had no known users and is easy to recreate by relinking ghc-internal with a custom backend. Remove the backend module, the bignum-ffi cabal flag, and the ffi option from Hadrian's --bignum selector. The backend interface documentation now lives in the Native backend module. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - 4bb3b1d8 by Sylvain Henry at 2026-05-29T13:18:14-04:00 ghc-bignum: remove Check backend (#27305) The Check backend of ghc-bignum (now part of ghc-internal) compared the selected backend's output against the Native backend for validation. It had no known users. Remove the backend module, the bignum-check cabal flag, the bignumCheck Hadrian flavour field, and the check- prefix in Hadrian's --bignum selector. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - 6b3044a0 by David Eichmann at 2026-05-30T11:58:48-04:00 Add code comments to allocator code - - - - - f4e04210 by Matthew Pickering at 2026-05-30T11:59:34-04:00 hadrian: Refactor system-cxx-std-lib rules I noticed a few things wrong with the hadrian rules for `system-cxx-std-lib` rules. * For `text` there is an ad-hoc check to depend on `system-cxx-std-lib` outside of `configurePackage`. * The `system-cxx-std-lib` dependency is not read from cabal files. * Recache is not called on the packge database after the `.conf` file is generated, a more natural place for this rule is `registerRules`. Treating this uniformly like other packages is complicated by it not having any source code or a cabal file. However we can do a bit better by reporting the dependency firstly in `PackageData` and then needing the `.conf` file in the same place as every other package in `configurePackage`. This commit increases the `shakeVersion`, to provide backwards compatibility to previous builds with different PackageData. Fixes #25303 Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com> - - - - - 576987d0 by Simon Jakobi at 2026-06-02T04:53:36-04:00 compiler: use nubOrd from containers Address #27103 by replacing GHC.Utils.Misc.ordNub[On] with Data.Containers.ListUtils.nubOrd[On]. Note that nubOrd suffers from a small inefficiency, a fix for which will be included in the next containers release: https://github.com/haskell/containers/issues/1202 - - - - - deea53c3 by David Eichmann at 2026-06-02T04:54:22-04:00 Hadrian: disable response files for GHC/Haddock builders on non-Windows This makes debugging build errors easier on non-windows hosts. See issue #27230 - - - - - f2f5c6ba by Nikita Efremov at 2026-06-02T16:04:54+00:00 fix typo : compete with performance, not complete - - - - - 5524ea0e by Wolfgang Jeltsch at 2026-06-03T08:01:26-04:00 Make the current `base` buildable with GHC 9.14 This comprises the following changes: * Disable some imports into `GHC.Base` for GHC 9.14 * Disable some imports into `Prelude` for GHC 9.14 * Disable separate `ArrowLoop` import for GHC 9.14 * Disable `GHC.Internal.STM` import for GHC 9.14 * Disable `GHC.Internal.Unicode.Version` import for GHC 9.14 * Disable `GHC.Internal.TH.Monad` import for GHC 9.14 * Add alternative `fixIO` import for GHC 9.14 * Add alternative `unsafeCodeCoerce` import for GHC 9.14 * Disable hiding of imported SIMD operations for GHC 9.14 * Disable use of GHC 9.14’s `printToHandleFinalizerExceptionHandler` * Enable use of `getFileHash` from `ghc-internal` for GHC 9.14 * Make `thenA` available for GHC 9.14 * Make `thenM` available for GHC 9.14 * Disable translation of `IoManagerFlagPoll` for GHC 9.14 * Add `hGetNewlineMode` for GHC 9.14 - - - - - d3438055 by Enrico Maria De Angelis at 2026-06-03T08:02:17-04:00 Fix #27067 - Clarify haddocks on `minusNaturalMaybe` - - - - - f9bcfac2 by sheaf at 2026-06-03T14:47:19-04:00 Avoid mkTick in Core Prep breaking ANF As discovered in #27182, mkTick can break ANF. This patch introduces a variant of mkTick that skips the single optimisation that could break ANF. This is preferrable over switching to the raw Tick constructor, as the latter may introduce spurious cost centres in profiling reports. This is a temporary measure until we more thoroughly refactor how mkTick works (see #27141). See Note [mkTick breaks ANF] in GHC.CoreToStg.Prep. Fixes #27182 - - - - - cf1fd661 by Artem Pelenitsyn at 2026-06-03T14:48:09-04:00 clarify comment for getSizeofMutableByteArray#: we get the size in bytes, not "elements" - - - - - a3b431f3 by David Eichmann at 2026-06-04T10:10:19+00:00 Hadrian: convert env variable ACLOCAL_PATH to unix paths. Convert ACLOCAL_PATH to a unix style path when invoking autoreconf. Autoreconf doesn't handle windows paths. See Note [Autoreconf unix paths from ACLOCAL_PATH]. Fixes #27311 - - - - - 18f6138a by Simon Jakobi at 2026-06-04T20:20:31-04:00 testsuite: Deduplicate --only test names config.only is assumed to be a set, but supplying --only overwrote it with the (list) argparse result, which can contain duplicates. When a test ran, config.only.remove(name) dropped only the first occurrence, so a duplicated name lingered and was later misreported as a "test not found" framework failure. Store it as a set instead. Fixes #27322 Co-Authored-By: Claude Opus 4.7 <noreply(a)anthropic.com> - - - - - 2f3cc9ff by Simon Jakobi at 2026-06-08T07:55:49-04:00 testsuite: detect fast bignum via ghc-internal, not removed ghc-bignum The ghc-bignum package was merged into ghc-internal, so the BIGNUM_GMP probe in test.mk ran `ghc-pkg field ghc-bignum exposed-modules`, which fails with "cannot find package ghc-bignum". That error went to stderr and leaked into the captured stderr of every makefile_test, causing spurious [bad stderr] failures across the suite. The probe also silently returned empty, so config.have_fast_bignum was wrongly False even on GMP builds. Probe ghc-internal's extra-libraries for the gmp library instead: the GMP backend module is an other-module (not exposed), but GMP_LIBS adds gmp to extra-libraries only on a GMP build, so this distinguishes the backends. Redirect stderr to keep any future missing-package error off the harness's stderr. This also removes a stale comment as per suggestion from hsyl20. Co-Authored-By: Claude Opus 4.7 <noreply(a)anthropic.com> - - - - - eb3bf6e7 by Alan Zimmerman at 2026-06-08T07:56:32-04:00 EPA: Rename Transform.anchorEof to addModuleCommentOrigDeltas This now matches what it actually does. - - - - - 498bb21a by David Eichmann at 2026-06-09T18:02:39-04:00 Hadrian: avoid response files when command line is short enough This replaces the logic of always using response files on Windows. With the new condition based on command line lenght, reponse files can be avoided in many more cases (on windows). Now that response files are only used in a small number of cases, response files are always kept and the -r / --keep-response-files command line options have been removed The response file paths are nolonger randomized. They are placed in the `_build/rsp` directory. This ensures they are ignored by git and we that Hadrian reuses response file paths when rebuilding rather than leaving stale response files around. Update user guide putting response files in its own section - - - - - 87f510a5 by Simon Hengel at 2026-06-09T18:03:25-04:00 Don't use non-breaking spaces - - - - - 41a19379 by David Eichmann at 2026-06-09T18:04:11-04:00 Hadrian: remove unused wrapper scripts from windows bindist These wrapper scripts are only installed on non-relocatable builds which are not generally supported on windows. - - - - - ce01ccb6 by sheaf at 2026-06-10T05:08:48-04:00 Don't drop ticks around variables of type `IO ()` GHC.Core.Utils.mkTick is responsible for placing a tick on a Core expression. It contains logic for dropping SCCs (non-counting profiling ticks) around non-function variables, as such variables cannot meaningfully contribute to profiles. However, the logic for what counts as a function was incorrect: it used `isFunTy` which returns 'False' for types such as 'IO ()' where the function arrow is hidden under a newtype. We now use 'mightBeFunTy' instead of 'isFunTy'. This ensures we don't drop ticks in cases we aren't sure. On the way, we improve the documentation of 'isFunTy', 'isPiTy' and 'mightBeFunTy', and update the latter's implementation to consistently handle unary classes. Fixes #27225 ------------------------- Metric Decrease: T5642 ------------------------- - - - - - d311c4f1 by Simon Jakobi at 2026-06-10T05:09:32-04:00 testsuite: Add regression test for #4081 Check that a strict constructor field is unboxed once outside an enclosing loop, not re-inspected each iteration (the float-out case-floating from 9cb20b488). Uses simonpj's `data T a = T !a` example from the ticket; T4081.stderr captures the expected Core. Co-Authored-By: Claude Opus 4.7 <noreply(a)anthropic.com> - - - - - 333df444 by sheaf at 2026-06-10T05:10:25-04:00 Check for cabal-install >= 3.12 upfront Starting with commit 8cb99552f607f6bc4000e45ab32532d50c8bb996, Hadrian requires cabal-install >= 3.12 in order to use the 'cabal path' command that was introduced in version 3.12, as per https://github.com/haskell/cabal/blob/a51c4ee1556d816ad86e90db7e6330dd51b0b… This was not reflected in the Hadrian build script, causing a delayed build failure instead of enforcing the version requirement upfront, which this patch does. Fixes #27317 - - - - - 98c20394 by sheaf at 2026-06-10T05:11:09-04:00 Fix crash in Data.Data instance for HsCtxt The Data.Data instance for HsCtxt contained an error for the 'toConstr' method, which could trigger for example when looking at -ddump-tc-ast traces. Replace it with the 'abstractConstr' pattern used in the rest of the codebase. - - - - - 5ac9ce7d by Zubin Duggal at 2026-06-10T21:26:32+05:30 hadrian: Remove old package.conf files when generating new ones Old package.conf files might exists with different hashes, causing issues like #26661 Fixes #26661 - - - - - c9015f09 by sheaf at 2026-06-11T12:40:28-04:00 Fix AArch64 clobbering bug for MUL2 On AArch64, the code generator could clobber one of the input operands when computing the lower bits of a MUL2 operation. This rendered invalid the subsequent computation of the high bits. This commit fixes that by using a temporary register. The register allocator can remove the redundant move in the common case when the registers do not conflict. Fixes #27046 - - - - - 7ab90288 by Rodrigo Mesquita at 2026-06-11T12:41:11-04:00 fix: make T27131 less flaky It seems that T27131 fails flakily in a race where we check the flag before the capability had the chance to process the mailbox which sets the flag. This seemingly should only happen if the capability ends up being the same for setting and checking the flag. - - - - - 8965cb76 by Marc Scholten at 2026-06-12T04:53:22-04:00 haddock: render modules concurrently - - - - - 8cc0b64a by Duncan Coutts at 2026-06-12T04:54:06-04:00 Promote HAVE_PREEMPTION from Timer.c to OSThreads.h We will want to know about HAVE_PREEMPTION in more places. HAVE_PREEMPTION tells us that we do have OS threads available, irrespective of whether THREADED is defined. In particular, HAVE_PREEMPTION is defined on all proper OSs, but not on WASM (and hyopthetically may not be true on some other platforms like micro-controllers, RTOSs, VM hypervisors etc). - - - - - cce574ed by Duncan Coutts at 2026-06-12T04:54:06-04:00 Define ACQUIRE_LOCK_ALWAYS and friends Fix issue #27335 Like the atomic _ALWAYS variants, these lock actions are always defined, rather than being dependent on whether we are in the THREADED case. All the "normal" LOCK macros are defined to be no-ops when !THREADED. The use case for the _ALWAYS variants is where we are using OS threads even in the non-threaded RTS. This includes everything to do with the timer/ticker thread, which is used in the non-threaded RTS too. In particular, we will want to use this for eventlog things, because the timer thread performs eventlogging concurrently with the main capability, even in the non-threaded RTS. - - - - - 1f28d1f6 by Duncan Coutts at 2026-06-12T04:54:06-04:00 Use ACQUIRE/RELEASE_LOCK_ALWAYS with eventBufMutex Even in the non-threaded RTS the eventBufMutex is needed by both the main capability and the timer/ticker thread, so always use the mutex. This should fix #25165 which is about the main capability and the timer thread posting events to the eventlog buffer concurrently and thereby corrupting the buffer data. - - - - - 0ff29782 by Duncan Coutts at 2026-06-12T04:54:06-04:00 Expose eventBufMutex in the EventLog interface/header We will need it in forkProcess to ensure we don't write to the global eventlog buffer concurrently with trying to flush eventlog buffers and do the fork(). - - - - - 7a688395 by Duncan Coutts at 2026-06-12T04:54:07-04:00 Split flushAllCapsEventsBufs into safe and unlocked version Following the convention that unlocked versions have a trailing _ underscore in their name. This one requires the caller to hold the eventlog global buffer mutex. We will need this in forkProcess. - - - - - 341ed474 by Duncan Coutts at 2026-06-12T04:54:07-04:00 Remove redundant use of stopTimer in setNumCapabilities Historically, the comment here was: We must stop the interval timer while we are changing the capabilities array lest handle_tick may try to context switch an old capability. See #17289. and We must disable the timer while we do this since the tick handler may call contextSwitchAllCapabilities, which may see the capabilities array as we free it. What this refers to is that historically, when changing the number of capabilities, the array of capabilities was reallocated to a new size, allocating new ones and freeing the old ones, thus invalidating all existing capbility pointers. Strangely, for good measure the code used to call stopTimer twice (hence the two similar comments above). However, since commit a3eccf06292dd666b24606251a52da2b466a9612, the capabilities array is no longer reallocated. Instead the array is allcoated once on RTS startup to the maximum size it could ever be allowed to be, and then capabilities get enabled/disabled at runtime. So the capability pointers never become invalid anymore. At worst, they may point to capabilities that are disabled. Thus we no longer need to stop the timer (twice) while we change the number of enabled capabilities. This also partially solves issue #27105, which notes that stopTimer is being used as if it were synchronous, when it is not. At least for this case, the solution is that stopTimer is not needed at all! - - - - - 674858e3 by Duncan Coutts at 2026-06-12T04:54:07-04:00 Remove redundant use of stopTimer in forkProcess but replace it with taking the eventlog buffer lock during the fork. Fixes issue #27105 The original reason to block the timer during a fork was that historically the timer was implemented using a periodic timer signal, and the signal itself would interrupt the fork system call (returning EINTR). For large processes (where fork() takes a while) this could permanently livelock: the timer always would go off before the fork could complete, which got retried in a loop forever. The timer is no longer implemented as a unix signal, but uses threads. Thus the original problem no longer exists. The only remaining reason to block the timer tick is to prevent actions taken by the tick from interfering with the delicate process involved in fork (taking a load of locks and pausing everything). The only thing we need to do is to prevent the eventlog from being written to or flushed while the fork is taking place. To achieve this all we need to do is hold the mutex for the global eventlog buffer. This removes the last use of stopTimer that expects stopTimer to work synchronously (which it was not) and thus solves issue #27105. To be clear, we solve issue #27105 not by making stopTimer synchronous, but by eliminating the use sites that expected it to be synchronous. - - - - - 40764930 by sheaf at 2026-06-12T14:54:43-04:00 Add type family performance test for #26426 Some GHC versions produced large numbers of coercions after typechecking and desugaring when compiling the program in #26426: Version | Typechecker time | Typechecker allocations | Coercions -------:|-----------------:|------------------------:|---------: 9.6 | 47 ms | 48 MB | 110k 9.8 | 1000 ms | 486 MB | 10,437k 9.10 | 922 ms | 489 MB | 10,436k 9.12 | 906 ms | 482 MB | 10,437k 9.14 | 63 ms | 55 MB | 333k 10.0 | 47 ms | 64 MB | 35k The improvement 9.12 -> 9.14 was due to commit 22d11fa818fae2c95c494fc0fac1f8cb4c6e7cb6, while the improvement 9.14 -> 10.0 was due to commit 0b7df6db9e46df40e86fbff1a66dc10440b99db5. As the behaviour of GHC seems better than it's ever been on this program, we declare victory, adding this performance test to ensure we don't regress on this program. On the way, we update Note [Combining equalities] in GHC.Tc.SolveR.Equality with the explanation of the 9.12 -> 9.14 improvement (getting rid of an exponential blowup in coercion sizes), and we update Note [Exploiting closed type families] in GHC.Tc.Solver.FunDeps with the explanation of the 9.14 -> 10.0 improvement (bringing down coercion size growth from cubic to quadratic). - - - - - 0f3d0a71 by Zubin Duggal at 2026-06-12T14:55:30-04:00 compiler: mark tool messages as errors/warnings depending on the exit code Fixes #27370 - - - - - d9ea2d76 by mangoiv at 2026-06-13T04:41:51-04:00 libraries/process: bump submodule to v1.6.30.0 - bump the submodule to the appropriate tag - suppress benign warning resulting from the change - - - - - 6ebaaba3 by David Eichmann at 2026-06-13T04:42:37-04:00 ghc-toolchain: don't throw when candidate executables are not found Fixes #27369 - - - - - 6c65e1e1 by David Eichmann at 2026-06-13T04:43:23-04:00 CI: lint-changelog checks for no-changelog label in script instead of rules - - - - - bab37cc6 by konsumlamm at 2026-06-13T19:10:21+02:00 Implement CLC proposal #378 Add `Data.Double` and `Data.Float` modules Document that GHC uses IEEE 754 - - - - - fb5246ad by fendor at 2026-06-15T18:07:23-04:00 Drop `preloadClosure` from `UnitState` It is always hard-coded to the same value. Backpack Unit instantiation isn't using it any more. Allows us to simplify the API and get rid of `improveUnit`. - - - - - 291ce3aa by ARATA Mizuki at 2026-06-15T18:08:26-04:00 RISC-V NCG: Zero-extend the result of castFloatToWord32 According to the ISA manual, FMV.X.W sign-extends the result. We need to truncate the result to avoid creating an exotic Word32 value. Fixes #27300 - - - - - 011be91f by ARATA Mizuki at 2026-06-15T18:08:26-04:00 RISC-V NCG: Treat d28-d31 (ft8-ft11) as caller-saved According to the calling convention, the registers d28-d31 (ft8-ft11) are caller-saved. Fixes #27306 - - - - - e8a54713 by ARATA Mizuki at 2026-06-15T18:08:26-04:00 RISC-V NCG: Set rounding mode when emitting `truncate` If we omit the rounding mode for `fcvt`, `dyn` will be used. We do not want that for `truncate`, so we set `rtz`. In other places, we set `rne` because we do not use the dynamic rounding mode. Fixes #27303 - - - - - 9438bec7 by Zubin Duggal at 2026-06-15T18:09:11-04:00 rts: fix validate build with gcc 16. `__attribute__((regparm(1)))` is ignored on x86_64 and now gcc warns that it is ignored: rts/sm/Evac.h:35:1: error: error: ‘regparm’ attribute ignored [-Werror=attributes] See https://gcc.gnu.org/git/?p=gcc.git;a=commit;h=ccead81bbc39668376eb5cf47066a… Fixes #27366 - - - - - 893e6133 by Andrew Lelechenko at 2026-06-15T23:55:36+01:00 base: more NonEmpty zips CLC proposal: https://github.com/haskell/core-libraries-committee/issues/409 - - - - - 1314f2fd by David Eichmann at 2026-06-16T05:46:52-04:00 Hadrian: fix ghc-internal .def file name - - - - - 7f72bcb3 by mangoiv at 2026-06-16T05:47:39-04:00 compiler: ignore camelCase and Eta reduce hlint hints These do not cohere with the style used in GHC. After disabling them, hlint lints are much less noisy again. - - - - - 842bef9f by Alan Zimmerman at 2026-06-16T05:48:25-04:00 EPA: Use standard type family declaration for Anno - - - - - 541804ef by fendor at 2026-06-16T14:51:12+02:00 WIP: introduce external unit database cache - - - - - 420972e9 by fendor at 2026-06-16T14:52:07+02:00 Never modify UnitInfo for better sharing - - - - - d499fe14 by fendor at 2026-06-16T14:53:26+02:00 WIP: Introduce UnitIndex for global data - - - - - 228 changed files: - .gitlab-ci.yml - boot - + changelog.d/T27046 - + changelog.d/T27182.md - + changelog.d/T27225 - + changelog.d/T27261 - + changelog.d/T27308 - + changelog.d/T27317 - + changelog.d/T27359 - + changelog.d/fix-blackhole-handling - changelog.d/hadrian-response-files.md - + changelog.d/hadrian-stale-package-confs-26661 - + changelog.d/hadrian-system-cxx-std-lib-25303 - + changelog.d/libdir-setting - + changelog.d/module-graph-reuse-in-downsweep - + changelog.d/remove-bignum-check-backend - + changelog.d/remove-bignum-ffi-backend - + changelog.d/tool-messages-27370 - + changelog.d/windows-rethrow-overlapped-exception - compiler/.hlint.yaml - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Regs.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/List/NonEmpty.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Main/Hsc.hs - compiler/GHC/Driver/Main/Interactive.hs - compiler/GHC/Driver/Main/Passes.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Unit.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Debugger/Breakpoints.hs - compiler/GHC/Runtime/Eval/Types.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Process.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/FunDeps.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Unit.hs - compiler/GHC/Unit/Env.hs - + compiler/GHC/Unit/External/Database.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - compiler/GHC/Utils/Logger.hs - compiler/GHC/Utils/Misc.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/ghc.cabal.in - docs/users_guide/bugs.rst - docs/users_guide/javascript.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - hadrian/README.md - hadrian/build-cabal - hadrian/doc/user-settings.md - hadrian/src/Builder.hs - hadrian/src/CommandLine.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Cabal/Type.hs - hadrian/src/Hadrian/Oracles/Path.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Main.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Control/Applicative.hs - libraries/base/src/Control/Arrow.hs - libraries/base/src/Control/Monad.hs - libraries/base/src/Data/Array/Byte.hs - + libraries/base/src/Data/Double.hs - libraries/base/src/Data/Fixed.hs - + libraries/base/src/Data/Float.hs - libraries/base/src/Data/List/NonEmpty.hs - libraries/base/src/GHC/Base.hs - libraries/base/src/GHC/Conc.hs - libraries/base/src/GHC/Conc/Sync.hs - libraries/base/src/GHC/Exts.hs - libraries/base/src/GHC/Fingerprint.hs - libraries/base/src/GHC/IO/Handle.hs - libraries/base/src/GHC/RTS/Flags.hs - libraries/base/src/GHC/Unicode.hs - libraries/base/src/GHC/Weak.hs - libraries/base/src/GHC/Weak/Finalize.hs - libraries/base/src/Prelude.hs - libraries/base/src/System/IO.hs - libraries/base/src/System/Mem/Weak.hs - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/ghc-boot/GHC/Data/ShortByteString.hs - libraries/ghc-boot/GHC/Settings/Utils.hs - libraries/ghc-boot/GHC/Unit/Database.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-internal/bignum-backend.rst - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs - − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Check.hs - − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/FFI.hs - libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs - − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Selected.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/Lexeme.hs - libraries/ghc-internal/src/GHC/Internal/Natural.hs - libraries/ghci/GHCi/Coverage.hs - libraries/ghci/GHCi/Run.hs - libraries/process - rts/Capability.c - rts/Messages.c - rts/Schedule.c - rts/ThreadPaused.c - rts/Threads.c - rts/Timer.c - rts/Updates.h - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/include/rts/OSThreads.h - rts/include/rts/storage/ClosureMacros.h - rts/sm/BlockAlloc.c - rts/sm/Evac.h - rts/sm/MBlock.c - rts/win32/libHSghc-internal.def.in - testsuite/driver/runtests.py - testsuite/driver/testlib.py - testsuite/mk/test.mk - testsuite/tests/MiniQuickCheck.hs - testsuite/tests/codeGen/should_run/T16617.hs - testsuite/tests/codeGen/should_run/T16617.stdout - + testsuite/tests/codeGen/should_run/T27046.hs - + testsuite/tests/codeGen/should_run/T27046_cmm.cmm - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/driver/T27370/Makefile - + testsuite/tests/driver/T27370/T27370.hs - + testsuite/tests/driver/T27370/T27370.pp - + testsuite/tests/driver/T27370/T27370.stderr - + testsuite/tests/driver/T27370/all.T - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/A.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/B.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/C.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/D.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/X.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Y.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Z.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.stdout - testsuite/tests/ghc-api/downsweep/OldModLocation.hs - testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs - testsuite/tests/ghc-api/downsweep/all.T - testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs - + testsuite/tests/ghc-api/settings/LibDir.hs - + testsuite/tests/ghc-api/settings/LibDir.stdout - + testsuite/tests/ghc-api/settings/all.T - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/numeric/should_run/foundation.hs - + testsuite/tests/perf/compiler/T26426.hs - testsuite/tests/perf/compiler/all.T - + testsuite/tests/perf/should_run/T11226.hs - + testsuite/tests/perf/should_run/T11226.stdout - testsuite/tests/perf/should_run/all.T - + testsuite/tests/profiling/should_compile/T27182.hs - testsuite/tests/profiling/should_compile/all.T - + testsuite/tests/profiling/should_run/T27225.hs - + testsuite/tests/profiling/should_run/T27225.stdout - + testsuite/tests/profiling/should_run/T27225b.hs - + testsuite/tests/profiling/should_run/T27225b.stdout - testsuite/tests/profiling/should_run/all.T - testsuite/tests/profiling/should_run/caller-cc/CallerCc1.prof.sample - testsuite/tests/profiling/should_run/callstack001.stdout - testsuite/tests/profiling/should_run/scc001.prof.sample - testsuite/tests/rts/T27131.hs - testsuite/tests/rts/T27131.stdout - + testsuite/tests/simplCore/should_compile/T27261.hs - + testsuite/tests/simplCore/should_compile/T27261_aux.hs - + testsuite/tests/simplCore/should_compile/T4081.hs - + testsuite/tests/simplCore/should_compile/T4081.stderr - testsuite/tests/simplCore/should_compile/all.T - utils/check-exact/Main.hs - utils/check-exact/Transform.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs - utils/haddock/haddock-api/haddock-api.cabal - utils/haddock/haddock-api/src/Haddock.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs - utils/haddock/haddock-api/src/Haddock/Options.hs - utils/haddock/haddock-api/src/Haddock/Utils.hs - utils/haddock/html-test/ref/Hash.html - utils/haddock/html-test/ref/Test.html - utils/haddock/html-test/ref/TypeFamilies3.html The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a00ce157046e07ddea7d35426983d2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a00ce157046e07ddea7d35426983d2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/ghc-9-14-building-base] Correct directory name and clarify GHC version expansion
by Wolfgang Jeltsch (＠jeltsch) 16 Jun '26

16 Jun '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/ghc-9-14-building-base at Glasgow Haskell Compiler / GHC Commits: 86b407c5 by Wolfgang Jeltsch at 2026-06-16T14:34:00+02:00 Correct directory name and clarify GHC version expansion - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1160,10 +1160,10 @@ base-build-with-ghc-914: script: - | ghc_version=9.14.1 - url=https://downloads.haskell.org/~ghc/$ghc_version/ghc-$ghc_version-x86_64… - curl "$url" >ghc-$ghc_version.tar.xz - tar -xJf ghc-$ghc_version.tar.xz - cd ghc-$ghc_version + url=https://downloads.haskell.org/~ghc/${ghc_version}/ghc-${ghc_version}-x8… + curl "$url" >ghc-${ghc_version}.tar.xz + tar -xJf ghc-${ghc_version}.tar.xz + cd ghc-${ghc_version}-x86_64-unknown-linux ./configure --prefix "$PWD/../ghc" make install cd - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86b407c5c066e3406c6d9e2a54a00c8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86b407c5c066e3406c6d9e2a54a00c8… You're receiving this email because of your account on gitlab.haskell.org.

1 0