[Git][ghc/ghc][wip/unitidset] Use UniqSet instead of UniqDSet in UnitIdSet
Josh Meredith (@JoshMeredith)
gitlab at gitlab.haskell.org
Thu May 25 08:03:16 UTC 2023
Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC
Commits:
51c916e8 by Josh Meredith at 2023-05-25T08:03:01+00:00
Use UniqSet instead of UniqDSet in UnitIdSet
- - - - -
13 changed files:
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Types/Unique/Set.hs
- compiler/GHC/Unit/Env.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/Types.hs
Changes:
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -56,7 +56,7 @@ import GHC.Types.SrcLoc
import GHC.Types.CostCentre
import GHC.Types.ForeignStubs
import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import System.Directory
import System.FilePath
@@ -164,7 +164,7 @@ outputC :: Logger
-> IO a
outputC logger dflags filenm cmm_stream unit_deps =
withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do
- let pkg_names = map unitIdString (uniqDSetToAscList unit_deps)
+ let pkg_names = map unitIdString (uniqSetToAscList unit_deps)
doOutput filenm $ \ h -> do
hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
hPutStr h "#include \"Stg.h\"\n"
=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -26,7 +26,6 @@ import GHC.Utils.Monad
import GHC.Types.Name
import GHC.Types.Name.Set ( NameSet, allUses )
import GHC.Types.Unique.Set
-import GHC.Types.Unique.DSet
import GHC.Unit
import GHC.Unit.Env
@@ -256,7 +255,7 @@ mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names
-- (need to recompile if its export list changes: export_fprint)
mkUsage :: Module -> ModIface -> Maybe Usage
mkUsage mod iface
- | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids
+ | not $ toUnitId (moduleUnit mod) `elementOfUniqSet` home_unit_ids
= Just $ UsagePackageModule{ usg_mod = mod,
usg_mod_hash = mod_hash,
usg_safe = imp_safe }
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -94,6 +94,7 @@ import GHC.Types.SourceFile
import GHC.Types.SafeHaskell
import GHC.Types.TypeEnv
import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Types.SrcLoc
import GHC.Types.TyThing
import GHC.Types.PkgQual
@@ -504,7 +505,7 @@ loadInterface doc_str mod from
-- overlapping instances.
; massertPpr
((isOneShot (ghcMode (hsc_dflags hsc_env)))
- || not (moduleUnitId mod `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env)
+ || not (moduleUnitId mod `elementOfUniqSet` hsc_all_home_unit_ids hsc_env)
|| mod == gHC_PRIM)
(text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod))
; ignore_prags <- goptM Opt_IgnoreInterfacePragmas
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -59,7 +59,6 @@ import GHC.Types.SrcLoc
import GHC.Types.Unique.Set
import GHC.Types.Fixity.Env
import GHC.Types.Unique.Map
-import GHC.Types.Unique.DSet
import GHC.Unit.External
import GHC.Unit.Finder
import GHC.Unit.State
@@ -618,8 +617,8 @@ checkDependencies hsc_env summary iface
all_home_units = hsc_all_home_unit_ids hsc_env
units = hsc_units hsc_env
prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface)
- prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface))
- (dep_plugin_pkgs (mi_deps iface)))
+ prev_dep_pkgs = uniqSetToAscList (unionUniqSets (dep_direct_pkgs (mi_deps iface))
+ (dep_plugin_pkgs (mi_deps iface)))
implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags)
@@ -634,7 +633,7 @@ checkDependencies hsc_env summary iface
classify _ (Found _ mod)
- | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod))
+ | (toUnitId $ moduleUnit mod) `elementOfUniqSet` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod))
| otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod))
classify reason _ = Left (RecompBecause reason)
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -63,6 +63,7 @@ import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.SrcLoc
import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Types.Unique.DFM
import GHC.Utils.Outputable
@@ -156,7 +157,7 @@ emptyLoaderState = LoaderState
--
-- The linker's symbol table is populated with RTS symbols using an
-- explicit list. See rts/Linker.c for details.
- where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqDSet)
+ where init_pkgs = unitUDFM rtsUnitId (LoadedPkgInfo rtsUnitId [] [] emptyUniqSet)
extendLoadedEnv :: Interp -> [(Name,ForeignHValue)] -> IO ()
extendLoadedEnv interp new_bindings =
@@ -222,12 +223,12 @@ loadDependencies interp hsc_env pls span needed_mods = do
-- Link the packages and modules required
pls1 <- loadPackages' interp hsc_env pkgs pls
(pls2, succ) <- loadModuleLinkables interp hsc_env pls1 lnks
- let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet trans_pkgs_needed
+ let this_pkgs_loaded = udfmRestrictKeys all_pkgs_loaded $ getUniqDSet $ mkUniqDSet $ nonDetEltsUniqSet trans_pkgs_needed
all_pkgs_loaded = pkgs_loaded pls2
- trans_pkgs_needed = unionManyUniqDSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg
- | pkg_id <- uniqDSetToList this_pkgs_needed
- , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id]
- ])
+ trans_pkgs_needed = unionManyUniqSets (this_pkgs_needed : [ loaded_pkg_trans_deps pkg
+ | pkg_id <- uniqSetToAscList this_pkgs_needed
+ , Just pkg <- [lookupUDFM all_pkgs_loaded pkg_id]
+ ])
return (pls2, succ, all_lnks, this_pkgs_loaded)
@@ -325,19 +326,19 @@ loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState
loadCmdLineLibs' interp hsc_env pls = snd <$>
foldM
(\(done', pls') cur_uid -> load done' cur_uid pls')
- (emptyUniqDSet, pls)
- (uniqDSetToList $ hsc_all_home_unit_ids hsc_env)
+ (emptyUniqSet, pls)
+ (uniqSetToAscList $ hsc_all_home_unit_ids hsc_env)
where
load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState)
- load done uid pls | uid `elementOfUniqDSet` done = return (done, pls)
+ load done uid pls | uid `elementOfUniqSet` done = return (done, pls)
load done uid pls = do
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'))
pls'' <- loadCmdLineLibs'' interp hsc' pls'
- return $ (addOneToUniqDSet done' uid, pls'')
+ return $ (addOneToUniqSet done' uid, pls'')
loadCmdLineLibs''
:: Interp
@@ -701,16 +702,16 @@ getLinkDeps hsc_env pls replace_osuf span mods
-- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests)
if isOneShot (ghcMode dflags)
then follow_deps (filterOut isInteractiveModule mods)
- emptyUniqDSet emptyUniqDSet;
+ emptyUniqDSet emptyUniqSet;
else do
(pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods
- return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs))
+ return (catMaybes mmods, unionManyUniqSets (init_pkg_set : pkgs))
; let
-- 2. Exclude ones already linked
-- Main reason: avoid findModule calls in get_linkable
(mods_needed, links_got) = partitionEithers (map split_mods mods_s)
- pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls
+ pkgs_needed = eltsUDFM $ getUniqDSet (mkUniqDSet $ uniqSetToAscList pkgs_s) `minusUDFM` pkgs_loaded pls
split_mods mod =
let is_linked = findModuleLinkable_maybe (objs_loaded pls) mod <|> findModuleLinkable_maybe (bcos_loaded pls) mod
@@ -751,10 +752,10 @@ getLinkDeps hsc_env pls replace_osuf span mods
in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts)
Nothing ->
let (ModNodeKeyWithUid _ uid) = nk
- in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts
+ in make_deps_loop (addOneToUniqSet found_units uid, found_mods) nexts
mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m)
- (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods)
+ (init_pkg_set, all_deps) = make_deps_loop (emptyUniqSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods)
all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps]
@@ -814,12 +815,12 @@ getLinkDeps hsc_env pls replace_osuf span mods
acc_mods' = case hsc_home_unit_maybe hsc_env of
Nothing -> acc_mods
Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps)
- acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps)
+ acc_pkgs' = addListToUniqSet acc_pkgs (uniqSetToAscList pkg_deps)
case hsc_home_unit_maybe hsc_env of
Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods)
acc_mods' acc_pkgs'
- _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg))
+ _ -> follow_deps mods acc_mods (addOneToUniqSet acc_pkgs' (toUnitId pkg))
where
msg = text "need to link module" <+> ppr mod <+>
text "due to use of Template Haskell"
@@ -1372,10 +1373,10 @@ loadPackages' interp hsc_env new_pks pls = do
; pkgs' <- link pkgs deps
-- Now link the package itself
; (hs_cls, extra_cls) <- loadPackage interp hsc_env pkg_cfg
- ; let trans_deps = unionManyUniqDSets [ addOneToUniqDSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg
- | dep_pkg <- deps
- , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg)
- ]
+ ; let trans_deps = unionManyUniqSets [ addOneToUniqSet (loaded_pkg_trans_deps loaded_pkg_info) dep_pkg
+ | dep_pkg <- deps
+ , Just loaded_pkg_info <- pure (lookupUDFM pkgs' dep_pkg)
+ ]
; return (addToUDFM pkgs' new_pkg (LoadedPkgInfo new_pkg hs_cls extra_cls trans_deps)) }
| otherwise
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -72,7 +72,7 @@ import GHC.Types.Id
import GHC.Types.HpcInfo
import GHC.Types.PkgQual
import GHC.Types.GREInfo (ConInfo(..))
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Unit
import GHC.Unit.Module.Warnings
@@ -211,8 +211,8 @@ rnImports imports = do
let merged_import_avail = clobberSourceImports imp_avails
dflags <- getDynFlags
let final_import_avail =
- merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags)
- `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail}
+ merged_import_avail { imp_dep_direct_pkgs = mkUniqSet (implicitPackageDeps dflags)
+ `unionUniqSets` imp_dep_direct_pkgs merged_import_avail}
return (decls, rdr_env, final_import_avail, hpc_usage)
where
@@ -534,7 +534,7 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by
-- Trusted packages are a lot like orphans.
trusted_pkgs | mod_safe' = dep_trusted_pkgs deps
- | otherwise = emptyUniqDSet
+ | otherwise = emptyUniqSet
pkg = moduleUnit (mi_module iface)
@@ -547,11 +547,11 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by
| isHomeUnit home_unit pkg = ptrust
| otherwise = False
- dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units
- then emptyUniqDSet
- else unitUniqDSet ipkg
+ dependent_pkgs = if toUnitId pkg `elementOfUniqSet` other_home_units
+ then emptyUniqSet
+ else unitUniqSet ipkg
- direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units
+ direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqSet` other_home_units
then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot))
else S.empty
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -143,7 +143,7 @@ import GHC.Types.Id.Info( IdDetails(..) )
import GHC.Types.Var.Env
import GHC.Types.TypeEnv
import GHC.Types.Unique.FM
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
@@ -2933,7 +2933,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
, text "Dependent modules:" <+>
(ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports)
, text "Dependent packages:" <+>
- ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)]
+ ppr (uniqSetToAscList $ imp_dep_direct_pkgs imports)]
-- The use of sort is just to reduce unnecessary
-- wobbling in testsuite output
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -142,7 +142,7 @@ import GHC.Types.SourceFile
import GHC.Types.SrcLoc
import GHC.Types.Var.Set
import GHC.Types.Unique.FM
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Types.Basic
import GHC.Types.CostCentre.State
import GHC.Types.HpcInfo
@@ -1368,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep
emptyImportAvails :: ImportAvails
emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv,
imp_direct_dep_mods = emptyInstalledModuleEnv,
- imp_dep_direct_pkgs = emptyUniqDSet,
+ imp_dep_direct_pkgs = emptyUniqSet,
imp_sig_mods = [],
- imp_trust_pkgs = emptyUniqDSet,
+ imp_trust_pkgs = emptyUniqSet,
imp_trust_own_pkg = False,
imp_boot_mods = emptyInstalledModuleEnv,
imp_orphs = [],
@@ -1399,8 +1399,8 @@ plusImportAvails
imp_orphs = orphs2, imp_finsts = finsts2 })
= ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2,
imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2,
- imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2,
- imp_trust_pkgs = tpkgs1 `unionUniqDSets` tpkgs2,
+ imp_dep_direct_pkgs = ddpkgs1 `unionUniqSets` ddpkgs2,
+ imp_trust_pkgs = tpkgs1 `unionUniqSets` tpkgs2,
imp_trust_own_pkg = tself1 || tself2,
imp_boot_mods = srs1 `plusModDeps` srcs2,
imp_sig_mods = unionListsOrd sig_mods1 sig_mods2,
=====================================
compiler/GHC/Types/Unique/Set.hs
=====================================
@@ -44,6 +44,7 @@ module GHC.Types.Unique.Set (
nonDetEltsUniqSet,
nonDetKeysUniqSet,
nonDetStrictFoldUniqSet,
+ uniqSetToAscList,
) where
import GHC.Prelude
@@ -55,6 +56,8 @@ import Data.Coerce
import GHC.Utils.Outputable
import Data.Data
import qualified Data.Semigroup as Semi
+import Data.List (sort)
+import GHC.Utils.Binary
-- Note [UniqSet invariant]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -159,6 +162,9 @@ lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k
nonDetEltsUniqSet :: UniqSet elt -> [elt]
nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet'
+uniqSetToAscList :: Ord elt => UniqSet elt -> [elt]
+uniqSetToAscList = sort . nonDetEltsUniqSet
+
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
@@ -180,6 +186,10 @@ mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet
instance Eq (UniqSet a) where
UniqSet a == UniqSet b = equalKeysUFM a b
+instance (Uniquable a, Ord a, Binary a) => Binary (UniqSet a) where
+ put_ bh = put_ bh . uniqSetToAscList
+ get bh = mkUniqSet <$> get bh
+
getUniqSet :: UniqSet a -> UniqFM a a
getUniqSet = getUniqSet'
=====================================
compiler/GHC/Unit/Env.hs
=====================================
@@ -81,7 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack)
import GHC.Driver.DynFlags
import GHC.Utils.Outputable
import GHC.Utils.Panic (pprPanic)
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Unit.Module.ModIface
import GHC.Unit.Module
import qualified Data.Set as Set
@@ -341,7 +341,7 @@ unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v
unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env
unitEnv_keys :: UnitEnvGraph v -> UnitIdSet
-unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env)
+unitEnv_keys env = mkUniqSet $ Map.keys (unitEnv_graph env)
unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)]
unitEnv_elts env = Map.toList (unitEnv_graph env)
=====================================
compiler/GHC/Unit/Module/Deps.hs
=====================================
@@ -30,7 +30,7 @@ import GHC.Unit.Module.Imported
import GHC.Unit.Module
import GHC.Unit.Home
import GHC.Unit.State
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Utils.Fingerprint
import GHC.Utils.Binary
@@ -113,7 +113,7 @@ data Dependencies = Deps
mkDependencies :: HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies
mkDependencies home_unit mod imports plugin_mods =
let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods
- plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins)
+ plugin_units = mkUniqSet (map (toUnitId . moduleUnit) external_plugins)
all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot))
(imp_direct_dep_mods imports)
(map (fmap toUnitId) home_plugins)
@@ -201,11 +201,11 @@ instance Binary Dependencies where
noDependencies :: Dependencies
noDependencies = Deps
{ dep_direct_mods = mempty
- , dep_direct_pkgs = emptyUniqDSet
- , dep_plugin_pkgs = emptyUniqDSet
+ , dep_direct_pkgs = emptyUniqSet
+ , dep_plugin_pkgs = emptyUniqSet
, dep_sig_mods = []
, dep_boot_mods = mempty
- , dep_trusted_pkgs = emptyUniqDSet
+ , dep_trusted_pkgs = emptyUniqSet
, dep_orphs = []
, dep_finsts = []
}
@@ -225,7 +225,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods
text "boot module dependencies:" <+> ppr_set ppr bmods,
text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs,
text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns,
- if isEmptyUniqDSet tps
+ if isEmptyUniqSet tps
then empty
else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps,
text "orphans:" <+> fsep (map ppr orphs),
@@ -239,7 +239,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods
ppr_set w = fsep . fmap w . Set.toAscList
ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc
- ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList
+ ppr_unitIdSet w = fsep . fmap w . sort . uniqSetToAscList
-- | Records modules for which changes may force recompilation of this module
-- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..]
merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do
debugTraceMsg logger 2 $
text "loading package database" <+> text db_path
- forM_ (uniqDSetToList override_set) $ \pkg ->
+ forM_ (uniqSetToAscList override_set) $ \pkg ->
debugTraceMsg logger 2 $
text "package" <+> ppr pkg <+>
text "overrides a previously defined package"
@@ -1375,7 +1375,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..]
-- ones that get overridden. Compute this just to give some
-- helpful debug messages at -v2
override_set :: UnitIdSet
- override_set = mkUniqDSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map
+ override_set = mkUniqSet $ nonDetKeysUniqMap $ intersectUniqMap db_map pkg_map
-- Now merge the sets together (NB: in case of duplicate,
-- first argument preferred)
@@ -1687,7 +1687,7 @@ mkUnitState logger cfg = do
let !state = UnitState
{ preloadUnits = dep_preload
, explicitUnits = explicit_pkgs
- , homeUnitDepends = uniqDSetToList home_unit_deps
+ , homeUnitDepends = uniqSetToAscList home_unit_deps
, unitInfoMap = pkg_db
, preloadClosure = emptyUniqSet
, moduleNameProvidersMap = mod_map
@@ -1701,14 +1701,14 @@ mkUnitState logger cfg = do
return (state, raw_dbs)
selectHptFlag :: UnitIdSet -> PackageFlag -> Bool
-selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True
+selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = True
selectHptFlag _ _ = False
selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet
-selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags
+selectHomeUnits home_units flags = foldl' go emptyUniqSet flags
where
go :: UnitIdSet -> PackageFlag -> UnitIdSet
- go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid)
+ go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqSet` home_units = addOneToUniqSet cur (toUnitId uid)
-- MP: This does not yet support thinning/renaming
go cur _ = cur
=====================================
compiler/GHC/Unit/Types.hs
=====================================
@@ -94,6 +94,7 @@ import GHC.Prelude
import GHC.Types.Unique
import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Data.FastString
@@ -540,7 +541,7 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs)
-- code for.
type DefUnitId = Definite UnitId
-type UnitIdSet = UniqDSet UnitId
+type UnitIdSet = UniqSet UnitId
unitIdString :: UnitId -> String
unitIdString = unpackFS . unitIdFS
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51c916e8f96cd7b56c26be4d0064e5c06a8ae543
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51c916e8f96cd7b56c26be4d0064e5c06a8ae543
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230525/e7e299f9/attachment-0001.html>
More information about the ghc-commits
mailing list