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