[Git][ghc/ghc][wip/unitidset] Use UniqSet instead of UniqDSet in UnitIdSet
Josh Meredith (@JoshMeredith)
gitlab at gitlab.haskell.org
Thu May 25 09:28:07 UTC 2023
Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC
Commits:
61aa6421 by Josh Meredith at 2023-05-25T09:27:45+00:00
Use UniqSet instead of UniqDSet in UnitIdSet
- - - - -
18 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline.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
- ghc/GHCi/UI.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -395,7 +395,7 @@ import GHC.Types.Name.Ppr
import GHC.Types.TypeEnv
import GHC.Types.BreakInfo
import GHC.Types.PkgQual
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Unit
import GHC.Unit.Env
@@ -603,7 +603,7 @@ setSessionDynFlags dflags0 = do
logger <- getLogger
dflags <- checkNewDynFlags logger dflags0
let all_uids = hsc_all_home_unit_ids hsc_env
- case uniqDSetToList all_uids of
+ case uniqSetToAscList all_uids of
[uid] -> do
setUnitDynFlagsNoCheck uid dflags
modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags))
@@ -1379,7 +1379,7 @@ data ModuleInfo = ModuleInfo {
-- | Request information about a loaded 'Module'
getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
getModuleInfo mdl = withSession $ \hsc_env -> do
- if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env
+ if moduleUnitId mdl `elementOfUniqSet` hsc_all_home_unit_ids hsc_env
then liftIO $ getHomeModuleInfo hsc_env mdl
else liftIO $ getPackageModuleInfo hsc_env mdl
=====================================
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/Driver/Main.hs
=====================================
@@ -245,7 +245,7 @@ import GHC.Types.Name.Ppr
import GHC.Types.Name.Set (NonCaffySet)
import GHC.Types.TyThing
import GHC.Types.HpcInfo
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Utils.Fingerprint ( Fingerprint )
import GHC.Utils.Panic
@@ -1457,15 +1457,15 @@ checkSafeImports tcg_env
clearDiagnostics
-- Check safe imports are correct
- safePkgs <- mkUniqDSet <$> mapMaybeM checkSafe safeImps
+ safePkgs <- mkUniqSet <$> mapMaybeM checkSafe safeImps
safeErrs <- getDiagnostics
clearDiagnostics
-- Check non-safe imports are correct if inferring safety
-- See the Note [Safe Haskell Inference]
(infErrs, infPkgs) <- case (safeInferOn dflags) of
- False -> return (emptyMessages, emptyUniqDSet)
- True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps
+ False -> return (emptyMessages, emptyUniqSet)
+ True -> do infPkgs <- mkUniqSet <$> mapMaybeM checkSafe regImps
infErrs <- getDiagnostics
clearDiagnostics
return (infErrs, infPkgs)
@@ -1521,7 +1521,7 @@ checkSafeImports tcg_env
pkgTrustReqs dflags req inf infPassed | safeInferOn dflags
&& not (safeHaskellModeEnabled dflags) && infPassed
= emptyImportAvails {
- imp_trust_pkgs = req `unionUniqDSets` inf
+ imp_trust_pkgs = req `unionUniqSets` inf
}
pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe
= emptyImportAvails
@@ -1545,7 +1545,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
(self, pkgs) <- hscCheckSafe' m l
good <- isEmptyMessages `fmap` getDiagnostics
clearDiagnostics -- don't want them printed...
- let pkgs' | Just p <- self = addOneToUniqDSet pkgs p
+ let pkgs' | Just p <- self = addOneToUniqSet pkgs p
| otherwise = pkgs
return (good, pkgs')
@@ -1651,7 +1651,7 @@ hscCheckSafe' m l = do
checkPkgTrust :: UnitIdSet -> Hsc ()
checkPkgTrust pkgs = do
hsc_env <- getHscEnv
- let errors = foldr go emptyBag $ uniqDSetToList pkgs
+ let errors = foldr go emptyBag $ uniqSetToAscList pkgs
state = hsc_units hsc_env
go pkg acc
| unitIsTrusted $ unsafeLookupUnitId state pkg
@@ -1699,7 +1699,7 @@ markUnsafeInfer tcg_env whyUnsafe = do
False -> return tcg_env
where
- wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet }
+ wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqSet }
pprMod = ppr $ moduleName $ tcg_mod tcg_env
whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!"
, text "Reason:"
@@ -2060,7 +2060,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
in NoStubs `appendStubC` ip_init
| otherwise = NoStubs
(_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos)
- <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet
+ <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqSet
rawCmms
return stub_c_exists
where
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -107,7 +107,7 @@ import GHC.Types.SourceFile
import GHC.Types.SourceError
import GHC.Types.SrcLoc
import GHC.Types.Unique.Map
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Types.PkgQual
import GHC.Unit
@@ -491,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much
mkBatchMsg :: HscEnv -> Messager
mkBatchMsg hsc_env =
- if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1
+ if sizeUniqSet (hsc_all_home_unit_ids hsc_env) > 1
-- This also displays what unit each module is from.
then batchMultiMsg
else batchMsg
@@ -1745,16 +1745,16 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages]
-- Fast path, trivially closed.
checkHomeUnitsClosed ue home_id_set home_imp_ids
- | sizeUniqDSet home_id_set == 1 = []
+ | sizeUniqSet home_id_set == 1 = []
| otherwise =
- let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet home_imp_ids
+ let res = foldr (\ids acc -> unionUniqSets acc $ loop ids) emptyUniqSet home_imp_ids
-- Now check whether everything which transitively depends on a home_unit is actually a home_unit
-- These units are the ones which we need to load as home packages but failed to do for some reason,
-- it's a bug in the tool invoking GHC.
- bad_unit_ids = res `minusUniqDSet` home_id_set
- in if isEmptyUniqDSet bad_unit_ids
+ bad_unit_ids = res `minusUniqSet` home_id_set
+ in if isEmptyUniqSet bad_unit_ids
then []
- else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)]
+ else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqSetToAscList bad_unit_ids)]
where
rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
@@ -1768,21 +1768,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids
Nothing -> pprPanic "uid not found" (ppr uid)
Just ui ->
let depends = unitDepends ui
- home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set
- other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set
+ home_depends = mkUniqSet depends `intersectUniqSets` home_id_set
+ other_depends = mkUniqSet depends `minusUniqSet` home_id_set
in
-- Case 1: The unit directly depends on a home_id
- if not (isEmptyUniqDSet home_depends)
+ if not (isEmptyUniqSet home_depends)
then
let res :: UnitIdSet
- res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends
- in addOneToUniqDSet res uid
+ res = foldr (\ide acc -> acc `unionUniqSets` loop (from_uid, ide)) emptyUniqSet $ uniqSetToAscList other_depends
+ in addOneToUniqSet res uid
-- Case 2: Check the rest of the dependencies, and then see if any of them depended on
else
- let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends
+ let res = foldr (\ide acc -> acc `unionUniqSets` loop (from_uid, ide)) emptyUniqSet $ uniqSetToAscList other_depends
in
- if not (isEmptyUniqDSet res)
- then addOneToUniqDSet res uid
+ if not (isEmptyUniqSet res)
+ then addOneToUniqSet res uid
else res
-- | Update the every ModSummary that is depended on
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -108,7 +108,7 @@ import GHC.Types.Target
import GHC.Types.SrcLoc
import GHC.Types.SourceFile
import GHC.Types.SourceError
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
import GHC.Unit
import GHC.Unit.Env
@@ -410,8 +410,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt
home_mod_infos = eltsHpt hpt
-- the packages we depend on
- pkg_deps = uniqDSetToList
- $ unionManyUniqDSets
+ pkg_deps = uniqSetToAscList
+ $ unionManyUniqSets
$ fmap (dep_direct_pkgs . mi_deps . hm_iface)
$ home_mod_infos
=====================================
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
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -106,7 +106,7 @@ import GHC.Utils.Misc
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.Bag (unitBag)
import qualified GHC.Data.Strict as Strict
-import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Set
-- Haskell Libraries
import System.Console.Haskeline as Haskeline
@@ -562,7 +562,7 @@ interactiveUI config srcs maybe_exprs = do
-- Set to True because Prelude is implicitly imported.
impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}}
hsc_env <- GHC.getSession
- let in_multi = sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1
+ let in_multi = sizeUniqSet (hsc_all_home_unit_ids hsc_env) > 1
empty_cache <- liftIO newIfaceCache
startGHCi (runGHCi srcs maybe_exprs)
GHCiState{ progname = default_progname,
@@ -2569,15 +2569,15 @@ isSafeModule m = do
-- print info to user...
liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")"
liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off")
- when (not $ isEmptyUniqDSet good)
+ when (not $ isEmptyUniqSet good)
(liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
- (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good)))
- case msafe && isEmptyUniqDSet bad of
+ (intercalate ", " $ map (showPpr dflags) (uniqSetToAscList good)))
+ case msafe && isEmptyUniqSet bad of
True -> liftIO $ putStrLn $ mname ++ " is trusted!"
False -> do
- when (not $ isEmptyUniqDSet bad)
+ when (not $ isEmptyUniqSet bad)
(liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
- ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad)))
+ ++ (intercalate ", " $ map (showPpr dflags) (uniqSetToAscList bad)))
liftIO $ putStrLn $ mname ++ " is NOT trusted!"
where
@@ -2587,8 +2587,8 @@ isSafeModule m = do
| isHomeModule (hsc_home_unit hsc_env) md = True
| otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md)
- tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet)
- | otherwise = partitionUniqDSet part deps
+ tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqSet, emptyUniqSet)
+ | otherwise = partitionUniqSet part deps
where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg
unit_state = hsc_units hsc_env
dflags = hsc_dflags hsc_env
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61aa6421222c1d7212b3106bd9594df742b8d697
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61aa6421222c1d7212b3106bd9594df742b8d697
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/29e2c3f1/attachment-0001.html>
More information about the ghc-commits
mailing list