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
- - - - -
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.
