Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
d17d1435
by Matthew Pickering at 2026-04-03T20:01:19-04:00
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:
| ... | ... | @@ -402,7 +402,7 @@ loadCmdLineLibs' interp hsc_env pls = snd <$> |
| 402 | 402 | let hsc' = hscSetActiveUnitId uid hsc_env
|
| 403 | 403 | -- Load potential dependencies first
|
| 404 | 404 | (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls)
|
| 405 | - (homeUnitDepends (hsc_units hsc'))
|
|
| 405 | + (Set.toList (homeUnitDepends (hsc_units hsc')))
|
|
| 406 | 406 | pls'' <- loadCmdLineLibs'' interp hsc' pls'
|
| 407 | 407 | return $ (Set.insert uid done', pls'')
|
| 408 | 408 |
| ... | ... | @@ -467,11 +467,14 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of |
| 467 | 467 | -- not really correct as pkg_fs is unlikely to be a valid unit-id but
|
| 468 | 468 | -- we will report the failure later...
|
| 469 | 469 | where
|
| 470 | - home_names = map (\uid -> (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))) hpt_deps
|
|
| 470 | + home_names =
|
|
| 471 | + [ (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))
|
|
| 472 | + | uid <- S.toList hpt_deps
|
|
| 473 | + ]
|
|
| 471 | 474 | |
| 472 | 475 | unit_state = ue_homeUnitState unit_env
|
| 473 | 476 | |
| 474 | - hpt_deps :: [UnitId]
|
|
| 477 | + hpt_deps :: S.Set UnitId
|
|
| 475 | 478 | hpt_deps = homeUnitDepends unit_state
|
| 476 | 479 | |
| 477 | 480 |
| ... | ... | @@ -72,6 +72,7 @@ import GHC.Driver.Config.Finder |
| 72 | 72 | import GHC.Types.Unique.Set
|
| 73 | 73 | import qualified Data.List as L(sort)
|
| 74 | 74 | import Data.List.NonEmpty ( NonEmpty (..) )
|
| 75 | +import qualified Data.Set as Set (toList)
|
|
| 75 | 76 | import qualified System.Directory as SD
|
| 76 | 77 | import qualified System.OsPath as OsPath
|
| 77 | 78 | import qualified Data.List.NonEmpty as NE
|
| ... | ... | @@ -241,7 +242,7 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg = |
| 241 | 242 | Nothing -> ue_homeUnitState ue
|
| 242 | 243 | Just home_unit -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue
|
| 243 | 244 | hpt_deps :: [UnitId]
|
| 244 | - hpt_deps = homeUnitDepends units
|
|
| 245 | + hpt_deps = Set.toList (homeUnitDepends units)
|
|
| 245 | 246 | other_fopts = map (\uid -> (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))) hpt_deps
|
| 246 | 247 | |
| 247 | 248 | -- | Locate a plugin module requested by the user, for a compiler
|
| ... | ... | @@ -229,15 +229,18 @@ updateUnitFlags uid f = unitEnv_adjust update uid |
| 229 | 229 | -- If the argument unit is not present in the graph returns Nothing.
|
| 230 | 230 | transitiveHomeDeps :: UnitId -> HomeUnitGraph -> Maybe [UnitId]
|
| 231 | 231 | transitiveHomeDeps uid hug = case lookupHugUnitId uid hug of
|
| 232 | - Nothing -> Nothing
|
|
| 232 | + Nothing -> Nothing
|
|
| 233 | 233 | Just hue -> Just $
|
| 234 | - Set.toList (loop (Set.singleton uid) (homeUnitDepends (homeUnitEnv_units hue)))
|
|
| 234 | + Set.toList $
|
|
| 235 | + loop (Set.singleton uid)
|
|
| 236 | + (Set.toList (homeUnitDepends (homeUnitEnv_units hue)))
|
|
| 235 | 237 | where
|
| 236 | 238 | loop acc [] = acc
|
| 237 | 239 | loop acc (uid:uids)
|
| 238 | 240 | | uid `Set.member` acc = loop acc uids
|
| 239 | 241 | | otherwise =
|
| 240 | - let hue = homeUnitDepends
|
|
| 242 | + let hue = Set.toList
|
|
| 243 | + . homeUnitDepends
|
|
| 241 | 244 | . homeUnitEnv_units
|
| 242 | 245 | . expectJust
|
| 243 | 246 | $ lookupHugUnitId uid hug
|
| ... | ... | @@ -359,7 +362,11 @@ unitEnv_assocs (UnitEnvGraph x) = Map.assocs x |
| 359 | 362 | hugSCCs :: HomeUnitGraph -> [SCC UnitId]
|
| 360 | 363 | hugSCCs hug = sccs where
|
| 361 | 364 | mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId
|
| 362 | - mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue))
|
|
| 365 | + mkNode (uid, hue) = DigraphNode
|
|
| 366 | + uid
|
|
| 367 | + uid
|
|
| 368 | + (Set.toList (homeUnitDepends (homeUnitEnv_units hue)))
|
|
| 369 | + |
|
| 363 | 370 | nodes = map mkNode (Map.toList $ unitEnv_graph hug)
|
| 364 | 371 | |
| 365 | 372 | sccs = stronglyConnCompFromEdgedVerticesOrd nodes
|
| ... | ... | @@ -459,7 +459,7 @@ data UnitState = UnitState { |
| 459 | 459 | -- -Wunused-packages warning.
|
| 460 | 460 | explicitUnits :: [(Unit, Maybe PackageArg)],
|
| 461 | 461 | |
| 462 | - homeUnitDepends :: [UnitId],
|
|
| 462 | + homeUnitDepends :: Set UnitId,
|
|
| 463 | 463 | |
| 464 | 464 | -- | This is a full map from 'ModuleName' to all modules which may possibly
|
| 465 | 465 | -- be providing it. These providers may be hidden (but we'll still want
|
| ... | ... | @@ -494,7 +494,7 @@ emptyUnitState = UnitState { |
| 494 | 494 | unwireMap = emptyUniqMap,
|
| 495 | 495 | preloadUnits = [],
|
| 496 | 496 | explicitUnits = [],
|
| 497 | - homeUnitDepends = [],
|
|
| 497 | + homeUnitDepends = Set.empty,
|
|
| 498 | 498 | moduleNameProvidersMap = emptyUniqMap,
|
| 499 | 499 | pluginModuleNameProvidersMap = emptyUniqMap,
|
| 500 | 500 | requirementContext = emptyUniqMap,
|
| ... | ... | @@ -1718,7 +1718,7 @@ mkUnitState logger cfg = do |
| 1718 | 1718 | let !state = UnitState
|
| 1719 | 1719 | { preloadUnits = dep_preload
|
| 1720 | 1720 | , explicitUnits = explicit_pkgs
|
| 1721 | - , homeUnitDepends = Set.toList home_unit_deps
|
|
| 1721 | + , homeUnitDepends = home_unit_deps
|
|
| 1722 | 1722 | , unitInfoMap = pkg_db
|
| 1723 | 1723 | , preloadClosure = emptyUniqSet
|
| 1724 | 1724 | , moduleNameProvidersMap = mod_map
|