summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-03-27 10:49:16 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-30 01:56:56 -0400
commit10a2ba90aa6a788677104cc43318c66f46e2e2b0 (patch)
tree86f1cadd79243ef67a7f150c5f074e5aa2115ccf /compiler/GHC
parent2cfc4ab9710c873a55e9a44aac9dacb06ecce36f (diff)
downloadhaskell-10a2ba90aa6a788677104cc43318c66f46e2e2b0.tar.gz
Refactor UnitInfo
* Rename InstalledPackageInfo into GenericUnitInfo The name InstalledPackageInfo is only kept for alleged backward compatibility reason in Cabal. ghc-boot has its own stripped down copy of this datatype but it doesn't need to keep the name. Internally we already use type aliases (UnitInfo in GHC, PackageCacheFormat in ghc-pkg). * Rename UnitInfo fields: add "unit" prefix and fix misleading names * Add comments on every UnitInfo field * Rename SourcePackageId into PackageId "Package" already indicates that it's a "source package". Installed package components are called units. Update Haddock submodule
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Driver/Backpack.hs66
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs4
-rw-r--r--compiler/GHC/Driver/Finder.hs12
-rw-r--r--compiler/GHC/Driver/Main.hs4
-rw-r--r--compiler/GHC/Driver/Make.hs4
-rw-r--r--compiler/GHC/Driver/Packages.hs130
-rw-r--r--compiler/GHC/Driver/Pipeline.hs4
-rw-r--r--compiler/GHC/Driver/Types.hs2
-rw-r--r--compiler/GHC/Runtime/Linker.hs28
-rw-r--r--compiler/GHC/SysTools/ExtraObj.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs2
-rw-r--r--compiler/GHC/Unit/Info.hs94
12 files changed, 176 insertions, 176 deletions
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 4b15a4da9d..2ced161775 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -307,20 +307,20 @@ buildUnit session cid insts lunit = do
let compat_fs = (case cid of ComponentId fs _ -> fs)
compat_pn = PackageName compat_fs
- return InstalledPackageInfo {
+ return GenericUnitInfo {
-- Stub data
- abiHash = "",
- sourcePackageId = SourcePackageId compat_fs,
- packageName = compat_pn,
- packageVersion = makeVersion [0],
+ unitAbiHash = "",
+ unitPackageId = PackageId compat_fs,
+ unitPackageName = compat_pn,
+ unitPackageVersion = makeVersion [0],
unitId = toInstalledUnitId (thisPackage dflags),
- sourceLibName = Nothing,
- componentId = cid,
- instantiatedWith = insts,
+ unitComponentName = Nothing,
+ unitInstanceOf = cid,
+ unitInstantiations = insts,
-- Slight inefficiency here haha
- exposedModules = map (\(m,n) -> (m,Just n)) mods,
- hiddenModules = [], -- TODO: doc only
- depends = case session of
+ unitExposedModules = map (\(m,n) -> (m,Just n)) mods,
+ unitHiddenModules = [], -- TODO: doc only
+ unitDepends = case session of
-- Technically, we should state that we depend
-- on all the indefinite libraries we used to
-- typecheck this. However, this field isn't
@@ -331,29 +331,29 @@ buildUnit session cid insts lunit = do
$ deps ++ [ moduleUnitId mod
| (_, mod) <- insts
, not (isHoleModule mod) ],
- abiDepends = [],
- ldOptions = case session of
- TcSession -> []
- _ -> obj_files,
- importDirs = [ hi_dir ],
- exposed = False,
- indefinite = case session of
- TcSession -> True
- _ -> False,
+ unitAbiDepends = [],
+ unitLinkerOptions = case session of
+ TcSession -> []
+ _ -> obj_files,
+ unitImportDirs = [ hi_dir ],
+ unitIsExposed = False,
+ unitIsIndefinite = case session of
+ TcSession -> True
+ _ -> False,
-- nope
- hsLibraries = [],
- extraLibraries = [],
- extraGHCiLibraries = [],
- libraryDynDirs = [],
- libraryDirs = [],
- frameworks = [],
- frameworkDirs = [],
- ccOptions = [],
- includes = [],
- includeDirs = [],
- haddockInterfaces = [],
- haddockHTMLs = [],
- trusted = False
+ unitLibraries = [],
+ unitExtDepLibsSys = [],
+ unitExtDepLibsGhc = [],
+ unitLibraryDynDirs = [],
+ unitLibraryDirs = [],
+ unitExtDepFrameworks = [],
+ unitExtDepFrameworkDirs = [],
+ unitCcOptions = [],
+ unitIncludes = [],
+ unitIncludeDirs = [],
+ unitHaddockInterfaces = [],
+ unitHaddockHTMLs = [],
+ unitIsTrusted = False
}
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index 7a768db4b9..cba5d1b644 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -135,7 +135,7 @@ outputC dflags filenm cmm_stream packages
--
let rts = getPackageDetails dflags rtsUnitId
- let cc_injects = unlines (map mk_include (includes rts))
+ let cc_injects = unlines (map mk_include (unitIncludes rts))
mk_include h_file =
case h_file of
'"':_{-"-} -> "#include "++h_file
@@ -226,7 +226,7 @@ outputForeignStubs dflags mod location stubs
-- we need the #includes from the rts package for the stub files
let rts_includes =
let rts_pkg = getPackageDetails dflags rtsUnitId in
- concatMap mk_include (includes rts_pkg)
+ concatMap mk_include (unitIncludes rts_pkg)
mk_include i = "#include \"" ++ i ++ "\"\n"
-- wrapper code mentions the ffi_arg type, which comes from ffi.h
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index 1118e764be..5eb00e6dd2 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -373,7 +373,7 @@ findPackageModule_ hsc_env mod pkg_conf =
mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf
- import_dirs = importDirs pkg_conf
+ import_dirs = unitImportDirs pkg_conf
-- we never look for a .hi-boot file in an external package;
-- .hi-boot files only make sense for the home package.
in
@@ -725,11 +725,11 @@ cantFindErr cannot_find _ dflags mod_name find_result
| gopt Opt_BuildingCabalPackage dflags
= let pkg = expectJust "pkg_hidden" (lookupUnit dflags uid)
in text "Perhaps you need to add" <+>
- quotes (ppr (packageName pkg)) <+>
+ quotes (ppr (unitPackageName pkg)) <+>
text "to the build-depends in your .cabal file."
| Just pkg <- lookupUnit dflags uid
= text "You can run" <+>
- quotes (text ":set -package " <> ppr (packageName pkg)) <+>
+ quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
text "to expose it." $$
text "(Note: this unloads all the modules in the current scope.)"
| otherwise = Outputable.empty
@@ -810,9 +810,9 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
looks_like_srcpkgid :: InstalledUnitId -> SDoc
looks_like_srcpkgid pk
- -- Unsafely coerce a unit id FastString into a source package ID
- -- FastString and see if it means anything.
- | (pkg:pkgs) <- searchPackageId pkgstate (SourcePackageId (installedUnitIdFS pk))
+ -- Unsafely coerce a unit id (i.e. an installed package component
+ -- identifier) into a PackageId and see if it means anything.
+ | (pkg:pkgs) <- searchPackageId pkgstate (PackageId (installedUnitIdFS pk))
= parens (text "This unit ID looks like the source package ID;" $$
text "the real unit ID is" <+> quotes (ftext (installedUnitIdFS (unitId pkg))) $$
(if null pkgs then Outputable.empty
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 9199130996..d5c5cfedbc 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1192,7 +1192,7 @@ hscCheckSafe' m l = do
packageTrusted _ Sf_SafeInferred False _ = True
packageTrusted dflags _ _ m
| isHomePkg dflags m = True
- | otherwise = trusted $ getPackageDetails dflags (moduleUnitId m)
+ | otherwise = unitIsTrusted $ getPackageDetails dflags (moduleUnitId m)
lookup' :: Module -> Hsc (Maybe ModIface)
lookup' m = do
@@ -1221,7 +1221,7 @@ checkPkgTrust pkgs = do
dflags <- getDynFlags
let errors = S.foldr go [] pkgs
go pkg acc
- | trusted $ getInstalledPackageDetails (pkgState dflags) pkg
+ | unitIsTrusted $ getInstalledPackageDetails (pkgState dflags) pkg
= acc
| otherwise
= (:acc) $ mkErrMsg dflags noSrcSpan (pkgQual dflags)
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 30e313ea46..dd8d0a217f 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -343,8 +343,8 @@ warnUnusedPackages = do
matchingStr :: String -> UnitInfo -> Bool
matchingStr str p
- = str == sourcePackageIdString p
- || str == packageNameString p
+ = str == unitPackageIdString p
+ || str == unitPackageNameString p
matching :: DynFlags -> PackageArg -> UnitInfo -> Bool
matching _ (PackageArg str) p = matchingStr str p
diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs
index a196467497..345f0dc1ed 100644
--- a/compiler/GHC/Driver/Packages.hs
+++ b/compiler/GHC/Driver/Packages.hs
@@ -423,8 +423,8 @@ lookupPackageName :: PackageState -> PackageName -> Maybe ComponentId
lookupPackageName pkgstate n = Map.lookup n (packageNameMap pkgstate)
-- | Search for packages with a given package ID (e.g. \"foo-0.1\")
-searchPackageId :: PackageState -> SourcePackageId -> [UnitInfo]
-searchPackageId pkgstate pid = filter ((pid ==) . sourcePackageId)
+searchPackageId :: PackageState -> PackageId -> [UnitInfo]
+searchPackageId pkgstate pid = filter ((pid ==) . unitPackageId)
(listUnitInfoMap pkgstate)
-- | Extends the package configuration map with a list of package configs.
@@ -650,7 +650,7 @@ readPackageDatabase dflags conf_file = do
distrustAllUnits :: [UnitInfo] -> [UnitInfo]
distrustAllUnits pkgs = map distrust pkgs
where
- distrust pkg = pkg{ trusted = False }
+ distrust pkg = pkg{ unitIsTrusted = False }
mungeUnitInfo :: FilePath -> FilePath
-> UnitInfo -> UnitInfo
@@ -661,12 +661,10 @@ mungeUnitInfo top_dir pkgroot =
mungeDynLibFields :: UnitInfo -> UnitInfo
mungeDynLibFields pkg =
pkg {
- libraryDynDirs = libraryDynDirs pkg
- `orIfNull` libraryDirs pkg
+ unitLibraryDynDirs = case unitLibraryDynDirs pkg of
+ [] -> unitLibraryDirs pkg
+ ds -> ds
}
- where
- orIfNull [] flags = flags
- orIfNull flags _ = flags
-- TODO: This code is duplicated in utils/ghc-pkg/Main.hs
mungePackagePaths :: FilePath -> FilePath -> UnitInfo -> UnitInfo
@@ -680,13 +678,13 @@ mungePackagePaths :: FilePath -> FilePath -> UnitInfo -> UnitInfo
-- installation (obtained from the -B option).
mungePackagePaths top_dir pkgroot pkg =
pkg {
- importDirs = munge_paths (importDirs pkg),
- includeDirs = munge_paths (includeDirs pkg),
- libraryDirs = munge_paths (libraryDirs pkg),
- libraryDynDirs = munge_paths (libraryDynDirs pkg),
- frameworkDirs = munge_paths (frameworkDirs pkg),
- haddockInterfaces = munge_paths (haddockInterfaces pkg),
- haddockHTMLs = munge_urls (haddockHTMLs pkg)
+ unitImportDirs = munge_paths (unitImportDirs pkg),
+ unitIncludeDirs = munge_paths (unitIncludeDirs pkg),
+ unitLibraryDirs = munge_paths (unitLibraryDirs pkg),
+ unitLibraryDynDirs = munge_paths (unitLibraryDynDirs pkg),
+ unitExtDepFrameworkDirs = munge_paths (unitExtDepFrameworkDirs pkg),
+ unitHaddockInterfaces = munge_paths (unitHaddockInterfaces pkg),
+ unitHaddockHTMLs = munge_urls (unitHaddockHTMLs pkg)
}
where
munge_paths = map munge_path
@@ -738,7 +736,7 @@ applyTrustFlag dflags prec_map unusable pkgs flag =
case selectPackages prec_map (PackageArg str) pkgs unusable of
Left ps -> trustFlagErr dflags flag ps
Right (ps,qs) -> return (map trust ps ++ qs)
- where trust p = p {trusted=True}
+ where trust p = p {unitIsTrusted=True}
DistrustPackage str ->
case selectPackages prec_map (PackageArg str) pkgs unusable of
@@ -851,7 +849,7 @@ findPackages prec_map pkg_db arg pkgs unusable
else Right (sortByPreference prec_map ps)
where
finder (PackageArg str) p
- = if str == sourcePackageIdString p || str == packageNameString p
+ = if str == unitPackageIdString p || str == unitPackageNameString p
then Just p
else Nothing
finder (UnitIdArg uid) p
@@ -879,11 +877,11 @@ renamePackage :: UnitInfoMap -> [(ModuleName, Module)]
renamePackage pkg_map insts conf =
let hsubst = listToUFM insts
smod = renameHoleModule' pkg_map hsubst
- new_insts = map (\(k,v) -> (k,smod v)) (instantiatedWith conf)
+ new_insts = map (\(k,v) -> (k,smod v)) (unitInstantiations conf)
in conf {
- instantiatedWith = new_insts,
- exposedModules = map (\(mod_name, mb_mod) -> (mod_name, fmap smod mb_mod))
- (exposedModules conf)
+ unitInstantiations = new_insts,
+ unitExposedModules = map (\(mod_name, mb_mod) -> (mod_name, fmap smod mb_mod))
+ (unitExposedModules conf)
}
@@ -891,8 +889,8 @@ renamePackage pkg_map insts conf =
-- version, or just the name if it is unambiguous.
matchingStr :: String -> UnitInfo -> Bool
matchingStr str p
- = str == sourcePackageIdString p
- || str == packageNameString p
+ = str == unitPackageIdString p
+ || str == unitPackageNameString p
matchingId :: InstalledUnitId -> UnitInfo -> Bool
matchingId uid p = uid == installedUnitInfoId p
@@ -937,7 +935,7 @@ compareByPreference prec_map pkg pkg'
= compare prec prec'
| otherwise
- = case comparing packageVersion pkg pkg' of
+ = case comparing unitPackageVersion pkg pkg' of
GT -> GT
EQ | Just prec <- Map.lookup (unitId pkg) prec_map
, Just prec' <- Map.lookup (unitId pkg') prec_map
@@ -948,11 +946,11 @@ compareByPreference prec_map pkg pkg'
-> EQ
LT -> LT
- where isIntegerPkg p = packageNameString p `elem`
+ where isIntegerPkg p = unitPackageNameString p `elem`
["integer-simple", "integer-gmp"]
differentIntegerPkgs p p' =
isIntegerPkg p && isIntegerPkg p' &&
- (packageName p /= packageName p')
+ (unitPackageName p /= unitPackageName p')
comparing :: Ord a => (t -> a) -> t -> t -> Ordering
comparing f a b = f a `compare` f b
@@ -1024,8 +1022,8 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
pc `matches` pid
-- See Note [The integer library] in GHC.Builtin.Names
| pid == unitIdString integerUnitId
- = packageNameString pc `elem` ["integer-gmp", "integer-simple"]
- pc `matches` pid = packageNameString pc == pid
+ = unitPackageNameString pc `elem` ["integer-gmp", "integer-simple"]
+ pc `matches` pid = unitPackageNameString pc == pid
-- find which package corresponds to each wired-in package
-- delete any other packages with the same name
@@ -1106,16 +1104,16 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
= let fs = installedUnitIdFS (unDefUnitId wiredInUnitId)
in pkg {
unitId = fsToInstalledUnitId fs,
- componentId = mkComponentId pkgstate fs
+ unitInstanceOf = mkComponentId pkgstate fs
}
| otherwise
= pkg
upd_deps pkg = pkg {
-- temporary harmless DefUnitId invariant violation
- depends = map (unDefUnitId . upd_wired_in wiredInMap . DefUnitId) (depends pkg),
- exposedModules
+ unitDepends = map (unDefUnitId . upd_wired_in wiredInMap . DefUnitId) (unitDepends pkg),
+ unitExposedModules
= map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v))
- (exposedModules pkg)
+ (unitExposedModules pkg)
}
@@ -1230,7 +1228,7 @@ type RevIndex = Map InstalledUnitId [InstalledUnitId]
reverseDeps :: InstalledPackageIndex -> RevIndex
reverseDeps db = Map.foldl' go Map.empty db
where
- go r pkg = foldl' (go' (unitId pkg)) r (depends pkg)
+ go r pkg = foldl' (go' (unitId pkg)) r (unitDepends pkg)
go' from r to = Map.insertWith (++) to [from] r
-- | Given a list of 'InstalledUnitId's to remove, a database,
@@ -1258,19 +1256,19 @@ removePackages uids index m = go uids (m,[])
depsNotAvailable :: InstalledPackageIndex
-> UnitInfo
-> [InstalledUnitId]
-depsNotAvailable pkg_map pkg = filter (not . (`Map.member` pkg_map)) (depends pkg)
+depsNotAvailable pkg_map pkg = filter (not . (`Map.member` pkg_map)) (unitDepends pkg)
-- | Given a 'UnitInfo' from some 'InstalledPackageIndex'
--- return all entries in 'abiDepends' which correspond to packages
+-- return all entries in 'unitAbiDepends' which correspond to packages
-- that do not exist, OR have mismatching ABIs.
depsAbiMismatch :: InstalledPackageIndex
-> UnitInfo
-> [InstalledUnitId]
-depsAbiMismatch pkg_map pkg = map fst . filter (not . abiMatch) $ abiDepends pkg
+depsAbiMismatch pkg_map pkg = map fst . filter (not . abiMatch) $ unitAbiDepends pkg
where
abiMatch (dep_uid, abi)
| Just dep_pkg <- Map.lookup dep_uid pkg_map
- = abiHash dep_pkg == abi
+ = unitAbiHash dep_pkg == abi
| otherwise
= False
@@ -1366,7 +1364,7 @@ validateDatabase dflags pkg_map1 =
unusable_broken = mk_unusable BrokenDependencies depsNotAvailable pkg_map2 broken
-- Find recursive packages
- sccs = stronglyConnComp [ (pkg, unitId pkg, depends pkg)
+ sccs = stronglyConnComp [ (pkg, unitId pkg, unitDepends pkg)
| pkg <- Map.elems pkg_map2 ]
getCyclicSCC (CyclicSCC vs) = map unitId vs
getCyclicSCC (AcyclicSCC _) = []
@@ -1517,7 +1515,7 @@ mkPackageState dflags dbs preload0 = do
-- Note: we NEVER expose indefinite packages by
-- default, because it's almost assuredly not
-- what you want (no mix-in linking has occurred).
- if exposed p && unitIdIsDefinite (packageConfigId p) && mostPreferable p
+ if unitIsExposed p && unitIdIsDefinite (packageConfigId p) && mostPreferable p
then Map.insert (packageConfigId p)
UnitVisibility {
uv_expose_all = True,
@@ -1591,7 +1589,7 @@ mkPackageState dflags dbs preload0 = do
let pkgname_map = foldl' add Map.empty pkgs2
where add pn_map p
- = Map.insert (packageName p) (componentId p) pn_map
+ = Map.insert (unitPackageName p) (unitInstanceOf p) pn_map
-- The explicitPackages accurately reflects the set of packages we have turned
-- on; as such, it also is the only way one can come up with requirements.
@@ -1693,7 +1691,7 @@ mkModuleNameProvidersMap dflags pkg_db vis_map =
| pkg <- eltsUDFM (unUnitInfoMap pkg_db)
-- Exclude specific instantiations of an indefinite
-- package
- , indefinite pkg || null (instantiatedWith pkg)
+ , unitIsIndefinite pkg || null (unitInstantiations pkg)
]
emptyMap = Map.empty
@@ -1742,8 +1740,8 @@ mkModuleNameProvidersMap dflags pkg_db vis_map =
unit_lookup uid = lookupUnit' (isIndefinite dflags) pkg_db uid
`orElse` pprPanic "unit_lookup" (ppr uid)
- exposed_mods = exposedModules pkg
- hidden_mods = hiddenModules pkg
+ exposed_mods = unitExposedModules pkg
+ hidden_mods = unitHiddenModules pkg
-- | Make a 'ModuleNameProvidersMap' covering a set of unusable packages.
mkUnusableModuleNameProvidersMap :: UnusablePackages -> ModuleNameProvidersMap
@@ -1763,8 +1761,8 @@ mkUnusableModuleNameProvidersMap unusables =
get_exposed (mod, Just mod') = (mod, Map.singleton mod' origin)
get_exposed (mod, _) = (mod, mkModMap pkg_id mod origin)
- exposed_mods = exposedModules pkg
- hidden_mods = hiddenModules pkg
+ exposed_mods = unitExposedModules pkg
+ hidden_mods = unitHiddenModules pkg
-- | Add a list of key/value pairs to a nested map.
--
@@ -1799,7 +1797,7 @@ getPackageIncludePath dflags pkgs =
collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
collectIncludeDirs :: [UnitInfo] -> [FilePath]
-collectIncludeDirs ps = ordNub (filter notNull (concatMap includeDirs ps))
+collectIncludeDirs ps = ordNub (filter notNull (concatMap unitIncludeDirs ps))
-- | Find all the library paths in these and the preload packages
getPackageLibraryPath :: DynFlags -> [PreloadUnitId] -> IO [String]
@@ -1820,8 +1818,8 @@ collectLinkOpts :: DynFlags -> [UnitInfo] -> ([String], [String], [String])
collectLinkOpts dflags ps =
(
concatMap (map ("-l" ++) . packageHsLibs dflags) ps,
- concatMap (map ("-l" ++) . extraLibraries) ps,
- concatMap ldOptions ps
+ concatMap (map ("-l" ++) . unitExtDepLibsSys) ps,
+ concatMap unitLinkerOptions ps
)
collectArchives :: DynFlags -> UnitInfo -> IO [FilePath]
collectArchives dflags pc =
@@ -1829,7 +1827,7 @@ collectArchives dflags pc =
| searchPath <- searchPaths
, lib <- libs ]
where searchPaths = ordNub . filter notNull . libraryDirsForWay dflags $ pc
- libs = packageHsLibs dflags pc ++ extraLibraries pc
+ libs = packageHsLibs dflags pc ++ unitExtDepLibsSys pc
getLibs :: DynFlags -> [PreloadUnitId] -> IO [(String,String)]
getLibs dflags pkgs = do
@@ -1840,7 +1838,7 @@ getLibs dflags pkgs = do
filterM (doesFileExist . fst) candidates
packageHsLibs :: DynFlags -> UnitInfo -> [String]
-packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
+packageHsLibs dflags p = map (mkDynName . addSuffix) (unitLibraries p)
where
ways0 = ways dflags
@@ -1887,29 +1885,29 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
expandTag t | null t = ""
| otherwise = '_':t
--- | Either the 'libraryDirs' or 'libraryDynDirs' as appropriate for the way.
+-- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
libraryDirsForWay :: DynFlags -> UnitInfo -> [String]
libraryDirsForWay dflags
- | WayDyn `elem` ways dflags = libraryDynDirs
- | otherwise = libraryDirs
+ | WayDyn `elem` ways dflags = unitLibraryDynDirs
+ | otherwise = unitLibraryDirs
-- | Find all the C-compiler options in these and the preload packages
getPackageExtraCcOpts :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageExtraCcOpts dflags pkgs = do
ps <- getPreloadPackagesAnd dflags pkgs
- return (concatMap ccOptions ps)
+ return (concatMap unitCcOptions ps)
-- | Find all the package framework paths in these and the preload packages
getPackageFrameworkPath :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageFrameworkPath dflags pkgs = do
ps <- getPreloadPackagesAnd dflags pkgs
- return (ordNub (filter notNull (concatMap frameworkDirs ps)))
+ return (ordNub (filter notNull (concatMap unitExtDepFrameworkDirs ps)))
-- | Find all the package frameworks in these and the preload packages
getPackageFrameworks :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageFrameworks dflags pkgs = do
ps <- getPreloadPackagesAnd dflags pkgs
- return (concatMap frameworks ps)
+ return (concatMap unitExtDepFrameworks ps)
-- -----------------------------------------------------------------------------
-- Package Utils
@@ -2095,7 +2093,7 @@ add_package dflags pkg_db ps (p, mb_parent)
missingDependencyMsg mb_parent)
Just pkg -> do
-- Add the package's dependents also
- ps' <- foldM add_unit_key ps (depends pkg)
+ ps' <- foldM add_unit_key ps (unitDepends pkg)
return (p : ps')
where
add_unit_key ps key
@@ -2140,10 +2138,10 @@ mkComponentId pkgstate raw =
case lookupInstalledPackage pkgstate (InstalledUnitId raw) of
Nothing -> ComponentId raw Nothing -- we didn't find the unit at all
Just c -> ComponentId raw $ Just $ ComponentDetails
- (packageNameString c)
- (packageVersion c)
- ((unpackFS . unPackageName) <$> sourceLibName c)
- (sourcePackageIdString c)
+ (unitPackageNameString c)
+ (unitPackageVersion c)
+ ((unpackFS . unPackageName) <$> unitComponentName c)
+ (unitPackageIdString c)
-- | Update component ID details from the database
updateComponentId :: PackageState -> ComponentId -> ComponentId
@@ -2152,7 +2150,7 @@ updateComponentId pkgstate (ComponentId raw _) = mkComponentId pkgstate raw
displayInstalledUnitId :: PackageState -> InstalledUnitId -> Maybe String
displayInstalledUnitId pkgstate uid =
- fmap sourcePackageIdString (lookupInstalledPackage pkgstate uid)
+ fmap unitPackageIdString (lookupInstalledPackage pkgstate uid)
-- | Will the 'Name' come from a dynamically linked package?
isDynLinkName :: Platform -> Module -> Name -> Bool
@@ -2204,8 +2202,8 @@ pprPackagesWith pprIPI pkgstate =
pprPackagesSimple :: PackageState -> SDoc
pprPackagesSimple = pprPackagesWith pprIPI
where pprIPI ipi = let i = installedUnitIdFS (unitId ipi)
- e = if exposed ipi then text "E" else text " "
- t = if trusted ipi then text "T" else text " "
+ e = if unitIsExposed ipi then text "E" else text " "
+ t = if unitIsTrusted ipi then text "T" else text " "
in e <> t <> text " " <> ftext i
-- | Show the mapping of modules to where they come from.
@@ -2220,7 +2218,9 @@ pprModuleMap mod_map =
| otherwise = ppr m' <+> parens (ppr o)
fsPackageName :: UnitInfo -> FastString
-fsPackageName = mkFastString . packageNameString
+fsPackageName info = fs
+ where
+ PackageName fs = unitPackageName info
-- | Given a fully instantiated 'UnitId', improve it into a
-- 'InstalledUnitId' if we can find it in the package database.
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index c13f7aa0dc..0f8f52798b 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -2066,8 +2066,8 @@ generatePackageVersionMacros pkgs = concat
-- Do not add any C-style comments. See #3389.
[ generateMacros "" pkgname version
| pkg <- pkgs
- , let version = packageVersion pkg
- pkgname = map fixchar (packageNameString pkg)
+ , let version = unitPackageVersion pkg
+ pkgname = map fixchar (unitPackageNameString pkg)
]
fixchar :: Char -> Char
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index b4f07618f6..2bddbe8a54 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -2038,7 +2038,7 @@ mkQualPackage dflags uid
= False
| otherwise
= True
- where mb_pkgid = fmap sourcePackageId (lookupUnit dflags uid)
+ where mb_pkgid = fmap unitPackageId (lookupUnit dflags uid)
-- | A function which only qualifies package names if necessary; but
-- qualifies all other identifiers.
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 30be5eca55..574e303e64 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -1260,7 +1260,7 @@ linkPackages' hsc_env new_pks pls = do
| Just pkg_cfg <- lookupInstalledPackage pkgstate new_pkg
= do { -- Link dependents first
- pkgs' <- link pkgs (depends pkg_cfg)
+ pkgs' <- link pkgs (unitDepends pkg_cfg)
-- Now link the package itself
; linkPackage hsc_env pkg_cfg
; return (new_pkg : pkgs') }
@@ -1275,12 +1275,12 @@ linkPackage hsc_env pkg
let dflags = hsc_dflags hsc_env
platform = targetPlatform dflags
is_dyn = interpreterDynamic (hscInterp hsc_env)
- dirs | is_dyn = Packages.libraryDynDirs pkg
- | otherwise = Packages.libraryDirs pkg
+ dirs | is_dyn = Packages.unitLibraryDynDirs pkg
+ | otherwise = Packages.unitLibraryDirs pkg
- let hs_libs = Packages.hsLibraries pkg
+ let hs_libs = Packages.unitLibraries pkg
-- The FFI GHCi import lib isn't needed as
- -- compiler/ghci/Linker.hs + rts/Linker.c link the
+ -- GHC.Runtime.Linker + rts/Linker.c link the
-- interpreted references to FFI to the compiled FFI.
-- We therefore filter it out so that we don't get
-- duplicate symbol errors.
@@ -1294,10 +1294,10 @@ linkPackage hsc_env pkg
-- package file provides an "extra-ghci-libraries" field then we use
-- that instead of the "extra-libraries" field.
extra_libs =
- (if null (Packages.extraGHCiLibraries pkg)
- then Packages.extraLibraries pkg
- else Packages.extraGHCiLibraries pkg)
- ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
+ (if null (Packages.unitExtDepLibsGhc pkg)
+ then Packages.unitExtDepLibsSys pkg
+ else Packages.unitExtDepLibsGhc pkg)
+ ++ [ lib | '-':'l':lib <- Packages.unitLinkerOptions pkg ]
-- See Note [Fork/Exec Windows]
gcc_paths <- getGCCPaths dflags (platformOS platform)
dirs_env <- addEnvPaths "LIBRARY_PATH" dirs
@@ -1322,10 +1322,10 @@ linkPackage hsc_env pkg
pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env
maybePutStr dflags
- ("Loading package " ++ sourcePackageIdString pkg ++ " ... ")
+ ("Loading package " ++ unitPackageIdString pkg ++ " ... ")
-- See comments with partOfGHCi
- when (packageName pkg `notElem` partOfGHCi) $ do
+ when (unitPackageName pkg `notElem` partOfGHCi) $ do
loadFrameworks hsc_env platform pkg
-- See Note [Crash early load_dyn and locateLib]
-- Crash early if can't load any of `known_dlls`
@@ -1352,7 +1352,7 @@ linkPackage hsc_env pkg
if succeeded ok
then maybePutStrLn dflags "done."
else let errmsg = "unable to load package `"
- ++ sourcePackageIdString pkg ++ "'"
+ ++ unitPackageIdString pkg ++ "'"
in throwGhcExceptionIO (InstallationError errmsg)
{-
@@ -1426,8 +1426,8 @@ loadFrameworks :: HscEnv -> Platform -> UnitInfo -> IO ()
loadFrameworks hsc_env platform pkg
= when (platformUsesFrameworks platform) $ mapM_ load frameworks
where
- fw_dirs = Packages.frameworkDirs pkg
- frameworks = Packages.frameworks pkg
+ fw_dirs = Packages.unitExtDepFrameworkDirs pkg
+ frameworks = Packages.unitExtDepFrameworks pkg
load fw = do r <- loadFramework hsc_env fw_dirs fw
case r of
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs
index 0a04860185..652d8cd897 100644
--- a/compiler/GHC/SysTools/ExtraObj.hs
+++ b/compiler/GHC/SysTools/ExtraObj.hs
@@ -55,7 +55,7 @@ mkExtraObj dflags extn xs
-- set of include directories and PIC flags.
cOpts = map Option (picCCOpts dflags)
++ map (FileOption "-I")
- (includeDirs $ getPackageDetails dflags rtsUnitId)
+ (unitIncludeDirs $ getPackageDetails dflags rtsUnitId)
-- When compiling assembler code, we drop the usual C options, and if the
-- compiler is Clang, we add an extra argument to tell Clang to ignore
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 98999e57c8..53d76f7b2a 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -572,7 +572,7 @@ mergeSignatures
isFromSignaturePackage =
let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid))
pkg = getInstalledPackageDetails pkgstate inst_uid
- in null (exposedModules pkg)
+ in null (unitExposedModules pkg)
-- 3(a). Rename the exports according to how the dependency
-- was instantiated. The resulting export list will be accurate
-- except for exports *from the signature itself* (which may
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs
index 7248d84620..80029dcaa5 100644
--- a/compiler/GHC/Unit/Info.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -17,14 +17,14 @@ module GHC.Unit.Info (
-- * The UnitInfo type: information about a unit
UnitInfo,
- InstalledPackageInfo(..),
+ GenericUnitInfo(..),
ComponentId(..),
- SourcePackageId(..),
+ PackageId(..),
PackageName(..),
Version(..),
defaultUnitInfo,
- sourcePackageIdString,
- packageNameString,
+ unitPackageNameString,
+ unitPackageIdString,
pprUnitInfo,
) where
@@ -41,12 +41,12 @@ import GHC.Types.Module as Module
import GHC.Types.Unique
-- -----------------------------------------------------------------------------
--- Our UnitInfo type is the InstalledPackageInfo from ghc-boot,
+-- Our UnitInfo type is the GenericUnitInfo from ghc-boot,
-- which is similar to a subset of the InstalledPackageInfo type from Cabal.
-type UnitInfo = InstalledPackageInfo
+type UnitInfo = GenericUnitInfo
ComponentId
- SourcePackageId
+ PackageId
PackageName
Module.InstalledUnitId
Module.UnitId
@@ -57,70 +57,70 @@ type UnitInfo = InstalledPackageInfo
-- feature, but ghc doesn't currently have convenient support for any
-- other compact string types, e.g. plain ByteString or Text.
-newtype SourcePackageId = SourcePackageId FastString deriving (Eq, Ord)
+newtype PackageId = PackageId FastString deriving (Eq, Ord)
newtype PackageName = PackageName
{ unPackageName :: FastString
}
deriving (Eq, Ord)
-instance BinaryStringRep SourcePackageId where
- fromStringRep = SourcePackageId . mkFastStringByteString
- toStringRep (SourcePackageId s) = bytesFS s
+instance BinaryStringRep PackageId where
+ fromStringRep = PackageId . mkFastStringByteString
+ toStringRep (PackageId s) = bytesFS s
instance BinaryStringRep PackageName where
fromStringRep = PackageName . mkFastStringByteString
toStringRep (PackageName s) = bytesFS s
-instance Uniquable SourcePackageId where
- getUnique (SourcePackageId n) = getUnique n
+instance Uniquable PackageId where
+ getUnique (PackageId n) = getUnique n
instance Uniquable PackageName where
getUnique (PackageName n) = getUnique n
-instance Outputable SourcePackageId where
- ppr (SourcePackageId str) = ftext str
+instance Outputable PackageId where
+ ppr (PackageId str) = ftext str
instance Outputable PackageName where
ppr (PackageName str) = ftext str
defaultUnitInfo :: UnitInfo
-defaultUnitInfo = emptyInstalledPackageInfo
+defaultUnitInfo = emptyGenericUnitInfo
-sourcePackageIdString :: UnitInfo -> String
-sourcePackageIdString pkg = unpackFS str
+unitPackageIdString :: UnitInfo -> String
+unitPackageIdString pkg = unpackFS str
where
- SourcePackageId str = sourcePackageId pkg
+ PackageId str = unitPackageId pkg
-packageNameString :: UnitInfo -> String
-packageNameString pkg = unpackFS str
+unitPackageNameString :: UnitInfo -> String
+unitPackageNameString pkg = unpackFS str
where
- PackageName str = packageName pkg
+ PackageName str = unitPackageName pkg
pprUnitInfo :: UnitInfo -> SDoc
-pprUnitInfo InstalledPackageInfo {..} =
+pprUnitInfo GenericUnitInfo {..} =
vcat [
- field "name" (ppr packageName),
- field "version" (text (showVersion packageVersion)),
+ field "name" (ppr unitPackageName),
+ field "version" (text (showVersion unitPackageVersion)),
field "id" (ppr unitId),
- field "exposed" (ppr exposed),
- field "exposed-modules" (ppr exposedModules),
- field "hidden-modules" (fsep (map ppr hiddenModules)),
- field "trusted" (ppr trusted),
- field "import-dirs" (fsep (map text importDirs)),
- field "library-dirs" (fsep (map text libraryDirs)),
- field "dynamic-library-dirs" (fsep (map text libraryDynDirs)),
- field "hs-libraries" (fsep (map text hsLibraries)),
- field "extra-libraries" (fsep (map text extraLibraries)),
- field "extra-ghci-libraries" (fsep (map text extraGHCiLibraries)),
- field "include-dirs" (fsep (map text includeDirs)),
- field "includes" (fsep (map text includes)),
- field "depends" (fsep (map ppr depends)),
- field "cc-options" (fsep (map text ccOptions)),
- field "ld-options" (fsep (map text ldOptions)),
- field "framework-dirs" (fsep (map text frameworkDirs)),
- field "frameworks" (fsep (map text frameworks)),
- field "haddock-interfaces" (fsep (map text haddockInterfaces)),
- field "haddock-html" (fsep (map text haddockHTMLs))
+ field "exposed" (ppr unitIsExposed),
+ field "exposed-modules" (ppr unitExposedModules),
+ field "hidden-modules" (fsep (map ppr unitHiddenModules)),
+ field "trusted" (ppr unitIsTrusted),
+ field "import-dirs" (fsep (map text unitImportDirs)),
+ field "library-dirs" (fsep (map text unitLibraryDirs)),
+ field "dynamic-library-dirs" (fsep (map text unitLibraryDynDirs)),
+ field "hs-libraries" (fsep (map text unitLibraries)),
+ field "extra-libraries" (fsep (map text unitExtDepLibsSys)),
+ field "extra-ghci-libraries" (fsep (map text unitExtDepLibsGhc)),
+ field "include-dirs" (fsep (map text unitIncludeDirs)),
+ field "includes" (fsep (map text unitIncludes)),
+ field "depends" (fsep (map ppr unitDepends)),
+ field "cc-options" (fsep (map text unitCcOptions)),
+ field "ld-options" (fsep (map text unitLinkerOptions)),
+ field "framework-dirs" (fsep (map text unitExtDepFrameworkDirs)),
+ field "frameworks" (fsep (map text unitExtDepFrameworks)),
+ field "haddock-interfaces" (fsep (map text unitHaddockInterfaces)),
+ field "haddock-html" (fsep (map text unitHaddockHTMLs))
]
where
field name body = text name <> colon <+> nest 4 body
@@ -142,13 +142,13 @@ installedUnitInfoId = unitId
packageConfigId :: UnitInfo -> UnitId
packageConfigId p =
- if indefinite p
- then newUnitId (componentId p) (instantiatedWith p)
+ if unitIsIndefinite p
+ then newUnitId (unitInstanceOf p) (unitInstantiations p)
else DefiniteUnitId (DefUnitId (unitId p))
expandedUnitInfoId :: UnitInfo -> UnitId
expandedUnitInfoId p =
- newUnitId (componentId p) (instantiatedWith p)
+ newUnitId (unitInstanceOf p) (unitInstantiations p)
definiteUnitInfoId :: UnitInfo -> Maybe DefUnitId
definiteUnitInfoId p =
View Lorry Controller Status