diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Module.hs | 20 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Types.hs | 90 |
2 files changed, 60 insertions, 50 deletions
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 {- ************************************************************************ |