June 2026 - ghc-commits

[Git][ghc/ghc] Pushed new branch wip/T27383
by Sebastian Graf (＠sgraf812) 17 Jun '26

17 Jun '26

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

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Fix two issues in the documentation of pipeline interruption
by Marge Bot (＠marge-bot) 17 Jun '26

17 Jun '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f6d30767 by Wolfgang Jeltsch at 2026-06-16T15:32:34-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. - - - - - a3fa10e0 by Christian Georgii at 2026-06-16T15:33:26-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 - - - - - d6b2183f by Ian-Woo Kim at 2026-06-16T16:05:29-04:00 Make the order of usages deterministic It has been observed that the ordering of usages can be non-determinstic in parallel builds. Therefore, this contribution introduces sorting of usages based on a platform- and race-independent sorting criterion. Resolves #26877. Co-authored-by: Wolfgang Jeltsch <wolfgang(a)well-typed.com> - - - - - 47db80e5 by Wolfgang Jeltsch at 2026-06-16T16:05:29-04:00 Change the descriptions of two existing changelog entries The descriptions now describe the changes in a user-friendly manner, as opposed to describing the contributions that led to these changes in a developer-friendly manner. - - - - - 7575a005 by Ian Duncan at 2026-06-16T16:05:34-04:00 AArch64: use SXTH, not SXTW, for W32 signExtendReg signExtendReg was using SXTH (sign-extend halfword, 16-bit) for W32-to-W64 sign extension. This should be SXTW (sign-extend word, 32-bit). SXTH only sign-extends the lower 16 bits, producing wrong results for 32-bit values whose bit 15 differs from bit 31. Other fixes: - At sub-W64, code gen for MO_S_Mul2 should use W32 registers for SMULL source operands as per the ARM spec (SMULL Xd, Wn, Wm), and not W64. - Ensure signExtendReg uses the source width for the source operand in SXTW/SXTH/SXTB instructions. GNU as requires sxtw Xd,Wn (not sxtw Xd,Xn), while LLVM's integrated assembler on macOS is lenient. - Fix overflow flag computation for `MO_S_Mul2`. The overflow bit was exactly inverted for sub-W64 operands. Fixes #26978 and #27047 - - - - - 798b1ee0 by Igor Ranieri at 2026-06-16T16:05:35-04:00 haddock: Update CONTRIBUTING with missing step, add missing test dependency - - - - - 36 changed files: - .gitlab-ci.yml - + changelog.d/T26978 - + changelog.d/T27047 - + changelog.d/deterministic-usage-order - + changelog.d/fix-plugin-finder-multi-home-unit.md - changelog.d/module-graph-reuse-in-downsweep - changelog.d/more-efficient-home-unit-imports-finding - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Module/Deps.hs - + testsuite/tests/codeGen/should_gen_asm/aarch64-sxth-mul2.asm - + testsuite/tests/codeGen/should_gen_asm/aarch64-sxth-mul2.cmm - + testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.asm - + testsuite/tests/codeGen/should_gen_asm/aarch64-sxtw.cmm - testsuite/tests/codeGen/should_gen_asm/all.T - + testsuite/tests/codeGen/should_run/aarch64-sxtw-cmm.cmm - + testsuite/tests/codeGen/should_run/aarch64-sxtw-run.hs - + testsuite/tests/codeGen/should_run/aarch64-sxtw-run.stdout - testsuite/tests/codeGen/should_run/all.T - + 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 - utils/haddock/CONTRIBUTING.md - utils/haddock/haddock-test/haddock-test.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/678ee3559c958e9e720ba48df4bcc2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/678ee3559c958e9e720ba48df4bcc2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Find plugins in sibling home units in multiple-home-unit sessions
by Marge Bot (＠marge-bot) 17 Jun '26

17 Jun '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a3fa10e0 by Christian Georgii at 2026-06-16T15:33:26-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 - - - - - 14 changed files: - + changelog.d/fix-plugin-finder-multi-home-unit.md - compiler/GHC/Unit/Finder.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: ===================================== 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/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 ===================================== 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/-/commit/a3fa10e0c93a58f46815c4fab7522f4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3fa10e0c93a58f46815c4fab7522f4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Fix two issues in the documentation of pipeline interruption
by Marge Bot (＠marge-bot) 17 Jun '26

17 Jun '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f6d30767 by Wolfgang Jeltsch at 2026-06-16T15:32:34-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. - - - - - 1 changed file: - .gitlab-ci.yml 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. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6d3076790dc4306d06080f4c42a8c4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6d3076790dc4306d06080f4c42a8c4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/az/ttg-hscondetails
by Alan Zimmerman (＠alanz) 17 Jun '26

17 Jun '26

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

1 0

[Git][ghc/ghc][wip/az/exactprint-annotation-rationalisation] 5 commits: EPA: Harmonise HsQual/HsQualTy TTG extension annotations
by Alan Zimmerman (＠alanz) 17 Jun '26

17 Jun '26

Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC Commits: d034595f by Alan Zimmerman at 2026-06-16T18:12:33+01:00 EPA: Harmonise HsQual/HsQualTy TTG extension annotations - - - - - 6444ba68 by Alan Zimmerman at 2026-06-16T18:12:33+01:00 EPA Remove LocatedLC / LocatedLS LocatedLC/LocatedLS were unused - - - - - d21dc757 by Alan Zimmerman at 2026-06-16T18:33:42+01:00 EPA: Remove LocatedLW from LStmtLR - - - - - a73050b5 by Alan Zimmerman at 2026-06-16T18:33:42+01:00 EPA: Remove LocatedLW from MatchGroup This is the last usage of LocatedLW / SrcSpanAnnLW - - - - - 79c8e7d0 by Alan Zimmerman at 2026-06-16T18:33:42+01:00 EPA: Move the 'where' annotation for PatSynBind This allows us to move it out of the MatchGroup exact print annotation too - - - - - 38 changed files: - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Expr.hs - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/ghc-api/exactprint/T22919.stderr - testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T15279.stderr - testsuite/tests/parser/should_compile/T20718.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/parser/should_compile/all.T - testsuite/tests/printer/Test20297.stdout - testsuite/tests/printer/Test24533.stdout - utils/check-exact/ExactPrint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01db143ebe9d4a1a53f18f86fc1e90… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01db143ebe9d4a1a53f18f86fc1e90… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[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