summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-08-09 11:29:45 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-08-13 07:54:32 -0400
commitc367b39e5236b86b4923d826ab0395b33211d30a (patch)
tree658e595a18356bcda04f3f72b168eb86bc51bf99 /compiler/GHC
parent7ad813a480c9ed383fe1fea11a57f90d4f6f9b71 (diff)
downloadhaskell-c367b39e5236b86b4923d826ab0395b33211d30a.tar.gz
Refactoring module dependencies
* Make mkDependencies pure * Use Sets instead of sorted lists Notable perf changes: MultiLayerModules(normal) ghc/alloc 4130851520.0 2981473072.0 -27.8% T13719(normal) ghc/alloc 4313296052.0 4151647512.0 -3.7% Metric Decrease: MultiLayerModules T13719
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs10
-rw-r--r--compiler/GHC/Driver/Env.hs86
-rw-r--r--compiler/GHC/Driver/Main.hs4
-rw-r--r--compiler/GHC/Driver/Pipeline.hs8
-rw-r--r--compiler/GHC/HsToCore.hs6
-rw-r--r--compiler/GHC/HsToCore/Usage.hs91
-rw-r--r--compiler/GHC/Iface/Load.hs19
-rw-r--r--compiler/GHC/Iface/Make.hs7
-rw-r--r--compiler/GHC/Iface/Recomp.hs19
-rw-r--r--compiler/GHC/Linker/Loader.hs13
-rw-r--r--compiler/GHC/Rename/Names.hs8
-rw-r--r--compiler/GHC/Tc/Module.hs3
-rw-r--r--compiler/GHC/Tc/Types.hs9
-rw-r--r--compiler/GHC/Unit/Module/Deps.hs21
-rw-r--r--compiler/GHC/Unit/Module/ModGuts.hs4
-rw-r--r--compiler/GHC/Unit/Types.hs3
-rw-r--r--compiler/GHC/Utils/Binary.hs6
17 files changed, 179 insertions, 138 deletions
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index 7382ec9a10..87b3af42df 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -57,6 +57,8 @@ import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
import System.Directory
import System.FilePath
import System.IO
+import Data.Set (Set)
+import qualified Data.Set as Set
{-
************************************************************************
@@ -77,7 +79,7 @@ codeOutput
-> (a -> ForeignStubs)
-> [(ForeignSrcLang, FilePath)]
-- ^ additional files to be compiled with the C compiler
- -> [UnitId]
+ -> Set UnitId -- ^ Dependencies
-> Stream IO RawCmmGroup a -- Compiled C--
-> IO (FilePath,
(Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),
@@ -134,11 +136,11 @@ outputC :: Logger
-> DynFlags
-> FilePath
-> Stream IO RawCmmGroup a
- -> [UnitId]
+ -> Set UnitId
-> IO a
-outputC logger dflags filenm cmm_stream packages =
+outputC logger dflags filenm cmm_stream unit_deps =
withTiming logger (text "C codegen") (\a -> seq a () {- FIXME -}) $ do
- let pkg_names = map unitIdString packages
+ let pkg_names = map unitIdString (Set.toAscList 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 c00537a3dd..45fa18e31d 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -1,4 +1,4 @@
-
+{-# LANGUAGE LambdaCase #-}
module GHC.Driver.Env
( Hsc(..)
@@ -61,7 +61,6 @@ import GHC.Types.Error ( emptyMessages, Messages )
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.TyThing
-import GHC.Types.Unique.FM
import GHC.Builtin.Names ( gHC_PRIM )
@@ -77,6 +76,7 @@ import GHC.Utils.Trace
import Data.IORef
import qualified Data.Set as Set
+import Data.Set (Set)
runHsc :: HscEnv -> Hsc a -> IO a
runHsc hsc_env (Hsc hsc) = do
@@ -202,7 +202,7 @@ hptAllInstances hsc_env
in (concat insts, concat famInsts)
-- | Find instances visible from the given set of imports
-hptInstancesBelow :: HscEnv -> ModuleName -> [ModuleNameWithIsBoot] -> ([ClsInst], [FamInst])
+hptInstancesBelow :: HscEnv -> ModuleName -> Set ModuleNameWithIsBoot -> ([ClsInst], [FamInst])
hptInstancesBelow hsc_env mn mns =
let (insts, famInsts) =
unzip $ hptSomeThingsBelowUs (\mod_info ->
@@ -217,53 +217,67 @@ hptInstancesBelow hsc_env mn mns =
in (concat insts, concat famInsts)
-- | Get rules from modules "below" this one (in the dependency sense)
-hptRules :: HscEnv -> [ModuleNameWithIsBoot] -> [CoreRule]
+hptRules :: HscEnv -> Set ModuleNameWithIsBoot -> [CoreRule]
hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False
-- | Get annotations from modules "below" this one (in the dependency sense)
-hptAnns :: HscEnv -> Maybe [ModuleNameWithIsBoot] -> [Annotation]
+hptAnns :: HscEnv -> Maybe (Set ModuleNameWithIsBoot) -> [Annotation]
hptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env deps
hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))
-hptModulesBelow :: HscEnv -> [ModuleNameWithIsBoot] -> Set.Set ModuleNameWithIsBoot
-hptModulesBelow hsc_env mn = Set.fromList (map fst (eltsUFM $ go mn emptyUFM))
+-- | This function returns all the modules belonging to the home-unit that can
+-- be reached by following the given dependencies. Additionally, if both the
+-- boot module and the non-boot module can be reached, it only returns the
+-- non-boot one.
+hptModulesBelow :: HscEnv -> Set ModuleNameWithIsBoot -> Set ModuleNameWithIsBoot
+hptModulesBelow hsc_env mn = filtered_mods $ dep_mods mn Set.empty
where
- hpt = hsc_HPT hsc_env
-
- go [] seen = seen
- go (mn:mns) seen
- | Just (mn', both) <- lookupUFM seen (gwib_mod mn)
- -- Already seen the module before
- , gwib_isBoot mn' == gwib_isBoot mn
- || both = go mns seen
- | otherwise =
- case lookupHpt hpt (gwib_mod mn) of
- -- Not a home module
- Nothing -> go mns seen
- Just hmi ->
- let
- -- The bool indicates if we have seen *both* the
- -- NotBoot and IsBoot versions
- comb :: (GenWithIsBoot ModuleName, Bool)
- -> (GenWithIsBoot ModuleName, Bool)
- -> (GenWithIsBoot ModuleName, Bool)
- comb (o@(GWIB { gwib_isBoot = NotBoot }), b) _ =
- (o, IsBoot == gwib_isBoot mn || b)
- comb ((GWIB { gwib_isBoot = IsBoot }, _)) (new_gwib, _) =
- (new_gwib, NotBoot == gwib_isBoot mn)
- in
- go (dep_direct_mods (mi_deps (hm_iface hmi)) ++ mns)
- (addToUFM_C comb seen (gwib_mod mn) (mn, False))
+ !hpt = hsc_HPT hsc_env
+
+ -- get all the dependent modules without filtering boot/non-boot
+ dep_mods !deps !seen -- invariant: intersection of deps and seen is null
+ | Set.null deps = seen
+ | otherwise = dep_mods deps' seen'
+ where
+ get_deps d@(GWIB mod _is_boot) (home_deps,all_deps) = case lookupHpt hpt mod of
+ Nothing -> (home_deps,all_deps) -- not a home-module
+ Just hmi -> let
+ !home_deps' = Set.insert d home_deps
+ !all_deps' = Set.union all_deps (dep_direct_mods (mi_deps (hm_iface hmi)))
+ in (home_deps', all_deps')
+
+ -- all the non-transitive deps from our deps
+ (seen',new_deps) = Set.foldr' get_deps (seen,Set.empty) deps
+
+ -- maintain the invariant that deps haven't already been seen
+ deps' = Set.difference new_deps seen'
+
+ -- remove boot modules when there is also a non-boot one
+ filtered_mods mods = Set.fromDistinctAscList $ filter_mods $ Set.toAscList mods
+
+ -- IsBoot and NotBoot modules are necessarily consecutive in the sorted list
+ -- (cf Ord instance of GenWithIsBoot). Hence we only have to perform a
+ -- linear sweep with a window of size 2 to remove boot modules for which we
+ -- have the corresponding non-boot.
+ filter_mods = \case
+ (r1@(GWIB m1 b1) : r2@(GWIB m2 _) : rs)
+ | m1 == m2 -> let !r' = case b1 of
+ NotBoot -> r1
+ IsBoot -> r2
+ in r' : filter_mods rs
+ | otherwise -> r1 : filter_mods (r2:rs)
+ rs -> rs
+
-- | Get things from modules "below" this one (in the dependency sense)
-- C.f Inst.hptInstances
-hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [ModuleNameWithIsBoot] -> [a]
-hptSomeThingsBelowUs extract include_hi_boot hsc_env mod
+hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> Set ModuleNameWithIsBoot -> [a]
+hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
| isOneShot (ghcMode (hsc_dflags hsc_env)) = []
| otherwise
@@ -271,7 +285,7 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env mod
in
[ thing
| -- Find each non-hi-boot module below me
- GWIB { gwib_mod = mod, gwib_isBoot = is_boot } <- Set.toList (hptModulesBelow hsc_env mod)
+ GWIB { gwib_mod = mod, gwib_isBoot = is_boot } <- Set.toList (hptModulesBelow hsc_env deps)
, include_hi_boot || (is_boot == NotBoot)
-- unsavoury: when compiling the base package with --make, we
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index ea3040c64e..24552da8c1 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1319,7 +1319,7 @@ hscCheckSafe' m l = do
-- check package is trusted
safeP = packageTrusted dflags (hsc_units hsc_env) home_unit trust trust_own_pkg m
-- pkg trust reqs
- pkgRs = S.fromList (dep_trusted_pkgs $ mi_deps iface')
+ pkgRs = dep_trusted_pkgs $ mi_deps iface'
-- warn if Safe module imports Safe-Inferred module.
warns = if wopt Opt_WarnInferredSafeImports dflags
&& safeLanguageOn dflags
@@ -1683,7 +1683,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
in NoStubs `appendStubC` ip_init
(_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos)
- <- codeOutput logger tmpfs dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] []
+ <- codeOutput logger tmpfs dflags (hsc_units hsc_env) cmm_mod output_filename no_loc foreign_stubs [] S.empty
rawCmms
return stub_c_exists
where
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index b282304a1a..cd8205f6ad 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -62,6 +62,7 @@ import GHC.Driver.Errors.Types
import GHC.Driver.Pipeline.Monad
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Phases
+import GHC.Driver.Pipeline.Execute
import GHC.Driver.Pipeline.Phases
import GHC.Driver.Session
import GHC.Driver.Backend
@@ -118,9 +119,9 @@ 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.Time ( getCurrentTime )
-import GHC.Driver.Pipeline.Execute
-- Simpler type synonym for actions in the pipeline monad
type P m = TPipelineClass TPhase m
@@ -412,7 +413,10 @@ link' logger tmpfs dflags unit_env batch_attempt_linking hpt
home_mod_infos = eltsHpt hpt
-- the packages we depend on
- pkg_deps = concatMap (dep_direct_pkgs . mi_deps . hm_iface) home_mod_infos
+ pkg_deps = Set.toList
+ $ Set.unions
+ $ fmap (dep_direct_pkgs . mi_deps . hm_iface)
+ $ home_mod_infos
-- the linkables to link
linkables = map (expectJust "link".hm_linkable) home_mod_infos
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 73c6accff4..88d1133963 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -197,8 +197,10 @@ deSugar hsc_env
; let used_names = mkUsedNames tcg_env
pluginModules = map lpModule (hsc_plugins hsc_env)
home_unit = hsc_home_unit hsc_env
- ; deps <- mkDependencies (homeUnitId home_unit)
- (map mi_module pluginModules) tcg_env
+ ; let deps = mkDependencies home_unit
+ (tcg_mod tcg_env)
+ (tcg_imports tcg_env)
+ (map mi_module pluginModules)
; used_th <- readIORef tc_splice_used
; dep_files <- readIORef dependent_files
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 4731d32591..c9c4214fd0 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -64,54 +64,49 @@ its dep_orphs. This was the cause of #14128.
-- | Extract information from the rename and typecheck phases to produce
-- a dependencies information for the module being compiled.
--
--- The second argument is additional dependencies from plugins
-mkDependencies :: UnitId -> [Module] -> TcGblEnv -> IO Dependencies
-mkDependencies iuid pluginModules
- (TcGblEnv{ tcg_mod = mod,
- tcg_imports = imports
- })
- = do
-
- let (home_plugins, package_plugins) = partition ((== iuid) . toUnitId . moduleUnit) pluginModules
- plugin_dep_pkgs = map (toUnitId . moduleUnit) package_plugins
- all_direct_mods = foldr (\mn m -> addToUFM m mn (GWIB mn NotBoot)) (imp_direct_dep_mods imports) (map moduleName home_plugins)
-
- direct_mods = modDepsElts (delFromUFM all_direct_mods (moduleName mod))
- -- M.hi-boot can be in the imp_dep_mods, but we must remove
- -- it before recording the modules on which this one depends!
- -- (We want to retain M.hi-boot in imp_dep_mods so that
- -- loadHiBootInterface can see if M's direct imports depend
- -- on M.hi-boot, and hence that we should do the hi-boot consistency
- -- check.)
-
- dep_orphs = filter (/= mod) (imp_orphs imports)
- -- We must also remove self-references from imp_orphs. See
- -- Note [Module self-dependency]
-
- direct_pkgs_0 = foldr Set.insert (imp_dep_direct_pkgs imports) plugin_dep_pkgs
-
- direct_pkgs = direct_pkgs_0
-
- -- Set the packages required to be Safe according to Safe Haskell.
- -- See Note [Tracking Trust Transitively] in GHC.Rename.Names
- sorted_direct_pkgs = sort (Set.toList direct_pkgs)
- trust_pkgs = imp_trust_pkgs imports
- -- If there's a non-boot import, then it shadows the boot import
- -- coming from the dependencies
- source_mods =
- modDepsElts $ (imp_boot_mods imports)
-
- sig_mods = filter (/= (moduleName mod)) $ imp_sig_mods imports
-
- return Deps { dep_direct_mods = direct_mods,
- dep_direct_pkgs = sorted_direct_pkgs,
- dep_sig_mods = sort sig_mods,
- dep_trusted_pkgs = sort (Set.toList trust_pkgs),
- dep_boot_mods = sort source_mods,
- dep_orphs = dep_orphs,
- dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
- -- sort to get into canonical order
- -- NB. remember to use lexicographic ordering
+-- The fourth argument is a list of plugin modules.
+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 = map (toUnitId . moduleUnit) external_plugins
+ all_direct_mods = foldr (\mn m -> addToUFM m mn (GWIB mn NotBoot))
+ (imp_direct_dep_mods imports)
+ (map moduleName home_plugins)
+
+ direct_mods = modDepsElts (delFromUFM all_direct_mods (moduleName mod))
+ -- M.hi-boot can be in the imp_dep_mods, but we must remove
+ -- it before recording the modules on which this one depends!
+ -- (We want to retain M.hi-boot in imp_dep_mods so that
+ -- loadHiBootInterface can see if M's direct imports depend
+ -- on M.hi-boot, and hence that we should do the hi-boot consistency
+ -- check.)
+
+ dep_orphs = filter (/= mod) (imp_orphs imports)
+ -- We must also remove self-references from imp_orphs. See
+ -- Note [Module self-dependency]
+
+ direct_pkgs = foldr Set.insert (imp_dep_direct_pkgs imports) plugin_units
+
+ -- Set the packages required to be Safe according to Safe Haskell.
+ -- See Note [Tracking Trust Transitively] in GHC.Rename.Names
+ trust_pkgs = imp_trust_pkgs imports
+
+ -- If there's a non-boot import, then it shadows the boot import
+ -- coming from the dependencies
+ source_mods = modDepsElts (imp_boot_mods imports)
+
+ sig_mods = filter (/= (moduleName mod)) $ imp_sig_mods imports
+
+ in Deps { dep_direct_mods = direct_mods
+ , dep_direct_pkgs = direct_pkgs
+ , dep_sig_mods = sort sig_mods
+ , dep_trusted_pkgs = trust_pkgs
+ , dep_boot_mods = source_mods
+ , dep_orphs = dep_orphs
+ , dep_finsts = sortBy stableModuleCmp (imp_finsts imports)
+ -- sort to get into canonical order
+ -- NB. remember to use lexicographic ordering
+ }
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index f4ac97f9af..5f47ef2431 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -115,6 +115,8 @@ import GHC.Data.FastString
import Control.Monad
import Data.Map ( toList )
+import qualified Data.Set as Set
+import Data.Set (Set)
import System.FilePath
import System.Directory
@@ -1190,20 +1192,21 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods
, dep_finsts = finsts
})
= pprWithUnitState unit_state $
- vcat [text "direct module dependencies:" <+> fsep (map ppr_mod dmods),
- text "boot module dependencies:" <+> fsep (map ppr bmods),
- text "direct package dependencies:" <+> fsep (map ppr_pkg pkgs),
+ 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,
if null tps
then empty
- else text "trusted package dependencies:" <+> fsep (map ppr_pkg tps),
+ else text "trusted package dependencies:" <+> ppr_set ppr tps,
text "orphans:" <+> fsep (map ppr orphs),
text "family instance modules:" <+> fsep (map ppr finsts)
]
where
- ppr_mod (GWIB { gwib_mod = mod_name, gwib_isBoot = boot }) = ppr mod_name <+> ppr_boot boot
- ppr_pkg pkg = ppr pkg
- ppr_boot IsBoot = text "[boot]"
- ppr_boot NotBoot = Outputable.empty
+ ppr_mod (GWIB mod IsBoot) = ppr mod <+> text "[boot]"
+ ppr_mod (GWIB mod NotBoot) = ppr mod
+
+ ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc
+ ppr_set w = fsep . fmap w . Set.toAscList
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities [] = Outputable.empty
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 7421eac86d..ed113ef7fd 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -199,9 +199,10 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary
let used_names = mkUsedNames tc_result
let pluginModules = map lpModule (hsc_plugins hsc_env)
let home_unit = hsc_home_unit hsc_env
- deps <- mkDependencies (homeUnitId home_unit)
- (map mi_module pluginModules)
- tc_result
+ let deps = mkDependencies home_unit
+ (tcg_mod tc_result)
+ (tcg_imports tc_result)
+ (map mi_module pluginModules)
let hpc_info = emptyHpcInfo other_hpc_info
used_th <- readIORef tc_splice_used
dep_files <- (readIORef dependent_files)
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 2e2824a7cb..0abee1a5c0 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -31,7 +31,6 @@ import GHC.Hs
import GHC.Data.Graph.Directed
import GHC.Data.Maybe
-import GHC.Data.FastString
import GHC.Utils.Error
import GHC.Utils.Panic
@@ -64,9 +63,9 @@ import GHC.Unit.Module.Warnings
import GHC.Unit.Module.Deps
import Control.Monad
-import Data.Function
import Data.List (sortBy, sort)
import qualified Data.Map as Map
+import qualified Data.Set as Set
import Data.Word (Word64)
import Data.Either
@@ -272,7 +271,7 @@ checkVersions hsc_env mod_summary iface
-- case we'll compile the module from scratch anyhow).
when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do {
- ; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ (dep_boot_mods (mi_deps iface)) }
+ ; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ dep_boot_mods (mi_deps iface) }
}
; recomp <- checkList [checkModUsage (hsc_FC hsc_env) (homeUnitAsUnit home_unit) u
| u <- mi_usages iface]
@@ -473,8 +472,8 @@ checkDependencies hsc_env summary iface
fc = hsc_FC hsc_env
home_unit = hsc_home_unit hsc_env
units = hsc_units hsc_env
- prev_dep_mods = map gwib_mod $ dep_direct_mods (mi_deps iface)
- prev_dep_pkgs = sort (dep_direct_pkgs (mi_deps iface))
+ prev_dep_mods = map gwib_mod $ Set.toAscList $ dep_direct_mods (mi_deps iface)
+ prev_dep_pkgs = Set.toAscList (dep_direct_pkgs (mi_deps iface))
bkpk_units = map (("Signature",) . indefUnit . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface)))
implicit_deps = map ("Implicit",) (implicitPackageDeps dflags)
@@ -1196,11 +1195,11 @@ getOrphanHashes hsc_env mods = do
sortDependencies :: Dependencies -> Dependencies
sortDependencies d
- = Deps { dep_direct_mods = sortBy (lexicalCompareFS `on` (moduleNameFS . gwib_mod)) (dep_direct_mods d),
- dep_direct_pkgs = sort (dep_direct_pkgs d),
- dep_sig_mods = sort (dep_sig_mods d),
- dep_trusted_pkgs = sort (dep_trusted_pkgs d),
- dep_boot_mods = sort (dep_boot_mods d),
+ = Deps { dep_direct_mods = dep_direct_mods d,
+ dep_direct_pkgs = dep_direct_pkgs d,
+ dep_sig_mods = sort (dep_sig_mods d),
+ dep_trusted_pkgs = dep_trusted_pkgs d,
+ dep_boot_mods = dep_boot_mods d,
dep_orphs = sortBy stableModuleCmp (dep_orphs d),
dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index 45ef0b3daa..ef15615656 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections, RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase #-}
--
-- (c) The University of Glasgow 2002-2006
@@ -99,7 +100,6 @@ import Control.Monad
import qualified Data.Set as Set
import Data.Char (isSpace)
-import Data.Function ((&))
import Data.IORef
import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition, find)
import Data.Maybe
@@ -712,15 +712,14 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
home_unit = hsc_home_unit hsc_env
pkg_deps = dep_direct_pkgs deps
- (boot_deps, mod_deps) = flip partitionWith (dep_direct_mods deps) $
- \ (GWIB { gwib_mod = m, gwib_isBoot = is_boot }) ->
- m & case is_boot of
- IsBoot -> Left
- NotBoot -> Right
+ (boot_deps, mod_deps) = flip partitionWith (Set.toList (dep_direct_mods deps)) $
+ \case
+ GWIB m IsBoot -> Left m
+ GWIB m NotBoot -> Right m
mod_deps' = filter (not . (`elementOfUniqDSet` acc_mods)) (boot_deps ++ mod_deps)
acc_mods' = addListToUniqDSet acc_mods (moduleName mod : mod_deps)
- acc_pkgs' = addListToUniqDSet acc_pkgs pkg_deps
+ acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps)
--
if not (isHomeUnit home_unit pkg)
then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg))
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 2a27773647..b7dd191aa0 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -486,7 +486,7 @@ calculateAvails home_unit iface mod_safe' want_boot imported_by =
| otherwise = dep_finsts deps
-- Trusted packages are a lot like orphans.
- trusted_pkgs | mod_safe' = S.fromList (dep_trusted_pkgs deps)
+ trusted_pkgs | mod_safe' = dep_trusted_pkgs deps
| otherwise = S.empty
@@ -502,11 +502,11 @@ calculateAvails home_unit iface mod_safe' want_boot imported_by =
dependent_pkgs = if isHomeUnit home_unit pkg
then S.empty
- else S.fromList [ipkg]
+ else S.singleton ipkg
direct_mods = mkModDeps $ if isHomeUnit home_unit pkg
- then [GWIB (moduleName imp_mod) want_boot]
- else []
+ then S.singleton (GWIB (moduleName imp_mod) want_boot)
+ else S.empty
dep_boot_mods_map = mkModDeps (dep_boot_mods deps)
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 5be998e07a..e0a4f58d39 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -381,7 +381,8 @@ tcRnImports hsc_env import_decls
-- filtering also ensures that we don't see instances from
-- modules batch (@--make@) compiled before this one, but
-- which are not below this one.
- ; (home_insts, home_fam_insts) = hptInstancesBelow hsc_env (moduleName this_mod) (eltsUFM dep_mods)
+ ; (home_insts, home_fam_insts) = hptInstancesBelow hsc_env (moduleName this_mod)
+ (S.fromList (eltsUFM dep_mods))
} ;
-- Record boot-file info in the EPS, so that it's
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 2d80039234..b3f47a8dc2 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -154,7 +154,6 @@ import GHC.Builtin.Names ( isUnboundName )
import Control.Monad (ap)
import Data.Set ( Set )
import qualified Data.Set as S
-import Data.List ( sort )
import Data.Map ( Map )
import Data.Dynamic ( Dynamic )
import Data.Typeable ( TypeRep )
@@ -1384,9 +1383,9 @@ data ImportAvails
-- including us for imported modules)
}
-mkModDeps :: [ModuleNameWithIsBoot]
+mkModDeps :: Set ModuleNameWithIsBoot
-> ModuleNameEnv ModuleNameWithIsBoot
-mkModDeps deps = foldl' add emptyUFM deps
+mkModDeps deps = S.foldl' add emptyUFM deps
where
add env elt = addToUFM env (gwib_mod elt) elt
@@ -1406,8 +1405,8 @@ plusModDeps = plusUFM_C plus_mod_dep
modDepsElts
:: ModuleNameEnv ModuleNameWithIsBoot
- -> [ModuleNameWithIsBoot]
-modDepsElts = sort . nonDetEltsUFM
+ -> Set ModuleNameWithIsBoot
+modDepsElts = S.fromList . nonDetEltsUFM
-- It's OK to use nonDetEltsUFM here because sorting by module names
-- restores determinism
diff --git a/compiler/GHC/Unit/Module/Deps.hs b/compiler/GHC/Unit/Module/Deps.hs
index 9832383d8a..ebdd4b351f 100644
--- a/compiler/GHC/Unit/Module/Deps.hs
+++ b/compiler/GHC/Unit/Module/Deps.hs
@@ -16,6 +16,9 @@ import GHC.Unit.Module
import GHC.Utils.Fingerprint
import GHC.Utils.Binary
+import Data.Set (Set)
+import qualified Data.Set as Set
+
-- | Dependency information about ALL modules and packages below this one
-- in the import hierarchy. This is the serialisable version of `ImportAvails`.
--
@@ -25,10 +28,10 @@ import GHC.Utils.Binary
--
-- See Note [Transitive Information in Dependencies]
data Dependencies = Deps
- { dep_direct_mods :: [ModuleNameWithIsBoot]
+ { dep_direct_mods :: Set ModuleNameWithIsBoot
-- ^ All home-package modules which are directly imported by this one.
- , dep_direct_pkgs :: [UnitId]
+ , dep_direct_pkgs :: Set UnitId
-- ^ All packages directly imported by this module
-- I.e. packages to which this module's direct imports belong.
--
@@ -38,12 +41,12 @@ data Dependencies = Deps
-- ^ Transitive closure of hsig files in the home package
- , dep_trusted_pkgs :: [UnitId]
+ , dep_trusted_pkgs :: Set UnitId
-- 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
- , dep_boot_mods :: [ModuleNameWithIsBoot]
+ , dep_boot_mods :: Set ModuleNameWithIsBoot
-- ^ All modules which have boot files below this one, and whether we
-- should use the boot file or not.
-- This information is only used to populate the eps_is_boot field.
@@ -96,7 +99,15 @@ instance Binary Dependencies where
dep_finsts = fis })
noDependencies :: Dependencies
-noDependencies = Deps [] [] [] [] [] [] []
+noDependencies = Deps
+ { dep_direct_mods = Set.empty
+ , dep_direct_pkgs = Set.empty
+ , dep_sig_mods = []
+ , dep_boot_mods = Set.empty
+ , dep_trusted_pkgs = Set.empty
+ , dep_orphs = []
+ , dep_finsts = []
+ }
-- | Records modules for which changes may force recompilation of this module
-- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance
diff --git a/compiler/GHC/Unit/Module/ModGuts.hs b/compiler/GHC/Unit/Module/ModGuts.hs
index e799ebf2a1..1558e5944a 100644
--- a/compiler/GHC/Unit/Module/ModGuts.hs
+++ b/compiler/GHC/Unit/Module/ModGuts.hs
@@ -36,6 +36,8 @@ 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
@@ -135,7 +137,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 :: ![UnitId], -- ^ Dependent packages, used to
+ cg_dep_pkgs :: !(Set UnitId), -- ^ 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
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 5dca26a90f..890e92b008 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -660,6 +660,9 @@ data GenWithIsBoot mod = GWIB
} deriving ( Eq, Ord, Show
, Functor, Foldable, Traversable
)
+ -- the Ord instance must ensure that we first sort by Module and then by
+ -- IsBootInterface: this is assumed to perform filtering of non-boot modules,
+ -- e.g. in GHC.Driver.Env.hptModulesBelow
type ModuleNameWithIsBoot = GenWithIsBoot ModuleName
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index 17fa675986..08e54acbd5 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -96,6 +96,8 @@ import Data.IORef
import Data.Char ( ord, chr )
import Data.Time
import Data.List (unfoldr)
+import Data.Set (Set)
+import qualified Data.Set as Set
import Control.Monad ( when, (<$!>), unless, forM_ )
import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO )
@@ -637,6 +639,10 @@ instance Binary a => Binary [a] where
loop n = do a <- get bh; as <- loop (n-1); return (a:as)
loop len
+instance Binary a => Binary (Set a) where
+ put_ bh a = put_ bh (Set.toAscList a)
+ get bh = Set.fromDistinctAscList <$> get bh
+
instance (Ix a, Binary a, Binary b) => Binary (Array a b) where
put_ bh arr = do
put_ bh $ bounds arr