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 Turn cache of home module name providers into a unique-map - - - - - 2 changed files: - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Module/Graph.hs Changes: ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -46,8 +46,8 @@ import GHC.Unit.Types import GHC.Unit.Module import GHC.Unit.Module.Graph ( - CompleteUnits (cu_inventory, cu_providers), - mgCompleteUnits + HomeModuleNameProvidersMap, + mgHomeModuleNameProvidersMap ) import GHC.Unit.Home import GHC.Unit.Home.Graph (UnitEnvGraph) @@ -187,8 +187,8 @@ findImportedModule hsc_env mod pkg_qual = dflags = hsc_dflags hsc_env fopts = initFinderOpts dflags in do - let complete_home_units = mgCompleteUnits (hsc_mod_graph hsc_env) - findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) complete_home_units mb_home_unit mod pkg_qual + let home_module_name_providers_map = mgHomeModuleNameProvidersMap (hsc_mod_graph hsc_env) + findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) home_module_name_providers_map mb_home_unit mod pkg_qual findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult findImportedModuleWithIsBoot hsc_env mod is_boot pkg_qual = do @@ -201,12 +201,12 @@ findImportedModuleNoHsc :: FinderCache -> FinderOpts -> UnitEnv - -> CompleteUnits + -> HomeModuleNameProvidersMap -> Maybe HomeUnit -> ModuleName -> PkgQual -> IO FindResult -findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb_pkg = +findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit mod_name mb_pkg = case mb_pkg of NoPkgQual -> unqual_import 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 -- 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 complete_home_units (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual + 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 = @@ -255,17 +255,17 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb -- TODO: this predicate is wrong, we need something more focused sorted_deps = case finder_lookupHomeInterfaces fopts of True -> Set.toList hpt_deps - False -> sortHomeUnitsByLikelihoodFor complete_home_units mb_home_unit_id mod_name hpt_deps + False -> sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps other_fopts = [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue))) | uid <- sorted_deps ] -sortHomeUnitsByLikelihoodFor :: CompleteUnits -> Maybe UnitId -> ModuleName -> Set.Set UnitId -> [UnitId] -sortHomeUnitsByLikelihoodFor complete_home_units mb_home_unit_id mod_name hpt_deps = +sortHomeUnitsByLikelihoodFor :: HomeModuleNameProvidersMap -> Maybe UnitId -> ModuleName -> Set.Set UnitId -> [UnitId] +sortHomeUnitsByLikelihoodFor home_module_name_providers_map mb_home_unit_id mod_name hpt_deps = let - cached_module_providers = M.findWithDefault Set.empty mod_name (cu_providers complete_home_units) + cached_module_providers = lookupWithDefaultUniqMap home_module_name_providers_map Set.empty mod_name cached_providing_deps = Set.intersection cached_module_providers hpt_deps other_cached_providing_deps = Set.toList $ ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -67,8 +67,8 @@ module GHC.Unit.Module.Graph , mgLookupModule , mgLookupModuleName , mgHasHoles - , CompleteUnits (CompleteUnits, cu_inventory, cu_providers) - , mgCompleteUnits + , HomeModuleNameProvidersMap + , mgHomeModuleNameProvidersMap , showModMsg -- ** Reachability queries @@ -163,6 +163,7 @@ import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map import GHC.Types.Unique.DSet +import GHC.Types.Unique.Map (UniqMap, emptyUniqMap, listToUniqMap_C) import GHC.Unit.Module import GHC.Unit.Module.ModNodeKey import GHC.Unit.Module.Stage @@ -205,34 +206,24 @@ data ModuleGraph = ModuleGraph -- Cached computation, whether any of the ModuleGraphNode are isHoleModule, -- This is only used for a hack in GHC.Iface.Load to do with backpack, please -- remove this at the earliest opportunity. - , mg_complete_units :: !CompleteUnits - -- ^ For each module name, which home unit UnitIds define it together with the set of units for which the listing is complete. + , mg_home_module_name_providers_map :: !HomeModuleNameProvidersMap + -- ^ For each module name, which home units provide it. } -data CompleteUnits = CompleteUnits - { - cu_inventory :: !(Set UnitId), - cu_providers :: !(Map ModuleName (Set UnitId)) - } +type HomeModuleNameProvidersMap = UniqMap ModuleName (Set UnitId) -mkCompleteUnits :: [ModuleGraphNode] -> CompleteUnits -mkCompleteUnits nodes = CompleteUnits inventory providers where +mkHomeModuleNameProvidersMap :: [ModuleGraphNode] -> HomeModuleNameProvidersMap +mkHomeModuleNameProvidersMap nodes + = listToUniqMap_C Set.union $ + [ + (moduleName, Set.singleton unitID) | + ModuleNode _ moduleNodeInfo <- nodes, + let moduleName = moduleNodeInfoModuleName moduleNodeInfo, + let unitID = moduleNodeInfoUnitId moduleNodeInfo + ] - providers :: Map ModuleName (Set UnitId) - providers - = Map.fromListWith Set.union $ - [ - (moduleName, Set.singleton unitID) | - ModuleNode _ moduleNodeInfo <- nodes, - let moduleName = moduleNodeInfoModuleName moduleNodeInfo, - let unitID = moduleNodeInfoUnitId moduleNodeInfo - ] - - inventory :: Set UnitId - inventory = Set.unions (Map.elems providers) - -mgCompleteUnits :: ModuleGraph -> CompleteUnits -mgCompleteUnits = mg_complete_units +mgHomeModuleNameProvidersMap :: ModuleGraph -> HomeModuleNameProvidersMap +mgHomeModuleNameProvidersMap = mg_home_module_name_providers_map -- | Why do we ever need to construct empty graphs? Is it because of one shot mode? emptyMG :: ModuleGraph @@ -240,7 +231,7 @@ emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing) (graphReachability emptyGraph, const Nothing) (graphReachability emptyGraph, const Nothing) False - (CompleteUnits Set.empty Map.empty) + emptyUniqMap -- | Construct a module graph. This function should be the only entry point for -- building a 'ModuleGraph', since it is supposed to be built once and never modified. @@ -516,7 +507,7 @@ isEmptyMG = null . mg_mss mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph mapMG f mg@ModuleGraph{..} = mg { mg_mss = new_mss - , mg_complete_units = mkCompleteUnits new_mss + , mg_home_module_name_providers_map = mkHomeModuleNameProvidersMap new_mss } where new_mss = @@ -1089,7 +1080,7 @@ extendMG ModuleGraph{..} node = , mg_loop_graph = mkTransLoopDeps new_mss , mg_zero_graph = mkTransZeroDeps new_mss , mg_has_holes = mg_has_holes || maybe False isHsigFile (moduleNodeInfoHscSource =<< mgNodeIsModule node) - , mg_complete_units = mkCompleteUnits new_mss + , mg_home_module_name_providers_map = mkHomeModuleNameProvidersMap new_mss } where new_mss = node : mg_mss View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/441d6c7dbf32101cd8e0bff72c99b7b2... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/441d6c7dbf32101cd8e0bff72c99b7b2... You're receiving this email because of your account on gitlab.haskell.org.