[Git][ghc/ghc][wip/jeltsch/more-efficient-home-unit-imports-finding] Resolve two bugs and improve debug info generation
Wolfgang Jeltsch pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding at Glasgow Haskell Compiler / GHC Commits: 1ce282bf by fendor at 2026-04-28T16:35:30+03:00 Resolve two bugs and improve debug info generation The bugs made the following tests fail: * `boot1` * `multipleHomeUnits_reexport` * `t25139` - - - - - 1 changed file: - compiler/GHC/Unit/Finder.hs Changes: ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -214,7 +214,6 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb | otherwise -> pprPanic "findImportModule" (ppr mod_name $$ ppr mb_pkg $$ ppr (homeUnitId <$> mb_home_unit) $$ ppr uid $$ ppr (map fst all_opts)) OtherPkg _ -> pkg_import where - cached_module_providers = M.findWithDefault Set.empty mod_name (cu_providers complete_home_units) mb_home_unit_id = homeUnitId <$> mb_home_unit all_opts = case mb_home_unit_id of Nothing -> other_fopts @@ -249,42 +248,42 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb units = case mb_home_unit_id of Nothing -> ue_homeUnitState ue Just home_unit_id -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv home_unit_id ue + hpt_deps :: Set.Set UnitId hpt_deps = homeUnitDepends units + + -- 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 + + 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 = + let + cached_module_providers = M.findWithDefault Set.empty mod_name (cu_providers complete_home_units) cached_providing_deps = Set.intersection cached_module_providers hpt_deps other_cached_providing_deps = Set.toList $ maybe cached_providing_deps (\u -> Set.delete u cached_providing_deps) mb_home_unit_id uncached_providing_deps = - let candidates = Set.difference hpt_deps (cu_inventory complete_home_units) + let candidates = Set.difference hpt_deps cached_module_providers excluded = maybe cached_providing_deps (\u -> Set.insert u cached_providing_deps) mb_home_unit_id in Set.toList (Set.difference candidates excluded) - other_providing_deps = other_cached_providing_deps ++ uncached_providing_deps - other_fopts = - [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue))) - | uid <- other_providing_deps - ] - !() = pprTrace "findImportedModuleNoHsc" (vcat lines) () where - - lines = [ - -- text "complete_home_units" <+> ppr complete_home_units, - -- text "mb_home_unit " <+> ppr mb_home_unit, - text "mod_name:" <+> ppr mod_name, - text "cached_module_providers:" <+> ppr cached_module_providers, - text "mb_home_unit_id:" <+> ppr mb_home_unit_id, - -- text "all_opts:" <+> ppr all_opts, - -- text "any_home_import:" <+> ppr any_home_import, - -- text "pkg_import:" <+> ppr pkg_import , - -- text "unqual_import:" <+> ppr unqual_import, - -- text "units:" <+> ppr units , - text "hpt_deps:" <+> ppr hpt_deps, - text "cached_providing_deps:" <+> ppr cached_providing_deps, - text "other_cached_providing_deps:" <+> ppr other_cached_providing_deps, - text "uncached_providing_deps:" <+> ppr uncached_providing_deps, - text "other_providing_deps:" <+> ppr other_providing_deps - -- text "other_fopts:" <+> ppr other_fopts - ] + all_deps = other_cached_providing_deps ++ uncached_providing_deps + in + assertPpr + (hpt_deps == Set.fromList all_deps) + ( text "Sorting must not remove HomeUnits" + $$ text "Module:" <+> ppr mod_name + $$ text "Original:" <+> ppr hpt_deps + $$ text "Sorted: " <+> ppr (Set.fromList all_deps)) + all_deps -- | Locate a plugin module requested by the user, for a compiler -- plugin. This consults the same set of exposed packages as View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ce282bf264ff8aa3bc12631a0b28d6a... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ce282bf264ff8aa3bc12631a0b28d6a... You're receiving this email because of your account on gitlab.haskell.org.
participants (1)
-
Wolfgang Jeltsch (@jeltsch)