summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-05-13 11:32:41 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-06-13 02:13:03 -0400
commited533ec217667423e4fce30040f24053dbcc7de4 (patch)
treea810bd338fb4044538fba0c78df041a3e2c225e1
parentf50c19b8a78da9252cb39f49c1c66db4a684cc3b (diff)
downloadhaskell-ed533ec217667423e4fce30040f24053dbcc7de4.tar.gz
Rename Package into Unit
The terminology changed over time and now package databases contain "units" (there can be several units compiled from a single Cabal package: one per-component, one for each option set, one per instantiation, etc.). We should try to be consistent internally and use "units": that's what this renaming does. Maybe one day we'll fix the UI too (e.g. replace -package-id with -unit-id, we already have -this-unit-id and ghc-pkg has -unit-id...) but it's not done in this patch. * rename getPkgFrameworkOpts into getUnitFrameworkOpts * rename UnitInfoMap into ClosureUnitInfoMap * rename InstalledPackageIndex into UnitInfoMap * rename UnusablePackages into UnusableUnits * rename PackagePrecedenceIndex into UnitPrecedenceMap * rename PackageDatabase into UnitDatabase * rename pkgDatabase into unitDatabases * rename pkgState into unitState * rename initPackages into initUnits * rename renamePackage into renameUnitInfo * rename UnusablePackageReason into UnusableUnitReason * rename getPackage* into getUnit* * etc.
-rw-r--r--compiler/GHC.hs8
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap/Utils.hs2
-rw-r--r--compiler/GHC/Driver/Backpack.hs24
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs4
-rw-r--r--compiler/GHC/Driver/Finder.hs10
-rw-r--r--compiler/GHC/Driver/Main.hs6
-rw-r--r--compiler/GHC/Driver/Make.hs4
-rw-r--r--compiler/GHC/Driver/Pipeline.hs36
-rw-r--r--compiler/GHC/Driver/Session.hs27
-rw-r--r--compiler/GHC/Driver/Session.hs-boot2
-rw-r--r--compiler/GHC/Driver/Types.hs6
-rw-r--r--compiler/GHC/HsToCore/Usage.hs2
-rw-r--r--compiler/GHC/Iface/Load.hs2
-rw-r--r--compiler/GHC/Iface/Recomp.hs4
-rw-r--r--compiler/GHC/Iface/Rename.hs10
-rw-r--r--compiler/GHC/Runtime/Linker.hs4
-rw-r--r--compiler/GHC/SysTools.hs14
-rw-r--r--compiler/GHC/SysTools/ExtraObj.hs6
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs6
-rw-r--r--compiler/GHC/Unit/State.hs316
-rw-r--r--compiler/GHC/Unit/State.hs-boot8
-rw-r--r--compiler/GHC/Unit/Subst.hs10
-rw-r--r--compiler/GHC/Unit/Types.hs4
-rw-r--r--ghc/GHCi/UI.hs8
-rw-r--r--ghc/Main.hs6
25 files changed, 262 insertions, 267 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index f95c61ace5..1aebb96c0f 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -597,7 +597,7 @@ checkBrokenTablesNextToCode' dflags
setSessionDynFlags :: GhcMonad m => DynFlags -> m [UnitId]
setSessionDynFlags dflags = do
dflags' <- checkNewDynFlags dflags
- (dflags''', preload) <- liftIO $ initPackages dflags'
+ (dflags''', preload) <- liftIO $ initUnits dflags'
-- Interpreter
interp <- if gopt Opt_ExternalInterpreter dflags
@@ -660,7 +660,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
dflags_prev <- getProgramDynFlags
(dflags'', preload) <-
if (packageFlagsChanged dflags_prev dflags')
- then liftIO $ initPackages dflags'
+ then liftIO $ initUnits dflags'
else return (dflags', [])
modifySession $ \h -> h{ hsc_dflags = dflags'' }
when invalidate_needed $ invalidateModSummaryCache
@@ -699,7 +699,7 @@ getProgramDynFlags = getSessionDynFlags
-- | Set the 'DynFlags' used to evaluate interactive expressions.
-- Note: this cannot be used for changes to packages. Use
-- 'setSessionDynFlags', or 'setProgramDynFlags' and then copy the
--- 'pkgState' into the interactive @DynFlags@.
+-- 'unitState' into the interactive @DynFlags@.
setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
setInteractiveDynFlags dflags = do
dflags' <- checkNewDynFlags dflags
@@ -1355,7 +1355,7 @@ packageDbModules :: GhcMonad m =>
-> m [Module]
packageDbModules only_exposed = do
dflags <- getSessionDynFlags
- let pkgs = eltsUFM (unitInfoMap (pkgState dflags))
+ let pkgs = eltsUFM (unitInfoMap (unitState dflags))
return $
[ mkModule pid modname
| p <- pkgs
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 44ab7f1946..8be03f30c5 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -567,7 +567,7 @@ Does 'main' print "error 1" or "error no"? We don't really want 'f'
to unbox its second argument. This actually happened in GHC's onwn
source code, in Packages.applyPackageFlag, which ended up un-boxing
the enormous DynFlags tuple, and being strict in the
-as-yet-un-filled-in pkgState files.
+as-yet-un-filled-in unitState files.
-}
----------------------
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 9dd5aeba85..8e72549d6a 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -86,7 +86,7 @@ doBackpack [src_filename] = do
POk _ pkgname_bkp -> do
-- OK, so we have an LHsUnit PackageName, but we want an
-- LHsUnit HsComponentId. So let's rename it.
- let pkgstate = pkgState dflags
+ let pkgstate = unitState dflags
let bkp = renameHsUnits pkgstate (bkpPackageNameMap pkgstate pkgname_bkp) pkgname_bkp
initBkpM src_filename bkp $
forM_ (zip [1..] bkp) $ \(i, lunit) -> do
@@ -194,7 +194,7 @@ withBkpSession cid insts deps session_type do_this = do
importPaths = [],
-- Synthesized the flags
packageFlags = packageFlags dflags ++ map (\(uid0, rn) ->
- let uid = unwireUnit dflags (improveUnit (unitInfoMap (pkgState dflags)) $ renameHoleUnit (pkgState dflags) (listToUFM insts) uid0)
+ let uid = unwireUnit dflags (improveUnit (unitInfoMap (unitState dflags)) $ renameHoleUnit (unitState dflags) (listToUFM insts) uid0)
in ExposePackage
(showSDoc dflags
(text "-unit-id" <+> ppr uid <+> ppr rn))
@@ -202,7 +202,7 @@ withBkpSession cid insts deps session_type do_this = do
} )) $ do
dflags <- getSessionDynFlags
-- pprTrace "flags" (ppr insts <> ppr deps) $ return ()
- -- Calls initPackages
+ -- Calls initUnits
_ <- setSessionDynFlags dflags
do_this
@@ -262,7 +262,7 @@ buildUnit session cid insts lunit = do
-- The compilation dependencies are just the appropriately filled
-- in unit IDs which must be compiled before we can compile.
let hsubst = listToUFM insts
- deps0 = map (renameHoleUnit (pkgState dflags) hsubst) raw_deps
+ deps0 = map (renameHoleUnit (unitState dflags) hsubst) raw_deps
-- Build dependencies OR make sure they make sense. BUT NOTE,
-- we can only check the ones that are fully filled; the rest
@@ -275,7 +275,7 @@ buildUnit session cid insts lunit = do
dflags <- getDynFlags
-- IMPROVE IT
- let deps = map (improveUnit (unitInfoMap (pkgState dflags))) deps0
+ let deps = map (improveUnit (unitInfoMap (unitState dflags))) deps0
mb_old_eps <- case session of
TcSession -> fmap Just getEpsGhc
@@ -379,24 +379,24 @@ compileExe lunit = do
ok <- load' LoadAllTargets (Just msg) mod_graph
when (failed ok) (liftIO $ exitWith (ExitFailure 1))
--- | Register a new virtual package database containing a single unit
+-- | Register a new virtual unit database containing a single unit
addPackage :: GhcMonad m => UnitInfo -> m ()
addPackage pkg = do
dflags <- GHC.getSessionDynFlags
- case pkgDatabase dflags of
+ case unitDatabases dflags of
Nothing -> panic "addPackage: called too early"
Just dbs -> do
- let newdb = PackageDatabase
- { packageDatabasePath = "(in memory " ++ showSDoc dflags (ppr (unitId pkg)) ++ ")"
- , packageDatabaseUnits = [pkg]
+ let newdb = UnitDatabase
+ { unitDatabasePath = "(in memory " ++ showSDoc dflags (ppr (unitId pkg)) ++ ")"
+ , unitDatabaseUnits = [pkg]
}
- _ <- GHC.setSessionDynFlags (dflags { pkgDatabase = Just (dbs ++ [newdb]) })
+ _ <- GHC.setSessionDynFlags (dflags { unitDatabases = Just (dbs ++ [newdb]) })
return ()
compileInclude :: Int -> (Int, Unit) -> BkpM ()
compileInclude n (i, uid) = do
hsc_env <- getSession
- let pkgs = pkgState (hsc_dflags hsc_env)
+ let pkgs = unitState (hsc_dflags hsc_env)
msgInclude (i, n) uid
-- Check if we've compiled it already
case uid of
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index e9ac354090..01de8cf982 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -131,7 +131,7 @@ outputC dflags filenm cmm_stream packages
-- * -#include options from the cmdline and OPTIONS pragmas
-- * the _stub.h file, if there is one.
--
- let rts = unsafeLookupUnitId (pkgState dflags) rtsUnitId
+ let rts = unsafeLookupUnitId (unitState dflags) rtsUnitId
let cc_injects = unlines (map mk_include (unitIncludes rts))
mk_include h_file =
@@ -223,7 +223,7 @@ outputForeignStubs dflags mod location stubs
-- we need the #includes from the rts package for the stub files
let rts_includes =
- let rts_pkg = unsafeLookupUnitId (pkgState dflags) rtsUnitId in
+ let rts_pkg = unsafeLookupUnitId (unitState dflags) rtsUnitId in
concatMap mk_include (unitIncludes rts_pkg)
mk_include i = "#include \"" ++ i ++ "\"\n"
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index c3332a663c..48fe9edba3 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -182,14 +182,14 @@ findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
findExposedPackageModule hsc_env mod_name mb_pkg
= findLookupResult hsc_env
$ lookupModuleWithSuggestions
- (pkgState (hsc_dflags hsc_env)) mod_name mb_pkg
+ (unitState (hsc_dflags hsc_env)) mod_name mb_pkg
findExposedPluginPackageModule :: HscEnv -> ModuleName
-> IO FindResult
findExposedPluginPackageModule hsc_env mod_name
= findLookupResult hsc_env
$ lookupPluginModuleWithSuggestions
- (pkgState (hsc_dflags hsc_env)) mod_name Nothing
+ (unitState (hsc_dflags hsc_env)) mod_name Nothing
findLookupResult :: HscEnv -> LookupResult -> IO FindResult
findLookupResult hsc_env r = case r of
@@ -343,7 +343,7 @@ findPackageModule hsc_env mod = do
let
dflags = hsc_dflags hsc_env
pkg_id = moduleUnit mod
- pkgstate = pkgState dflags
+ pkgstate = unitState dflags
--
case lookupUnitId pkgstate pkg_id of
Nothing -> return (InstalledNoPackage pkg_id)
@@ -672,7 +672,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
= ptext cannot_find <+> quotes (ppr mod_name)
$$ more_info
where
- pkgs = pkgState dflags
+ pkgs = unitState dflags
more_info
= case find_result of
NoPackage pkg
@@ -810,7 +810,7 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
_ -> panic "cantFindInstalledErr"
build_tag = buildTag dflags
- pkgstate = pkgState dflags
+ pkgstate = unitState dflags
looks_like_srcpkgid :: UnitId -> SDoc
looks_like_srcpkgid pk
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 5d9abc254a..eff29cdcd7 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1159,7 +1159,7 @@ hscCheckSafe' m l = do
return (trust == Sf_Trustworthy, pkgRs)
where
- state = pkgState dflags
+ state = unitState dflags
inferredImportWarn = unitBag
$ makeIntoWarning (Reason Opt_WarnInferredSafeImports)
$ mkWarnMsg dflags l (pkgQual state)
@@ -1193,7 +1193,7 @@ hscCheckSafe' m l = do
packageTrusted _ Sf_SafeInferred False _ = True
packageTrusted dflags _ _ m
| isHomeModule dflags m = True
- | otherwise = unitIsTrusted $ unsafeLookupUnit (pkgState dflags) (moduleUnit m)
+ | otherwise = unitIsTrusted $ unsafeLookupUnit (unitState dflags) (moduleUnit m)
lookup' :: Module -> Hsc (Maybe ModIface)
lookup' m = do
@@ -1216,7 +1216,7 @@ checkPkgTrust :: Set UnitId -> Hsc ()
checkPkgTrust pkgs = do
dflags <- getDynFlags
let errors = S.foldr go [] pkgs
- state = pkgState dflags
+ state = unitState dflags
go pkg acc
| unitIsTrusted $ unsafeLookupUnitId state pkg
= acc
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 714619d7b2..d825435ecc 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -307,7 +307,7 @@ warnUnusedPackages = do
eps <- liftIO $ hscEPS hsc_env
let dflags = hsc_dflags hsc_env
- state = pkgState dflags
+ state = unitState dflags
pit = eps_PIT eps
let loadedPackages
@@ -1533,7 +1533,7 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
-- instantiations that are themselves instantiations and so on recursively.
instantiatedUnitsToCheck :: DynFlags -> [Unit]
instantiatedUnitsToCheck dflags =
- nubSort $ concatMap goUnit (explicitPackages (pkgState dflags))
+ nubSort $ concatMap goUnit (explicitUnits (unitState dflags))
where
goUnit HoleUnit = []
goUnit (RealUnit _) = []
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 5465ebefd9..15cce2f11d 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -513,7 +513,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
-- next, check libraries. XXX this only checks Haskell libraries,
-- not extra_libraries or -l things from the command line.
- let pkgstate = pkgState dflags
+ let pkgstate = unitState dflags
let pkg_hslibs = [ (collectLibraryPaths dflags [c], lib)
| Just c <- map (lookupUnitId pkgstate) pkg_deps,
lib <- packageHsLibs dflags c ]
@@ -1233,7 +1233,7 @@ runPhase (RealPhase cc_phase) input_fn dflags
-- add package include paths even if we're just compiling .c
-- files; this is the Value Add(TM) that using ghc instead of
-- gcc gives you :)
- pkg_include_dirs <- liftIO $ getPackageIncludePath dflags pkgs
+ pkg_include_dirs <- liftIO $ getUnitIncludePath dflags pkgs
let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
(includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)
let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []
@@ -1261,11 +1261,11 @@ runPhase (RealPhase cc_phase) input_fn dflags
pkg_extra_cc_opts <- liftIO $
if hcc
then return []
- else getPackageExtraCcOpts dflags pkgs
+ else getUnitExtraCcOpts dflags pkgs
framework_paths <-
if platformUsesFrameworks platform
- then do pkgFrameworkPaths <- liftIO $ getPackageFrameworkPath dflags pkgs
+ then do pkgFrameworkPaths <- liftIO $ getUnitFrameworkPath dflags pkgs
let cmdlineFrameworkPaths = frameworkPaths dflags
return $ map ("-F"++)
(cmdlineFrameworkPaths ++ pkgFrameworkPaths)
@@ -1654,7 +1654,7 @@ linkBinary :: DynFlags -> [FilePath] -> [UnitId] -> IO ()
linkBinary = linkBinary' False
linkBinary' :: Bool -> DynFlags -> [FilePath] -> [UnitId] -> IO ()
-linkBinary' staticLink dflags o_files dep_packages = do
+linkBinary' staticLink dflags o_files dep_units = do
let platform = targetPlatform dflags
toolSettings' = toolSettings dflags
verbFlags = getVerbFlags dflags
@@ -1668,7 +1668,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
then return output_fn
else do d <- getCurrentDirectory
return $ normalise (d </> output_fn)
- pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
+ pkg_lib_paths <- getUnitLibraryPath dflags dep_units
let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
get_pkg_lib_path_opts l
| osElfTarget (platformOS platform) &&
@@ -1706,7 +1706,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
pkg_lib_path_opts <-
if gopt Opt_SingleLibFolder dflags
then do
- libs <- getLibs dflags dep_packages
+ libs <- getLibs dflags dep_units
tmpDir <- newTempDir dflags
sequence_ [ copyFile lib (tmpDir </> basename)
| (lib, basename) <- libs]
@@ -1723,7 +1723,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
let lib_path_opts = map ("-L"++) lib_paths
extraLinkObj <- mkExtraObjToLinkIntoBinary dflags
- noteLinkObjs <- mkNoteObjsToLinkIntoBinary dflags dep_packages
+ noteLinkObjs <- mkNoteObjsToLinkIntoBinary dflags dep_units
let
(pre_hs_libs, post_hs_libs)
@@ -1736,7 +1736,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
= ([],[])
pkg_link_opts <- do
- (package_hs_libs, extra_libs, other_flags) <- getPackageLinkOpts dflags dep_packages
+ (package_hs_libs, extra_libs, other_flags) <- getUnitLinkOpts dflags dep_units
return $ if staticLink
then package_hs_libs -- If building an executable really means making a static
-- library (e.g. iOS), then we only keep the -l options for
@@ -1758,7 +1758,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
-- that defines the symbol."
-- frameworks
- pkg_framework_opts <- getPkgFrameworkOpts dflags platform dep_packages
+ pkg_framework_opts <- getUnitFrameworkOpts dflags platform dep_units
let framework_opts = getFrameworkOpts dflags platform
-- probably _stub.o files
@@ -1911,7 +1911,7 @@ maybeCreateManifest dflags exe_filename
linkDynLibCheck :: DynFlags -> [String] -> [UnitId] -> IO ()
-linkDynLibCheck dflags o_files dep_packages
+linkDynLibCheck dflags o_files dep_units
= do
when (haveRtsOptsFlags dflags) $ do
putLogMsg dflags NoReason SevInfo noSrcSpan
@@ -1919,13 +1919,13 @@ linkDynLibCheck dflags o_files dep_packages
(text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$
text " Call hs_init_ghc() from your main() function to set these options.")
- linkDynLib dflags o_files dep_packages
+ linkDynLib dflags o_files dep_units
-- | Linking a static lib will not really link anything. It will merely produce
-- a static archive of all dependent static libraries. The resulting library
-- will still need to be linked with any remaining link flags.
linkStaticLib :: DynFlags -> [String] -> [UnitId] -> IO ()
-linkStaticLib dflags o_files dep_packages = do
+linkStaticLib dflags o_files dep_units = do
let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
modules = o_files ++ extra_ld_inputs
output_fn = exeFileName True dflags
@@ -1937,7 +1937,7 @@ linkStaticLib dflags o_files dep_packages = do
output_exists <- doesFileExist full_output_fn
(when output_exists) $ removeFile full_output_fn
- pkg_cfgs <- getPreloadPackagesAnd dflags dep_packages
+ pkg_cfgs <- getPreloadUnitsAnd dflags dep_units
archives <- concatMapM (collectArchives dflags) pkg_cfgs
ar <- foldl mappend
@@ -1959,7 +1959,7 @@ doCpp dflags raw input_fn output_fn = do
let hscpp_opts = picPOpts dflags
let cmdline_include_paths = includePaths dflags
- pkg_include_dirs <- getPackageIncludePath dflags []
+ pkg_include_dirs <- getUnitIncludePath dflags []
let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
(includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)
let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) []
@@ -2002,8 +2002,8 @@ doCpp dflags raw input_fn output_fn = do
let hsSourceCppOpts = [ "-include", ghcVersionH ]
-- MIN_VERSION macros
- let state = pkgState dflags
- uids = explicitPackages state
+ let state = unitState dflags
+ uids = explicitUnits state
pkgs = catMaybes (map (lookupUnit state) uids)
mb_macro_include <-
if not (null pkgs) && gopt Opt_VersionMacros dflags
@@ -2223,7 +2223,7 @@ getGhcVersionPathName dflags = do
candidates <- case ghcVersionFile dflags of
Just path -> return [path]
Nothing -> (map (</> "ghcversion.h")) <$>
- (getPackageIncludePath dflags [rtsUnitId])
+ (getUnitIncludePath dflags [rtsUnitId])
found <- filterM doesFileExist candidates
case found of
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 9f4c30096e..f301024c9a 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -254,7 +254,7 @@ import GHC.Unit.Module
import {-# SOURCE #-} GHC.Driver.Plugins
import {-# SOURCE #-} GHC.Driver.Hooks
import GHC.Builtin.Names ( mAIN )
-import {-# SOURCE #-} GHC.Unit.State (PackageState, emptyPackageState, PackageDatabase, updateIndefUnitId)
+import {-# SOURCE #-} GHC.Unit.State (PackageState, emptyPackageState, UnitDatabase, updateIndefUnitId)
import GHC.Driver.Phases ( Phase(..), phaseInputExt )
import GHC.Driver.Flags
import GHC.Driver.Ways
@@ -617,7 +617,7 @@ data DynFlags = DynFlags {
-- *reverse* order that they're specified on the command line.
-- This is intended to be applied with the list of "initial"
-- package databases derived from @GHC_PACKAGE_PATH@; see
- -- 'getPackageConfRefs'.
+ -- 'getPackageDbRefs'.
ignorePackageFlags :: [IgnorePackageFlag],
-- ^ The @-ignore-package@ flags from the command line.
@@ -634,21 +634,18 @@ data DynFlags = DynFlags {
packageEnv :: Maybe FilePath,
-- ^ Filepath to the package environment file (if overriding default)
- pkgDatabase :: Maybe [PackageDatabase UnitId],
- -- ^ Stack of package databases for the target platform.
+ unitDatabases :: Maybe [UnitDatabase UnitId],
+ -- ^ Stack of unit databases for the target platform.
--
- -- A "package database" is a misleading name as it is really a Unit
- -- database (cf Note [About Units]).
- --
- -- This field is populated by `initPackages`.
+ -- This field is populated by `initUnits`.
--
-- 'Nothing' means the databases have never been read from disk. If
- -- `initPackages` is called again, it doesn't reload the databases from
+ -- `initUnits` is called again, it doesn't reload the databases from
-- disk.
- pkgState :: PackageState,
- -- ^ Consolidated unit database built by 'initPackages' from the package
- -- databases in 'pkgDatabase' and flags ('-ignore-package', etc.).
+ unitState :: PackageState,
+ -- ^ Consolidated unit database built by 'initUnits' from the unit
+ -- databases in 'unitDatabases' and flags ('-ignore-package', etc.).
--
-- It also contains mapping from module names to actual Modules.
@@ -1379,8 +1376,8 @@ defaultDynFlags mySettings llvmConfig =
ignorePackageFlags = [],
trustFlags = [],
packageEnv = Nothing,
- pkgDatabase = Nothing,
- pkgState = emptyPackageState,
+ unitDatabases = Nothing,
+ unitState = emptyPackageState,
ways = defaultWays mySettings,
buildTag = waysTag (defaultWays mySettings),
splitInfo = Nothing,
@@ -1981,7 +1978,7 @@ homeUnit dflags =
-- modules and the home unit id is the same as the instantiating unit
-- id (see Note [About units] in GHC.Unit)
| all (isHoleModule . snd) is && indefUnit u == homeUnitId dflags
- -> mkVirtUnit (updateIndefUnitId (pkgState dflags) u) is
+ -> mkVirtUnit (updateIndefUnitId (unitState dflags) u) is
-- otherwise it must be that we compile a fully definite units
-- TODO: error when the unit is partially instantiated??
| otherwise
diff --git a/compiler/GHC/Driver/Session.hs-boot b/compiler/GHC/Driver/Session.hs-boot
index e35241aec1..0de689d2da 100644
--- a/compiler/GHC/Driver/Session.hs-boot
+++ b/compiler/GHC/Driver/Session.hs-boot
@@ -9,7 +9,7 @@ data DynFlags
targetPlatform :: DynFlags -> Platform
pprUserLength :: DynFlags -> Int
-pkgState :: DynFlags -> PackageState
+unitState :: DynFlags -> PackageState
unsafeGlobalDynFlags :: DynFlags
hasPprDebug :: DynFlags -> Bool
hasNoDebugOutput :: DynFlags -> Bool
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index 3ddd4b1b26..2dabe1891f 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -903,7 +903,7 @@ data FindResult
-- but the *unit* is hidden
-- | Module is in these units, but it is unusable
- , fr_unusables :: [(Unit, UnusablePackageReason)]
+ , fr_unusables :: [(Unit, UnusableUnitReason)]
, fr_suggestions :: [ModuleSuggestion] -- ^ Possible mis-spelled modules
}
@@ -1957,7 +1957,7 @@ mkPrintUnqualified dflags env = QueryQualify qual_name
(mkQualModule dflags)
(mkQualPackage pkgs)
where
- pkgs = pkgState dflags
+ pkgs = unitState dflags
qual_name mod occ
| [gre] <- unqual_gres
, right_name gre
@@ -2023,7 +2023,7 @@ mkQualModule dflags mod
= False
| otherwise = True
- where lookup = lookupModuleInAllPackages (pkgState dflags) (moduleName mod)
+ where lookup = lookupModuleInAllPackages (unitState dflags) (moduleName mod)
-- | Creates a function for formatting packages based on two heuristics:
-- (1) don't qualify if the package in question is "main", and (2) only qualify
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index c68248744f..f3b0aa44e1 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -215,7 +215,7 @@ mkPluginUsage hsc_env pluginModule
where
dflags = hsc_dflags hsc_env
platform = targetPlatform dflags
- pkgs = pkgState dflags
+ pkgs = unitState dflags
pNm = moduleName $ mi_module pluginModule
pPkg = moduleUnit $ mi_module pluginModule
deps = map gwib_mod $
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 7572a69b6b..37ad1db8fe 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -949,7 +949,7 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
case getModuleInstantiation wanted_mod_with_insts of
(_, Nothing) -> wanted_mod_with_insts
(_, Just indef_mod) ->
- instModuleToModule (pkgState dflags)
+ instModuleToModule (unitState dflags)
(uninstantiateInstantiatedModule indef_mod)
read_result <- readIface wanted_mod file_path
case read_result of
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 5b58457f73..5f10815703 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -403,9 +403,9 @@ checkMergedSignatures mod_summary iface = do
dflags <- getDynFlags
let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ]
new_merged = case Map.lookup (ms_mod_name mod_summary)
- (requirementContext (pkgState dflags)) of
+ (requirementContext (unitState dflags)) of
Nothing -> []
- Just r -> sort $ map (instModuleToModule (pkgState dflags)) r
+ Just r -> sort $ map (instModuleToModule (unitState dflags)) r
if old_merged == new_merged
then up_to_date (text "signatures to merge in unchanged" $$ ppr new_merged)
else return (RecompBecause "signatures to merge in changed")
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 487525f2d3..0c7603c79a 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -164,7 +164,7 @@ rnDepModules sel deps = do
-- not to do it in this case either...)
--
-- This mistake was bug #15594.
- let mod' = renameHoleModule (pkgState dflags) hmap mod
+ let mod' = renameHoleModule (unitState dflags) hmap mod
if isHoleModule mod
then do iface <- liftIO . initIfaceCheck (text "rnDepModule") hsc_env
$ loadSysInterface (text "rnDepModule") mod'
@@ -186,7 +186,7 @@ initRnIface hsc_env iface insts nsubst do_this = do
errs_var <- newIORef emptyBag
let dflags = hsc_dflags hsc_env
hsubst = listToUFM insts
- rn_mod = renameHoleModule (pkgState dflags) hsubst
+ rn_mod = renameHoleModule (unitState dflags) hsubst
env = ShIfEnv {
sh_if_module = rn_mod (mi_module iface),
sh_if_semantic_module = rn_mod (mi_semantic_module iface),
@@ -233,7 +233,7 @@ rnModule :: Rename Module
rnModule mod = do
hmap <- getHoleSubst
dflags <- getDynFlags
- return (renameHoleModule (pkgState dflags) hmap mod)
+ return (renameHoleModule (unitState dflags) hmap mod)
rnAvailInfo :: Rename AvailInfo
rnAvailInfo (Avail n) = Avail <$> rnIfaceGlobal n
@@ -302,7 +302,7 @@ rnIfaceGlobal n = do
mb_nsubst <- fmap sh_if_shape getGblEnv
hmap <- getHoleSubst
let m = nameModule n
- m' = renameHoleModule (pkgState dflags) hmap m
+ m' = renameHoleModule (unitState dflags) hmap m
case () of
-- Did we encounter {A.T} while renaming p[A=<B>]:A? If so,
-- do NOT assume B.hi is available.
@@ -363,7 +363,7 @@ rnIfaceNeverExported name = do
hmap <- getHoleSubst
dflags <- getDynFlags
iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
- let m = renameHoleModule (pkgState dflags) hmap $ nameModule name
+ let m = renameHoleModule (unitState dflags) hmap $ nameModule name
-- Doublecheck that this DFun/coercion axiom was, indeed, locally defined.
MASSERT2( iface_semantic_mod == m, ppr iface_semantic_mod <+> ppr m )
setNameModule (Just m) name
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 7c8612ecb1..68dadc53a4 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -287,7 +287,7 @@ reallyInitDynLinker hsc_env = do
initObjLinker hsc_env
-- (b) Load packages from the command-line (Note [preload packages])
- pls <- linkPackages' hsc_env (preloadPackages (pkgState dflags)) pls0
+ pls <- linkPackages' hsc_env (preloadUnits (unitState dflags)) pls0
-- steps (c), (d) and (e)
linkCmdLineLibs' hsc_env pls
@@ -1251,7 +1251,7 @@ linkPackages' hsc_env new_pks pls = do
return $! pls { pkgs_loaded = pkgs' }
where
dflags = hsc_dflags hsc_env
- pkgstate = pkgState dflags
+ pkgstate = unitState dflags
link :: [UnitId] -> [UnitId] -> IO [UnitId]
link pkgs new_pkgs =
diff --git a/compiler/GHC/SysTools.hs b/compiler/GHC/SysTools.hs
index 04bfea46ce..24a3fefca9 100644
--- a/compiler/GHC/SysTools.hs
+++ b/compiler/GHC/SysTools.hs
@@ -32,7 +32,7 @@ module GHC.SysTools (
libmLinkOpts,
-- * Mac OS X frameworks
- getPkgFrameworkOpts,
+ getUnitFrameworkOpts,
getFrameworkOpts
) where
@@ -247,7 +247,7 @@ linkDynLib dflags0 o_files dep_packages
verbFlags = getVerbFlags dflags
o_file = outputFile dflags
- pkgs <- getPreloadPackagesAnd dflags dep_packages
+ pkgs <- getPreloadUnitsAnd dflags dep_packages
let pkg_lib_paths = collectLibraryPaths dflags pkgs
let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
@@ -285,7 +285,7 @@ linkDynLib dflags0 o_files dep_packages
let extra_ld_inputs = ldInputs dflags
-- frameworks
- pkg_framework_opts <- getPkgFrameworkOpts dflags platform
+ pkg_framework_opts <- getUnitFrameworkOpts dflags platform
(map unitId pkgs)
let framework_opts = getFrameworkOpts dflags platform
@@ -421,15 +421,15 @@ libmLinkOpts =
[]
#endif
-getPkgFrameworkOpts :: DynFlags -> Platform -> [UnitId] -> IO [String]
-getPkgFrameworkOpts dflags platform dep_packages
+getUnitFrameworkOpts :: DynFlags -> Platform -> [UnitId] -> IO [String]
+getUnitFrameworkOpts dflags platform dep_packages
| platformUsesFrameworks platform = do
pkg_framework_path_opts <- do
- pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
+ pkg_framework_paths <- getUnitFrameworkPath dflags dep_packages
return $ map ("-F" ++) pkg_framework_paths
pkg_framework_opts <- do
- pkg_frameworks <- getPackageFrameworks dflags dep_packages
+ pkg_frameworks <- getUnitFrameworks dflags dep_packages
return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
return (pkg_framework_path_opts ++ pkg_framework_opts)
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs
index 789a3ed661..643ccdff18 100644
--- a/compiler/GHC/SysTools/ExtraObj.hs
+++ b/compiler/GHC/SysTools/ExtraObj.hs
@@ -50,7 +50,7 @@ mkExtraObj dflags extn xs
else asmOpts ccInfo)
return oFile
where
- pkgs = pkgState dflags
+ pkgs = unitState dflags
-- Pass a different set of options to the C compiler depending one whether
-- we're compiling C or assembler. When compiling C, we pass the usual
@@ -170,9 +170,9 @@ mkNoteObjsToLinkIntoBinary dflags dep_packages = do
-- See Note [LinkInfo section]
getLinkInfo :: DynFlags -> [UnitId] -> IO String
getLinkInfo dflags dep_packages = do
- package_link_opts <- getPackageLinkOpts dflags dep_packages
+ package_link_opts <- getUnitLinkOpts dflags dep_packages
pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags)
- then getPackageFrameworks dflags dep_packages
+ then getUnitFrameworks dflags dep_packages
else return []
let extra_ld_inputs = ldInputs dflags
let
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 5643ec05fb..87890fa94d 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -274,7 +274,7 @@ findExtraSigImports' hsc_env HsigFile modname =
$ moduleFreeHolesPrecise (text "findExtraSigImports")
(mkModule (VirtUnit iuid) mod_name)))
where
- pkgstate = pkgState (hsc_dflags hsc_env)
+ pkgstate = unitState (hsc_dflags hsc_env)
reqs = requirementMerges pkgstate modname
findExtraSigImports' _ _ _ = return emptyUniqDSet
@@ -535,7 +535,7 @@ mergeSignatures
let outer_mod = tcg_mod tcg_env
inner_mod = tcg_semantic_mod tcg_env
mod_name = moduleName (tcg_mod tcg_env)
- pkgstate = pkgState dflags
+ pkgstate = unitState dflags
-- STEP 1: Figure out all of the external signature interfaces
-- we are going to merge in.
@@ -1005,7 +1005,7 @@ instantiateSignature = do
let uid = fromJust (homeUnitInstanceOfId dflags)
-- we need to fetch the most recent ppr infos from the unit
-- database because we might have modified it
- uid' = updateIndefUnitId (pkgState dflags) uid
+ uid' = updateIndefUnitId (unitState dflags) uid
inner_mod `checkImplements`
Module
(mkInstantiatedUnit uid' (homeUnitInstantiations dflags))
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 887079c63d..9faf23a70c 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -8,14 +8,14 @@ module GHC.Unit.State (
-- * Reading the package config, and processing cmdline args
PackageState(..),
- PackageDatabase (..),
- UnitInfoMap,
+ UnitDatabase (..),
+ ClosureUnitInfoMap,
emptyPackageState,
- initPackages,
- readPackageDatabases,
- readPackageDatabase,
- getPackageConfRefs,
- resolvePackageDatabase,
+ initUnits,
+ readUnitDatabases,
+ readUnitDatabase,
+ getPackageDbRefs,
+ resolveUnitDatabase,
listUnitInfo,
-- * Querying the package config
@@ -37,17 +37,17 @@ module GHC.Unit.State (
LookupResult(..),
ModuleSuggestion(..),
ModuleOrigin(..),
- UnusablePackageReason(..),
+ UnusableUnitReason(..),
pprReason,
-- * Inspecting the set of packages in scope
- getPackageIncludePath,
- getPackageLibraryPath,
- getPackageLinkOpts,
- getPackageExtraCcOpts,
- getPackageFrameworkPath,
- getPackageFrameworks,
- getPreloadPackagesAnd,
+ getUnitIncludePath,
+ getUnitLibraryPath,
+ getUnitLinkOpts,
+ getUnitExtraCcOpts,
+ getUnitFrameworkPath,
+ getUnitFrameworks,
+ getPreloadUnitsAnd,
collectArchives,
collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
@@ -112,7 +112,7 @@ import qualified Data.Set as Set
-- all packages, which packages are exposed, and which modules they
-- provide.
--
--- The package state is computed by 'initPackages', and kept in DynFlags.
+-- The package state is computed by 'initUnits', and kept in DynFlags.
-- It is influenced by various package flags:
--
-- * @-package <pkg>@ and @-package-id <pkg>@ cause @<pkg>@ to become exposed.
@@ -163,7 +163,7 @@ data ModuleOrigin =
-- of these modules.)
ModHidden
-- | Module is unavailable because the package is unusable.
- | ModUnusable UnusablePackageReason
+ | ModUnusable UnusableUnitReason
-- | Module is public, and could have come from some places.
| ModOrigin {
-- | @Just False@ means that this module is in
@@ -245,8 +245,8 @@ originEmpty _ = False
-- | Map from 'UnitId' to 'UnitInfo', plus
-- the transitive closure of preload units.
-data UnitInfoMap = UnitInfoMap
- { unUnitInfoMap :: UniqDFM UnitInfo
+data ClosureUnitInfoMap = ClosureUnitInfoMap
+ { unClosureUnitInfoMap :: UniqDFM UnitInfo
-- ^ Map from 'UnitId' to 'UnitInfo'
, preloadClosure :: UniqSet UnitId
@@ -324,7 +324,7 @@ data PackageState = PackageState {
-- what was stored *on disk*, except for the 'trusted' flag, which
-- is adjusted at runtime. (In particular, some packages in this map
-- may have the 'exposed' flag be 'False'.)
- unitInfoMap :: UnitInfoMap,
+ unitInfoMap :: ClosureUnitInfoMap,
-- | A mapping of 'PackageName' to 'IndefUnitId'. This is used when
-- users refer to packages in Backpack includes.
@@ -337,11 +337,11 @@ data PackageState = PackageState {
-- | The packages we're going to link in eagerly. This list
-- should be in reverse dependency order; that is, a package
-- is always mentioned before the packages it depends on.
- preloadPackages :: [UnitId],
+ preloadUnits :: [UnitId],
-- | Packages which we explicitly depend on (from a command line flag).
-- We'll use this to generate version macros.
- explicitPackages :: [Unit],
+ explicitUnits :: [Unit],
-- | This is a full map from 'ModuleName' to all modules which may possibly
-- be providing it. These providers may be hidden (but we'll still want
@@ -369,28 +369,28 @@ data PackageState = PackageState {
emptyPackageState :: PackageState
emptyPackageState = PackageState {
- unitInfoMap = emptyUnitInfoMap,
+ unitInfoMap = emptyClosureUnitInfoMap,
packageNameMap = Map.empty,
unwireMap = Map.empty,
- preloadPackages = [],
- explicitPackages = [],
+ preloadUnits = [],
+ explicitUnits = [],
moduleNameProvidersMap = Map.empty,
pluginModuleNameProvidersMap = Map.empty,
requirementContext = Map.empty,
allowVirtualUnits = False
}
--- | Package database
-data PackageDatabase unit = PackageDatabase
- { packageDatabasePath :: FilePath
- , packageDatabaseUnits :: [GenUnitInfo unit]
+-- | Unit database
+data UnitDatabase unit = UnitDatabase
+ { unitDatabasePath :: FilePath
+ , unitDatabaseUnits :: [GenUnitInfo unit]
}
-type InstalledPackageIndex = Map UnitId UnitInfo
+type UnitInfoMap = Map UnitId UnitInfo
-- | Empty package configuration map
-emptyUnitInfoMap :: UnitInfoMap
-emptyUnitInfoMap = UnitInfoMap emptyUDFM emptyUniqSet
+emptyClosureUnitInfoMap :: ClosureUnitInfoMap
+emptyClosureUnitInfoMap = ClosureUnitInfoMap emptyUDFM emptyUniqSet
-- | Find the unit we know about with the given unit, if any
lookupUnit :: PackageState -> Unit -> Maybe UnitInfo
@@ -398,14 +398,14 @@ lookupUnit pkgs = lookupUnit' (allowVirtualUnits pkgs) (unitInfoMap pkgs)
-- | A more specialized interface, which takes a boolean specifying
-- whether or not to look for on-the-fly renamed interfaces, and
--- just a 'UnitInfoMap' rather than a 'PackageState' (so it can
+-- just a 'ClosureUnitInfoMap' rather than a 'PackageState' (so it can
-- be used while we're initializing 'DynFlags'
-lookupUnit' :: Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
-lookupUnit' False (UnitInfoMap pkg_map _) uid = lookupUDFM pkg_map uid
-lookupUnit' True m@(UnitInfoMap pkg_map _) uid = case uid of
+lookupUnit' :: Bool -> ClosureUnitInfoMap -> Unit -> Maybe UnitInfo
+lookupUnit' False (ClosureUnitInfoMap pkg_map _) uid = lookupUDFM pkg_map uid
+lookupUnit' True m@(ClosureUnitInfoMap pkg_map _) uid = case uid of
HoleUnit -> error "Hole unit"
RealUnit _ -> lookupUDFM pkg_map uid
- VirtUnit i -> fmap (renamePackage m (instUnitInsts i))
+ VirtUnit i -> fmap (renameUnitInfo m (instUnitInsts i))
(lookupUDFM pkg_map (instUnitInstanceOf i))
-- | Find the unit we know about with the given unit id, if any
@@ -413,8 +413,8 @@ lookupUnitId :: PackageState -> UnitId -> Maybe UnitInfo
lookupUnitId state uid = lookupUnitId' (unitInfoMap state) uid
-- | Find the unit we know about with the given unit id, if any
-lookupUnitId' :: UnitInfoMap -> UnitId -> Maybe UnitInfo
-lookupUnitId' (UnitInfoMap db _) uid = lookupUDFM db uid
+lookupUnitId' :: ClosureUnitInfoMap -> UnitId -> Maybe UnitInfo
+lookupUnitId' (ClosureUnitInfoMap db _) uid = lookupUDFM db uid
-- | Looks up the given unit in the package state, panicing if it is not found
@@ -449,9 +449,9 @@ searchPackageId pkgstate pid = filter ((pid ==) . unitPackageId)
-- We do the same thing for fully indefinite units (which are "instantiated"
-- with module holes).
--
-mkUnitInfoMap :: [UnitInfo] -> UnitInfoMap
-mkUnitInfoMap infos
- = UnitInfoMap (foldl' add emptyUDFM infos) emptyUniqSet
+mkClosureUnitInfoMap :: [UnitInfo] -> UnitInfoMap
+mkClosureUnitInfoMap infos
+ = ClosureUnitInfoMap (foldl' add emptyUDFM infos) emptyUniqSet
where
mkVirt p = mkVirtUnit (unitInstanceOf p) (unitInstantiations p)
add pkg_map p
@@ -467,7 +467,7 @@ mkUnitInfoMap infos
listUnitInfo :: PackageState -> [UnitInfo]
listUnitInfo pkgstate = eltsUDFM pkg_map
where
- UnitInfoMap pkg_map _ = unitInfoMap pkgstate
+ ClosureUnitInfoMap pkg_map _ = unitInfoMap pkgstate
-- ----------------------------------------------------------------------------
-- Loading the package db files and building up the package state
@@ -480,21 +480,21 @@ listUnitInfo pkgstate = eltsUDFM pkg_map
-- This list contains the packages that the user explicitly mentioned with
-- @-package@ flags.
--
--- 'initPackages' can be called again subsequently after updating the
+-- 'initUnits' can be called again subsequently after updating the
-- 'packageFlags' field of the 'DynFlags', and it will update the
--- 'pkgState' in 'DynFlags' and return a list of packages to
+-- 'unitState' in 'DynFlags' and return a list of packages to
-- link in.
-initPackages :: DynFlags -> IO (DynFlags, [UnitId])
-initPackages dflags = withTiming dflags
+initUnits :: DynFlags -> IO (DynFlags, [UnitId])
+initUnits dflags = withTiming dflags
(text "initializing package database")
forcePkgDb $ do
read_pkg_dbs <-
- case pkgDatabase dflags of
- Nothing -> readPackageDatabases dflags
+ case unitDatabases dflags of
+ Nothing -> readUnitDatabases dflags
Just dbs -> return dbs
let
- distrust_all db = db { packageDatabaseUnits = distrustAllUnits (packageDatabaseUnits db) }
+ distrust_all db = db { unitDatabaseUnits = distrustAllUnits (unitDatabaseUnits db) }
pkg_dbs
| gopt Opt_DistrustAllPackages dflags = map distrust_all read_pkg_dbs
@@ -502,25 +502,25 @@ initPackages dflags = withTiming dflags
(pkg_state, preload, insts)
<- mkPackageState dflags pkg_dbs []
- return (dflags{ pkgDatabase = Just read_pkg_dbs,
- pkgState = pkg_state,
+ return (dflags{ unitDatabases = Just read_pkg_dbs,
+ unitState = pkg_state,
homeUnitInstantiations = insts },
preload)
where
- forcePkgDb (dflags, _) = unitInfoMap (pkgState dflags) `seq` ()
+ forcePkgDb (dflags, _) = unitInfoMap (unitState dflags) `seq` ()
-- -----------------------------------------------------------------------------
--- Reading the package database(s)
+-- Reading the unit database(s)
-readPackageDatabases :: DynFlags -> IO [PackageDatabase UnitId]
-readPackageDatabases dflags = do
- conf_refs <- getPackageConfRefs dflags
- confs <- liftM catMaybes $ mapM (resolvePackageDatabase dflags) conf_refs
- mapM (readPackageDatabase dflags) confs
+readUnitDatabases :: DynFlags -> IO [UnitDatabase UnitId]
+readUnitDatabases dflags = do
+ conf_refs <- getPackageDbRefs dflags
+ confs <- liftM catMaybes $ mapM (resolveUnitDatabase dflags) conf_refs
+ mapM (readUnitDatabase dflags) confs
-getPackageConfRefs :: DynFlags -> IO [PkgDbRef]
-getPackageConfRefs dflags = do
+getPackageDbRefs :: DynFlags -> IO [PkgDbRef]
+getPackageDbRefs dflags = do
let system_conf_refs = [UserPkgDb, GlobalPkgDb]
e_pkg_path <- tryIO (getEnv $ map toUpper (programName dflags) ++ "_PACKAGE_PATH")
@@ -559,17 +559,17 @@ getPackageConfRefs dflags = do
-- NB: This logic is reimplemented in Cabal, so if you change it,
-- make sure you update Cabal. (Or, better yet, dump it in the
-- compiler info so Cabal can use the info.)
-resolvePackageDatabase :: DynFlags -> PkgDbRef -> IO (Maybe FilePath)
-resolvePackageDatabase dflags GlobalPkgDb = return $ Just (globalPackageDatabasePath dflags)
-resolvePackageDatabase dflags UserPkgDb = runMaybeT $ do
+resolveUnitDatabase :: DynFlags -> PkgDbRef -> IO (Maybe FilePath)
+resolveUnitDatabase dflags GlobalPkgDb = return $ Just (globalPackageDatabasePath dflags)
+resolveUnitDatabase dflags UserPkgDb = runMaybeT $ do
dir <- versionedAppDir dflags
let pkgconf = dir </> "package.conf.d"
exist <- tryMaybeT $ doesDirectoryExist pkgconf
if exist then return pkgconf else mzero
-resolvePackageDatabase _ (PkgDbPath name) = return $ Just name
+resolveUnitDatabase _ (PkgDbPath name) = return $ Just name
-readPackageDatabase :: DynFlags -> FilePath -> IO (PackageDatabase UnitId)
-readPackageDatabase dflags conf_file = do
+readUnitDatabase :: DynFlags -> FilePath -> IO (UnitDatabase UnitId)
+readUnitDatabase dflags conf_file = do
isdir <- doesDirectoryExist conf_file
proto_pkg_configs <-
@@ -598,7 +598,7 @@ readPackageDatabase dflags conf_file = do
pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . mapUnitInfo (\(UnitKey x) -> UnitId x) unitIdFS . mkUnitKeyInfo)
proto_pkg_configs
--
- return $ PackageDatabase conf_file' pkg_configs1
+ return $ UnitDatabase conf_file' pkg_configs1
where
readDirStyleUnitInfo conf_dir = do
let filename = conf_dir </> "package.cache"
@@ -675,8 +675,8 @@ mungeDynLibFields pkg =
applyTrustFlag
:: DynFlags
- -> PackagePrecedenceIndex
- -> UnusablePackages
+ -> UnitPrecedenceMap
+ -> UnusableUnits
-> [UnitInfo]
-> TrustFlag
-> IO [UnitInfo]
@@ -707,9 +707,9 @@ homeUnitIsDefinite dflags = unitIsDefinite (homeUnit dflags)
applyPackageFlag
:: DynFlags
- -> PackagePrecedenceIndex
- -> UnitInfoMap
- -> UnusablePackages
+ -> UnitPrecedenceMap
+ -> ClosureUnitInfoMap
+ -> UnusableUnits
-> Bool -- if False, if you expose a package, it implicitly hides
-- any previously exposed packages with the same name
-> [UnitInfo]
@@ -792,10 +792,10 @@ applyPackageFlag dflags prec_map pkg_db unusable no_hide_others pkgs vm flag =
-- | Like 'selectPackages', but doesn't return a list of unmatched
-- packages. Furthermore, any packages it returns are *renamed*
-- if the 'UnitArg' has a renaming associated with it.
-findPackages :: PackagePrecedenceIndex
- -> UnitInfoMap -> PackageArg -> [UnitInfo]
- -> UnusablePackages
- -> Either [(UnitInfo, UnusablePackageReason)]
+findPackages :: UnitPrecedenceMap
+ -> ClosureUnitInfoMap -> PackageArg -> [UnitInfo]
+ -> UnusableUnits
+ -> Either [(UnitInfo, UnusableUnitReason)]
[UnitInfo]
findPackages prec_map pkg_db arg pkgs unusable
= let ps = mapMaybe (finder arg) pkgs
@@ -815,12 +815,12 @@ findPackages prec_map pkg_db arg pkgs unusable
-> Just p
VirtUnit inst
| indefUnit (instUnitInstanceOf inst) == unitId p
- -> Just (renamePackage pkg_db (instUnitInsts inst) p)
+ -> Just (renameUnitInfo pkg_db (instUnitInsts inst) p)
_ -> Nothing
-selectPackages :: PackagePrecedenceIndex -> PackageArg -> [UnitInfo]
- -> UnusablePackages
- -> Either [(UnitInfo, UnusablePackageReason)]
+selectPackages :: UnitPrecedenceMap -> PackageArg -> [UnitInfo]
+ -> UnusableUnits
+ -> Either [(UnitInfo, UnusableUnitReason)]
([UnitInfo], [UnitInfo])
selectPackages prec_map arg pkgs unusable
= let matches = matching arg
@@ -830,9 +830,8 @@ selectPackages prec_map arg pkgs unusable
else Right (sortByPreference prec_map ps, rest)
-- | Rename a 'UnitInfo' according to some module instantiation.
-renamePackage :: UnitInfoMap -> [(ModuleName, Module)]
- -> UnitInfo -> UnitInfo
-renamePackage pkg_map insts conf =
+renameUnitInfo :: ClosureUnitInfoMap -> [(ModuleName, Module)] -> UnitInfo -> UnitInfo
+renameUnitInfo pkg_map insts conf =
let hsubst = listToUFM insts
smod = renameHoleModule' pkg_map hsubst
new_insts = map (\(k,v) -> (k,smod v)) (unitInstantiations conf)
@@ -860,7 +859,7 @@ matching (UnitIdArg _) = \_ -> False -- TODO: warn in this case
-- | This sorts a list of packages, putting "preferred" packages first.
-- See 'compareByPreference' for the semantics of "preference".
-sortByPreference :: PackagePrecedenceIndex -> [UnitInfo] -> [UnitInfo]
+sortByPreference :: UnitPrecedenceMap -> [UnitInfo] -> [UnitInfo]
sortByPreference prec_map = sortBy (flip (compareByPreference prec_map))
-- | Returns 'GT' if @pkg@ should be preferred over @pkg'@ when picking
@@ -882,7 +881,7 @@ sortByPreference prec_map = sortBy (flip (compareByPreference prec_map))
-- the fake @integer-wired-in@ package, see Note [The integer library]
-- in the @GHC.Builtin.Names@ module.
compareByPreference
- :: PackagePrecedenceIndex
+ :: UnitPrecedenceMap
-> UnitInfo
-> UnitInfo
-> Ordering
@@ -915,21 +914,21 @@ comparing f a b = f a `compare` f b
packageFlagErr :: DynFlags
-> PackageFlag
- -> [(UnitInfo, UnusablePackageReason)]
+ -> [(UnitInfo, UnusableUnitReason)]
-> IO a
packageFlagErr dflags flag reasons
= packageFlagErr' dflags (pprFlag flag) reasons
trustFlagErr :: DynFlags
-> TrustFlag
- -> [(UnitInfo, UnusablePackageReason)]
+ -> [(UnitInfo, UnusableUnitReason)]
-> IO a
trustFlagErr dflags flag reasons
= packageFlagErr' dflags (pprTrustFlag flag) reasons
packageFlagErr' :: DynFlags
-> SDoc
- -> [(UnitInfo, UnusablePackageReason)]
+ -> [(UnitInfo, UnusableUnitReason)]
-> IO a
packageFlagErr' dflags flag_doc reasons
= throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err))
@@ -960,7 +959,7 @@ type WiringMap = Map UnitId UnitId
findWiredInPackages
:: DynFlags
- -> PackagePrecedenceIndex
+ -> UnitPrecedenceMap
-> [UnitInfo] -- database
-> VisibilityMap -- info on what packages are visible
-- for wired in selection
@@ -1039,7 +1038,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
where upd_pkg pkg
| Just wiredInUnitId <- Map.lookup (unitId pkg) wiredInMap
= pkg { unitId = wiredInUnitId
- , unitInstanceOf = mkIndefUnitId (pkgState dflags) (unitIdFS wiredInUnitId)
+ , unitInstanceOf = mkIndefUnitId (unitState dflags) (unitIdFS wiredInUnitId)
-- every non instantiated unit is an instance of
-- itself (required by Backpack...)
--
@@ -1092,7 +1091,7 @@ updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap
-- ----------------------------------------------------------------------------
-- | The reason why a package is unusable.
-data UnusablePackageReason
+data UnusableUnitReason
= -- | We ignored it explicitly using @-ignore-package@.
IgnoredWithFlag
-- | This package transitively depends on a package that was never present
@@ -1109,17 +1108,16 @@ data UnusablePackageReason
-- shadowed by an ABI-incompatible package.
| ShadowedDependencies [UnitId]
-instance Outputable UnusablePackageReason where
+instance Outputable UnusableUnitReason where
ppr IgnoredWithFlag = text "[ignored with flag]"
ppr (BrokenDependencies uids) = brackets (text "broken" <+> ppr uids)
ppr (CyclicDependencies uids) = brackets (text "cyclic" <+> ppr uids)
ppr (IgnoredDependencies uids) = brackets (text "ignored" <+> ppr uids)
ppr (ShadowedDependencies uids) = brackets (text "shadowed" <+> ppr uids)
-type UnusablePackages = Map UnitId
- (UnitInfo, UnusablePackageReason)
+type UnusableUnits = Map UnitId (UnitInfo, UnusableUnitReason)
-pprReason :: SDoc -> UnusablePackageReason -> SDoc
+pprReason :: SDoc -> UnusableUnitReason -> SDoc
pprReason pref reason = case reason of
IgnoredWithFlag ->
pref <+> text "ignored due to an -ignore-package flag"
@@ -1146,7 +1144,7 @@ reportCycles dflags sccs = mapM_ report sccs
text "these packages are involved in a cycle:" $$
nest 2 (hsep (map (ppr . unitId) vs))
-reportUnusable :: DynFlags -> UnusablePackages -> IO ()
+reportUnusable :: DynFlags -> UnusableUnits -> IO ()
reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
where
report (ipid, (_, reason)) =
@@ -1164,7 +1162,7 @@ reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
type RevIndex = Map UnitId [UnitId]
-- | Compute the reverse dependency index of a package database.
-reverseDeps :: InstalledPackageIndex -> RevIndex
+reverseDeps :: UnitInfoMap -> RevIndex
reverseDeps db = Map.foldl' go Map.empty db
where
go r pkg = foldl' (go' (unitId pkg)) r (unitDepends pkg)
@@ -1176,8 +1174,8 @@ reverseDeps db = Map.foldl' go Map.empty db
-- Returns the pruned database, as well as a list of 'UnitInfo's
-- that was removed.
removePackages :: [UnitId] -> RevIndex
- -> InstalledPackageIndex
- -> (InstalledPackageIndex, [UnitInfo])
+ -> UnitInfoMap
+ -> (UnitInfoMap, [UnitInfo])
removePackages uids index m = go uids (m,[])
where
go [] (m,pkgs) = (m,pkgs)
@@ -1189,18 +1187,18 @@ removePackages uids index m = go uids (m,[])
| otherwise
= go uids (m,pkgs)
--- | Given a 'UnitInfo' from some 'InstalledPackageIndex',
+-- | Given a 'UnitInfo' from some 'UnitInfoMap',
-- return all entries in 'depends' which correspond to packages
-- that do not exist in the index.
-depsNotAvailable :: InstalledPackageIndex
+depsNotAvailable :: UnitInfoMap
-> UnitInfo
-> [UnitId]
depsNotAvailable pkg_map pkg = filter (not . (`Map.member` pkg_map)) (unitDepends pkg)
--- | Given a 'UnitInfo' from some 'InstalledPackageIndex'
+-- | Given a 'UnitInfo' from some 'UnitInfoMap'
-- return all entries in 'unitAbiDepends' which correspond to packages
-- that do not exist, OR have mismatching ABIs.
-depsAbiMismatch :: InstalledPackageIndex
+depsAbiMismatch :: UnitInfoMap
-> UnitInfo
-> [UnitId]
depsAbiMismatch pkg_map pkg = map fst . filter (not . abiMatch) $ unitAbiDepends pkg
@@ -1214,7 +1212,7 @@ depsAbiMismatch pkg_map pkg = map fst . filter (not . abiMatch) $ unitAbiDepends
-- -----------------------------------------------------------------------------
-- Ignore packages
-ignorePackages :: [IgnorePackageFlag] -> [UnitInfo] -> UnusablePackages
+ignorePackages :: [IgnorePackageFlag] -> [UnitInfo] -> UnusableUnits
ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
where
doit (IgnorePackage str) =
@@ -1235,17 +1233,17 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
-- the command line. We use this mapping to make sure we prefer
-- packages that were defined later on the command line, if there
-- is an ambiguity.
-type PackagePrecedenceIndex = Map UnitId Int
+type UnitPrecedenceMap = Map UnitId Int
-- | Given a list of databases, merge them together, where
-- packages with the same unit id in later databases override
-- earlier ones. This does NOT check if the resulting database
-- makes sense (that's done by 'validateDatabase').
-mergeDatabases :: DynFlags -> [PackageDatabase UnitId]
- -> IO (InstalledPackageIndex, PackagePrecedenceIndex)
+mergeDatabases :: DynFlags -> [UnitDatabase UnitId]
+ -> IO (UnitInfoMap, UnitPrecedenceMap)
mergeDatabases dflags = foldM merge (Map.empty, Map.empty) . zip [1..]
where
- merge (pkg_map, prec_map) (i, PackageDatabase db_path db) = do
+ merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do
debugTraceMsg dflags 2 $
text "loading package database" <+> text db_path
forM_ (Set.toList override_set) $ \pkg ->
@@ -1266,10 +1264,10 @@ mergeDatabases dflags = foldM merge (Map.empty, Map.empty) . zip [1..]
-- Now merge the sets together (NB: in case of duplicate,
-- first argument preferred)
- pkg_map' :: InstalledPackageIndex
+ pkg_map' :: UnitInfoMap
pkg_map' = Map.union db_map pkg_map
- prec_map' :: PackagePrecedenceIndex
+ prec_map' :: UnitPrecedenceMap
prec_map' = Map.union (Map.map (const i) db_map) prec_map
-- | Validates a database, removing unusable packages from it
@@ -1281,8 +1279,8 @@ mergeDatabases dflags = foldM merge (Map.empty, Map.empty) . zip [1..]
-- 3. Apply ignore flags
-- 4. Remove all packages which have deps with mismatching ABIs
--
-validateDatabase :: DynFlags -> InstalledPackageIndex
- -> (InstalledPackageIndex, UnusablePackages, [SCC UnitInfo])
+validateDatabase :: DynFlags -> UnitInfoMap
+ -> (UnitInfoMap, UnusableUnits, [SCC UnitInfo])
validateDatabase dflags pkg_map1 =
(pkg_map5, unusable, sccs)
where
@@ -1335,7 +1333,7 @@ mkPackageState
:: DynFlags
-- initial databases, in the order they were specified on
-- the command line (later databases shadow earlier ones)
- -> [PackageDatabase UnitId]
+ -> [UnitDatabase UnitId]
-> [UnitId] -- preloaded packages
-> IO (PackageState,
[UnitId], -- new packages to preload
@@ -1416,7 +1414,7 @@ mkPackageState dflags dbs preload0 = do
-- or not packages are visible or not)
pkgs1 <- foldM (applyTrustFlag dflags prec_map unusable)
(Map.elems pkg_map2) (reverse (trustFlags dflags))
- let prelim_pkg_db = mkUnitInfoMap pkgs1
+ let prelim_pkg_db = mkClosureUnitInfoMap pkgs1
--
-- Calculate the initial set of units from package databases, prior to any package flags.
@@ -1482,7 +1480,7 @@ mkPackageState dflags dbs preload0 = do
-- package arguments we need to key against the old versions.
--
(pkgs2, wired_map) <- findWiredInPackages dflags prec_map pkgs1 vis_map2
- let pkg_db = mkUnitInfoMap pkgs2
+ let pkg_db = mkClosureUnitInfoMap pkgs2
-- Update the visibility map, so we treat wired packages as visible.
let vis_map = updateVisibilityMap wired_map vis_map2
@@ -1530,7 +1528,7 @@ mkPackageState dflags dbs preload0 = do
where add pn_map p
= Map.insert (unitPackageName p) (unitInstanceOf p) pn_map
- -- The explicitPackages accurately reflects the set of packages we have turned
+ -- The explicitUnits accurately reflects the set of units we have turned
-- on; as such, it also is the only way one can come up with requirements.
-- The requirement context is directly based off of this: we simply
-- look for nested unit IDs that are directly fed holes: the requirements
@@ -1543,21 +1541,21 @@ mkPackageState dflags dbs preload0 = do
let preload2 = preload1
let
- -- add base & rts to the preload packages
- basicLinkedPackages
+ -- add base & rts to the preload units
+ basicLinkedUnits
| gopt Opt_AutoLinkPackages dflags
= fmap (RealUnit . Definite) $
- filter (flip elemUDFM (unUnitInfoMap pkg_db))
+ filter (flip elemUDFM (unClosureUnitInfoMap pkg_db))
[baseUnitId, rtsUnitId]
| otherwise = []
- -- but in any case remove the current package from the set of
- -- preloaded packages so that base/rts does not end up in the
- -- set up preloaded package when we are just building it
+ -- but in any case remove the current unit from the set of
+ -- preloaded units so that base/rts does not end up in the
+ -- set up units package when we are just building it
-- (NB: since this is only relevant for base/rts it doesn't matter
- -- that thisUnitIdInsts_ is not wired yet)
+ -- that homeUnitInstantiations is not wired yet)
--
preload3 = ordNub $ filter (/= homeUnit dflags)
- $ (basicLinkedPackages ++ preload2)
+ $ (basicLinkedUnits ++ preload2)
-- Close the preload packages with their dependencies
dep_preload <- closeDeps dflags pkg_db (zip (map toUnitId preload3) (repeat Nothing))
@@ -1573,8 +1571,8 @@ mkPackageState dflags dbs preload0 = do
-- Force pstate to avoid leaking the dflags passed to mkPackageState
let !pstate = PackageState
- { preloadPackages = dep_preload
- , explicitPackages = explicit_pkgs
+ { preloadUnits = dep_preload
+ , explicitUnits = explicit_pkgs
, unitInfoMap = pkg_db
, moduleNameProvidersMap = mod_map
, pluginModuleNameProvidersMap = mkModuleNameProvidersMap dflags pkg_db plugin_vis_map
@@ -1594,7 +1592,7 @@ mkPackageState dflags dbs preload0 = do
-- that it was recorded as in the package database.
unwireUnit :: DynFlags -> Unit-> Unit
unwireUnit dflags uid@(RealUnit (Definite def_uid)) =
- maybe uid (RealUnit . Definite) (Map.lookup def_uid (unwireMap (pkgState dflags)))
+ maybe uid (RealUnit . Definite) (Map.lookup def_uid (unwireMap (unitState dflags)))
unwireUnit _ uid = uid
-- -----------------------------------------------------------------------------
@@ -1606,7 +1604,7 @@ unwireUnit _ uid = uid
mkModuleNameProvidersMap
:: DynFlags
- -> UnitInfoMap
+ -> ClosureUnitInfoMap
-> VisibilityMap
-> ModuleNameProvidersMap
mkModuleNameProvidersMap dflags pkg_db vis_map =
@@ -1633,7 +1631,7 @@ mkModuleNameProvidersMap dflags pkg_db vis_map =
default_vis = Map.fromList
[ (mkUnit pkg, mempty)
- | pkg <- eltsUDFM (unUnitInfoMap pkg_db)
+ | pkg <- eltsUDFM (unClosureUnitInfoMap pkg_db)
-- Exclude specific instantiations of an indefinite
-- package
, unitIsIndefinite pkg || null (unitInstantiations pkg)
@@ -1689,7 +1687,7 @@ mkModuleNameProvidersMap dflags pkg_db vis_map =
hidden_mods = unitHiddenModules pkg
-- | Make a 'ModuleNameProvidersMap' covering a set of unusable packages.
-mkUnusableModuleNameProvidersMap :: UnusablePackages -> ModuleNameProvidersMap
+mkUnusableModuleNameProvidersMap :: UnusableUnits -> ModuleNameProvidersMap
mkUnusableModuleNameProvidersMap unusables =
Map.foldl' extend_modmap Map.empty unusables
where
@@ -1737,17 +1735,17 @@ mkModMap pkg mod = Map.singleton (mkModule pkg mod)
-- use.
-- | Find all the include directories in these and the preload packages
-getPackageIncludePath :: DynFlags -> [UnitId] -> IO [String]
-getPackageIncludePath dflags pkgs =
- collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
+getUnitIncludePath :: DynFlags -> [UnitId] -> IO [String]
+getUnitIncludePath dflags pkgs =
+ collectIncludeDirs `fmap` getPreloadUnitsAnd dflags pkgs
collectIncludeDirs :: [UnitInfo] -> [FilePath]
collectIncludeDirs ps = ordNub (filter notNull (concatMap unitIncludeDirs ps))
-- | Find all the library paths in these and the preload packages
-getPackageLibraryPath :: DynFlags -> [UnitId] -> IO [String]
-getPackageLibraryPath dflags pkgs =
- collectLibraryPaths dflags `fmap` getPreloadPackagesAnd dflags pkgs
+getUnitLibraryPath :: DynFlags -> [UnitId] -> IO [String]
+getUnitLibraryPath dflags pkgs =
+ collectLibraryPaths dflags `fmap` getPreloadUnitsAnd dflags pkgs
collectLibraryPaths :: DynFlags -> [UnitInfo] -> [FilePath]
collectLibraryPaths dflags = ordNub . filter notNull
@@ -1755,9 +1753,9 @@ collectLibraryPaths dflags = ordNub . filter notNull
-- | Find all the link options in these and the preload packages,
-- returning (package hs lib options, extra library options, other flags)
-getPackageLinkOpts :: DynFlags -> [UnitId] -> IO ([String], [String], [String])
-getPackageLinkOpts dflags pkgs =
- collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
+getUnitLinkOpts :: DynFlags -> [UnitId] -> IO ([String], [String], [String])
+getUnitLinkOpts dflags pkgs =
+ collectLinkOpts dflags `fmap` getPreloadUnitsAnd dflags pkgs
collectLinkOpts :: DynFlags -> [UnitInfo] -> ([String], [String], [String])
collectLinkOpts dflags ps =
@@ -1776,7 +1774,7 @@ collectArchives dflags pc =
getLibs :: DynFlags -> [UnitId] -> IO [(String,String)]
getLibs dflags pkgs = do
- ps <- getPreloadPackagesAnd dflags pkgs
+ ps <- getPreloadUnitsAnd dflags pkgs
fmap concat . forM ps $ \p -> do
let candidates = [ (l </> f, f) | l <- collectLibraryPaths dflags [p]
, f <- (\n -> "lib" ++ n ++ ".a") <$> packageHsLibs dflags p ]
@@ -1837,21 +1835,21 @@ libraryDirsForWay dflags
| otherwise = unitLibraryDirs
-- | Find all the C-compiler options in these and the preload packages
-getPackageExtraCcOpts :: DynFlags -> [UnitId] -> IO [String]
-getPackageExtraCcOpts dflags pkgs = do
- ps <- getPreloadPackagesAnd dflags pkgs
+getUnitExtraCcOpts :: DynFlags -> [UnitId] -> IO [String]
+getUnitExtraCcOpts dflags pkgs = do
+ ps <- getPreloadUnitsAnd dflags pkgs
return (concatMap unitCcOptions ps)
-- | Find all the package framework paths in these and the preload packages
-getPackageFrameworkPath :: DynFlags -> [UnitId] -> IO [String]
-getPackageFrameworkPath dflags pkgs = do
- ps <- getPreloadPackagesAnd dflags pkgs
+getUnitFrameworkPath :: DynFlags -> [UnitId] -> IO [String]
+getUnitFrameworkPath dflags pkgs = do
+ ps <- getPreloadUnitsAnd dflags pkgs
return (ordNub (filter notNull (concatMap unitExtDepFrameworkDirs ps)))
-- | Find all the package frameworks in these and the preload packages
-getPackageFrameworks :: DynFlags -> [UnitId] -> IO [String]
-getPackageFrameworks dflags pkgs = do
- ps <- getPreloadPackagesAnd dflags pkgs
+getUnitFrameworks :: DynFlags -> [UnitId] -> IO [String]
+getUnitFrameworks dflags pkgs = do
+ ps <- getPreloadUnitsAnd dflags pkgs
return (concatMap unitExtDepFrameworks ps)
-- -----------------------------------------------------------------------------
@@ -1974,13 +1972,13 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
listVisibleModuleNames :: DynFlags -> [ModuleName]
listVisibleModuleNames dflags =
- map fst (filter visible (Map.toList (moduleNameProvidersMap (pkgState dflags))))
+ map fst (filter visible (Map.toList (moduleNameProvidersMap (unitState dflags))))
where visible (_, ms) = any originVisible (Map.elems ms)
-- | Find all the 'UnitInfo' in both the preload packages from 'DynFlags' and corresponding to the list of
-- 'UnitInfo's
-getPreloadPackagesAnd :: DynFlags -> [UnitId] -> IO [UnitInfo]
-getPreloadPackagesAnd dflags pkgids0 =
+getPreloadUnitsAnd :: DynFlags -> [UnitId] -> IO [UnitInfo]
+getPreloadUnitsAnd dflags pkgids0 =
let
pkgids = pkgids0 ++
-- An indefinite package will have insts to HOLE,
@@ -1990,9 +1988,9 @@ getPreloadPackagesAnd dflags pkgids0 =
then []
else map (toUnitId . moduleUnit . snd)
(homeUnitInstantiations dflags)
- state = pkgState dflags
+ state = unitState dflags
pkg_map = unitInfoMap state
- preload = preloadPackages state
+ preload = preloadUnits state
pairs = zip pkgids (repeat Nothing)
in do
all_pkgs <- throwErr dflags (foldM (add_package dflags pkg_map) preload pairs)
@@ -2001,7 +1999,7 @@ getPreloadPackagesAnd dflags pkgids0 =
-- Takes a list of packages, and returns the list with dependencies included,
-- in reverse dependency order (a package appears before those it depends on).
closeDeps :: DynFlags
- -> UnitInfoMap
+ -> ClosureUnitInfoMap
-> [(UnitId, Maybe UnitId)]
-> IO [UnitId]
closeDeps dflags pkg_map ps
@@ -2014,14 +2012,14 @@ throwErr dflags m
Succeeded r -> return r
closeDepsErr :: DynFlags
- -> UnitInfoMap
+ -> ClosureUnitInfoMap
-> [(UnitId,Maybe UnitId)]
-> MaybeErr MsgDoc [UnitId]
closeDepsErr dflags pkg_map ps = foldM (add_package dflags pkg_map) [] ps
-- internal helper
add_package :: DynFlags
- -> UnitInfoMap
+ -> ClosureUnitInfoMap
-> [UnitId]
-> (UnitId,Maybe UnitId)
-> MaybeErr MsgDoc [UnitId]
@@ -2120,7 +2118,7 @@ fsPackageName info = fs
-- | Given a fully instantiated 'InstantiatedUnit', improve it into a
-- 'RealUnit' if we can find it in the package database.
-improveUnit :: UnitInfoMap -> Unit -> Unit
+improveUnit :: ClosureUnitInfoMap -> Unit -> Unit
improveUnit _ uid@(RealUnit _) = uid -- short circuit
improveUnit pkg_map uid =
-- Do NOT lookup indefinite ones, they won't be useful!
diff --git a/compiler/GHC/Unit/State.hs-boot b/compiler/GHC/Unit/State.hs-boot
index 01309afb2f..226516b731 100644
--- a/compiler/GHC/Unit/State.hs-boot
+++ b/compiler/GHC/Unit/State.hs-boot
@@ -3,11 +3,11 @@ import GHC.Prelude
import GHC.Data.FastString
import {-# SOURCE #-} GHC.Unit.Types (IndefUnitId, Unit, UnitId)
data PackageState
-data UnitInfoMap
-data PackageDatabase unit
+data ClosureUnitInfoMap
+data UnitDatabase unit
emptyPackageState :: PackageState
mkIndefUnitId :: PackageState -> FastString -> IndefUnitId
displayUnitId :: PackageState -> UnitId -> Maybe String
-improveUnit :: UnitInfoMap -> Unit -> Unit
-unitInfoMap :: PackageState -> UnitInfoMap
+improveUnit :: ClosureUnitInfoMap -> Unit -> Unit
+unitInfoMap :: PackageState -> ClosureUnitInfoMap
updateIndefUnitId :: PackageState -> IndefUnitId -> IndefUnitId
diff --git a/compiler/GHC/Unit/Subst.hs b/compiler/GHC/Unit/Subst.hs
index 3539d5a255..b911edfa80 100644
--- a/compiler/GHC/Unit/Subst.hs
+++ b/compiler/GHC/Unit/Subst.hs
@@ -36,9 +36,9 @@ renameHoleModule state = renameHoleModule' (unitInfoMap state)
renameHoleUnit :: PackageState -> ShHoleSubst -> Unit -> Unit
renameHoleUnit state = renameHoleUnit' (unitInfoMap state)
--- | Like 'renameHoleModule', but requires only 'UnitInfoMap'
+-- | Like 'renameHoleModule', but requires only 'ClosureUnitInfoMap'
-- so it can be used by "Packages".
-renameHoleModule' :: UnitInfoMap -> ShHoleSubst -> Module -> Module
+renameHoleModule' :: ClosureUnitInfoMap -> ShHoleSubst -> Module -> Module
renameHoleModule' pkg_map env m
| not (isHoleModule m) =
let uid = renameHoleUnit' pkg_map env (moduleUnit m)
@@ -47,9 +47,9 @@ renameHoleModule' pkg_map env m
-- NB m = <Blah>, that's what's in scope.
| otherwise = m
--- | Like 'renameHoleUnit, but requires only 'UnitInfoMap'
+-- | Like 'renameHoleUnit, but requires only 'ClosureUnitInfoMap'
-- so it can be used by "Packages".
-renameHoleUnit' :: UnitInfoMap -> ShHoleSubst -> Unit -> Unit
+renameHoleUnit' :: ClosureUnitInfoMap -> ShHoleSubst -> Unit -> Unit
renameHoleUnit' pkg_map env uid =
case uid of
(VirtUnit
@@ -59,7 +59,7 @@ renameHoleUnit' pkg_map env uid =
-> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)
then uid
-- Functorially apply the substitution to the instantiation,
- -- then check the 'UnitInfoMap' to see if there is
+ -- then check the 'ClosureUnitInfoMap' to see if there is
-- a compiled version of this 'InstantiatedUnit' we can improve to.
-- See Note [VirtUnit to RealUnit improvement]
else improveUnit pkg_map $
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 63816d5b09..d752f92884 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -104,7 +104,7 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
import {-# SOURCE #-} GHC.Unit.State (improveUnit, PackageState, unitInfoMap, displayUnitId)
-import {-# SOURCE #-} GHC.Driver.Session (pkgState)
+import {-# SOURCE #-} GHC.Driver.Session (unitState)
---------------------------------------------------------------------
-- MODULES
@@ -525,7 +525,7 @@ instance Outputable UnitId where
ppr uid@(UnitId fs) =
getPprDebug $ \debug ->
sdocWithDynFlags $ \dflags ->
- case displayUnitId (pkgState dflags) uid of
+ case displayUnitId (unitState dflags) uid of
Just str | not debug -> text str
_ -> ftext fs
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 18976c2c88..a17cbe01e1 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -2360,12 +2360,12 @@ isSafeModule m = do
packageTrusted dflags md
| isHomeModule dflags md = True
- | otherwise = unitIsTrusted $ unsafeLookupUnit (pkgState dflags) (moduleUnit md)
+ | otherwise = unitIsTrusted $ unsafeLookupUnit (unitState dflags) (moduleUnit md)
tallyPkgs dflags deps | not (packageTrustOn dflags) = (S.empty, S.empty)
| otherwise = S.partition part deps
where part pkg = unitIsTrusted $ unsafeLookupUnitId pkgstate pkg
- pkgstate = pkgState dflags
+ pkgstate = unitState dflags
-----------------------------------------------------------------------------
-- :browse
@@ -2952,8 +2952,8 @@ newDynFlags interactive_only minus_opts = do
-- and copy the package state to the interactive DynFlags
idflags <- GHC.getInteractiveDynFlags
GHC.setInteractiveDynFlags
- idflags{ pkgState = pkgState dflags2
- , pkgDatabase = pkgDatabase dflags2
+ idflags{ unitState = unitState dflags2
+ , unitDatabases = unitDatabases dflags2
, packageFlags = packageFlags dflags2 }
let ld0length = length $ ldInputs dflags0
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 655b03e7bd..bd2028b70b 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -865,9 +865,9 @@ dumpFastStringStats dflags = do
x `pcntOf` y = int ((x * 100) `quot` y) Outputable.<> char '%'
showPackages, dumpPackages, dumpPackagesSimple :: DynFlags -> IO ()
-showPackages dflags = putStrLn (showSDoc dflags (pprPackages (pkgState dflags)))
-dumpPackages dflags = putMsg dflags (pprPackages (pkgState dflags))
-dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple (pkgState dflags))
+showPackages dflags = putStrLn (showSDoc dflags (pprPackages (unitState dflags)))
+dumpPackages dflags = putMsg dflags (pprPackages (unitState dflags))
+dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple (unitState dflags))
-- -----------------------------------------------------------------------------
-- Frontend plugin support