summaryrefslogtreecommitdiff
path: root/compiler/GHC/Driver
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Driver')
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs9
-rw-r--r--compiler/GHC/Driver/Env.hs2
-rw-r--r--compiler/GHC/Driver/Main.hs28
-rw-r--r--compiler/GHC/Driver/Make.hs34
-rw-r--r--compiler/GHC/Driver/Pipeline.hs9
5 files changed, 42 insertions, 40 deletions
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index c5c0534d20..2b4d569710 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/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"
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index c9967c7120..5008194b72 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/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
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 3321d1203f..3450ca0f0c 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/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
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index c047056ea6..a6dbad4f30 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/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
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 0737a2f8c1..c392515aa3 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/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)
View Lorry Controller Status