Hannes Siebenhandl pushed to branch wip/fendor/27834 at Glasgow Haskell Compiler / GHC

Commits:

7 changed files:

Changes:

  • changelog.d/unit-index
    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.
    

  • compiler/GHC/Unit/External/Wired.hs
    ... ... @@ -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 =
    

  • compiler/GHC/Unit/State.hs
    ... ... @@ -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
    

  • testsuite/tests/ghci/scripts/T27834.hs
    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)

  • testsuite/tests/ghci/scripts/T27834.script
    1
    +:load T27834
    
    2
    +putStrLn "Can import trusted module from ghc-internal"

  • testsuite/tests/ghci/scripts/T27834.stdout
    1
    +Can import trusted module from ghc-internal

  • testsuite/tests/ghci/scripts/all.T
    ... ... @@ -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'])