diff options
Diffstat (limited to 'compiler/GHC/Unit')
| -rw-r--r-- | compiler/GHC/Unit/Env.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Unit/Module/Deps.hs | 34 | ||||
| -rw-r--r-- | compiler/GHC/Unit/Module/ModGuts.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Unit/State.hs | 28 | ||||
| -rw-r--r-- | compiler/GHC/Unit/Types.hs | 3 |
5 files changed, 41 insertions, 35 deletions
diff --git a/compiler/GHC/Unit/Env.hs b/compiler/GHC/Unit/Env.hs index a34ae550e0..e473c45669 100644 --- a/compiler/GHC/Unit/Env.hs +++ b/compiler/GHC/Unit/Env.hs @@ -81,6 +81,7 @@ import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.Session import GHC.Utils.Outputable import GHC.Utils.Panic (pprPanic) +import GHC.Types.Unique.DSet import GHC.Unit.Module.ModIface import GHC.Unit.Module import qualified Data.Set as Set @@ -339,8 +340,8 @@ unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env) unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env -unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey -unitEnv_keys env = Map.keysSet (unitEnv_graph env) +unitEnv_keys :: UnitEnvGraph v -> UnitIdSet +unitEnv_keys env = mkUniqDSet $ Map.keys (unitEnv_graph env) unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] unitEnv_elts env = Map.toList (unitEnv_graph env) @@ -443,7 +444,7 @@ ue_unitHomeUnit_maybe uid ue_env = ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env -ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId +ue_all_home_unit_ids :: UnitEnv -> UnitIdSet ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph -- ------------------------------------------------------- -- Query and modify the currently active unit diff --git a/compiler/GHC/Unit/Module/Deps.hs b/compiler/GHC/Unit/Module/Deps.hs index 583b7fdaaa..07f6bc33b7 100644 --- a/compiler/GHC/Unit/Module/Deps.hs +++ b/compiler/GHC/Unit/Module/Deps.hs @@ -28,6 +28,7 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module import GHC.Unit.Home import GHC.Unit.State +import GHC.Types.Unique.DSet import GHC.Utils.Fingerprint import GHC.Utils.Binary @@ -53,13 +54,13 @@ data Dependencies = Deps -- ^ All home-package modules which are directly imported by this one. -- This may include modules from other units when using multiple home units - , dep_direct_pkgs :: Set UnitId + , dep_direct_pkgs :: UnitIdSet -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. -- Does not include other home units when using multiple home units. -- Modules from these units will go in `dep_direct_mods` - , dep_plugin_pkgs :: Set UnitId + , dep_plugin_pkgs :: UnitIdSet -- ^ All units needed for plugins ------------------------------------ @@ -69,7 +70,7 @@ data Dependencies = Deps -- ^ Transitive closure of hsig files in the home package - , dep_trusted_pkgs :: Set UnitId + , dep_trusted_pkgs :: UnitIdSet -- 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 @@ -110,7 +111,7 @@ data Dependencies = Deps 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 = Set.fromList (map (toUnitId . moduleUnit) external_plugins) + plugin_units = mkUniqDSet (map (toUnitId . moduleUnit) external_plugins) all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) (imp_direct_dep_mods imports) (map (fmap toUnitId) home_plugins) @@ -197,12 +198,12 @@ instance Binary Dependencies where noDependencies :: Dependencies noDependencies = Deps - { dep_direct_mods = Set.empty - , dep_direct_pkgs = Set.empty - , dep_plugin_pkgs = Set.empty + { dep_direct_mods = mempty + , dep_direct_pkgs = emptyUniqDSet + , dep_plugin_pkgs = emptyUniqDSet , dep_sig_mods = [] - , dep_boot_mods = Set.empty - , dep_trusted_pkgs = Set.empty + , dep_boot_mods = mempty + , dep_trusted_pkgs = emptyUniqDSet , dep_orphs = [] , dep_finsts = [] } @@ -220,11 +221,11 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods = pprWithUnitState unit_state $ 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, - text "plugin package dependencies:" <+> ppr_set ppr plgns, - if null tps + text "direct package dependencies:" <+> ppr_unitIdSet ppr pkgs, + text "plugin package dependencies:" <+> ppr_unitIdSet ppr plgns, + if isEmptyUniqDSet tps then empty - else text "trusted package dependencies:" <+> ppr_set ppr tps, + else text "trusted package dependencies:" <+> ppr_unitIdSet ppr tps, text "orphans:" <+> fsep (map ppr orphs), text "family instance modules:" <+> fsep (map ppr finsts) ] @@ -235,6 +236,9 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc ppr_set w = fsep . fmap w . Set.toAscList + ppr_unitIdSet :: (UnitId -> SDoc) -> UnitIdSet -> SDoc + ppr_unitIdSet w = fsep . fmap w . sort . uniqDSetToList + -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance -- @@ -491,7 +495,7 @@ data ImportAvails imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot, -- ^ Home-package modules directly imported by the module being compiled. - imp_dep_direct_pkgs :: Set UnitId, + imp_dep_direct_pkgs :: UnitIdSet, -- ^ Packages directly needed by the module being compiled imp_trust_own_pkg :: Bool, @@ -502,7 +506,7 @@ data ImportAvails -- Transitive information below here - imp_trust_pkgs :: Set UnitId, + imp_trust_pkgs :: UnitIdSet, -- ^ This records the -- packages the current module needs to trust for Safe Haskell -- compilation to succeed. A package is required to be trusted if diff --git a/compiler/GHC/Unit/Module/ModGuts.hs b/compiler/GHC/Unit/Module/ModGuts.hs index d54e836d71..00bbfca1b4 100644 --- a/compiler/GHC/Unit/Module/ModGuts.hs +++ b/compiler/GHC/Unit/Module/ModGuts.hs @@ -37,8 +37,6 @@ 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 @@ -137,7 +135,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 :: !(Set UnitId), -- ^ Dependent packages, used to + cg_dep_pkgs :: !UnitIdSet, -- ^ 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/State.hs b/compiler/GHC/Unit/State.hs index f5aeb65216..39a350cffe 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -346,10 +346,10 @@ data UnitConfig = UnitConfig , unitConfigFlagsIgnored :: [IgnorePackageFlag] -- ^ Ignored units , unitConfigFlagsTrusted :: [TrustFlag] -- ^ Trusted units , unitConfigFlagsPlugins :: [PackageFlag] -- ^ Plugins exposed units - , unitConfigHomeUnits :: Set.Set UnitId + , unitConfigHomeUnits :: UnitIdSet } -initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> UnitConfig +initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> UnitConfig initUnitConfig dflags cached_dbs home_units = let !hu_id = homeUnitId_ dflags !hu_instanceof = homeUnitInstanceOf_ dflags @@ -626,7 +626,7 @@ listUnitInfo state = nonDetEltsUniqMap (unitInfoMap state) -- 'initUnits' can be called again subsequently after updating the -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'unitState' in 'DynFlags'. -initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> Set.Set UnitId -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) +initUnits :: Logger -> DynFlags -> Maybe [UnitDatabase UnitId] -> UnitIdSet -> IO ([UnitDatabase UnitId], UnitState, HomeUnit, Maybe PlatformConstants) initUnits logger dflags cached_dbs home_units = do let forceUnitInfoMap (state, _) = unitInfoMap state `seq` () @@ -1362,7 +1362,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do debugTraceMsg logger 2 $ text "loading package database" <+> text db_path - forM_ (Set.toList override_set) $ \pkg -> + forM_ (uniqDSetToList override_set) $ \pkg -> debugTraceMsg logger 2 $ text "package" <+> ppr pkg <+> text "overrides a previously defined package" @@ -1374,9 +1374,9 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..] -- The set of UnitIds which appear in both db and pkgs. These are the -- ones that get overridden. Compute this just to give some -- helpful debug messages at -v2 - override_set :: Set UnitId - override_set = Set.intersection (nonDetUniqMapToKeySet db_map) - (nonDetUniqMapToKeySet pkg_map) + override_set :: UnitIdSet + override_set = intersectUniqDSets (mkUniqDSet $ nonDetKeysUniqMap db_map) + (mkUniqDSet $ nonDetKeysUniqMap pkg_map) -- Now merge the sets together (NB: in case of duplicate, -- first argument preferred) @@ -1688,7 +1688,7 @@ mkUnitState logger cfg = do let !state = UnitState { preloadUnits = dep_preload , explicitUnits = explicit_pkgs - , homeUnitDepends = Set.toList home_unit_deps + , homeUnitDepends = uniqDSetToList home_unit_deps , unitInfoMap = pkg_db , preloadClosure = emptyUniqSet , moduleNameProvidersMap = mod_map @@ -1701,15 +1701,15 @@ mkUnitState logger cfg = do } return (state, raw_dbs) -selectHptFlag :: Set.Set UnitId -> PackageFlag -> Bool -selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = True +selectHptFlag :: UnitIdSet -> PackageFlag -> Bool +selectHptFlag home_units (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = True selectHptFlag _ _ = False -selectHomeUnits :: Set.Set UnitId -> [PackageFlag] -> Set.Set UnitId -selectHomeUnits home_units flags = foldl' go Set.empty flags +selectHomeUnits :: UnitIdSet -> [PackageFlag] -> UnitIdSet +selectHomeUnits home_units flags = foldl' go emptyUniqDSet flags where - go :: Set.Set UnitId -> PackageFlag -> Set.Set UnitId - go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `Set.member` home_units = Set.insert (toUnitId uid) cur + go :: UnitIdSet -> PackageFlag -> UnitIdSet + go cur (ExposePackage _ (UnitIdArg uid) _) | toUnitId uid `elementOfUniqDSet` home_units = addOneToUniqDSet cur (toUnitId uid) -- MP: This does not yet support thinning/renaming go cur _ = cur diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs index 7439ab7dde..a92383b0ec 100644 --- a/compiler/GHC/Unit/Types.hs +++ b/compiler/GHC/Unit/Types.hs @@ -33,6 +33,7 @@ module GHC.Unit.Types , GenInstantiatedUnit (..) , InstantiatedUnit , DefUnitId + , UnitIdSet , Instantiations , GenInstantiations , mkInstantiatedUnit @@ -538,6 +539,8 @@ pprUnitId (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- code for. type DefUnitId = Definite UnitId +type UnitIdSet = UniqDSet UnitId + unitIdString :: UnitId -> String unitIdString = unpackFS . unitIdFS |