Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d17d1435 by Matthew Pickering at 2026-04-03T20:01:19-04:00 Make home unit dependencies stored as sets Co-authored-by: Wolfgang Jeltsch <wolfgang@well-typed.com> - - - - - 5 changed files: - compiler/GHC/Linker/Loader.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/State.hs Changes: ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -402,7 +402,7 @@ loadCmdLineLibs' interp hsc_env pls = snd <$> let hsc' = hscSetActiveUnitId uid hsc_env -- Load potential dependencies first (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls) - (homeUnitDepends (hsc_units hsc')) + (Set.toList (homeUnitDepends (hsc_units hsc'))) pls'' <- loadCmdLineLibs'' interp hsc' pls' return $ (Set.insert uid done', pls'') ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -467,11 +467,14 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of -- not really correct as pkg_fs is unlikely to be a valid unit-id but -- we will report the failure later... where - home_names = map (\uid -> (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))) hpt_deps + home_names = + [ (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env))) + | uid <- S.toList hpt_deps + ] unit_state = ue_homeUnitState unit_env - hpt_deps :: [UnitId] + hpt_deps :: S.Set UnitId hpt_deps = homeUnitDepends unit_state ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -72,6 +72,7 @@ import GHC.Driver.Config.Finder import GHC.Types.Unique.Set import qualified Data.List as L(sort) import Data.List.NonEmpty ( NonEmpty (..) ) +import qualified Data.Set as Set (toList) import qualified System.Directory as SD import qualified System.OsPath as OsPath import qualified Data.List.NonEmpty as NE @@ -241,7 +242,7 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg = Nothing -> ue_homeUnitState ue Just home_unit -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue hpt_deps :: [UnitId] - hpt_deps = homeUnitDepends units + hpt_deps = Set.toList (homeUnitDepends units) other_fopts = map (\uid -> (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))) hpt_deps -- | Locate a plugin module requested by the user, for a compiler ===================================== compiler/GHC/Unit/Home/Graph.hs ===================================== @@ -229,15 +229,18 @@ updateUnitFlags uid f = unitEnv_adjust update uid -- If the argument unit is not present in the graph returns Nothing. transitiveHomeDeps :: UnitId -> HomeUnitGraph -> Maybe [UnitId] transitiveHomeDeps uid hug = case lookupHugUnitId uid hug of - Nothing -> Nothing + Nothing -> Nothing Just hue -> Just $ - Set.toList (loop (Set.singleton uid) (homeUnitDepends (homeUnitEnv_units hue))) + Set.toList $ + loop (Set.singleton uid) + (Set.toList (homeUnitDepends (homeUnitEnv_units hue))) where loop acc [] = acc loop acc (uid:uids) | uid `Set.member` acc = loop acc uids | otherwise = - let hue = homeUnitDepends + let hue = Set.toList + . homeUnitDepends . homeUnitEnv_units . expectJust $ lookupHugUnitId uid hug @@ -359,7 +362,11 @@ unitEnv_assocs (UnitEnvGraph x) = Map.assocs x hugSCCs :: HomeUnitGraph -> [SCC UnitId] hugSCCs hug = sccs where mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId - mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue)) + mkNode (uid, hue) = DigraphNode + uid + uid + (Set.toList (homeUnitDepends (homeUnitEnv_units hue))) + nodes = map mkNode (Map.toList $ unitEnv_graph hug) sccs = stronglyConnCompFromEdgedVerticesOrd nodes ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -459,7 +459,7 @@ data UnitState = UnitState { -- -Wunused-packages warning. explicitUnits :: [(Unit, Maybe PackageArg)], - homeUnitDepends :: [UnitId], + homeUnitDepends :: Set UnitId, -- | This is a full map from 'ModuleName' to all modules which may possibly -- be providing it. These providers may be hidden (but we'll still want @@ -494,7 +494,7 @@ emptyUnitState = UnitState { unwireMap = emptyUniqMap, preloadUnits = [], explicitUnits = [], - homeUnitDepends = [], + homeUnitDepends = Set.empty, moduleNameProvidersMap = emptyUniqMap, pluginModuleNameProvidersMap = emptyUniqMap, requirementContext = emptyUniqMap, @@ -1718,7 +1718,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = Set.toList home_unit_deps + , homeUnitDepends = home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d17d1435d1ac1f1e4f806181da944ec5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d17d1435d1ac1f1e4f806181da944ec5... You're receiving this email because of your account on gitlab.haskell.org.