summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-05-05 13:48:19 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2021-05-18 11:24:38 +0100
commit71971c323b0ff2c2c53eb428d9508144eb00a438 (patch)
tree7ddde4dd2f94da7e8465c2b9ba7423c64572c450
parentfc9546caf3e16db070bfc7bb5523c38595233e26 (diff)
downloadhaskell-wip/ghc-transitive-deps.tar.gz
Remove transitive information about modules and packages from interface fileswip/ghc-transitive-deps
This commit modifies interface files so that *only* direct information about modules and packages is stored in the interface file. * Only direct module and direct package dependencies are stored in the interface files. * Trusted packages are now stored separately as they need to be checked transitively. * hs-boot files below the compiled module in the home module are stored so that eps_is_boot can be calculated in one-shot mode without loading all interface files in the home package. * The transitive closure of signatures is stored separately This is important for two reasons * Less recompilation is needed, as motivated by #16885, a lot of redundant compilation was triggered when adding new imports deep in the module tree as all the parent interface files had to be redundantly updated. * Checking an interface file is cheaper because you don't have to perform a transitive traversal to check the dependencies are up-to-date. In the code, places where we would have used the transitive closure, we instead compute the necessary transitive closure. The closure is not computed very often, was already happening in checkDependencies, and was already happening in getLinkDeps. Fixes #16885 ------------------------- Metric Decrease: MultiLayerModules T13701 T13719 -------------------------
-rw-r--r--compiler/GHC/Core/Opt/Pipeline.hs2
-rw-r--r--compiler/GHC/Core/Opt/Specialise.hs2
-rw-r--r--compiler/GHC/Driver/Env.hs55
-rw-r--r--compiler/GHC/Driver/Main.hs3
-rw-r--r--compiler/GHC/Driver/Pipeline.hs2
-rw-r--r--compiler/GHC/HsToCore/Usage.hs33
-rw-r--r--compiler/GHC/Iface/Load.hs19
-rw-r--r--compiler/GHC/Iface/Recomp.hs119
-rw-r--r--compiler/GHC/Iface/Tidy.hs2
-rw-r--r--compiler/GHC/Linker/Loader.hs10
-rw-r--r--compiler/GHC/Rename/Module.hs4
-rw-r--r--compiler/GHC/Rename/Names.hs83
-rw-r--r--compiler/GHC/Tc/Module.hs20
-rw-r--r--compiler/GHC/Tc/Types.hs90
-rw-r--r--compiler/GHC/Types/Unique/FM.hs16
-rw-r--r--compiler/GHC/Unit/Module/Deps.hs137
-rw-r--r--compiler/GHC/Unit/Module/ModIface.hs2
-rw-r--r--testsuite/tests/ado/ado004.stderr2
-rw-r--r--testsuite/tests/dependent/should_compile/T14729.stderr2
-rw-r--r--testsuite/tests/dependent/should_compile/T15743.stderr2
-rw-r--r--testsuite/tests/dependent/should_compile/T15743e.stderr2
-rw-r--r--testsuite/tests/determinism/determ021/determ021.stdout4
-rw-r--r--testsuite/tests/driver/boot5688/A.hs12
-rw-r--r--testsuite/tests/driver/boot5688/B.hs8
-rw-r--r--testsuite/tests/driver/boot5688/B.hs-boot3
-rw-r--r--testsuite/tests/driver/boot5688/C.hs3
-rw-r--r--testsuite/tests/driver/boot5688/D.hs3
-rw-r--r--testsuite/tests/driver/boot5688/E.hs3
-rw-r--r--testsuite/tests/driver/boot5688/Makefile10
-rw-r--r--testsuite/tests/driver/boot5688/all.T3
-rw-r--r--testsuite/tests/driver/boot5688/boot5688.stdout6
-rw-r--r--testsuite/tests/driver/json2.stderr2
-rw-r--r--testsuite/tests/driver/recomp-boot/A.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot/B1.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot/B2.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot/C.hs1
-rw-r--r--testsuite/tests/driver/recomp-boot/C.hs-boot1
-rw-r--r--testsuite/tests/driver/recomp-boot/Makefile20
-rw-r--r--testsuite/tests/driver/recomp-boot/all.T3
-rw-r--r--testsuite/tests/driver/recomp-boot/recomp-boot.stdout6
-rw-r--r--testsuite/tests/driver/recomp-boot2/A.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot2/B1.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot2/B2.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot2/C.hs1
-rw-r--r--testsuite/tests/driver/recomp-boot2/C.hs-boot1
-rw-r--r--testsuite/tests/driver/recomp-boot2/M.hs4
-rw-r--r--testsuite/tests/driver/recomp-boot2/Makefile21
-rw-r--r--testsuite/tests/driver/recomp-boot2/Top.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot2/all.T3
-rw-r--r--testsuite/tests/driver/recomp-boot2/recomp-boot.stdout6
-rw-r--r--testsuite/tests/driver/recomp-boot2/recomp-boot2.stdout10
-rw-r--r--testsuite/tests/driver/recomp007/Makefile2
-rw-r--r--testsuite/tests/driver/recomp007/recomp007.stdout3
-rw-r--r--testsuite/tests/indexed-types/should_compile/T15711.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_compile/T15852.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_compile/T3017.stderr2
-rw-r--r--testsuite/tests/parser/should_run/CountDeps.hs2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ADT.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Either.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Every.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Forall1.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/GenNamed.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Meltdown.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/PatBind.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/PatBind2.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/PatternSig.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Recursive.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/SkipMany.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Uncurry.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr2
-rw-r--r--testsuite/tests/polykinds/T15592.stderr2
-rw-r--r--testsuite/tests/polykinds/T15592b.stderr2
-rw-r--r--testsuite/tests/printer/T18052a.stderr2
-rw-r--r--testsuite/tests/roles/should_compile/Roles1.stderr2
-rw-r--r--testsuite/tests/roles/should_compile/Roles14.stderr2
-rw-r--r--testsuite/tests/roles/should_compile/Roles2.stderr2
-rw-r--r--testsuite/tests/roles/should_compile/Roles3.stderr2
-rw-r--r--testsuite/tests/roles/should_compile/Roles4.stderr2
-rw-r--r--testsuite/tests/roles/should_compile/T8958.stderr2
-rw-r--r--testsuite/tests/safeHaskell/check/pkg01/Makefile16
-rw-r--r--testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout15
-rw-r--r--testsuite/tests/th/TH_Roles2.stderr4
-rw-r--r--testsuite/tests/typecheck/should_compile/T12763.stderr2
-rw-r--r--testsuite/tests/typecheck/should_compile/tc231.stderr2
119 files changed, 605 insertions, 323 deletions
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index ba75cab359..90b5968a2f 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -109,7 +109,7 @@ core2core hsc_env guts@(ModGuts { mg_module = mod
where
logger = hsc_logger hsc_env
dflags = hsc_dflags hsc_env
- home_pkg_rules = hptRules hsc_env (dep_mods deps)
+ home_pkg_rules = hptRules hsc_env (dep_direct_mods deps)
hpt_rule_base = mkRuleBase home_pkg_rules
print_unqual = mkPrintUnqualified (hsc_unit_env hsc_env) rdr_env
-- mod: get the module out of the current HscEnv so we can retrieve it from the monad.
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 459e3fe43c..68b16ea753 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -2592,7 +2592,7 @@ data CallInfoSet = CIS Id (Bag CallInfo)
data CallInfo
= CI { ci_key :: [SpecArg] -- All arguments
, ci_fvs :: IdSet -- Free Ids of the ci_key call
- -- *not* including the main id itself, of course
+ -- _not_ including the main id itself, of course
-- NB: excluding tyvars:
-- See Note [Specialising polymorphic dictionaries]
}
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index 27e250b68c..756d8eaff0 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -13,7 +13,8 @@ module GHC.Driver.Env
, hscEPS
, hscInterp
, hptCompleteSigs
- , hptInstances
+ , hptAllInstances
+ , hptInstancesBelow
, hptAnns
, hptAllThings
, hptSomeThingsBelowUs
@@ -64,9 +65,10 @@ import GHC.Utils.Outputable
import GHC.Utils.Monad
import GHC.Utils.Panic
import GHC.Utils.Misc
+import GHC.Types.Unique.FM
-import Control.Monad ( guard )
import Data.IORef
+import qualified Data.Set as Set
runHsc :: HscEnv -> Hsc a -> IO a
runHsc hsc_env (Hsc hsc) = do
@@ -180,14 +182,28 @@ hptCompleteSigs = hptAllThings (md_complete_matches . hm_details)
-- the Home Package Table filtered by the provided predicate function.
-- Used in @tcRnImports@, to select the instances that are in the
-- transitive closure of imports from the currently compiled module.
-hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
-hptInstances hsc_env want_this_module
+hptAllInstances :: HscEnv -> ([ClsInst], [FamInst])
+hptAllInstances hsc_env
= let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do
- guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))
let details = hm_details mod_info
return (md_insts details, md_fam_insts details)
in (concat insts, concat famInsts)
+-- | Find instances visible from the given set of imports
+hptInstancesBelow :: HscEnv -> ModuleName -> [ModuleNameWithIsBoot] -> ([ClsInst], [FamInst])
+hptInstancesBelow hsc_env mn mns =
+ let (insts, famInsts) =
+ unzip $ hptSomeThingsBelowUs (\mod_info ->
+ let details = hm_details mod_info
+ -- Don't include instances for the current module
+ in if moduleName (mi_module (hm_iface mod_info)) == mn
+ then []
+ else [(md_insts details, md_fam_insts details)])
+ True -- Include -hi-boot
+ hsc_env
+ mns
+ in (concat insts, concat famInsts)
+
-- | Get rules from modules "below" this one (in the dependency sense)
hptRules :: HscEnv -> [ModuleNameWithIsBoot] -> [CoreRule]
hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False
@@ -201,10 +217,33 @@ 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 (eltsUFM $ go mn emptyUFM)
+ where
+ hpt = hsc_HPT hsc_env
+
+ go [] seen = seen
+ go (mn:mns) seen
+ | Just mn' <- lookupUFM seen (gwib_mod mn)
+ -- Already seen the module before
+ , gwib_isBoot mn' == gwib_isBoot mn = go mns seen
+ | otherwise =
+ case lookupHpt hpt (gwib_mod mn) of
+ -- Not a home module
+ Nothing -> go mns seen
+ Just hmi ->
+ let
+ comb m@(GWIB { gwib_isBoot = NotBoot }) _ = m
+ comb (GWIB { gwib_isBoot = IsBoot }) x = x
+ in
+ go (dep_direct_mods (mi_deps (hm_iface hmi)) ++ mns)
+ (addToUFM_C comb seen (gwib_mod mn) mn)
+
+
-- | 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 deps
+hptSomeThingsBelowUs extract include_hi_boot hsc_env mod
| isOneShot (ghcMode (hsc_dflags hsc_env)) = []
| otherwise
@@ -212,7 +251,7 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
in
[ thing
| -- Find each non-hi-boot module below me
- GWIB { gwib_mod = mod, gwib_isBoot = is_boot } <- deps
+ GWIB { gwib_mod = mod, gwib_isBoot = is_boot } <- Set.toList (hptModulesBelow hsc_env mod)
, include_hi_boot || (is_boot == NotBoot)
-- unsavoury: when compiling the base package with --make, we
@@ -243,7 +282,7 @@ prepareAnnotations hsc_env mb_guts = do
-- Extract dependencies of the module if we are supplied one,
-- otherwise load annotations from all home package table
-- entries regardless of dependency ordering.
- home_pkg_anns = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts
+ home_pkg_anns = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_direct_mods . mg_deps) mb_guts
other_pkg_anns = eps_ann_env eps
ann_env = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
Just home_pkg_anns,
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 210c8644da..2d3e1e3925 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1362,7 +1362,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 . map fst $ filter snd $ dep_pkgs $ mi_deps iface'
+ pkgRs = S.fromList (dep_trusted_pkgs $ mi_deps iface')
-- warn if Safe module imports Safe-Inferred module.
warns = if wopt Opt_WarnInferredSafeImports dflags
&& safeLanguageOn dflags
@@ -1518,7 +1518,6 @@ markUnsafeInfer tcg_env whyUnsafe = do
text "overlap mode isn't allowed in Safe Haskell"]
| otherwise = []
-
-- | Figure out the final correct safe haskell mode
hscGetSafeMode :: TcGblEnv -> Hsc SafeHaskellMode
hscGetSafeMode tcg_env = do
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 02ebfbb5ce..e766fda3c7 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -554,7 +554,7 @@ link' logger tmpfs dflags unit_env batch_attempt_linking hpt
home_mod_infos = eltsHpt hpt
-- the packages we depend on
- pkg_deps = concatMap (map fst . dep_pkgs . mi_deps . hm_iface) home_mod_infos
+ pkg_deps = concatMap (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/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 139ec05167..0da8f59070 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -38,11 +38,12 @@ import GHC.Unit.Module.Deps
import GHC.Data.Maybe
import Control.Monad (filterM)
-import Data.List (sort, sortBy, nub)
+import Data.List (sortBy, sort, nub)
import Data.IORef
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
+
import System.Directory
import System.FilePath
@@ -80,8 +81,7 @@ mkDependencies iuid pluginModules
let (dep_plgins, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]
plugin_dep_pkgs = filter (/= iuid) (map (toUnitId . moduleUnit) ms)
th_used <- readIORef th_var
- let dep_mods = modDepsElts (delFromUFM (imp_dep_mods imports)
- (moduleName mod))
+ let direct_mods = modDepsElts (delFromUFM (imp_direct_dep_mods imports) (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
@@ -93,19 +93,28 @@ mkDependencies iuid pluginModules
-- We must also remove self-references from imp_orphs. See
-- Note [Module self-dependency]
- raw_pkgs = foldr Set.insert (imp_dep_pkgs imports) plugin_dep_pkgs
+ direct_pkgs_0 = foldr Set.insert (imp_dep_direct_pkgs imports) plugin_dep_pkgs
- pkgs | th_used = Set.insert thUnitId raw_pkgs
- | otherwise = raw_pkgs
+ direct_pkgs
+ | th_used = Set.insert thUnitId direct_pkgs_0
+ | otherwise = direct_pkgs_0
-- Set the packages required to be Safe according to Safe Haskell.
-- See Note [Tracking Trust Transitively] in GHC.Rename.Names
- sorted_pkgs = sort (Set.toList pkgs)
+ sorted_direct_pkgs = sort (Set.toList direct_pkgs)
trust_pkgs = imp_trust_pkgs imports
- dep_pkgs' = map (\x -> (x, x `Set.member` trust_pkgs)) sorted_pkgs
-
- return Deps { dep_mods = dep_mods,
- dep_pkgs = dep_pkgs',
+ -- 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_plgins = dep_plgins,
dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
@@ -235,7 +244,7 @@ mkPluginUsage hsc_env pluginModule
pNm = moduleName $ mi_module pluginModule
pPkg = moduleUnit $ mi_module pluginModule
deps = map gwib_mod $
- dep_mods $ mi_deps pluginModule
+ dep_direct_mods $ mi_deps pluginModule
-- Lookup object file for a plugin dependency,
-- from the same package as the plugin.
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 7b2a659161..89480c6112 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -1179,18 +1179,25 @@ pprUsageImport usage usg_mod'
-- | Pretty-print unit dependencies
pprDeps :: UnitState -> Dependencies -> SDoc
-pprDeps unit_state (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
- dep_finsts = finsts })
+pprDeps unit_state (Deps { dep_direct_mods = dmods
+ , dep_boot_mods = bmods
+ , dep_orphs = orphs
+ , dep_direct_pkgs = pkgs
+ , dep_trusted_pkgs = tps
+ , dep_finsts = finsts
+ , dep_plgins = plugins })
= pprWithUnitState unit_state $
- vcat [text "module dependencies:" <+> fsep (map ppr_mod mods),
- text "package dependencies:" <+> fsep (map ppr_pkg pkgs),
+ 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),
+ if null tps then empty else text "trusted package dependencies:" <+> fsep (map ppr_pkg pkgs),
text "orphans:" <+> fsep (map ppr orphs),
+ text "plugins:" <+> fsep (map ppr plugins),
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,trust_req) = ppr pkg <>
- (if trust_req then text "*" else Outputable.empty)
+ ppr_pkg pkg = ppr pkg
ppr_boot IsBoot = text "[boot]"
ppr_boot NotBoot = Outputable.empty
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index e033a6628a..9bccffab3d 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -63,9 +63,8 @@ import GHC.Unit.Module.Deps
import Control.Monad
import Data.Function
-import Data.List (find, sortBy, sort)
+import Data.List (sortBy, sort)
import qualified Data.Map as Map
-import qualified Data.Set as Set
import Data.Word (Word64)
--Qualified import so we can define a Semigroup instance
@@ -265,11 +264,10 @@ checkVersions hsc_env mod_summary iface
-- It's just temporary because either the usage check will succeed
-- (in which case we are done with this module) or it'll fail (in which
-- case we'll compile the module from scratch anyhow).
- --
- -- We do this regardless of compilation mode, although in --make mode
- -- all the dependent modules should be in the HPT already, so it's
- -- quite redundant
- ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
+
+ when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do {
+ ; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ (dep_boot_mods (mi_deps iface)) }
+ }
; recomp <- checkList [checkModUsage (homeUnitAsUnit home_unit) u
| u <- mi_usages iface]
; return (recomp, Just iface)
@@ -278,9 +276,9 @@ checkVersions hsc_env mod_summary iface
logger = hsc_logger hsc_env
dflags = hsc_dflags hsc_env
home_unit = hsc_home_unit hsc_env
- -- This is a bit of a hack really
- mod_deps :: ModuleNameEnv ModuleNameWithIsBoot
- mod_deps = mkModDeps (dep_mods (mi_deps iface))
+
+
+
-- | Check if any plugins are requesting recompilation
checkPlugins :: HscEnv -> ModIface -> IfG RecompileRequired
@@ -450,38 +448,19 @@ checkMergedSignatures hsc_env mod_summary iface = do
-- - a new home module has been added that shadows a package module
-- See bug #1372.
--
--- In addition, we also check if the union of dependencies of the imported
--- modules has any difference to the previous set of dependencies. We would need
--- to recompile in that case also since the `mi_deps` field of ModIface needs
--- to be updated to match that information. This is one of the invariants
--- of interface files (see https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance#interface-file-invariants).
--- See bug #16511.
---
-- Returns (RecompBecause <textual reason>) if recompilation is required.
checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
checkDependencies hsc_env summary iface
- =
- checkList $
- [ liftIO $ checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
- , do
- (recomp, mnames_seen) <- runUntilRecompRequired $ map
- checkForNewHomeDependency
- (ms_home_imps summary)
- liftIO $ case recomp of
- UpToDate -> do
- let
- seen_home_deps = Set.unions $ map Set.fromList mnames_seen
- checkIfAllOldHomeDependenciesAreSeen seen_home_deps
- _ -> return recomp]
+ = liftIO $ checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
where
dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
fc = hsc_FC hsc_env
home_unit = hsc_home_unit hsc_env
units = hsc_units hsc_env
- prev_dep_mods = dep_mods (mi_deps iface)
+ prev_dep_mods = dep_direct_mods (mi_deps iface)
prev_dep_plgn = dep_plgins (mi_deps iface)
- prev_dep_pkgs = dep_pkgs (mi_deps iface)
+ prev_dep_pkgs = dep_direct_pkgs (mi_deps iface)
dep_missing (mb_pkg, L _ mod) = do
find_res <- findImportedModule fc units home_unit dflags mod (mb_pkg)
@@ -497,7 +476,7 @@ checkDependencies hsc_env summary iface
else
return UpToDate
| otherwise
- -> if toUnitId pkg `notElem` (map fst prev_dep_pkgs)
+ -> if toUnitId pkg `notElem` prev_dep_pkgs
then do trace_hi_diffs logger dflags $
text "imported module " <> quotes (ppr mod) <>
text " is from package " <> quotes (ppr pkg) <>
@@ -508,58 +487,6 @@ checkDependencies hsc_env summary iface
where pkg = moduleUnit mod
_otherwise -> return (RecompBecause reason)
- projectNonBootNames = map gwib_mod . filter ((== NotBoot) . gwib_isBoot)
- old_deps = Set.fromList
- $ projectNonBootNames prev_dep_mods
- isOldHomeDeps = flip Set.member old_deps
- checkForNewHomeDependency (L _ mname) = do
- let
- mod = mkHomeModule home_unit mname
- str_mname = moduleNameString mname
- reason = str_mname ++ " changed"
- -- We only want to look at home modules to check if any new home dependency
- -- pops in and thus here, skip modules that are not home. Checking
- -- membership in old home dependencies suffice because the `dep_missing`
- -- check already verified that all imported home modules are present there.
- if not (isOldHomeDeps mname)
- then return (UpToDate, [])
- else do
- mb_result <- getFromModIface "need mi_deps for" mod $ \imported_iface -> do
- let mnames = mname:(map gwib_mod $ filter ((== NotBoot) . gwib_isBoot) $
- dep_mods $ mi_deps imported_iface)
- case find (not . isOldHomeDeps) mnames of
- Nothing -> return (UpToDate, mnames)
- Just new_dep_mname -> do
- trace_hi_diffs logger dflags $
- text "imported home module " <> quotes (ppr mod) <>
- text " has a new dependency " <> quotes (ppr new_dep_mname)
- return (RecompBecause reason, [])
- return $ fromMaybe (MustCompile, []) mb_result
-
- -- Performs all recompilation checks in the list until a check that yields
- -- recompile required is encountered. Returns the list of the results of
- -- all UpToDate checks.
- runUntilRecompRequired [] = return (UpToDate, [])
- runUntilRecompRequired (check:checks) = do
- (recompile, value) <- check
- if recompileRequired recompile
- then return (recompile, [])
- else do
- (recomp, values) <- runUntilRecompRequired checks
- return (recomp, value:values)
-
- checkIfAllOldHomeDependenciesAreSeen seen_deps = do
- let unseen_old_deps = Set.difference
- old_deps
- seen_deps
- if not (null unseen_old_deps)
- then do
- let missing_dep = Set.elemAt 0 unseen_old_deps
- trace_hi_diffs logger dflags $
- text "missing old home dependency " <> quotes (ppr missing_dep)
- return $ RecompBecause "missing old dependency"
- else return UpToDate
-
needInterface :: Module -> (ModIface -> IO RecompileRequired)
-> IfG RecompileRequired
needInterface mod continue
@@ -1043,17 +970,22 @@ addFingerprints hsc_env iface0
orphan_hash <- computeFingerprint (mk_put_name local_env)
(map ifDFun orph_insts, orph_rules, orph_fis)
+ -- Hash of the transitive things in dependencies
+ dep_hash <- computeFingerprint putNameLiterally
+ (dep_sig_mods (mi_deps iface0),
+ dep_boot_mods (mi_deps iface0),
+ -- Trusted packages are like orphans
+ dep_trusted_pkgs (mi_deps iface0),
+ -- See Note [Export hash depends on non-orphan family instances]
+ dep_finsts (mi_deps iface0) )
+
-- the export list hash doesn't depend on the fingerprints of
-- the Names it mentions, only the Names themselves, hence putNameLiterally.
export_hash <- computeFingerprint putNameLiterally
(mi_exports iface0,
orphan_hash,
+ dep_hash,
dep_orphan_hashes,
- dep_pkgs (mi_deps iface0),
- -- See Note [Export hash depends on non-orphan family instances]
- dep_finsts (mi_deps iface0),
- -- dep_pkgs: see "Package Version Changes" on
- -- wiki/commentary/compiler/recompilation-avoidance
mi_trust iface0)
-- Make sure change of Safe Haskell mode causes recomp.
@@ -1209,8 +1141,11 @@ getOrphanHashes hsc_env mods = do
sortDependencies :: Dependencies -> Dependencies
sortDependencies d
- = Deps { dep_mods = sortBy (lexicalCompareFS `on` (moduleNameFS . gwib_mod)) (dep_mods d),
- dep_pkgs = sortBy (compare `on` fst) (dep_pkgs 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),
dep_orphs = sortBy stableModuleCmp (dep_orphs d),
dep_finsts = sortBy stableModuleCmp (dep_finsts d),
dep_plgins = sortBy (lexicalCompareFS `on` moduleNameFS) (dep_plgins d) }
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 71e93671b9..96da0ce2c0 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -459,7 +459,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
cg_binds = all_tidy_binds,
cg_foreign = add_spt_init_code foreign_stubs,
cg_foreign_files = foreign_files,
- cg_dep_pkgs = map fst $ dep_pkgs deps,
+ cg_dep_pkgs = dep_direct_pkgs deps,
cg_hpc_info = hpc_info,
cg_modBreaks = modBreaks,
cg_spt_entries = spt_entries },
diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index 1258034fb5..ccd3879910 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -692,20 +692,20 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
deps = mi_deps iface
home_unit = hsc_home_unit hsc_env
- pkg_deps = dep_pkgs deps
- (boot_deps, mod_deps) = flip partitionWith (dep_mods deps) $
+ 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' = filter (not . (`elementOfUniqDSet` acc_mods)) boot_deps
+ 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 $ map fst pkg_deps
+ acc_pkgs' = addListToUniqDSet acc_pkgs pkg_deps
--
if not (isHomeUnit home_unit pkg)
then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg))
- else follow_deps (map (mkHomeModule home_unit) boot_deps' ++ mods)
+ else follow_deps (map (mkHomeModule home_unit) mod_deps' ++ mods)
acc_mods' acc_pkgs'
where
msg = text "need to link module" <+> ppr mod <+>
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 8bb8557186..2eb048f3f6 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -763,10 +763,10 @@ rnFamEqn doc atfi extra_kvars
-- See Note [Renaming associated types].
-- Per that Note, the LHS type variables consist of:
--
- -- * The variables mentioned in the instance's type patterns
+ -- - The variables mentioned in the instance's type patterns
-- (pat_fvs), and
--
- -- * The variables mentioned in an outermost kind signature on the
+ -- - The variables mentioned in an outermost kind signature on the
-- RHS. This is a subset of `rhs_fvs`. To compute it, we look up
-- each RdrName in `extra_kvars` to find its corresponding Name in
-- the LocalRdrEnv.
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index b747f73987..68dab19a9b 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -71,6 +71,7 @@ import GHC.Types.Basic ( TopLevelFlag(..) )
import GHC.Types.SourceText
import GHC.Types.Id
import GHC.Types.HpcInfo
+import GHC.Types.Unique.FM
import GHC.Unit
import GHC.Unit.Module.Warnings
@@ -198,9 +199,20 @@ rnImports imports = do
stuff2 <- mapAndReportM (rnImportDecl this_mod) source
-- Safe Haskell: See Note [Tracking Trust Transitively]
let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)
- return (decls, rdr_env, imp_avails, hpc_usage)
+ -- Update imp_boot_mods if imp_direct_mods mentions any of them
+ let final_import_avail = clobberSourceImports imp_avails
+ return (decls, rdr_env, final_import_avail, hpc_usage)
where
+ clobberSourceImports imp_avails =
+ imp_avails { imp_boot_mods = imp_boot_mods' }
+ where
+ imp_boot_mods' = mergeUFM combJ id (const mempty)
+ (imp_boot_mods imp_avails)
+ (imp_direct_dep_mods imp_avails)
+
+ combJ (GWIB _ IsBoot) x = Just x
+ combJ r _ = Just r
-- See Note [Combining ImportAvails]
combine :: [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
-> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
@@ -422,6 +434,7 @@ calculateAvails home_unit iface mod_safe' want_boot imported_by =
deps = mi_deps iface
trust = getSafeMode $ mi_trust iface
trust_pkg = mi_trust_pkg iface
+ is_sig = mi_hsc_src iface == HsigFile
-- If the module exports anything defined in this module, just
-- ignore it. Reason: otherwise it looks as if there are two
@@ -457,53 +470,61 @@ calculateAvails home_unit iface mod_safe' want_boot imported_by =
imp_sem_mod : dep_finsts deps
| otherwise = dep_finsts deps
+ -- Trusted packages are a lot like orphans.
+ trusted_pkgs | mod_safe' = S.fromList (dep_trusted_pkgs deps)
+ | otherwise = S.empty
+
+
pkg = moduleUnit (mi_module iface)
ipkg = toUnitId pkg
-- Does this import mean we now require our own pkg
-- to be trusted? See Note [Trust Own Package]
ptrust = trust == Sf_Trustworthy || trust_pkg
+ pkg_trust_req
+ | isHomeUnit home_unit pkg = ptrust
+ | otherwise = False
+
+ dependent_pkgs = if isHomeUnit home_unit pkg
+ then S.empty
+ else S.fromList [ipkg]
+
+ direct_mods = mkModDeps $ if isHomeUnit home_unit pkg
+ then [GWIB (moduleName imp_mod) want_boot]
+ else []
+
+ dep_boot_mods_map = mkModDeps (dep_boot_mods deps)
+
+ boot_mods
+ -- If we are looking for a boot module, it must be HPT
+ | IsBoot <- want_boot = addToUFM dep_boot_mods_map (moduleName imp_mod) (GWIB (moduleName imp_mod) IsBoot)
+ -- Now we are importing A properly, so don't go looking for
+ -- A.hs-boot
+ | isHomeUnit home_unit pkg = dep_boot_mods_map
+ -- There's no boot files to find in external imports
+ | otherwise = emptyUFM
+
+ sig_mods =
+ if is_sig
+ then moduleName imp_mod : dep_sig_mods deps
+ else dep_sig_mods deps
- (dependent_mods, dependent_pkgs, pkg_trust_req)
- | isHomeUnit home_unit pkg =
- -- Imported module is from the home package
- -- Take its dependent modules and add imp_mod itself
- -- Take its dependent packages unchanged
- --
- -- NB: (dep_mods deps) might include a hi-boot file
- -- for the module being compiled, CM. Do *not* filter
- -- this out (as we used to), because when we've
- -- finished dealing with the direct imports we want to
- -- know if any of them depended on CM.hi-boot, in
- -- which case we should do the hi-boot consistency
- -- check. See GHC.Iface.Load.loadHiBootInterface
- ( GWIB { gwib_mod = moduleName imp_mod, gwib_isBoot = want_boot } : dep_mods deps
- , dep_pkgs deps
- , ptrust
- )
-
- | otherwise =
- -- Imported module is from another package
- -- Dump the dependent modules
- -- Add the package imp_mod comes from to the dependent packages
- assertPpr (not (ipkg `elem` (map fst $ dep_pkgs deps)))
- (ppr ipkg <+> ppr (dep_pkgs deps))
- ([], (ipkg, False) : dep_pkgs deps, False)
in ImportAvails {
imp_mods = unitModuleEnv (mi_module iface) [imported_by],
imp_orphs = orphans,
imp_finsts = finsts,
- imp_dep_mods = mkModDeps dependent_mods,
- imp_dep_pkgs = S.fromList . map fst $ dependent_pkgs,
+ imp_sig_mods = sig_mods,
+ imp_direct_dep_mods = direct_mods,
+ imp_dep_direct_pkgs = dependent_pkgs,
+ imp_boot_mods = boot_mods,
+
-- Add in the imported modules trusted package
-- requirements. ONLY do this though if we import the
-- module as a safe import.
-- See Note [Tracking Trust Transitively]
-- and Note [Trust Transitive Property]
- imp_trust_pkgs = if mod_safe'
- then S.fromList . map fst $ filter snd dependent_pkgs
- else S.empty,
+ imp_trust_pkgs = trusted_pkgs,
-- Do we require our own pkg to be trusted?
-- See Note [Trust Own Package]
imp_trust_own_pkg = pkg_trust_req
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 5e3f0b3501..b04ab96e43 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -366,7 +366,7 @@ tcRnImports hsc_env import_decls
; this_mod <- getModule
; let { dep_mods :: ModuleNameEnv ModuleNameWithIsBoot
- ; dep_mods = imp_dep_mods imports
+ ; dep_mods = imp_direct_dep_mods imports
-- We want instance declarations from all home-package
-- modules below this one, including boot modules, except
@@ -375,17 +375,15 @@ 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.
- ; want_instances :: ModuleName -> Bool
- ; want_instances mod = mod `elemUFM` dep_mods
- && mod /= moduleName this_mod
- ; (home_insts, home_fam_insts) = hptInstances hsc_env
- want_instances
+ ; (home_insts, home_fam_insts) = hptInstancesBelow hsc_env (moduleName this_mod) (eltsUFM dep_mods)
} ;
-- Record boot-file info in the EPS, so that it's
-- visible to loadHiBootInterface in tcRnSrcDecls,
-- and any other incrementally-performed imports
- ; updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ;
+ ; when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do {
+ updateEps_ $ \eps -> eps { eps_is_boot = imp_boot_mods imports }
+ }
-- Update the gbl env
; updGblEnv ( \ gbl ->
@@ -399,7 +397,7 @@ tcRnImports hsc_env import_decls
tcg_hpc = hpc_info
}) $ do {
- ; traceRn "rn1" (ppr (imp_dep_mods imports))
+ ; traceRn "rn1" (ppr (imp_direct_dep_mods imports))
-- Fail if there are any errors so far
-- The error printing (if needed) takes advantage
-- of the tcg_env we have now set
@@ -2070,7 +2068,7 @@ runTcInteractive hsc_env thing_inside
; setEnvs (gbl_env', lcl_env') thing_inside }
where
- (home_insts, home_fam_insts) = hptInstances hsc_env (\_ -> True)
+ (home_insts, home_fam_insts) = hptAllInstances hsc_env
icxt = hsc_IC hsc_env
(ic_insts, ic_finsts) = ic_instances icxt
@@ -2952,9 +2950,9 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
, ppr_fam_insts fam_insts
, ppr_rules rules
, text "Dependent modules:" <+>
- pprUFM (imp_dep_mods imports) (ppr . sort)
+ pprUFM (imp_direct_dep_mods imports) (ppr . sort)
, text "Dependent packages:" <+>
- ppr (S.toList $ imp_dep_pkgs imports)]
+ ppr (S.toList $ imp_dep_direct_pkgs imports)]
-- The use of sort is just to reduce unnecessary
-- wobbling in testsuite output
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 0145ee9b43..2d80039234 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -1346,31 +1346,11 @@ data ImportAvails
-- different packages. (currently not the case, but might be in the
-- future).
- imp_dep_mods :: ModuleNameEnv ModuleNameWithIsBoot,
- -- ^ Home-package modules needed by the module being compiled
- --
- -- It doesn't matter whether any of these dependencies
- -- are actually /used/ when compiling the module; they
- -- are listed if they are below it at all. For
- -- example, suppose M imports A which imports X. Then
- -- compiling M might not need to consult X.hi, but X
- -- is still listed in M's dependencies.
-
- imp_dep_pkgs :: Set UnitId,
- -- ^ Packages needed by the module being compiled, whether directly,
- -- or via other modules in this package, or via modules imported
- -- from other packages.
+ imp_direct_dep_mods :: ModuleNameEnv ModuleNameWithIsBoot,
+ -- ^ Home-package modules directly imported by the module being compiled.
- imp_trust_pkgs :: Set UnitId,
- -- ^ This is strictly a subset of imp_dep_pkgs and records the
- -- packages the current module needs to trust for Safe Haskell
- -- compilation to succeed. A package is required to be trusted if
- -- we are dependent on a trustworthy module in that package.
- -- While perhaps making imp_dep_pkgs a tuple of (UnitId, Bool)
- -- where True for the bool indicates the package is required to be
- -- trusted is the more logical design, doing so complicates a lot
- -- of code not concerned with Safe Haskell.
- -- See Note [Tracking Trust Transitively] in "GHC.Rename.Names"
+ imp_dep_direct_pkgs :: Set UnitId,
+ -- ^ Packages directly needed by the module being compiled
imp_trust_own_pkg :: Bool,
-- ^ Do we require that our own package is trusted?
@@ -1378,6 +1358,23 @@ data ImportAvails
-- a Trustworthy module that resides in the same package as it.
-- See Note [Trust Own Package] in "GHC.Rename.Names"
+ -- Transitive information below here
+
+ imp_trust_pkgs :: Set UnitId,
+ -- ^ This records the
+ -- packages the current module needs to trust for Safe Haskell
+ -- compilation to succeed. A package is required to be trusted if
+ -- we are dependent on a trustworthy module in that package.
+ -- See Note [Tracking Trust Transitively] in "GHC.Rename.Names"
+
+ imp_boot_mods :: ModuleNameEnv ModuleNameWithIsBoot,
+ -- ^ Domain is all modules which have hs-boot files, and whether
+ -- we should import the boot version of interface file. Only used
+ -- in one-shot mode to populate eps_is_boot.
+
+ imp_sig_mods :: [ModuleName],
+ -- ^ Signature modules below this one
+
imp_orphs :: [Module],
-- ^ Orphan modules below us in the import tree (and maybe including
-- us for imported modules)
@@ -1393,6 +1390,20 @@ mkModDeps deps = foldl' add emptyUFM deps
where
add env elt = addToUFM env (gwib_mod elt) elt
+plusModDeps :: ModuleNameEnv ModuleNameWithIsBoot
+ -> ModuleNameEnv ModuleNameWithIsBoot
+ -> ModuleNameEnv ModuleNameWithIsBoot
+plusModDeps = plusUFM_C plus_mod_dep
+ where
+ plus_mod_dep r1@(GWIB { gwib_mod = m1, gwib_isBoot = boot1 })
+ r2@(GWIB {gwib_mod = m2, gwib_isBoot = boot2})
+ | assertPpr (m1 == m2) ((ppr m1 <+> ppr m2) $$ (ppr (boot1 == IsBoot) <+> ppr (boot2 == IsBoot)))
+ boot1 == IsBoot = r2
+ | otherwise = r1
+ -- If either side can "see" a non-hi-boot interface, use that
+ -- Reusing existing tuples saves 10% of allocations on test
+ -- perf/compiler/MultiLayerModules
+
modDepsElts
:: ModuleNameEnv ModuleNameWithIsBoot
-> [ModuleNameWithIsBoot]
@@ -1402,10 +1413,12 @@ modDepsElts = sort . nonDetEltsUFM
emptyImportAvails :: ImportAvails
emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv,
- imp_dep_mods = emptyUFM,
- imp_dep_pkgs = S.empty,
+ imp_direct_dep_mods = emptyUFM,
+ imp_dep_direct_pkgs = S.empty,
+ imp_sig_mods = [],
imp_trust_pkgs = S.empty,
imp_trust_own_pkg = False,
+ imp_boot_mods = emptyUFM,
imp_orphs = [],
imp_finsts = [] }
@@ -1417,29 +1430,28 @@ emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv,
plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails
plusImportAvails
(ImportAvails { imp_mods = mods1,
- imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,
+ imp_direct_dep_mods = ddmods1,
+ imp_dep_direct_pkgs = ddpkgs1,
+ imp_boot_mods = srs1,
+ imp_sig_mods = sig_mods1,
imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,
imp_orphs = orphs1, imp_finsts = finsts1 })
(ImportAvails { imp_mods = mods2,
- imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
+ imp_direct_dep_mods = ddmods2,
+ imp_dep_direct_pkgs = ddpkgs2,
+ imp_boot_mods = srcs2,
+ imp_sig_mods = sig_mods2,
imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,
imp_orphs = orphs2, imp_finsts = finsts2 })
= ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2,
- imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2,
- imp_dep_pkgs = dpkgs1 `S.union` dpkgs2,
+ imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2,
+ imp_dep_direct_pkgs = ddpkgs1 `S.union` ddpkgs2,
imp_trust_pkgs = tpkgs1 `S.union` tpkgs2,
imp_trust_own_pkg = tself1 || tself2,
+ imp_boot_mods = srs1 `plusModDeps` srcs2,
+ imp_sig_mods = sig_mods1 `unionLists` sig_mods2,
imp_orphs = orphs1 `unionLists` orphs2,
imp_finsts = finsts1 `unionLists` finsts2 }
- where
- plus_mod_dep r1@(GWIB { gwib_mod = m1, gwib_isBoot = boot1 })
- r2@(GWIB {gwib_mod = m2, gwib_isBoot = boot2})
- | assertPpr (m1 == m2) ((ppr m1 <+> ppr m2) $$ (ppr (boot1 == IsBoot) <+> ppr (boot2 == IsBoot))) $
- boot1 == IsBoot = r2
- | otherwise = r1
- -- If either side can "see" a non-hi-boot interface, use that
- -- Reusing existing tuples saves 10% of allocations on test
- -- perf/compiler/MultiLayerModules
{-
************************************************************************
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
index 102025bda2..35a8a2b3fc 100644
--- a/compiler/GHC/Types/Unique/FM.hs
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -54,6 +54,7 @@ module GHC.Types.Unique.FM (
plusUFM_C,
plusUFM_CD,
plusUFM_CD2,
+ mergeUFM,
plusMaybeUFM_C,
plusUFMList,
minusUFM,
@@ -88,6 +89,7 @@ import qualified Data.IntSet as S
import Data.Data
import qualified Data.Semigroup as Semi
import Data.Functor.Classes (Eq1 (..))
+import Data.Coerce
-- | A finite map from @uniques@ of one type to
-- elements in another type.
@@ -273,6 +275,20 @@ plusUFM_CD2 f (UFM xm) (UFM ym)
(MS.map (\y -> Nothing `f` Just y))
xm ym
+mergeUFM
+ :: (elta -> eltb -> Maybe eltc)
+ -> (UniqFM key elta -> UniqFM key eltc) -- map X
+ -> (UniqFM key eltb -> UniqFM key eltc) -- map Y
+ -> UniqFM key elta
+ -> UniqFM key eltb
+ -> UniqFM key eltc
+mergeUFM f g h (UFM xm) (UFM ym)
+ = UFM $ MS.mergeWithKey
+ (\_ x y -> (x `f` y))
+ (coerce g)
+ (coerce h)
+ xm ym
+
plusMaybeUFM_C :: (elt -> elt -> Maybe elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusMaybeUFM_C f (UFM xm) (UFM ym)
diff --git a/compiler/GHC/Unit/Module/Deps.hs b/compiler/GHC/Unit/Module/Deps.hs
index 5bdd23239b..2de3fe710d 100644
--- a/compiler/GHC/Unit/Module/Deps.hs
+++ b/compiler/GHC/Unit/Module/Deps.hs
@@ -17,25 +17,41 @@ import GHC.Utils.Fingerprint
import GHC.Utils.Binary
-- | Dependency information about ALL modules and packages below this one
--- in the import hierarchy.
+-- in the import hierarchy. This is the serialisable version of `ImportAvails`.
--
-- Invariant: the dependencies of a module @M@ never includes @M@.
--
-- Invariant: none of the lists contain duplicates.
+--
+-- See Note [Transitive Information in Dependencies]
data Dependencies = Deps
- { dep_mods :: [ModuleNameWithIsBoot]
- -- ^ All home-package modules transitively below this one
- -- I.e. modules that this one imports, or that are in the
- -- dep_mods of those directly-imported modules
-
- , dep_pkgs :: [(UnitId, Bool)]
- -- ^ All packages transitively below this module
- -- I.e. packages to which this module's direct imports belong,
- -- or that are in the dep_pkgs of those modules
- -- The bool indicates if the package is required to be
- -- trusted when the module is imported as a safe import
+ { dep_direct_mods :: [ModuleNameWithIsBoot]
+ -- ^ All home-package modules which are directly imported by this one.
+
+ , dep_direct_pkgs :: [UnitId]
+ -- ^ All packages directly imported by this module
+ -- I.e. packages to which this module's direct imports belong.
+ --
+ , dep_plgins :: [ModuleName]
+ -- ^ All the plugins used while compiling this module.
+
+
+ -- Transitive information below here
+ , dep_sig_mods :: ![ModuleName]
+ -- ^ Transitive closure of hsig files in the home package
+
+
+ , dep_trusted_pkgs :: [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]
+ -- ^ 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.
+ -- See Note [Structure of dep_boot_mods]
+
, dep_orphs :: [Module]
-- ^ Transitive closure of orphan modules (whether
-- home or external pkg).
@@ -53,30 +69,39 @@ data Dependencies = Deps
-- does NOT include us, unlike 'imp_finsts'. See Note
-- [The type family instance consistency story].
- , dep_plgins :: [ModuleName]
- -- ^ All the plugins used while compiling this module.
}
deriving( Eq )
-- Equality used only for old/new comparison in GHC.Iface.Recomp.addFingerprints
-- See 'GHC.Tc.Utils.ImportAvails' for details on dependencies.
instance Binary Dependencies where
- put_ bh deps = do put_ bh (dep_mods deps)
- put_ bh (dep_pkgs deps)
+ put_ bh deps = do put_ bh (dep_direct_mods deps)
+ put_ bh (dep_direct_pkgs deps)
+ put_ bh (dep_trusted_pkgs deps)
+ put_ bh (dep_sig_mods deps)
+ put_ bh (dep_boot_mods deps)
put_ bh (dep_orphs deps)
put_ bh (dep_finsts deps)
put_ bh (dep_plgins deps)
- get bh = do ms <- get bh
- ps <- get bh
+ get bh = do dms <- get bh
+ dps <- get bh
+ tps <- get bh
+ hsigms <- get bh
+ sms <- get bh
os <- get bh
fis <- get bh
pl <- get bh
- return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
+ return (Deps { dep_direct_mods = dms
+ , dep_direct_pkgs = dps
+ , dep_sig_mods = hsigms
+ , dep_boot_mods = sms
+ , dep_trusted_pkgs = tps
+ , dep_orphs = os,
dep_finsts = fis, dep_plgins = pl })
noDependencies :: Dependencies
-noDependencies = Deps [] [] [] [] []
+noDependencies = Deps [] [] [] [] [] [] [] []
-- | Records modules for which changes may force recompilation of this module
-- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance
@@ -193,3 +218,75 @@ instance Binary Usage where
hash <- get bh
return UsageMergedRequirement { usg_mod = mod, usg_mod_hash = hash }
i -> error ("Binary.get(Usage): " ++ show i)
+
+
+{-
+Note [Transitive Information in Dependencies]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+It is important to be careful what information we put in 'Dependencies' because
+ultimately it ends up serialised in an interface file. Interface files must always
+be kept up-to-date with the state of the world, so if `Dependencies` needs to be updated
+then the module had to be recompiled just to update `Dependencies`.
+
+Before #16885, the dependencies used to contain the transitive closure of all
+home modules. Therefore, if you added an import somewhere low down in the home package
+it would recompile nearly every module in your project, just to update this information.
+
+Now, we are a bit more careful about what we store and
+explicitly store transitive information only if it is really needed.
+
+# Direct Information
+
+* dep_direct_mods - Directly imported home package modules
+* dep_direct_pkgs - Directly imported packages
+* dep_plgins - Directly used plugins
+
+# Transitive Information
+
+Some features of the compiler require transitive information about what is currently
+being compiled, so that is explicitly stored separately in the form they need.
+
+* dep_trusted_pkgs - Only used for the -fpackage-trust feature
+* dep_boot_mods - Only used to populate eps_is_boot in -c mode
+* dep_orphs - Modules with orphan instances
+* dep_finsts - Modules with type family instances
+
+Important note: If you add some transitive information to the interface file then
+you need to make sure recompilation is triggered when it could be out of date.
+The correct way to do this is to include the transitive information in the export
+hash of the module. The export hash is computed in `GHC.Iface.Recomp.addFingerprints`.
+-}
+
+{-
+Note [Structure of mod_boot_deps]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In `-c` mode we always need to know whether to load the normal or boot version of
+an interface file, and this can't be determined from just looking at the direct imports.
+
+Consider modules with dependencies:
+
+```
+A -(S)-> B
+A -> C -> B -(S)-> B
+```
+
+Say when compiling module `A` that we need to load the interface for `B`, do we load
+`B.hi` or `B.hi-boot`? Well, `A` does directly {-# SOURCE #-} import B, so you might think
+that we would load the `B.hi-boot` file, however this is wrong because `C` imports
+`B` normally. Therefore in the interface file for `C` we still need to record that
+there is a hs-boot file for `B` below it but that we now want `B.hi` rather than
+`B.hi-boot`. When `C` is imported, the fact that it needs `B.hi` clobbers the `{- SOURCE -}`
+import for `B`.
+
+Therefore in mod_boot_deps we store the names of any modules which have hs-boot files,
+and whether we want to import the .hi or .hi-boot version of the interface file.
+
+If you get this wrong, then GHC fails to compile, so there is a test but you might
+not make it that far if you get this wrong!
+
+Question: does this happen even across packages?
+No: if I need to load the interface for module X from package P I always look for p:X.hi.
+
+-}
diff --git a/compiler/GHC/Unit/Module/ModIface.hs b/compiler/GHC/Unit/Module/ModIface.hs
index b7e0235730..18101e309b 100644
--- a/compiler/GHC/Unit/Module/ModIface.hs
+++ b/compiler/GHC/Unit/Module/ModIface.hs
@@ -282,7 +282,7 @@ mi_free_holes iface =
-> renameFreeHoles (mkUniqDSet cands) (instUnitInsts (moduleUnit indef))
_ -> emptyUniqDSet
where
- cands = map gwib_mod $ dep_mods $ mi_deps iface
+ cands = dep_sig_mods $ mi_deps iface
-- | Given a set of free holes, and a unit identifier, rename
-- the free holes according to the instantiation of the unit
diff --git a/testsuite/tests/ado/ado004.stderr b/testsuite/tests/ado/ado004.stderr
index 2d19929ff3..d3f33c81f6 100644
--- a/testsuite/tests/ado/ado004.stderr
+++ b/testsuite/tests/ado/ado004.stderr
@@ -42,4 +42,4 @@ TYPE SIGNATURES
(Monad m, Num (m a)) =>
(m a -> m (m a)) -> p -> m a
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/dependent/should_compile/T14729.stderr b/testsuite/tests/dependent/should_compile/T14729.stderr
index 60707bb193..ac0108be7c 100644
--- a/testsuite/tests/dependent/should_compile/T14729.stderr
+++ b/testsuite/tests/dependent/should_compile/T14729.stderr
@@ -11,4 +11,4 @@ COERCION AXIOMS
FAMILY INSTANCES
type instance F Int = Bool -- Defined at T14729.hs:10:15
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/dependent/should_compile/T15743.stderr b/testsuite/tests/dependent/should_compile/T15743.stderr
index 20bfaafadb..c9c95159a3 100644
--- a/testsuite/tests/dependent/should_compile/T15743.stderr
+++ b/testsuite/tests/dependent/should_compile/T15743.stderr
@@ -3,4 +3,4 @@ TYPE CONSTRUCTORS
forall {k1} k2 (k3 :: k2). Proxy k3 -> k1 -> k2 -> *
roles nominal nominal nominal phantom phantom phantom
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/dependent/should_compile/T15743e.stderr b/testsuite/tests/dependent/should_compile/T15743e.stderr
index 8db06cbdcb..0fad2d93fc 100644
--- a/testsuite/tests/dependent/should_compile/T15743e.stderr
+++ b/testsuite/tests/dependent/should_compile/T15743e.stderr
@@ -54,4 +54,4 @@ DATA CONSTRUCTORS
(d :: Proxy k5) (e :: Proxy k7).
f c -> T k8 a b f c d e
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/determinism/determ021/determ021.stdout b/testsuite/tests/determinism/determ021/determ021.stdout
index 19da368e19..3141769f68 100644
--- a/testsuite/tests/determinism/determ021/determ021.stdout
+++ b/testsuite/tests/determinism/determ021/determ021.stdout
@@ -5,7 +5,7 @@ TYPE SIGNATURES
(Applicative f, Num t, Num b) =>
(t -> f b) -> f b
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
[1 of 1] Compiling A ( A.hs, A.o )
TYPE SIGNATURES
test2 ::
@@ -13,4 +13,4 @@ TYPE SIGNATURES
(Applicative f, Num t, Num b) =>
(t -> f b) -> f b
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/driver/boot5688/A.hs b/testsuite/tests/driver/boot5688/A.hs
new file mode 100644
index 0000000000..3b8b80d6ca
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/A.hs
@@ -0,0 +1,12 @@
+module A where
+
+-- E source imports B
+-- In interface file see source module dependencies: B {-# SOURCE #-}
+import E
+-- C imports B
+-- In interface file see source module dependencies: B
+import C
+
+-- Instance for B only available from B.hi not B.hi-boot, so tests we load
+-- that.
+main = print B
diff --git a/testsuite/tests/driver/boot5688/B.hs b/testsuite/tests/driver/boot5688/B.hs
new file mode 100644
index 0000000000..e8458aa739
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/B.hs
@@ -0,0 +1,8 @@
+module B where
+
+import D
+
+data B = B
+
+instance Show B where
+ show B = "B"
diff --git a/testsuite/tests/driver/boot5688/B.hs-boot b/testsuite/tests/driver/boot5688/B.hs-boot
new file mode 100644
index 0000000000..64e74c695a
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/B.hs-boot
@@ -0,0 +1,3 @@
+module B where
+
+data B = B
diff --git a/testsuite/tests/driver/boot5688/C.hs b/testsuite/tests/driver/boot5688/C.hs
new file mode 100644
index 0000000000..158757ed80
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/C.hs
@@ -0,0 +1,3 @@
+module C where
+
+import B
diff --git a/testsuite/tests/driver/boot5688/D.hs b/testsuite/tests/driver/boot5688/D.hs
new file mode 100644
index 0000000000..01b53223f9
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/D.hs
@@ -0,0 +1,3 @@
+module D where
+
+import {-# SOURCE #-} B
diff --git a/testsuite/tests/driver/boot5688/E.hs b/testsuite/tests/driver/boot5688/E.hs
new file mode 100644
index 0000000000..a5f78cab2a
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/E.hs
@@ -0,0 +1,3 @@
+module E(B(B)) where
+
+import {-# SOURCE #-} B
diff --git a/testsuite/tests/driver/boot5688/Makefile b/testsuite/tests/driver/boot5688/Makefile
new file mode 100644
index 0000000000..74deae442c
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/Makefile
@@ -0,0 +1,10 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean:
+ rm -f *.o *.hi *.hi-boot *.o-boot
+
+boot5688: clean
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make A.hs -fno-code -fwrite-interface
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c A.hs
diff --git a/testsuite/tests/driver/boot5688/all.T b/testsuite/tests/driver/boot5688/all.T
new file mode 100644
index 0000000000..97c8003111
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/all.T
@@ -0,0 +1,3 @@
+test('boot5688', [extra_files(['A.hs', 'B.hs', 'B.hs-boot', 'C.hs', 'D.hs', 'E.hs']),
+ when(fast(), skip)],
+ makefile_test, [])
diff --git a/testsuite/tests/driver/boot5688/boot5688.stdout b/testsuite/tests/driver/boot5688/boot5688.stdout
new file mode 100644
index 0000000000..96311b5787
--- /dev/null
+++ b/testsuite/tests/driver/boot5688/boot5688.stdout
@@ -0,0 +1,6 @@
+[1 of 6] Compiling B[boot] ( B.hs-boot, nothing )
+[2 of 6] Compiling D ( D.hs, nothing )
+[3 of 6] Compiling B ( B.hs, nothing )
+[4 of 6] Compiling C ( C.hs, nothing )
+[5 of 6] Compiling E ( E.hs, nothing )
+[6 of 6] Compiling A ( A.hs, nothing )
diff --git a/testsuite/tests/driver/json2.stderr b/testsuite/tests/driver/json2.stderr
index 17d072363d..71d7f5edfa 100644
--- a/testsuite/tests/driver/json2.stderr
+++ b/testsuite/tests/driver/json2.stderr
@@ -1 +1 @@
-{"span": null,"doc": "TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]","messageClass": "MCOutput"}
+{"span": null,"doc": "TYPE SIGNATURES\n foo :: forall a. a -> a\nDependent modules: []\nDependent packages: [base-4.16.0.0]","messageClass": "MCOutput"}
diff --git a/testsuite/tests/driver/recomp-boot/A.hs b/testsuite/tests/driver/recomp-boot/A.hs
new file mode 100644
index 0000000000..41644a1c54
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot/A.hs
@@ -0,0 +1,3 @@
+module A where
+
+import B
diff --git a/testsuite/tests/driver/recomp-boot/B1.hs b/testsuite/tests/driver/recomp-boot/B1.hs
new file mode 100644
index 0000000000..ca48559b6d
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot/B1.hs
@@ -0,0 +1,3 @@
+module B where
+
+import C
diff --git a/testsuite/tests/driver/recomp-boot/B2.hs b/testsuite/tests/driver/recomp-boot/B2.hs
new file mode 100644
index 0000000000..29b41f12fe
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot/B2.hs
@@ -0,0 +1,3 @@
+module B where
+
+import {-# SOURCE #-} C
diff --git a/testsuite/tests/driver/recomp-boot/C.hs b/testsuite/tests/driver/recomp-boot/C.hs
new file mode 100644
index 0000000000..5831959653
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot/C.hs
@@ -0,0 +1 @@
+module C where
diff --git a/testsuite/tests/driver/recomp-boot/C.hs-boot b/testsuite/tests/driver/recomp-boot/C.hs-boot
new file mode 100644
index 0000000000..5831959653
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot/C.hs-boot
@@ -0,0 +1 @@
+module C where
diff --git a/testsuite/tests/driver/recomp-boot/Makefile b/testsuite/tests/driver/recomp-boot/Makefile
new file mode 100644
index 0000000000..e888238170
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot/Makefile
@@ -0,0 +1,20 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+# Recompilation tests
+
+clean:
+ rm -f *.o *.hi
+ rm -f B.hs
+
+# Recompile
+
+recomp-boot: clean
+ cp B1.hs B.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make A.hs
+ sleep 1
+ cp B2.hs B.hs
+ # Operating systems with poor timer resolution (e.g. Darwin) need a bit
+ # of time here, lest GHC not realize that the file changed.
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make A.hs
diff --git a/testsuite/tests/driver/recomp-boot/all.T b/testsuite/tests/driver/recomp-boot/all.T
new file mode 100644
index 0000000000..ca3ab09047
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot/all.T
@@ -0,0 +1,3 @@
+test('recomp-boot', [extra_files(['A.hs', 'B1.hs', 'B2.hs', 'C.hs', 'C.hs-boot']),
+ when(fast(), skip)],
+ makefile_test, [])
diff --git a/testsuite/tests/driver/recomp-boot/recomp-boot.stdout b/testsuite/tests/driver/recomp-boot/recomp-boot.stdout
new file mode 100644
index 0000000000..77f5a1794a
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot/recomp-boot.stdout
@@ -0,0 +1,6 @@
+[1 of 3] Compiling C ( C.hs, C.o )
+[2 of 3] Compiling B ( B.hs, B.o )
+[3 of 3] Compiling A ( A.hs, A.o )
+[1 of 4] Compiling C[boot] ( C.hs-boot, C.o-boot )
+[3 of 4] Compiling B ( B.hs, B.o )
+[4 of 4] Compiling A ( A.hs, A.o ) [B changed]
diff --git a/testsuite/tests/driver/recomp-boot2/A.hs b/testsuite/tests/driver/recomp-boot2/A.hs
new file mode 100644
index 0000000000..41644a1c54
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/A.hs
@@ -0,0 +1,3 @@
+module A where
+
+import B
diff --git a/testsuite/tests/driver/recomp-boot2/B1.hs b/testsuite/tests/driver/recomp-boot2/B1.hs
new file mode 100644
index 0000000000..ca48559b6d
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/B1.hs
@@ -0,0 +1,3 @@
+module B where
+
+import C
diff --git a/testsuite/tests/driver/recomp-boot2/B2.hs b/testsuite/tests/driver/recomp-boot2/B2.hs
new file mode 100644
index 0000000000..29b41f12fe
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/B2.hs
@@ -0,0 +1,3 @@
+module B where
+
+import {-# SOURCE #-} C
diff --git a/testsuite/tests/driver/recomp-boot2/C.hs b/testsuite/tests/driver/recomp-boot2/C.hs
new file mode 100644
index 0000000000..5831959653
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/C.hs
@@ -0,0 +1 @@
+module C where
diff --git a/testsuite/tests/driver/recomp-boot2/C.hs-boot b/testsuite/tests/driver/recomp-boot2/C.hs-boot
new file mode 100644
index 0000000000..5831959653
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/C.hs-boot
@@ -0,0 +1 @@
+module C where
diff --git a/testsuite/tests/driver/recomp-boot2/M.hs b/testsuite/tests/driver/recomp-boot2/M.hs
new file mode 100644
index 0000000000..34172494e2
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/M.hs
@@ -0,0 +1,4 @@
+module M where
+
+import A
+import C
diff --git a/testsuite/tests/driver/recomp-boot2/Makefile b/testsuite/tests/driver/recomp-boot2/Makefile
new file mode 100644
index 0000000000..8af96fafe7
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/Makefile
@@ -0,0 +1,21 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+# Recompilation tests
+
+clean:
+ rm -f *.o *.hi
+ rm -f B.hs
+
+# Recompile, adding the extra boot dependency should also cause Top to be recompiled
+# even though we don't use the boot file.
+
+recomp-boot2: clean
+ cp B1.hs B.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make Top.hs
+ sleep 1
+ cp B2.hs B.hs
+ # Operating systems with poor timer resolution (e.g. Darwin) need a bit
+ # of time here, lest GHC not realize that the file changed.
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make Top.hs
diff --git a/testsuite/tests/driver/recomp-boot2/Top.hs b/testsuite/tests/driver/recomp-boot2/Top.hs
new file mode 100644
index 0000000000..ead43b5317
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/Top.hs
@@ -0,0 +1,3 @@
+module Top where
+
+import M
diff --git a/testsuite/tests/driver/recomp-boot2/all.T b/testsuite/tests/driver/recomp-boot2/all.T
new file mode 100644
index 0000000000..ea33c7ba48
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/all.T
@@ -0,0 +1,3 @@
+test('recomp-boot2', [extra_files(['A.hs', 'B1.hs', 'B2.hs', 'C.hs', 'C.hs-boot', 'Top.hs', 'M.hs']),
+ when(fast(), skip)],
+ makefile_test, [])
diff --git a/testsuite/tests/driver/recomp-boot2/recomp-boot.stdout b/testsuite/tests/driver/recomp-boot2/recomp-boot.stdout
new file mode 100644
index 0000000000..77f5a1794a
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/recomp-boot.stdout
@@ -0,0 +1,6 @@
+[1 of 3] Compiling C ( C.hs, C.o )
+[2 of 3] Compiling B ( B.hs, B.o )
+[3 of 3] Compiling A ( A.hs, A.o )
+[1 of 4] Compiling C[boot] ( C.hs-boot, C.o-boot )
+[3 of 4] Compiling B ( B.hs, B.o )
+[4 of 4] Compiling A ( A.hs, A.o ) [B changed]
diff --git a/testsuite/tests/driver/recomp-boot2/recomp-boot2.stdout b/testsuite/tests/driver/recomp-boot2/recomp-boot2.stdout
new file mode 100644
index 0000000000..aec38b5f06
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot2/recomp-boot2.stdout
@@ -0,0 +1,10 @@
+[1 of 5] Compiling C ( C.hs, C.o )
+[2 of 5] Compiling B ( B.hs, B.o )
+[3 of 5] Compiling A ( A.hs, A.o )
+[4 of 5] Compiling M ( M.hs, M.o )
+[5 of 5] Compiling Top ( Top.hs, Top.o )
+[1 of 6] Compiling C[boot] ( C.hs-boot, C.o-boot )
+[3 of 6] Compiling B ( B.hs, B.o )
+[4 of 6] Compiling A ( A.hs, A.o ) [B changed]
+[5 of 6] Compiling M ( M.hs, M.o ) [A changed]
+[6 of 6] Compiling Top ( Top.hs, Top.o ) [M changed]
diff --git a/testsuite/tests/driver/recomp007/Makefile b/testsuite/tests/driver/recomp007/Makefile
index 0ced239efe..caf746ed84 100644
--- a/testsuite/tests/driver/recomp007/Makefile
+++ b/testsuite/tests/driver/recomp007/Makefile
@@ -17,10 +17,12 @@ recomp007:
"$(TEST_HC)" -v0 --make Setup.hs
$(MAKE) -s --no-print-directory prep.a1
$(MAKE) -s --no-print-directory prep.b
+ ./b/dist/build/test/test
"$(GHC_PKG)" unregister --package-db=$(LOCAL_PKGCONF) a-1.0
$(MAKE) -s --no-print-directory prep.a2
cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF)
cd b && ../Setup build
+ ./b/dist/build/test/test
prep.%:
cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF)
diff --git a/testsuite/tests/driver/recomp007/recomp007.stdout b/testsuite/tests/driver/recomp007/recomp007.stdout
index d8343152e0..51b9a2a30c 100644
--- a/testsuite/tests/driver/recomp007/recomp007.stdout
+++ b/testsuite/tests/driver/recomp007/recomp007.stdout
@@ -1,5 +1,6 @@
+"1.0"
Preprocessing executable 'test' for b-1.0..
Building executable 'test' for b-1.0..
[1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A changed]
-[2 of 2] Compiling Main ( Main.hs, dist/build/test/test-tmp/Main.o ) [B changed]
Linking dist/build/test/test ...
+"2.0"
diff --git a/testsuite/tests/indexed-types/should_compile/T15711.stderr b/testsuite/tests/indexed-types/should_compile/T15711.stderr
index 7c47eaf82a..39545a9c28 100644
--- a/testsuite/tests/indexed-types/should_compile/T15711.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T15711.stderr
@@ -3,4 +3,4 @@ TYPE CONSTRUCTORS
associated type family F{2} :: forall a. Maybe a -> *
roles nominal nominal
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/indexed-types/should_compile/T15852.stderr b/testsuite/tests/indexed-types/should_compile/T15852.stderr
index eab430ac83..53fd60fd80 100644
--- a/testsuite/tests/indexed-types/should_compile/T15852.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T15852.stderr
@@ -9,4 +9,4 @@ FAMILY INSTANCES
data instance forall {k1} {j :: k1} {k2} {c :: k2}.
DF (Proxy c) -- Defined at T15852.hs:10:15
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr
index a860b3c76b..be4b88943e 100644
--- a/testsuite/tests/indexed-types/should_compile/T3017.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr
@@ -20,4 +20,4 @@ CLASS INSTANCES
FAMILY INSTANCES
type instance Elem (ListColl a) = a -- Defined at T3017.hs:13:9
Dependent modules: []
-Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/parser/should_run/CountDeps.hs b/testsuite/tests/parser/should_run/CountDeps.hs
index 43a5c58f9f..0f0027d1bf 100644
--- a/testsuite/tests/parser/should_run/CountDeps.hs
+++ b/testsuite/tests/parser/should_run/CountDeps.hs
@@ -50,4 +50,4 @@ calcDeps modName libdir =
mkModule = Module (stringToUnit "ghc")
modDeps :: ModIface -> [ModuleName]
- modDeps mi = map gwib_mod $ dep_mods (mi_deps mi)
+ modDeps mi = map gwib_mod $ dep_direct_mods (mi_deps mi)
diff --git a/testsuite/tests/partial-sigs/should_compile/ADT.stderr b/testsuite/tests/partial-sigs/should_compile/ADT.stderr
index 97ae106add..6db1e3d1a1 100644
--- a/testsuite/tests/partial-sigs/should_compile/ADT.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ADT.stderr
@@ -5,4 +5,4 @@ TYPE CONSTRUCTORS
DATA CONSTRUCTORS
Foo :: forall x y z. x -> y -> z -> Foo x y z
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr
index 3198cb6b23..127b6fc9d1 100644
--- a/testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
addAndOr1 :: (Int, Bool) -> (Bool, Int) -> (Int, Bool)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr
index deb02f8f43..b17d8479c2 100644
--- a/testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
addAndOr2 :: (Int, Bool) -> (Bool, Int) -> (Int, Bool)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr
index 2946f59924..588a4f002c 100644
--- a/testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
addAndOr3 :: (Int, Bool) -> (Bool, Int) -> (Int, Bool)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr
index bb82f3bfa0..e258ab7ed2 100644
--- a/testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
addAndOr4 :: (Int, Bool) -> (Bool, Int) -> (Int, Bool)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr
index 3ca7e2ea02..81e3a08f0a 100644
--- a/testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
addAndOr5 :: (Int, Bool) -> (Bool, Int) -> (Int, Bool)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr
index 2155c3fce8..abceb2441e 100644
--- a/testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
addAndOr6 :: (Int, Bool) -> (Bool, Int) -> (Int, Bool)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr b/testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr
index faab3eb07d..da12cce48b 100644
--- a/testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
bar :: Bool -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
index d7f5af5039..9f79b9e34d 100644
--- a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
@@ -15,4 +15,4 @@ DATA CONSTRUCTORS
FAMILY INSTANCES
data instance Sing _ -- Defined at DataFamilyInstanceLHS.hs:8:15
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr
index a0e169ad0d..288432e39a 100644
--- a/testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
alpha :: Integer
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr
index 12b6786159..549c00050f 100644
--- a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
bravo :: forall {w}. Num w => w
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr
index 12b6786159..549c00050f 100644
--- a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
bravo :: forall {w}. Num w => w
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Either.stderr b/testsuite/tests/partial-sigs/should_compile/Either.stderr
index f9a713aa06..806f23e505 100644
--- a/testsuite/tests/partial-sigs/should_compile/Either.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Either.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
barry :: forall {w}. w -> (Either String w, Either String w)
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr b/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr
index d917f6c5d1..b0e10c980e 100644
--- a/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: forall a. (a ~ Bool) => (a, Bool)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Every.stderr b/testsuite/tests/partial-sigs/should_compile/Every.stderr
index 3b857f3acb..a7806d6e39 100644
--- a/testsuite/tests/partial-sigs/should_compile/Every.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Every.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
every :: forall {t}. (t -> Bool) -> [t] -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr b/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr
index aa6acdfc52..55b3d61f9e 100644
--- a/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
every :: forall {w}. (w -> Bool) -> [w] -> Bool
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr b/testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr
index faab3eb07d..da12cce48b 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
bar :: Bool -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr b/testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr
index faab3eb07d..da12cce48b 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
bar :: Bool -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr
index 93d4ebfff5..3c64c81f34 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr
@@ -5,4 +5,4 @@ TYPE SIGNATURES
arbitCs4 :: forall a. (Eq a, Show a, Enum a) => a -> String
arbitCs5 :: forall a. (Eq a, Enum a, Show a) => a -> String
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr
index 02947b6719..4b5e8d2693 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: String
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
index 9d2f1c5562..85fcc04b19 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
@@ -236,4 +236,4 @@ TYPE SIGNATURES
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
(||) :: Bool -> Bool -> Bool
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr
index 3e52f819cd..424ceda0e0 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: forall a. Num a => a
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr
index 3e52f819cd..424ceda0e0 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: forall a. Num a => a
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Forall1.stderr b/testsuite/tests/partial-sigs/should_compile/Forall1.stderr
index 52e0095fed..edaf392fcc 100644
--- a/testsuite/tests/partial-sigs/should_compile/Forall1.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Forall1.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
fall :: forall a. a -> a
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/GenNamed.stderr b/testsuite/tests/partial-sigs/should_compile/GenNamed.stderr
index faab3eb07d..da12cce48b 100644
--- a/testsuite/tests/partial-sigs/should_compile/GenNamed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/GenNamed.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
bar :: Bool -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr b/testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr
index 292e6171e7..78309d688f 100644
--- a/testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: (forall a. [a] -> [a]) -> ([Bool], [Char])
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr b/testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr
index 292e6171e7..78309d688f 100644
--- a/testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: (forall a. [a] -> [a]) -> ([Bool], [Char])
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr b/testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr
index 02f05a1afd..c6d7b5cfa5 100644
--- a/testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
monoLoc :: forall a. a -> ((a, String), (a, String))
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Meltdown.stderr b/testsuite/tests/partial-sigs/should_compile/Meltdown.stderr
index 2791c29866..916a898fa5 100644
--- a/testsuite/tests/partial-sigs/should_compile/Meltdown.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Meltdown.stderr
@@ -12,4 +12,4 @@ CLASS INSTANCES
-- Defined at Meltdown.hs:12:10
instance Monad (NukeMonad a b) -- Defined at Meltdown.hs:16:10
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr b/testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr
index 02f05a1afd..c6d7b5cfa5 100644
--- a/testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
monoLoc :: forall a. a -> ((a, String), (a, String))
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr b/testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr
index 0afe19b408..b21d99f8b2 100644
--- a/testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: forall b a. (a, b) -> (a, b)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr
index 88da1d2558..fbaff8ffb4 100644
--- a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr
@@ -14,4 +14,4 @@ FAMILY INSTANCES
data instance Sing _a
-- Defined at NamedWildcardInDataFamilyInstanceLHS.hs:8:15
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr
index 55ee78dab9..0718bd597f 100644
--- a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr
@@ -4,4 +4,4 @@ TYPE CONSTRUCTORS
COERCION AXIOMS
axiom NamedWildcardInTypeFamilyInstanceLHS.D:R:F :: F _t = Int
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr b/testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr
index 7ab676d8a3..f7a9e34a0e 100644
--- a/testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
f :: forall a. Eq a => a -> a -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/PatBind.stderr b/testsuite/tests/partial-sigs/should_compile/PatBind.stderr
index 650336fd6d..a795dcd27c 100644
--- a/testsuite/tests/partial-sigs/should_compile/PatBind.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/PatBind.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: forall {a}. a -> a
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/PatBind2.stderr b/testsuite/tests/partial-sigs/should_compile/PatBind2.stderr
index af309b9dd2..49852a1758 100644
--- a/testsuite/tests/partial-sigs/should_compile/PatBind2.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/PatBind2.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: Bool -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/PatternSig.stderr b/testsuite/tests/partial-sigs/should_compile/PatternSig.stderr
index faab3eb07d..da12cce48b 100644
--- a/testsuite/tests/partial-sigs/should_compile/PatternSig.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/PatternSig.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
bar :: Bool -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Recursive.stderr b/testsuite/tests/partial-sigs/should_compile/Recursive.stderr
index 8c8fb7247a..af7fde6f8e 100644
--- a/testsuite/tests/partial-sigs/should_compile/Recursive.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Recursive.stderr
@@ -3,4 +3,4 @@ TYPE SIGNATURES
g :: Bool
orr :: forall a. a -> a -> a
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr b/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr
index 9a839230b9..a7cd75974c 100644
--- a/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
test3 :: Bool -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr b/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr
index e9b3719533..ed05ffce9d 100644
--- a/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
foo :: Bool -> Char
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr b/testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr
index 8f4bebc1b0..31d4fe1430 100644
--- a/testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
showTwo :: forall {a}. Show a => a -> String
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr b/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr
index 21266519f5..02aa357eb9 100644
--- a/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
bar :: forall {w}. w -> Bool
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/SkipMany.stderr b/testsuite/tests/partial-sigs/should_compile/SkipMany.stderr
index 3e7ac69431..a611448bc5 100644
--- a/testsuite/tests/partial-sigs/should_compile/SkipMany.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/SkipMany.stderr
@@ -8,4 +8,4 @@ TYPE CONSTRUCTORS
DATA CONSTRUCTORS
GenParser :: forall tok st a. tok -> st -> a -> GenParser tok st a
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr b/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr
index a0ba926b48..7742b5811c 100644
--- a/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr
@@ -1,7 +1,7 @@
TYPE SIGNATURES
somethingShowable :: Show Bool => Bool -> String
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
SomethingShowable.hs:5:1: warning: [-Wsimplifiable-class-constraints (in -Wdefault)]
• The constraint ‘Show Bool’ matches
diff --git a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
index 0ef2f903f1..84f14200b1 100644
--- a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
@@ -12,4 +12,4 @@ FAMILY INSTANCES
type instance F Bool _ = Bool
-- Defined at TypeFamilyInstanceLHS.hs:8:15
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr b/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr
index a3c0ce2313..8f6c2fb215 100644
--- a/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
unc :: forall {w1} {w2} {w3}. (w1 -> w2 -> w3) -> (w1, w2) -> w3
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr b/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr
index a3c0ce2313..8f6c2fb215 100644
--- a/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr
@@ -1,4 +1,4 @@
TYPE SIGNATURES
unc :: forall {w1} {w2} {w3}. (w1 -> w2 -> w3) -> (w1, w2) -> w3
Dependent modules: []
-Dependent packages: [base-4.14.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
index e9f875b6a3..23b6ee3c2e 100644
--- a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
@@ -2,7 +2,7 @@ TYPE SIGNATURES
bar :: forall {t} {w}. t -> (t -> w) -> w
foo :: forall {a}. (Show a, Enum a) => a -> String
Dependent modules: []
-Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_a’ standing for ‘a’
diff --git a/testsuite/tests/polykinds/T15592.stderr b/testsuite/tests/polykinds/T15592.stderr
index c0f494f281..f04d4f56f3 100644
--- a/testsuite/tests/polykinds/T15592.stderr
+++ b/testsuite/tests/polykinds/T15592.stderr
@@ -5,4 +5,4 @@ DATA CONSTRUCTORS
MkT :: forall {k} k1 (f :: k1 -> k -> *) (a :: k1) (b :: k).
f a b -> T f a b -> T f a b
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/polykinds/T15592b.stderr b/testsuite/tests/polykinds/T15592b.stderr
index e64b81cebe..3b56a07ab0 100644
--- a/testsuite/tests/polykinds/T15592b.stderr
+++ b/testsuite/tests/polykinds/T15592b.stderr
@@ -4,4 +4,4 @@ TYPE CONSTRUCTORS
forall k (f :: k -> *) (a :: k). f a -> *
roles nominal nominal nominal nominal
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/printer/T18052a.stderr b/testsuite/tests/printer/T18052a.stderr
index 28c96670cd..341c4fcbe6 100644
--- a/testsuite/tests/printer/T18052a.stderr
+++ b/testsuite/tests/printer/T18052a.stderr
@@ -6,7 +6,7 @@ TYPE CONSTRUCTORS
PATTERN SYNONYMS
(:||:) :: forall {a} {b}. a -> b -> (a, b)
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
==================== Tidy Core ====================
Result size of Tidy Core
diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr
index 4305b2f737..3941c2d01f 100644
--- a/testsuite/tests/roles/should_compile/Roles1.stderr
+++ b/testsuite/tests/roles/should_compile/Roles1.stderr
@@ -20,7 +20,7 @@ DATA CONSTRUCTORS
K2 :: forall a. a -> T2 a
K1 :: forall a. a -> T1 a
Dependent modules: []
-Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
==================== Typechecker ====================
Roles1.$tcT7
diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr
index 461f4c1318..ec103457b1 100644
--- a/testsuite/tests/roles/should_compile/Roles14.stderr
+++ b/testsuite/tests/roles/should_compile/Roles14.stderr
@@ -6,7 +6,7 @@ TYPE CONSTRUCTORS
COERCION AXIOMS
axiom Roles12.N:C2 :: C2 a = a -> a
Dependent modules: []
-Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
==================== Typechecker ====================
Roles12.$tcC2
diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr
index f9a13b3236..1b8d2172e4 100644
--- a/testsuite/tests/roles/should_compile/Roles2.stderr
+++ b/testsuite/tests/roles/should_compile/Roles2.stderr
@@ -6,7 +6,7 @@ DATA CONSTRUCTORS
K2 :: forall a. FunPtr a -> T2 a
K1 :: forall a. IO a -> T1 a
Dependent modules: []
-Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
==================== Typechecker ====================
Roles2.$tcT2
diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr
index c3bfb99faa..1613bcdf7a 100644
--- a/testsuite/tests/roles/should_compile/Roles3.stderr
+++ b/testsuite/tests/roles/should_compile/Roles3.stderr
@@ -21,7 +21,7 @@ COERCION AXIOMS
axiom Roles3.N:C3 :: C3 a b = a -> F3 b -> F3 b
axiom Roles3.N:C4 :: C4 a b = a -> F4 b -> F4 b
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
==================== Typechecker ====================
Roles3.$tcC4
diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr
index bd7baee0c6..803825d4ec 100644
--- a/testsuite/tests/roles/should_compile/Roles4.stderr
+++ b/testsuite/tests/roles/should_compile/Roles4.stderr
@@ -9,7 +9,7 @@ COERCION AXIOMS
axiom Roles4.N:C1 :: C1 a = a -> a
axiom Roles4.N:C3 :: C3 a = a -> Syn1 a
Dependent modules: []
-Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]
==================== Typechecker ====================
Roles4.$tcC3
diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr
index 3247b4b0d4..196ff7e7c7 100644
--- a/testsuite/tests/roles/should_compile/T8958.stderr
+++ b/testsuite/tests/roles/should_compile/T8958.stderr
@@ -16,7 +16,7 @@ CLASS INSTANCES
-- Defined at T8958.hs:11:10
instance [incoherent] Nominal a -- Defined at T8958.hs:8:10
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
==================== Typechecker ====================
T8958.$tcMap
diff --git a/testsuite/tests/safeHaskell/check/pkg01/Makefile b/testsuite/tests/safeHaskell/check/pkg01/Makefile
index 283a7df530..4997a728a8 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/Makefile
+++ b/testsuite/tests/safeHaskell/check/pkg01/Makefile
@@ -40,28 +40,28 @@ safePkg01:
$(safePkg01_GHC_PKG) field safePkg01-1.0 trusted
echo
echo 'M_SafePkg'
- '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:'
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg.$(HI_SUF) | grep -E '^trusted package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo 'M_SafePkg2'
- '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg2.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:'
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg2.$(HI_SUF) | grep -E '^trusted package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo 'M_SafePkg3'
- '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg3.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:'
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg3.$(HI_SUF) | grep -E '^trusted package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo 'M_SafePkg4'
- '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg4.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:'
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg4.$(HI_SUF) | grep -E '^trusted package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo 'M_SafePkg5'
- '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg5.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:'
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg5.$(HI_SUF) | grep -E '^trusted package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo 'M_SafePkg6'
- '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg6.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:'
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg6.$(HI_SUF) | grep -E '^trusted package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo 'M_SafePkg7'
- '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg7.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:'
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg7.$(HI_SUF) | grep -E '^trusted package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo 'M_SafePkg8'
- '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg8.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:'
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg8.$(HI_SUF) | grep -E '^trusted package dependencies:|^trusted:|^require own pkg trusted:'
echo
echo 'Testing setting trust'
$(safePkg01_GHC_PKG) trust safePkg01-1.0
diff --git a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
index f2d60007a1..fea0257b7d 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
+++ b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
@@ -4,42 +4,41 @@ pdb.safePkg01/local.db
trusted: False
M_SafePkg
-package dependencies: base-4.13.0.0* ghc-bignum-1.0 ghc-prim-0.7.0
+trusted package dependencies: base-4.16.0.0
trusted: safe
require own pkg trusted: False
M_SafePkg2
-package dependencies: base-4.13.0.0 ghc-bignum-1.0 ghc-prim-0.7.0
trusted: trustworthy
require own pkg trusted: False
M_SafePkg3
-package dependencies: base-4.13.0.0* ghc-bignum-1.0 ghc-prim-0.7.0
+trusted package dependencies: base-4.16.0.0
trusted: safe
require own pkg trusted: True
M_SafePkg4
-package dependencies: base-4.13.0.0* ghc-bignum-1.0 ghc-prim-0.7.0
+trusted package dependencies: base-4.16.0.0
trusted: safe
require own pkg trusted: True
M_SafePkg5
-package dependencies: base-4.13.0.0* ghc-bignum-1.0 ghc-prim-0.7.0
+trusted package dependencies: base-4.16.0.0
trusted: safe-inferred
require own pkg trusted: True
M_SafePkg6
-package dependencies: array-0.5.4.0 base-4.13.0.0* bytestring-0.10.9.0* deepseq-1.4.4.0 ghc-bignum-1.0 ghc-prim-0.7.0
+trusted package dependencies: base-4.16.0.0 bytestring-0.11.1.0
trusted: trustworthy
require own pkg trusted: False
M_SafePkg7
-package dependencies: array-0.5.4.0 base-4.13.0.0* bytestring-0.10.9.0* deepseq-1.4.4.0 ghc-bignum-1.0 ghc-prim-0.7.0
+trusted package dependencies: base-4.16.0.0 bytestring-0.11.1.0
trusted: safe
require own pkg trusted: False
M_SafePkg8
-package dependencies: array-0.5.4.0 base-4.13.0.0 bytestring-0.10.9.0* deepseq-1.4.4.0 ghc-bignum-1.0 ghc-prim-0.7.0
+trusted package dependencies: base-4.16.0.0 bytestring-0.11.1.0
trusted: trustworthy
require own pkg trusted: False
diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr
index 35ed3cc39f..46857abf86 100644
--- a/testsuite/tests/th/TH_Roles2.stderr
+++ b/testsuite/tests/th/TH_Roles2.stderr
@@ -2,9 +2,7 @@ TYPE CONSTRUCTORS
data type T{2} :: forall k. k -> *
roles nominal representational
Dependent modules: []
-Dependent packages: [array-0.5.4.0, base-4.16.0.0, deepseq-1.4.4.0,
- ghc-bignum-1.0, ghc-boot-th-9.1, ghc-prim-0.8.0, pretty-1.1.3.6,
- template-haskell-2.18.0.0]
+Dependent packages: [base-4.16.0.0, template-haskell-2.18.0.0]
==================== Typechecker ====================
TH_Roles2.$tcT
diff --git a/testsuite/tests/typecheck/should_compile/T12763.stderr b/testsuite/tests/typecheck/should_compile/T12763.stderr
index 2496d16dcd..d918ca9690 100644
--- a/testsuite/tests/typecheck/should_compile/T12763.stderr
+++ b/testsuite/tests/typecheck/should_compile/T12763.stderr
@@ -8,4 +8,4 @@ COERCION AXIOMS
CLASS INSTANCES
instance C Int -- Defined at T12763.hs:9:10
Dependent modules: []
-Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.8.0]
+Dependent packages: [base-4.16.0.0]
diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr
index 61ec4e0551..16ed21fdd4 100644
--- a/testsuite/tests/typecheck/should_compile/tc231.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc231.stderr
@@ -15,4 +15,4 @@ DATA CONSTRUCTORS
Z :: forall a. a -> Z a
Node :: forall s a chain. s -> a -> chain -> Q s a chain
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.16.0.0]