Wolfgang Jeltsch pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding at Glasgow Haskell Compiler / GHC Commits: 943f569e by Wolfgang Jeltsch at 2026-04-11T21:21:55+03:00 Improve naming - - - - - 2 changed files: - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Module/Graph.hs Changes: ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -44,7 +44,11 @@ import GHC.Data.OsPath import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module -import GHC.Unit.Module.Graph (ModuleNameHomeMap (..), mgHomeModuleMap) +import GHC.Unit.Module.Graph + ( + CompleteUnits (cu_inventory, cu_providers), + mgCompleteUnits + ) import GHC.Unit.Home import GHC.Unit.Home.Graph (UnitEnvGraph) import qualified GHC.Unit.Home.Graph as HUG @@ -183,8 +187,8 @@ findImportedModule hsc_env mod pkg_qual = dflags = hsc_dflags hsc_env fopts = initFinderOpts dflags in do - let home_module_map = mgHomeModuleMap (hsc_mod_graph hsc_env) - findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) home_module_map mhome_unit mod pkg_qual + let complete_home_units = mgCompleteUnits (hsc_mod_graph hsc_env) + findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) complete_home_units mhome_unit mod pkg_qual findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult findImportedModuleWithIsBoot hsc_env mod is_boot pkg_qual = do @@ -197,12 +201,12 @@ findImportedModuleNoHsc :: FinderCache -> FinderOpts -> UnitEnv - -> ModuleNameHomeMap + -> CompleteUnits -> Maybe HomeUnit -> ModuleName -> PkgQual -> IO FindResult -findImportedModuleNoHsc fc fopts ue home_module_map mhome_unit mod_name mb_pkg = +findImportedModuleNoHsc fc fopts ue complete_home_units mhome_unit mod_name mb_pkg = case mb_pkg of NoPkgQual -> unqual_import ThisPkg uid | (homeUnitId <$> mhome_unit) == Just uid -> home_import @@ -210,8 +214,7 @@ findImportedModuleNoHsc fc fopts ue home_module_map mhome_unit mod_name mb_pkg = | otherwise -> pprPanic "findImportModule" (ppr mod_name $$ ppr mb_pkg $$ ppr (homeUnitId <$> mhome_unit) $$ ppr uid $$ ppr (map fst all_opts)) OtherPkg _ -> pkg_import where - ModuleNameHomeMap complete_units module_name_map = home_module_map - module_home_units = M.findWithDefault Set.empty mod_name module_name_map + cached_module_providers = M.findWithDefault Set.empty mod_name (cu_providers complete_home_units) current_unit_id = homeUnitId <$> mhome_unit all_opts = case current_unit_id of Nothing -> other_fopts @@ -226,7 +229,7 @@ findImportedModuleNoHsc fc fopts ue home_module_map mhome_unit mod_name mb_pkg = -- 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_map (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual + findImportedModuleNoHsc fc opts ue complete_home_units (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual | elementOfUniqSet mod_name (finder_hiddenModules opts) = return (mkHomeHidden uid) | otherwise = @@ -248,12 +251,12 @@ findImportedModuleNoHsc fc fopts ue home_module_map mhome_unit mod_name mb_pkg = Just home_unit_id -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv home_unit_id ue hpt_deps :: Set.Set UnitId hpt_deps = homeUnitDepends units - dep_providers = Set.intersection module_home_units hpt_deps + dep_providers = Set.intersection cached_module_providers hpt_deps known_other_uids = let providers = maybe dep_providers (\u -> Set.delete u dep_providers) current_unit_id in Set.toList providers unknown_units = - let candidates = Set.difference hpt_deps complete_units + let candidates = Set.difference hpt_deps (cu_inventory complete_home_units) excluded = maybe dep_providers (\u -> Set.insert u dep_providers) current_unit_id in Set.toList (Set.difference candidates excluded) other_home_uids = known_other_uids ++ unknown_units ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -67,8 +67,8 @@ module GHC.Unit.Module.Graph , mgLookupModule , mgLookupModuleName , mgHasHoles - , ModuleNameHomeMap (ModuleNameHomeMap) - , mgHomeModuleMap + , CompleteUnits (CompleteUnits, cu_inventory, cu_providers) + , mgCompleteUnits , showModMsg -- ** Reachability queries @@ -205,18 +205,21 @@ 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_home_map :: ModuleNameHomeMap + , 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. } -data ModuleNameHomeMap = ModuleNameHomeMap !(Set UnitId) - !(Map ModuleName (Set UnitId)) +data CompleteUnits = CompleteUnits + { + cu_inventory :: !(Set UnitId), + cu_providers :: !(Map ModuleName (Set UnitId)) + } -mkHomeModuleMap :: [ModuleGraphNode] -> ModuleNameHomeMap -mkHomeModuleMap nodes = ModuleNameHomeMap completeUnits providerMap where +mkCompleteUnits :: [ModuleGraphNode] -> CompleteUnits +mkCompleteUnits nodes = CompleteUnits inventory providers where - providerMap :: Map ModuleName (Set UnitId) - providerMap + providers :: Map ModuleName (Set UnitId) + providers = Map.fromListWith Set.union $ [ (moduleName, Set.singleton unitID) | @@ -225,11 +228,11 @@ mkHomeModuleMap nodes = ModuleNameHomeMap completeUnits providerMap where let unitID = moduleNodeInfoUnitId moduleNodeInfo ] - completeUnits :: Set UnitId - completeUnits = Set.unions (Map.elems providerMap) + inventory :: Set UnitId + inventory = Set.unions (Map.elems providers) -mgHomeModuleMap :: ModuleGraph -> ModuleNameHomeMap -mgHomeModuleMap = mg_home_map +mgCompleteUnits :: ModuleGraph -> CompleteUnits +mgCompleteUnits = mg_complete_units -- | Why do we ever need to construct empty graphs? Is it because of one shot mode? emptyMG :: ModuleGraph @@ -237,7 +240,7 @@ emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing) (graphReachability emptyGraph, const Nothing) (graphReachability emptyGraph, const Nothing) False - (ModuleNameHomeMap Set.empty Map.empty) + (CompleteUnits Set.empty Map.empty) -- | 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. @@ -513,7 +516,7 @@ isEmptyMG = null . mg_mss mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph mapMG f mg@ModuleGraph{..} = mg { mg_mss = new_mss - , mg_home_map = mkHomeModuleMap new_mss + , mg_complete_units = mkCompleteUnits new_mss } where new_mss = @@ -1086,7 +1089,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_home_map = mkHomeModuleMap new_mss + , mg_complete_units = mkCompleteUnits new_mss } where new_mss = node : mg_mss View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/943f569e5e152ca2917266024f63bebf... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/943f569e5e152ca2917266024f63bebf... You're receiving this email because of your account on gitlab.haskell.org.