Wolfgang Jeltsch pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding at Glasgow Haskell Compiler / GHC
Commits:
-
441d6c7d
by Wolfgang Jeltsch at 2026-04-28T21:19:22+03:00
2 changed files:
Changes:
| ... | ... | @@ -46,8 +46,8 @@ import GHC.Unit.Types |
| 46 | 46 | import GHC.Unit.Module
|
| 47 | 47 | import GHC.Unit.Module.Graph
|
| 48 | 48 | (
|
| 49 | - CompleteUnits (cu_inventory, cu_providers),
|
|
| 50 | - mgCompleteUnits
|
|
| 49 | + HomeModuleNameProvidersMap,
|
|
| 50 | + mgHomeModuleNameProvidersMap
|
|
| 51 | 51 | )
|
| 52 | 52 | import GHC.Unit.Home
|
| 53 | 53 | import GHC.Unit.Home.Graph (UnitEnvGraph)
|
| ... | ... | @@ -187,8 +187,8 @@ findImportedModule hsc_env mod pkg_qual = |
| 187 | 187 | dflags = hsc_dflags hsc_env
|
| 188 | 188 | fopts = initFinderOpts dflags
|
| 189 | 189 | in do
|
| 190 | - let complete_home_units = mgCompleteUnits (hsc_mod_graph hsc_env)
|
|
| 191 | - findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) complete_home_units mb_home_unit mod pkg_qual
|
|
| 190 | + let home_module_name_providers_map = mgHomeModuleNameProvidersMap (hsc_mod_graph hsc_env)
|
|
| 191 | + findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) home_module_name_providers_map mb_home_unit mod pkg_qual
|
|
| 192 | 192 | |
| 193 | 193 | findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult
|
| 194 | 194 | findImportedModuleWithIsBoot hsc_env mod is_boot pkg_qual = do
|
| ... | ... | @@ -201,12 +201,12 @@ findImportedModuleNoHsc |
| 201 | 201 | :: FinderCache
|
| 202 | 202 | -> FinderOpts
|
| 203 | 203 | -> UnitEnv
|
| 204 | - -> CompleteUnits
|
|
| 204 | + -> HomeModuleNameProvidersMap
|
|
| 205 | 205 | -> Maybe HomeUnit
|
| 206 | 206 | -> ModuleName
|
| 207 | 207 | -> PkgQual
|
| 208 | 208 | -> IO FindResult
|
| 209 | -findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb_pkg =
|
|
| 209 | +findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit mod_name mb_pkg =
|
|
| 210 | 210 | case mb_pkg of
|
| 211 | 211 | NoPkgQual -> unqual_import
|
| 212 | 212 | ThisPkg uid | (homeUnitId <$> mb_home_unit) == Just uid -> home_import
|
| ... | ... | @@ -228,7 +228,7 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb |
| 228 | 228 | -- If the module is reexported, then look for it as if it was from the perspective
|
| 229 | 229 | -- of that package which reexports it.
|
| 230 | 230 | | Just real_mod_name <- lookupUniqMap (finder_reexportedModules opts) mod_name =
|
| 231 | - findImportedModuleNoHsc fc opts ue complete_home_units (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual
|
|
| 231 | + findImportedModuleNoHsc fc opts ue home_module_name_providers_map (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual
|
|
| 232 | 232 | | elementOfUniqSet mod_name (finder_hiddenModules opts) =
|
| 233 | 233 | return (mkHomeHidden uid)
|
| 234 | 234 | | otherwise =
|
| ... | ... | @@ -255,17 +255,17 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb |
| 255 | 255 | -- TODO: this predicate is wrong, we need something more focused
|
| 256 | 256 | sorted_deps = case finder_lookupHomeInterfaces fopts of
|
| 257 | 257 | True -> Set.toList hpt_deps
|
| 258 | - False -> sortHomeUnitsByLikelihoodFor complete_home_units mb_home_unit_id mod_name hpt_deps
|
|
| 258 | + False -> sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps
|
|
| 259 | 259 | |
| 260 | 260 | other_fopts =
|
| 261 | 261 | [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))
|
| 262 | 262 | | uid <- sorted_deps
|
| 263 | 263 | ]
|
| 264 | 264 | |
| 265 | -sortHomeUnitsByLikelihoodFor :: CompleteUnits -> Maybe UnitId -> ModuleName -> Set.Set UnitId -> [UnitId]
|
|
| 266 | -sortHomeUnitsByLikelihoodFor complete_home_units mb_home_unit_id mod_name hpt_deps =
|
|
| 265 | +sortHomeUnitsByLikelihoodFor :: HomeModuleNameProvidersMap -> Maybe UnitId -> ModuleName -> Set.Set UnitId -> [UnitId]
|
|
| 266 | +sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps =
|
|
| 267 | 267 | let
|
| 268 | - cached_module_providers = M.findWithDefault Set.empty mod_name (cu_providers complete_home_units)
|
|
| 268 | + cached_module_providers = lookupWithDefaultUniqMap home_module_name_providers_map Set.empty mod_name
|
|
| 269 | 269 | cached_providing_deps = Set.intersection cached_module_providers hpt_deps
|
| 270 | 270 | other_cached_providing_deps =
|
| 271 | 271 | Set.toList $
|
| ... | ... | @@ -67,8 +67,8 @@ module GHC.Unit.Module.Graph |
| 67 | 67 | , mgLookupModule
|
| 68 | 68 | , mgLookupModuleName
|
| 69 | 69 | , mgHasHoles
|
| 70 | - , CompleteUnits (CompleteUnits, cu_inventory, cu_providers)
|
|
| 71 | - , mgCompleteUnits
|
|
| 70 | + , HomeModuleNameProvidersMap
|
|
| 71 | + , mgHomeModuleNameProvidersMap
|
|
| 72 | 72 | , showModMsg
|
| 73 | 73 | |
| 74 | 74 | -- ** Reachability queries
|
| ... | ... | @@ -163,6 +163,7 @@ import qualified Data.Set as Set |
| 163 | 163 | import Data.Map (Map)
|
| 164 | 164 | import qualified Data.Map as Map
|
| 165 | 165 | import GHC.Types.Unique.DSet
|
| 166 | +import GHC.Types.Unique.Map (UniqMap, emptyUniqMap, listToUniqMap_C)
|
|
| 166 | 167 | import GHC.Unit.Module
|
| 167 | 168 | import GHC.Unit.Module.ModNodeKey
|
| 168 | 169 | import GHC.Unit.Module.Stage
|
| ... | ... | @@ -205,34 +206,24 @@ data ModuleGraph = ModuleGraph |
| 205 | 206 | -- Cached computation, whether any of the ModuleGraphNode are isHoleModule,
|
| 206 | 207 | -- This is only used for a hack in GHC.Iface.Load to do with backpack, please
|
| 207 | 208 | -- remove this at the earliest opportunity.
|
| 208 | - , mg_complete_units :: !CompleteUnits
|
|
| 209 | - -- ^ For each module name, which home unit UnitIds define it together with the set of units for which the listing is complete.
|
|
| 209 | + , mg_home_module_name_providers_map :: !HomeModuleNameProvidersMap
|
|
| 210 | + -- ^ For each module name, which home units provide it.
|
|
| 210 | 211 | }
|
| 211 | 212 | |
| 212 | -data CompleteUnits = CompleteUnits
|
|
| 213 | - {
|
|
| 214 | - cu_inventory :: !(Set UnitId),
|
|
| 215 | - cu_providers :: !(Map ModuleName (Set UnitId))
|
|
| 216 | - }
|
|
| 213 | +type HomeModuleNameProvidersMap = UniqMap ModuleName (Set UnitId)
|
|
| 217 | 214 | |
| 218 | -mkCompleteUnits :: [ModuleGraphNode] -> CompleteUnits
|
|
| 219 | -mkCompleteUnits nodes = CompleteUnits inventory providers where
|
|
| 215 | +mkHomeModuleNameProvidersMap :: [ModuleGraphNode] -> HomeModuleNameProvidersMap
|
|
| 216 | +mkHomeModuleNameProvidersMap nodes
|
|
| 217 | + = listToUniqMap_C Set.union $
|
|
| 218 | + [
|
|
| 219 | + (moduleName, Set.singleton unitID) |
|
|
| 220 | + ModuleNode _ moduleNodeInfo <- nodes,
|
|
| 221 | + let moduleName = moduleNodeInfoModuleName moduleNodeInfo,
|
|
| 222 | + let unitID = moduleNodeInfoUnitId moduleNodeInfo
|
|
| 223 | + ]
|
|
| 220 | 224 | |
| 221 | - providers :: Map ModuleName (Set UnitId)
|
|
| 222 | - providers
|
|
| 223 | - = Map.fromListWith Set.union $
|
|
| 224 | - [
|
|
| 225 | - (moduleName, Set.singleton unitID) |
|
|
| 226 | - ModuleNode _ moduleNodeInfo <- nodes,
|
|
| 227 | - let moduleName = moduleNodeInfoModuleName moduleNodeInfo,
|
|
| 228 | - let unitID = moduleNodeInfoUnitId moduleNodeInfo
|
|
| 229 | - ]
|
|
| 230 | - |
|
| 231 | - inventory :: Set UnitId
|
|
| 232 | - inventory = Set.unions (Map.elems providers)
|
|
| 233 | - |
|
| 234 | -mgCompleteUnits :: ModuleGraph -> CompleteUnits
|
|
| 235 | -mgCompleteUnits = mg_complete_units
|
|
| 225 | +mgHomeModuleNameProvidersMap :: ModuleGraph -> HomeModuleNameProvidersMap
|
|
| 226 | +mgHomeModuleNameProvidersMap = mg_home_module_name_providers_map
|
|
| 236 | 227 | |
| 237 | 228 | -- | Why do we ever need to construct empty graphs? Is it because of one shot mode?
|
| 238 | 229 | emptyMG :: ModuleGraph
|
| ... | ... | @@ -240,7 +231,7 @@ emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing) |
| 240 | 231 | (graphReachability emptyGraph, const Nothing)
|
| 241 | 232 | (graphReachability emptyGraph, const Nothing)
|
| 242 | 233 | False
|
| 243 | - (CompleteUnits Set.empty Map.empty)
|
|
| 234 | + emptyUniqMap
|
|
| 244 | 235 | |
| 245 | 236 | -- | Construct a module graph. This function should be the only entry point for
|
| 246 | 237 | -- building a 'ModuleGraph', since it is supposed to be built once and never modified.
|
| ... | ... | @@ -516,7 +507,7 @@ isEmptyMG = null . mg_mss |
| 516 | 507 | mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
|
| 517 | 508 | mapMG f mg@ModuleGraph{..} = mg
|
| 518 | 509 | { mg_mss = new_mss
|
| 519 | - , mg_complete_units = mkCompleteUnits new_mss
|
|
| 510 | + , mg_home_module_name_providers_map = mkHomeModuleNameProvidersMap new_mss
|
|
| 520 | 511 | }
|
| 521 | 512 | where
|
| 522 | 513 | new_mss =
|
| ... | ... | @@ -1089,7 +1080,7 @@ extendMG ModuleGraph{..} node = |
| 1089 | 1080 | , mg_loop_graph = mkTransLoopDeps new_mss
|
| 1090 | 1081 | , mg_zero_graph = mkTransZeroDeps new_mss
|
| 1091 | 1082 | , mg_has_holes = mg_has_holes || maybe False isHsigFile (moduleNodeInfoHscSource =<< mgNodeIsModule node)
|
| 1092 | - , mg_complete_units = mkCompleteUnits new_mss
|
|
| 1083 | + , mg_home_module_name_providers_map = mkHomeModuleNameProvidersMap new_mss
|
|
| 1093 | 1084 | }
|
| 1094 | 1085 | where
|
| 1095 | 1086 | new_mss = node : mg_mss
|