Hannes Siebenhandl pushed to branch wip/fendor/27834 at Glasgow Haskell Compiler / GHC
Commits:
-
50b56b9c
by Hannes Siebenhandl at 2026-10-01T10:20:44+02:00
7 changed files:
- changelog.d/unit-index
- compiler/GHC/Unit/External/Wired.hs
- compiler/GHC/Unit/State.hs
- + testsuite/tests/ghci/scripts/T27834.hs
- + testsuite/tests/ghci/scripts/T27834.script
- + testsuite/tests/ghci/scripts/T27834.stdout
- testsuite/tests/ghci/scripts/all.T
Changes:
| 1 | 1 | section: compiler
|
| 2 | 2 | synopsis: Use global ``UnitIndex`` to deduplicate ``UnitInfo``s over multiple home units
|
| 3 | -issues: #27500 #26423 #27748
|
|
| 4 | -mrs: !16115 !16598
|
|
| 3 | +issues: #27500 #26423 #27748 #27834
|
|
| 4 | +mrs: !16115 !16598 !16743
|
|
| 5 | 5 | |
| 6 | 6 | description: {
|
| 7 | 7 | The ``UnitState`` used to be duplicated for all ``HomeUnitEnv``, not sharing any of the ``UnitInfo``s.
|
| ... | ... | @@ -5,6 +5,7 @@ module GHC.Unit.External.Wired ( |
| 5 | 5 | isWireMapEmpty,
|
| 6 | 6 | lookupWireMap,
|
| 7 | 7 | listWireMap,
|
| 8 | + nonDetFoldWireMap,
|
|
| 8 | 9 | -- * 'UnwireMap'
|
| 9 | 10 | UnwireMap,
|
| 10 | 11 | emptyUnwireMap,
|
| ... | ... | @@ -48,6 +49,9 @@ lookupWireMap uid (WireMap wmap) = lookupUniqMap wmap uid |
| 48 | 49 | listWireMap :: WireMap -> [(UnitId, UnitId)]
|
| 49 | 50 | listWireMap (WireMap wmap) = nonDetUniqMapToList wmap
|
| 50 | 51 | |
| 52 | +nonDetFoldWireMap :: ((UnitId, UnitId) -> b -> b) -> b -> WireMap -> b
|
|
| 53 | +nonDetFoldWireMap go z (WireMap uniq) = nonDetFoldUniqMap go z uniq
|
|
| 54 | + |
|
| 51 | 55 | -- | The reverse of 'WireMap'.
|
| 52 | 56 | -- Records the mapping from the wired-in 'UnitId' to the on-disk 'UnitId'.
|
| 53 | 57 | newtype UnwireMap =
|
| ... | ... | @@ -286,6 +286,21 @@ trustUnits elements (TrustOverlay to) = TrustOverlay $ foldl' (\ acc uid -> addT |
| 286 | 286 | emptyTrustOverlay :: TrustOverlay
|
| 287 | 287 | emptyTrustOverlay = TrustOverlay emptyUniqMap
|
| 288 | 288 | |
| 289 | +-- | For all values in the 'WireMap', copy the recorded trust/distrust
|
|
| 290 | +-- for the wired-in unit id.
|
|
| 291 | +--
|
|
| 292 | +extendForWireMap :: TrustOverlay -> WireMap -> TrustOverlay
|
|
| 293 | +extendForWireMap to wmap =
|
|
| 294 | + nonDetFoldWireMap go to wmap
|
|
| 295 | + where
|
|
| 296 | + go (onDiskUid, wiredInUid) overlay =
|
|
| 297 | + case lookupTrustOverlay overlay onDiskUid of
|
|
| 298 | + Nothing -> overlay
|
|
| 299 | + Just Trusted ->
|
|
| 300 | + trustUnits [wiredInUid] overlay
|
|
| 301 | + Just Distrusted ->
|
|
| 302 | + distrustUnits [wiredInUid] overlay
|
|
| 303 | + |
|
| 289 | 304 | {-
|
| 290 | 305 | Note [Sharing 'UnitInfo's across the 'UnitEnv']
|
| 291 | 306 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
| ... | ... | @@ -957,7 +972,7 @@ mkUnitState logger unit_index cfg = do |
| 957 | 972 | , explicitUnits = explicit_pkgs
|
| 958 | 973 | , homeUnitDepends = home_unit_deps
|
| 959 | 974 | , unitInfoMap = pkg_db
|
| 960 | - , trustedUnits = trustUnitsOverlay
|
|
| 975 | + , trustedUnits = trustUnitsOverlay `extendForWireMap` wired_map
|
|
| 961 | 976 | , moduleNameProvidersMap = mod_map
|
| 962 | 977 | , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger (unitConfigAllowVirtual cfg) pkg_db plugin_vis_map
|
| 963 | 978 | , packageNameMap = pkgname_map
|
| 1 | +{-# LANGUAGE Haskell2010 #-}
|
|
| 2 | +{-# LANGUAGE Safe #-}
|
|
| 3 | +module Main where
|
|
| 4 | + |
|
| 5 | +-- Importing a wired-in in module should honour trustworthiness
|
|
| 6 | +import GHC.Internal.Char (chr)
|
|
| 7 | + |
|
| 8 | +main :: IO ()
|
|
| 9 | +main = print (chr 120) |
| 1 | +:load T27834
|
|
| 2 | +putStrLn "Can import trusted module from ghc-internal" |
| 1 | +Can import trusted module from ghc-internal |
| ... | ... | @@ -402,3 +402,4 @@ test('GhciPackageRename', |
| 402 | 402 | ghci_script,
|
| 403 | 403 | ['GhciPackageRename.script'])
|
| 404 | 404 | test('T26233', normal, ghci_script, ['T26233.script'])
|
| 405 | +test('T27834', [extra_hc_opts("-fpackage-trust -trust base -trust ghc-internal -package ghc-internal")], ghci_script, ['T27834.script']) |