Commit ed533ec2 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

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.
parent f50c19b8
......@@ -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
......
......@@ -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.
-}
----------------------
......
......@@ -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
......
......@@ -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"
......
......@@ -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
......
......@@ -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
......
......@@ -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 _) = []
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 $
......
......@@ -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
......
......@@ -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")
......
......@@ -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
......
......@@ -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 =
......
......@@ -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)
......
......@@ -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
......
......@@ -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))
......
This diff is collapsed.
......@@ -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
......@@ -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