[Git][ghc/ghc][wip/unitidset] Refactor `Set UnitId` to `UniqDSet UnitId` (#23335)
Josh Meredith (@JoshMeredith)
gitlab at gitlab.haskell.org
Thu May 4 10:40:00 UTC 2023
Josh Meredith pushed to branch wip/unitidset at Glasgow Haskell Compiler / GHC
Commits:
ddbb211e by Josh Meredith at 2023-05-04T10:39:38+00:00
Refactor `Set UnitId` to `UniqDSet UnitId` (#23335)
- - - - -
21 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Env.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/Linker/Types.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Types/Unique/DSet.hs
- compiler/GHC/Unit/Env.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/Types.hs
- ghc/GHCi/UI.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -395,6 +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.Unit
import GHC.Unit.Env
@@ -418,8 +419,6 @@ import Data.Typeable ( Typeable )
import Data.Word ( Word8 )
import qualified Data.Map.Strict as Map
-import Data.Set (Set)
-import qualified Data.Set as S
import qualified Data.Sequence as Seq
import System.Directory
@@ -604,7 +603,7 @@ setSessionDynFlags dflags0 = do
logger <- getLogger
dflags <- checkNewDynFlags logger dflags0
let all_uids = hsc_all_home_unit_ids hsc_env
- case S.toList all_uids of
+ case uniqDSetToList all_uids of
[uid] -> do
setUnitDynFlagsNoCheck uid dflags
modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags))
@@ -1379,7 +1378,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 `S.member` hsc_all_home_unit_ids hsc_env
+ if moduleUnitId mdl `elementOfUniqDSet` hsc_all_home_unit_ids hsc_env
then liftIO $ getHomeModuleInfo hsc_env mdl
else liftIO $ getPackageModuleInfo hsc_env mdl
@@ -1756,7 +1755,7 @@ isModuleTrusted m = withSession $ \hsc_env ->
liftIO $ hscCheckSafe hsc_env m noSrcSpan
-- | Return if a module is trusted and the pkgs it depends on to be trusted.
-moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId)
+moduleTrustReqs :: GhcMonad m => Module -> m (Bool, UnitIdSet)
moduleTrustReqs m = withSession $ \hsc_env ->
liftIO $ hscGetSafe hsc_env m noSrcSpan
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -56,12 +56,11 @@ import GHC.Types.SrcLoc
import GHC.Types.CostCentre
import GHC.Types.ForeignStubs
import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
+import GHC.Types.Unique.DSet
import System.Directory
import System.FilePath
import System.IO
-import Data.Set (Set)
-import qualified Data.Set as Set
{-
************************************************************************
@@ -84,7 +83,7 @@ codeOutput
-> (a -> ForeignStubs)
-> [(ForeignSrcLang, FilePath)]
-- ^ additional files to be compiled with the C compiler
- -> Set UnitId -- ^ Dependencies
+ -> UnitIdSet -- ^ Dependencies
-> Stream IO RawCmmGroup a -- Compiled C--
-> IO (FilePath,
(Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),
@@ -161,11 +160,11 @@ outputC :: Logger
-> DynFlags
-> FilePath
-> Stream IO RawCmmGroup a
- -> Set UnitId
+ -> UnitIdSet
-> 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 (Set.toAscList unit_deps)
+ let pkg_names = map unitIdString (uniqDSetToAscList unit_deps)
doOutput filenm $ \ h -> do
hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
hPutStr h "#include \"Stg.h\"\n"
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -127,7 +127,7 @@ hsc_HUE = ue_currentHomeUnitEnv . hsc_unit_env
hsc_HUG :: HscEnv -> HomeUnitGraph
hsc_HUG = ue_home_unit_graph . hsc_unit_env
-hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId
+hsc_all_home_unit_ids :: HscEnv -> UnitIdSet
hsc_all_home_unit_ids = unitEnv_keys . hsc_HUG
hscUpdateHPT_lazy :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -245,6 +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.Utils.Fingerprint ( Fingerprint )
import GHC.Utils.Panic
@@ -274,7 +275,6 @@ import Data.IORef
import System.FilePath as FilePath
import System.Directory
import qualified Data.Set as S
-import Data.Set (Set)
import Data.Functor
import Control.DeepSeq (force)
import Data.Bifunctor (first)
@@ -1457,15 +1457,15 @@ checkSafeImports tcg_env
clearDiagnostics
-- Check safe imports are correct
- safePkgs <- S.fromList <$> mapMaybeM checkSafe safeImps
+ safePkgs <- mkUniqDSet <$> 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, S.empty)
- True -> do infPkgs <- S.fromList <$> mapMaybeM checkSafe regImps
+ False -> return (emptyMessages, emptyUniqDSet)
+ True -> do infPkgs <- mkUniqDSet <$> mapMaybeM checkSafe regImps
infErrs <- getDiagnostics
clearDiagnostics
return (infErrs, infPkgs)
@@ -1516,12 +1516,12 @@ checkSafeImports tcg_env
checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l
-- what pkg's to add to our trust requirements
- pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId ->
+ pkgTrustReqs :: DynFlags -> UnitIdSet -> UnitIdSet ->
Bool -> ImportAvails
pkgTrustReqs dflags req inf infPassed | safeInferOn dflags
&& not (safeHaskellModeEnabled dflags) && infPassed
= emptyImportAvails {
- imp_trust_pkgs = req `S.union` inf
+ imp_trust_pkgs = req `unionUniqDSets` inf
}
pkgTrustReqs dflags _ _ _ | safeHaskell dflags == Sf_Unsafe
= emptyImportAvails
@@ -1540,12 +1540,12 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do
return $ isEmptyMessages errs
-- | Return if a module is trusted and the pkgs it depends on to be trusted.
-hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId)
+hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, UnitIdSet)
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 = S.insert p pkgs
+ let pkgs' | Just p <- self = addOneToUniqDSet pkgs p
| otherwise = pkgs
return (good, pkgs')
@@ -1554,7 +1554,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
-- own package be trusted and a list of other packages required to be trusted
-- (these later ones haven't been checked) but the own package trust has been.
hscCheckSafe' :: Module -> SrcSpan
- -> Hsc (Maybe UnitId, Set UnitId)
+ -> Hsc (Maybe UnitId, UnitIdSet)
hscCheckSafe' m l = do
hsc_env <- getHscEnv
let home_unit = hsc_home_unit hsc_env
@@ -1566,7 +1566,7 @@ hscCheckSafe' m l = do
-- Not necessary if that is reflected in dependencies
| otherwise -> return (Just $ toUnitId (moduleUnit m), pkgs)
where
- isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId)
+ isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, UnitIdSet)
isModSafe home_unit m l = do
hsc_env <- getHscEnv
dflags <- getDynFlags
@@ -1648,10 +1648,10 @@ hscCheckSafe' m l = do
-- | Check the list of packages are trusted.
-checkPkgTrust :: Set UnitId -> Hsc ()
+checkPkgTrust :: UnitIdSet -> Hsc ()
checkPkgTrust pkgs = do
hsc_env <- getHscEnv
- let errors = S.foldr go emptyBag pkgs
+ let errors = foldr go emptyBag $ uniqDSetToList 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 = S.empty }
+ wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = emptyUniqDSet }
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 [] S.empty
+ <- codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] emptyUniqDSet
rawCmms
return stub_c_exists
where
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -107,6 +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.PkgQual
import GHC.Unit
@@ -490,7 +491,7 @@ load how_much = loadWithCache noIfaceCache how_much
mkBatchMsg :: HscEnv -> Messager
mkBatchMsg hsc_env =
- if length (hsc_all_home_unit_ids hsc_env) > 1
+ if sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1
-- This also displays what unit each module is from.
then batchMultiMsg
else batchMsg
@@ -1735,25 +1736,25 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
-- This function checks then important property that if both p and q are home units
-- then any dependency of p, which transitively depends on q is also a home unit.
-checkHomeUnitsClosed :: UnitEnv -> Set.Set UnitId -> [(UnitId, UnitId)] -> [DriverMessages]
+checkHomeUnitsClosed :: UnitEnv -> UnitIdSet -> [(UnitId, UnitId)] -> [DriverMessages]
-- Fast path, trivially closed.
checkHomeUnitsClosed ue home_id_set home_imp_ids
- | Set.size home_id_set == 1 = []
+ | sizeUniqDSet home_id_set == 1 = []
| otherwise =
- let res = foldMap loop home_imp_ids
+ let res = foldr (\ids acc -> unionUniqDSets acc $ loop ids) emptyUniqDSet 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 = Set.difference res home_id_set
- in if Set.null bad_unit_ids
+ bad_unit_ids = res `minusUniqDSet` home_id_set
+ in if isEmptyUniqDSet bad_unit_ids
then []
- else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)]
+ else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (uniqDSetToAscList bad_unit_ids)]
where
rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
-- TODO: This could repeat quite a bit of work but I struggled to write this function.
-- Which units transitively depend on a home unit
- loop :: (UnitId, UnitId) -> Set.Set UnitId -- The units which transitively depend on a home unit
+ loop :: (UnitId, UnitId) -> UnitIdSet -- The units which transitively depend on a home unit
loop (from_uid, uid) =
let us = ue_findHomeUnitEnv from_uid ue in
let um = unitInfoMap (homeUnitEnv_units us) in
@@ -1761,20 +1762,21 @@ checkHomeUnitsClosed ue home_id_set home_imp_ids
Nothing -> pprPanic "uid not found" (ppr uid)
Just ui ->
let depends = unitDepends ui
- home_depends = Set.fromList depends `Set.intersection` home_id_set
- other_depends = Set.fromList depends `Set.difference` home_id_set
+ home_depends = mkUniqDSet depends `intersectUniqDSets` home_id_set
+ other_depends = mkUniqDSet depends `minusUniqDSet` home_id_set
in
-- Case 1: The unit directly depends on a home_id
- if not (null home_depends)
+ if not (isEmptyUniqDSet home_depends)
then
- let res = foldMap (loop . (from_uid,)) other_depends
- in Set.insert uid res
+ let res :: UnitIdSet
+ res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends
+ in addOneToUniqDSet res uid
-- Case 2: Check the rest of the dependencies, and then see if any of them depended on
else
- let res = foldMap (loop . (from_uid,)) other_depends
+ let res = foldr (\ide acc -> acc `unionUniqDSets` loop (from_uid, ide)) emptyUniqDSet $ uniqDSetToList other_depends
in
- if not (Set.null res)
- then Set.insert uid res
+ if not (isEmptyUniqDSet res)
+ then addOneToUniqDSet res uid
else res
-- | Update the every ModSummary that is depended on
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -108,6 +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.Unit
import GHC.Unit.Env
@@ -125,7 +126,7 @@ import Control.Monad
import qualified Control.Monad.Catch as MC (handle)
import Data.Maybe
import Data.Either ( partitionEithers )
-import qualified Data.Set as Set
+import Data.List ( sort )
import Data.Time ( getCurrentTime )
import GHC.Iface.Recomp
@@ -408,8 +409,8 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt
home_mod_infos = eltsHpt hpt
-- the packages we depend on
- pkg_deps = Set.toList
- $ Set.unions
+ pkg_deps = uniqDSetToList
+ $ unionManyUniqDSets
$ fmap (dep_direct_pkgs . mi_deps . hm_iface)
$ home_mod_infos
@@ -418,7 +419,7 @@ link' logger tmpfs dflags unit_env batch_attempt_linking mHscMessager hpt
debugTraceMsg logger 3 (text "link: hmi ..." $$ vcat (map (ppr . mi_module . hm_iface) home_mod_infos))
debugTraceMsg logger 3 (text "link: linkables are ..." $$ vcat (map ppr linkables))
- debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr pkg_deps))
+ debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr $ sort pkg_deps))
-- check for the -no-link flag
if isNoLink (ghcLink dflags)
=====================================
compiler/GHC/HsToCore/Usage.hs
=====================================
@@ -26,6 +26,7 @@ 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
@@ -40,7 +41,6 @@ import Data.IORef
import Data.List (sortBy)
import Data.Map (Map)
import qualified Data.Map as Map
-import qualified Data.Set as Set
import GHC.Linker.Types
import GHC.Unit.Finder
@@ -196,7 +196,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do
mk_mod_usage_info :: UsageConfig
-> HomeUnit
- -> Set.Set UnitId
+ -> UnitIdSet
-> Module
-> ImportedMods
-> NameSet
@@ -255,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
- | toUnitId (moduleUnit mod) `Set.notMember` home_unit_ids
+ | not $ toUnitId (moduleUnit mod) `elementOfUniqDSet` home_unit_ids
= Just $ UsagePackageModule{ usg_mod = mod,
usg_mod_hash = mod_hash,
usg_safe = imp_safe }
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -504,7 +504,7 @@ loadInterface doc_str mod from
-- overlapping instances.
; massertPpr
((isOneShot (ghcMode (hsc_dflags hsc_env)))
- || moduleUnitId mod `notElem` hsc_all_home_unit_ids hsc_env
+ || not (moduleUnitId mod `elementOfUniqDSet` 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,6 +59,7 @@ 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
@@ -617,8 +618,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 = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface))
- (dep_plugin_pkgs (mi_deps iface)))
+ prev_dep_pkgs = uniqDSetToAscList (unionUniqDSets (dep_direct_pkgs (mi_deps iface))
+ (dep_plugin_pkgs (mi_deps iface)))
implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags)
@@ -633,7 +634,7 @@ checkDependencies hsc_env summary iface
classify _ (Found _ mod)
- | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod))
+ | (toUnitId $ moduleUnit mod) `elementOfUniqDSet` 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
=====================================
@@ -324,20 +324,20 @@ loadCmdLineLibs interp hsc_env = do
loadCmdLineLibs' :: Interp -> HscEnv -> LoaderState -> IO LoaderState
loadCmdLineLibs' interp hsc_env pls = snd <$>
foldM
- (\(done', pls') cur_uid -> load done' cur_uid pls')
- (Set.empty, pls)
- (hsc_all_home_unit_ids hsc_env)
+ (\(done', pls') cur_uid -> load done' cur_uid pls')
+ (emptyUniqDSet, pls)
+ (uniqDSetToList $ hsc_all_home_unit_ids hsc_env)
where
- load :: Set.Set UnitId -> UnitId -> LoaderState -> IO (Set.Set UnitId, LoaderState)
- load done uid pls | uid `Set.member` done = return (done, pls)
+ load :: UnitIdSet -> UnitId -> LoaderState -> IO (UnitIdSet, LoaderState)
+ load done uid pls | uid `elementOfUniqDSet` 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'))
+ (homeUnitDepends (hsc_units hsc'))
pls'' <- loadCmdLineLibs'' interp hsc' pls'
- return $ (Set.insert uid done', pls'')
+ return $ (addOneToUniqDSet done' uid, pls'')
loadCmdLineLibs''
:: Interp
@@ -685,7 +685,7 @@ getLinkDeps :: HscEnv
-> Maybe FilePath -- replace object suffixes?
-> SrcSpan -- for error messages
-> [Module] -- If you need these
- -> IO ([Linkable], [Linkable], [UnitId], UniqDSet UnitId) -- ... then link these first
+ -> IO ([Linkable], [Linkable], [UnitId], UnitIdSet) -- ... then link these first
-- The module and package dependencies for the needed modules are returned.
-- See Note [Object File Dependencies]
-- Fails with an IO exception if it can't find enough files
@@ -737,7 +737,7 @@ getLinkDeps hsc_env pls replace_osuf span mods
-- It is also a matter of correctness to use the module graph so that dependencies between home units
-- is resolved correctly.
- make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey)
+ make_deps_loop :: (UnitIdSet, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UnitIdSet, Set.Set NodeKey)
make_deps_loop found [] = found
make_deps_loop found@(found_units, found_mods) (nk:nexts)
| NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts
@@ -766,7 +766,7 @@ getLinkDeps hsc_env pls replace_osuf span mods
HsBootFile -> link_boot_mod_error (mi_module iface)
_ -> return $ Just (mi_module iface)
- in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod
+ in (dep_direct_pkgs (mi_deps iface),) <$> mmod
Nothing ->
let err = text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid
in throwGhcExceptionIO (ProgramError (showSDoc dflags err))
@@ -780,9 +780,9 @@ getLinkDeps hsc_env pls replace_osuf span mods
-- dependencies of that. Hence we need to traverse the dependency
-- tree recursively. See bug #936, testcase ghci/prog007.
follow_deps :: [Module] -- modules to follow
- -> UniqDSet Module -- accum. module dependencies
- -> UniqDSet UnitId -- accum. package dependencies
- -> IO ([Module], UniqDSet UnitId) -- result
+ -> UniqDSet Module -- accum. module dependencies
+ -> UnitIdSet -- accum. package dependencies
+ -> IO ([Module], UnitIdSet) -- result
follow_deps [] acc_mods acc_pkgs
= return (uniqDSetToList acc_mods, acc_pkgs)
follow_deps (mod:mods) acc_mods acc_pkgs
@@ -814,7 +814,7 @@ 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 (Set.toList pkg_deps)
+ acc_pkgs' = addListToUniqDSet acc_pkgs (uniqDSetToList pkg_deps)
case hsc_home_unit_maybe hsc_env of
Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods)
=====================================
compiler/GHC/Linker/Types.hs
=====================================
@@ -37,7 +37,7 @@ module GHC.Linker.Types
where
import GHC.Prelude
-import GHC.Unit ( UnitId, Module )
+import GHC.Unit ( UnitId, Module, UnitIdSet )
import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode )
import GHC.Fingerprint.Type ( Fingerprint )
import GHCi.RemoteTypes ( ForeignHValue )
@@ -53,7 +53,6 @@ import Control.Concurrent.MVar
import Data.Time ( UTCTime )
import Data.Maybe
import GHC.Unit.Module.Env
-import GHC.Types.Unique.DSet
import GHC.Types.Unique.DFM
import GHC.Unit.Module.WholeCoreBindings
@@ -146,7 +145,7 @@ data LoadedPkgInfo
{ loaded_pkg_uid :: !UnitId
, loaded_pkg_hs_objs :: ![LibrarySpec]
, loaded_pkg_non_hs_objs :: ![LibrarySpec]
- , loaded_pkg_trans_deps :: UniqDSet UnitId
+ , loaded_pkg_trans_deps :: UnitIdSet
}
instance Outputable LoadedPkgInfo where
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -74,6 +74,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.Unit
import GHC.Unit.Module.Warnings
@@ -212,8 +213,8 @@ rnImports imports = do
let merged_import_avail = clobberSourceImports imp_avails
dflags <- getDynFlags
let final_import_avail =
- merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags)
- `S.union` imp_dep_direct_pkgs merged_import_avail}
+ merged_import_avail { imp_dep_direct_pkgs = mkUniqDSet (implicitPackageDeps dflags)
+ `unionUniqDSets` imp_dep_direct_pkgs merged_import_avail}
return (decls, rdr_env, final_import_avail, hpc_usage)
where
@@ -480,7 +481,7 @@ renamePkgQual unit_env mn mb_pkg = case mb_pkg of
-- | Calculate the 'ImportAvails' induced by an import of a particular
-- interface, but without 'imp_mods'.
calculateAvails :: HomeUnit
- -> S.Set UnitId
+ -> UnitIdSet
-> ModIface
-> IsSafeImport
-> IsBootInterface
@@ -535,7 +536,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 = S.empty
+ | otherwise = emptyUniqDSet
pkg = moduleUnit (mi_module iface)
@@ -548,11 +549,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 `S.member` other_home_units
- then S.empty
- else S.singleton ipkg
+ dependent_pkgs = if toUnitId pkg `elementOfUniqDSet` other_home_units
+ then emptyUniqDSet
+ else unitUniqDSet ipkg
- direct_mods = mkModDeps $ if toUnitId pkg `S.member` other_home_units
+ direct_mods = mkModDeps $ if toUnitId pkg `elementOfUniqDSet` other_home_units
then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot))
else S.empty
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -148,6 +148,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.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
@@ -185,7 +186,6 @@ import Data.List ( sortBy, sort )
import Data.List.NonEmpty ( NonEmpty (..) )
import qualified Data.List.NonEmpty as NE
import Data.Ord
-import qualified Data.Set as S
import Data.Traversable ( for )
@@ -3134,7 +3134,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
, text "Dependent modules:" <+>
(ppr . sort . installedModuleEnvElts $ imp_direct_dep_mods imports)
, text "Dependent packages:" <+>
- ppr (S.toList $ imp_dep_direct_pkgs imports)]
+ ppr (uniqDSetToAscList $ imp_dep_direct_pkgs imports)]
-- The use of sort is just to reduce unnecessary
-- wobbling in testsuite output
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -142,6 +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.Basic
import GHC.Types.CostCentre.State
import GHC.Types.HpcInfo
@@ -1367,9 +1368,9 @@ plusModDeps = plusInstalledModuleEnv plus_mod_dep
emptyImportAvails :: ImportAvails
emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv,
imp_direct_dep_mods = emptyInstalledModuleEnv,
- imp_dep_direct_pkgs = S.empty,
+ imp_dep_direct_pkgs = emptyUniqDSet,
imp_sig_mods = [],
- imp_trust_pkgs = S.empty,
+ imp_trust_pkgs = emptyUniqDSet,
imp_trust_own_pkg = False,
imp_boot_mods = emptyInstalledModuleEnv,
imp_orphs = [],
@@ -1398,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 `S.union` ddpkgs2,
- imp_trust_pkgs = tpkgs1 `S.union` tpkgs2,
+ imp_dep_direct_pkgs = ddpkgs1 `unionUniqDSets` ddpkgs2,
+ imp_trust_pkgs = tpkgs1 `unionUniqDSets` 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/DSet.hs
=====================================
@@ -32,6 +32,7 @@ module GHC.Types.Unique.DSet (
isEmptyUniqDSet,
lookupUniqDSet,
uniqDSetToList,
+ uniqDSetToAscList,
partitionUniqDSet,
mapUniqDSet
) where
@@ -43,8 +44,11 @@ import GHC.Types.Unique.DFM
import GHC.Types.Unique.Set
import GHC.Types.Unique
+import GHC.Utils.Binary
+
import Data.Coerce
import Data.Data
+import Data.List (sort)
-- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here.
-- Beyond preserving invariants, we may also want to 'override' typeclass
@@ -120,6 +124,9 @@ lookupUniqDSet = lookupUDFM . getUniqDSet
uniqDSetToList :: UniqDSet a -> [a]
uniqDSetToList = eltsUDFM . getUniqDSet
+uniqDSetToAscList :: Ord a => UniqDSet a -> [a]
+uniqDSetToAscList = sort . uniqDSetToList
+
partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a)
partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet
@@ -140,3 +147,7 @@ instance Outputable a => Outputable (UniqDSet a) where
pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc
pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList
+
+instance (Uniquable a, Binary a, Ord a) => Binary (UniqDSet a) where
+ put_ bh = put_ bh . uniqDSetToAscList
+ get bh = mkUniqDSet <$> get bh
=====================================
compiler/GHC/Unit/Env.hs
=====================================
@@ -81,6 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack)
import GHC.Driver.Session
import GHC.Utils.Outputable
import GHC.Utils.Panic (pprPanic)
+import GHC.Types.Unique.DSet
import GHC.Unit.Module.ModIface
import GHC.Unit.Module
import qualified Data.Set as Set
@@ -339,8 +340,8 @@ unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env)
unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v
unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env
-unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey
-unitEnv_keys env = Map.keysSet (unitEnv_graph env)
+unitEnv_keys :: UnitEnvGraph v -> UnitIdSet
+unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env)
unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)]
unitEnv_elts env = Map.toList (unitEnv_graph env)
@@ -443,7 +444,7 @@ ue_unitHomeUnit_maybe uid ue_env =
ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit
ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env
-ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId
+ue_all_home_unit_ids :: UnitEnv -> UnitIdSet
ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph
-- -------------------------------------------------------
-- Query and modify the currently active unit
=====================================
compiler/GHC/Unit/Module/Deps.hs
=====================================
@@ -28,6 +28,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.Utils.Fingerprint
import GHC.Utils.Binary
@@ -53,13 +54,13 @@ data Dependencies = Deps
-- ^ All home-package modules which are directly imported by this one.
-- This may include modules from other units when using multiple home units
- , dep_direct_pkgs :: Set UnitId
+ , dep_direct_pkgs :: UnitIdSet
-- ^ All packages directly imported by this module
-- I.e. packages to which this module's direct imports belong.
-- Does not include other home units when using multiple home units.
-- Modules from these units will go in `dep_direct_mods`
- , dep_plugin_pkgs :: Set UnitId
+ , dep_plugin_pkgs :: UnitIdSet
-- ^ All units needed for plugins
------------------------------------
@@ -69,7 +70,7 @@ data Dependencies = Deps
-- ^ Transitive closure of hsig files in the home package
- , dep_trusted_pkgs :: Set UnitId
+ , dep_trusted_pkgs :: UnitIdSet
-- Packages which we are required to trust
-- when the module is imported as a safe import
-- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names
@@ -110,7 +111,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 = Set.fromList (map (toUnitId . moduleUnit) external_plugins)
+ plugin_units = mkUniqDSet (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)
@@ -197,12 +198,12 @@ instance Binary Dependencies where
noDependencies :: Dependencies
noDependencies = Deps
- { dep_direct_mods = Set.empty
- , dep_direct_pkgs = Set.empty
- , dep_plugin_pkgs = Set.empty
+ { dep_direct_mods = mempty
+ , dep_direct_pkgs = emptyUniqDSet
+ , dep_plugin_pkgs = emptyUniqDSet
, dep_sig_mods = []
- , dep_boot_mods = Set.empty
- , dep_trusted_pkgs = Set.empty
+ , dep_boot_mods = mempty
+ , dep_trusted_pkgs = emptyUniqDSet
, dep_orphs = []
, dep_finsts = []
}
@@ -220,11 +221,11 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods
= pprWithUnitState unit_state $
vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods,
text "boot module dependencies:" <+> ppr_set ppr bmods,
- text "direct package dependencies:" <+> ppr_set ppr pkgs,
- text "plugin package dependencies:" <+> ppr_set ppr plgns,
- if null tps
+ text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs,
+ text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns,
+ if isEmptyUniqDSet tps
then empty
- else text "trusted package dependencies:" <+> ppr_set ppr tps,
+ else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps,
text "orphans:" <+> fsep (map ppr orphs),
text "family instance modules:" <+> fsep (map ppr finsts)
]
@@ -235,6 +236,9 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods
ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc
ppr_set w = fsep . fmap w . Set.toAscList
+ ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc
+ ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList
+
-- | Records modules for which changes may force recompilation of this module
-- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance
--
@@ -491,7 +495,7 @@ data ImportAvails
imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot,
-- ^ Home-package modules directly imported by the module being compiled.
- imp_dep_direct_pkgs :: Set UnitId,
+ imp_dep_direct_pkgs :: UnitIdSet,
-- ^ Packages directly needed by the module being compiled
imp_trust_own_pkg :: Bool,
@@ -502,7 +506,7 @@ data ImportAvails
-- Transitive information below here
- imp_trust_pkgs :: Set UnitId,
+ imp_trust_pkgs :: UnitIdSet,
-- ^ This records the
-- packages the current module needs to trust for Safe Haskell
-- compilation to succeed. A package is required to be trusted if
=====================================
compiler/GHC/Unit/Module/ModGuts.hs
=====================================
@@ -37,8 +37,6 @@ import GHC.Types.SourceFile ( HscSource(..), hscSourceToIsBoot )
import GHC.Types.SrcLoc
import GHC.Types.CostCentre
-import Data.Set (Set)
-
-- | A ModGuts is carried through the compiler, accumulating stuff as it goes
-- There is only one ModGuts at any time, the one for the module
@@ -137,7 +135,7 @@ data CgGuts
cg_ccs :: [CostCentre], -- List of cost centres used in bindings and rules
cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
cg_foreign_files :: ![(ForeignSrcLang, FilePath)],
- cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to
+ cg_dep_pkgs :: !UnitIdSet, -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information
cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -346,10 +346,10 @@ data UnitConfig = UnitConfig
, unitConfigFlagsIgnored :: [IgnorePackageFlag] -- ^ Ignored units
, unitConfigFlagsTrusted :: [TrustFlag] -- ^ Trusted units
, unitConfigFlagsPlugins :: [PackageFlag] -- ^ Plugins exposed units
- , unitConfigHomeUnits :: Set.Set UnitId
+ , unitConfigHomeUnits :: UnitIdSet
}
-initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig
+initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> UnitConfig
initUnitConfig dflags cached_dbs home_units =
let !hu_id = homeUnitId_ dflags
!hu_instanceof = homeUnitInstanceOf_ dflags
@@ -626,7 +626,7 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state)
-- 'initUnits' can be called again subsequently after updating the
-- 'packageFlags' field of the 'DynFlags', and it will update the
-- 'unitState' in 'DynFlags'.
-initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants)
+initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants)
initUnits logger dflags cached_dbs home_units = do
let forceUnitInfoMap (state, _) = unitInfoMap state `seq` ()
@@ -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_ (Set.toList override_set) $ \pkg ->
+ forM_ (uniqDSetToList override_set) $ \pkg ->
debugTraceMsg logger 2 $
text "package" <+> ppr pkg <+>
text "overrides a previously defined package"
@@ -1374,9 +1374,9 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..]
-- The set of UnitIds which appear in both db and pkgs. These are the
-- ones that get overridden. Compute this just to give some
-- helpful debug messages at -v2
- override_set :: Set UnitId
- override_set = Set.intersection (nonDetUniqMapToKeySet db_map)
- (nonDetUniqMapToKeySet pkg_map)
+ override_set :: UnitIdSet
+ override_set = intersectUniqDSets (mkUniqDSet $ nonDetKeysUniqMap db_map)
+ (mkUniqDSet $ nonDetKeysUniqMap pkg_map)
-- Now merge the sets together (NB: in case of duplicate,
-- first argument preferred)
@@ -1688,7 +1688,7 @@ mkUnitState logger cfg = do
let !state = UnitState
{ preloadUnits = dep_preload
, explicitUnits = explicit_pkgs
- , homeUnitDepends = Set.toList home_unit_deps
+ , homeUnitDepends = uniqDSetToList home_unit_deps
, unitInfoMap = pkg_db
, preloadClosure = emptyUniqSet
, moduleNameProvidersMap = mod_map
@@ -1701,15 +1701,15 @@ mkUnitState logger cfg = do
}
return (state, raw_dbs)
-selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool
-selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True
+selectHptFlag :: UnitIdSet -> PackageFlag -> Bool
+selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True
selectHptFlag _ _ = False
-selectHomeUnits :: Set.Set UnitId -> [PackageFlag] -> Set.Set UnitId
-selectHomeUnits home_units flags = foldl' go Set.empty flags
+selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet
+selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags
where
- go :: Set.Set UnitId -> PackageFlag -> Set.Set UnitId
- go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = Set.insert (toUnitId uid) cur
+ go :: UnitIdSet -> PackageFlag -> UnitIdSet
+ go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid)
-- MP: This does not yet support thinning/renaming
go cur _ = cur
=====================================
compiler/GHC/Unit/Types.hs
=====================================
@@ -33,6 +33,7 @@ module GHC.Unit.Types
, GenInstantiatedUnit (..)
, InstantiatedUnit
, DefUnitId
+ , UnitIdSet
, Instantiations
, GenInstantiations
, mkInstantiatedUnit
@@ -538,6 +539,8 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs)
-- code for.
type DefUnitId = Definite UnitId
+type UnitIdSet = UniqDSet UnitId
+
unitIdString :: UnitId -> String
unitIdString = unpackFS . unitIdFS
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -105,6 +105,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
-- Haskell Libraries
import System.Console.Haskeline as Haskeline
@@ -125,7 +126,6 @@ import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
import Data.List ( elemIndices, find, intercalate, intersperse, minimumBy,
isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
import qualified Data.List.NonEmpty as NE
-import qualified Data.Set as S
import Data.Maybe
import qualified Data.Map as M
import Data.IntMap.Strict (IntMap)
@@ -561,7 +561,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 = length (hsc_all_home_unit_ids hsc_env) > 1
+ let in_multi = sizeUniqDSet (hsc_all_home_unit_ids hsc_env) > 1
empty_cache <- liftIO newIfaceCache
startGHCi (runGHCi srcs maybe_exprs)
GHCiState{ progname = default_progname,
@@ -2568,15 +2568,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 $ S.null good)
+ when (not $ isEmptyUniqDSet good)
(liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
- (intercalate ", " $ map (showPpr dflags) (S.toList good)))
- case msafe && S.null bad of
+ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList good)))
+ case msafe && isEmptyUniqDSet bad of
True -> liftIO $ putStrLn $ mname ++ " is trusted!"
False -> do
- when (not $ null bad)
+ when (not $ isEmptyUniqDSet bad)
(liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
- ++ (intercalate ", " $ map (showPpr dflags) (S.toList bad)))
+ ++ (intercalate ", " $ map (showPpr dflags) (uniqDSetToList bad)))
liftIO $ putStrLn $ mname ++ " is NOT trusted!"
where
@@ -2586,8 +2586,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) = (S.empty, S.empty)
- | otherwise = S.partition part deps
+ tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (emptyUniqDSet, emptyUniqDSet)
+ | otherwise = partitionUniqDSet 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/ddbb211eb3625cfbc8fe5a7f55fef1ee2cea34d8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddbb211eb3625cfbc8fe5a7f55fef1ee2cea34d8
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/20230504/832aa8e8/attachment-0001.html>
More information about the ghc-commits
mailing list