summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-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
-rw-r--r--ghc/GHCi/UI.hs6
-rw-r--r--libraries/ghc-boot/GHC/PackageDb.hs467
-rw-r--r--utils/ghc-pkg/Main.hs68
m---------utils/haddock0
16 files changed, 502 insertions, 391 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 =
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 46fe4fb4a5..0da9741f30 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -57,7 +57,7 @@ import GHC.Driver.Types ( tyThingParent_maybe, handleFlagWarnings, getSafeMode,
hsc_dynLinker, hsc_interp )
import GHC.Types.Module
import GHC.Types.Name
-import GHC.Driver.Packages ( trusted, getPackageDetails, getInstalledPackageDetails,
+import GHC.Driver.Packages ( unitIsTrusted, getPackageDetails, getInstalledPackageDetails,
listVisibleModuleNames, pprFlag )
import GHC.Iface.Syntax ( showToHeader )
import GHC.Core.Ppr.TyThing
@@ -2341,11 +2341,11 @@ isSafeModule m = do
packageTrusted dflags md
| thisPackage dflags == moduleUnitId md = True
- | otherwise = trusted $ getPackageDetails dflags (moduleUnitId md)
+ | otherwise = unitIsTrusted $ getPackageDetails dflags (moduleUnitId md)
tallyPkgs dflags deps | not (packageTrustOn dflags) = (S.empty, S.empty)
| otherwise = S.partition part deps
- where part pkg = trusted $ getInstalledPackageDetails pkgstate pkg
+ where part pkg = unitIsTrusted $ getInstalledPackageDetails pkgstate pkg
pkgstate = pkgState dflags
-----------------------------------------------------------------------------
diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs
index 3382cf3025..b0d7a179cb 100644
--- a/libraries/ghc-boot/GHC/PackageDb.hs
+++ b/libraries/ghc-boot/GHC/PackageDb.hs
@@ -46,23 +46,27 @@
-- is kept in the file but here we treat it as an opaque blob of data. That way
-- this library avoids depending on Cabal.
--
-module GHC.PackageDb (
- InstalledPackageInfo(..),
- DbModule(..),
- DbUnitId(..),
- BinaryStringRep(..),
- DbUnitIdModuleRep(..),
- emptyInstalledPackageInfo,
- PackageDbLock,
- lockPackageDb,
- unlockPackageDb,
- DbMode(..),
- DbOpenMode(..),
- isDbOpenReadMode,
- readPackageDbForGhc,
- readPackageDbForGhcPkg,
- writePackageDb
- ) where
+module GHC.PackageDb
+ ( GenericUnitInfo(..)
+ , emptyGenericUnitInfo
+ -- * Read and write
+ , DbMode(..)
+ , DbOpenMode(..)
+ , isDbOpenReadMode
+ , readPackageDbForGhc
+ , readPackageDbForGhcPkg
+ , writePackageDb
+ -- * Locking
+ , PackageDbLock
+ , lockPackageDb
+ , unlockPackageDb
+ -- * Misc
+ , DbModule(..)
+ , DbUnitId(..)
+ , BinaryStringRep(..)
+ , DbUnitIdModuleRep(..)
+ )
+where
import Prelude -- See note [Why do we import Prelude here?]
import Data.Version (Version(..))
@@ -85,49 +89,155 @@ import GHC.IO.Handle.Lock
import System.Directory
--- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits
--- that GHC is interested in. See Cabal's documentation for a more detailed
--- description of all of the fields.
+-- | Information about an unit (a unit is an installed module library).
--
-data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod
- = InstalledPackageInfo {
- unitId :: instunitid,
- componentId :: compid,
- instantiatedWith :: [(modulename, mod)],
- sourcePackageId :: srcpkgid,
- packageName :: srcpkgname,
- packageVersion :: Version,
- sourceLibName :: Maybe srcpkgname,
- abiHash :: String,
- depends :: [instunitid],
- -- | Like 'depends', but each dependency is annotated with the
- -- ABI hash we expect the dependency to respect.
- abiDepends :: [(instunitid, String)],
- importDirs :: [FilePath],
- hsLibraries :: [String],
- extraLibraries :: [String],
- extraGHCiLibraries :: [String],
- libraryDirs :: [FilePath],
- libraryDynDirs :: [FilePath],
- frameworks :: [String],
- frameworkDirs :: [FilePath],
- ldOptions :: [String],
- ccOptions :: [String],
- includes :: [String],
- includeDirs :: [FilePath],
- haddockInterfaces :: [FilePath],
- haddockHTMLs :: [FilePath],
- exposedModules :: [(modulename, Maybe mod)],
- hiddenModules :: [modulename],
- indefinite :: Bool,
- exposed :: Bool,
- trusted :: Bool
- }
- deriving (Eq, Show)
+-- This is a subset of Cabal's 'InstalledPackageInfo', with just the bits
+-- that GHC is interested in.
+--
+-- Some types are left as parameters to be instantiated differently in ghc-pkg
+-- and in ghc itself.
+--
+data GenericUnitInfo compid srcpkgid srcpkgname instunitid unitid modulename mod = GenericUnitInfo
+ { unitId :: instunitid
+ -- ^ Unique unit identifier that is used during compilation (e.g. to
+ -- generate symbols).
+
+ , unitInstanceOf :: compid
+ -- ^ Identifier of an indefinite unit (i.e. with module holes) that this
+ -- unit is an instance of.
+
+ , unitInstantiations :: [(modulename, mod)]
+ -- ^ How this unit instantiates some of its module holes. Map hole module
+ -- names to actual module
+
+ , unitPackageId :: srcpkgid
+ -- ^ Source package identifier.
+ --
+ -- Cabal instantiates this with Distribution.Types.PackageId.PackageId
+ -- type which only contains the source package name and version. Notice
+ -- that it doesn't contain the Hackage revision, nor any kind of hash.
+
+ , unitPackageName :: srcpkgname
+ -- ^ Source package name
+
+ , unitPackageVersion :: Version
+ -- ^ Source package version
+
+ , unitComponentName :: Maybe srcpkgname
+ -- ^ Name of the component.
+ --
+ -- Cabal supports more than one components (libraries, executables,
+ -- testsuites) in the same package. Each component has a name except the
+ -- default one (that can only be a library component) for which we use
+ -- "Nothing".
+ --
+ -- GHC only deals with "library" components as they are the only kind of
+ -- components that can be registered in a database and used by other
+ -- modules.
+
+ , unitAbiHash :: String
+ -- ^ ABI hash used to avoid mixing up units compiled with different
+ -- dependencies, compiler, options, etc.
+
+ , unitDepends :: [instunitid]
+ -- ^ Identifiers of the units this one depends on
+
+ , unitAbiDepends :: [(instunitid, String)]
+ -- ^ Like 'unitDepends', but each dependency is annotated with the ABI hash
+ -- we expect the dependency to respect.
+
+ , unitImportDirs :: [FilePath]
+ -- ^ Directories containing module interfaces
+
+ , unitLibraries :: [String]
+ -- ^ Names of the Haskell libraries provided by this unit
+
+ , unitExtDepLibsSys :: [String]
+ -- ^ Names of the external system libraries that this unit depends on. See
+ -- also `unitExtDepLibsGhc` field.
+
+ , unitExtDepLibsGhc :: [String]
+ -- ^ Because of slight differences between the GHC dynamic linker (in
+ -- GHC.Runtime.Linker) and the
+ -- native system linker, some packages have to link with a different list
+ -- of libraries when using GHC's. Examples include: libs that are actually
+ -- gnu ld scripts, and the possibility that the .a libs do not exactly
+ -- match the .so/.dll equivalents.
+ --
+ -- If this field is set, then we use that instead of the
+ -- `unitExtDepLibsSys` field.
+
+ , unitLibraryDirs :: [FilePath]
+ -- ^ Directories containing libraries provided by this unit. See also
+ -- `unitLibraryDynDirs`.
+ --
+ -- It seems to be used to store paths to external library dependencies
+ -- too.
+
+ , unitLibraryDynDirs :: [FilePath]
+ -- ^ Directories containing the dynamic libraries provided by this unit.
+ -- See also `unitLibraryDirs`.
+ --
+ -- It seems to be used to store paths to external dynamic library
+ -- dependencies too.
+
+ , unitExtDepFrameworks :: [String]
+ -- ^ Names of the external MacOS frameworks that this unit depends on.
+
+ , unitExtDepFrameworkDirs :: [FilePath]
+ -- ^ Directories containing MacOS frameworks that this unit depends
+ -- on.
+
+ , unitLinkerOptions :: [String]
+ -- ^ Linker (e.g. ld) command line options
+
+ , unitCcOptions :: [String]
+ -- ^ C compiler options that needs to be passed to the C compiler when we
+ -- compile some C code against this unit.
+
+ , unitIncludes :: [String]
+ -- ^ C header files that are required by this unit (provided by this unit
+ -- or external)
+
+ , unitIncludeDirs :: [FilePath]
+ -- ^ Directories containing C header files that this unit depends
+ -- on.
+
+ , unitHaddockInterfaces :: [FilePath]
+ -- ^ Paths to Haddock interface files for this unit
+
+ , unitHaddockHTMLs :: [FilePath]
+ -- ^ Paths to Haddock directories containing HTML files
+
+ , unitExposedModules :: [(modulename, Maybe mod)]
+ -- ^ Modules exposed by the unit.
+ --
+ -- A module can be re-exported from another package. In this case, we
+ -- indicate the module origin in the second parameter.
+
+ , unitHiddenModules :: [modulename]
+ -- ^ Hidden modules.
+ --
+ -- These are useful for error reporting (e.g. if a hidden module is
+ -- imported)
+
+ , unitIsIndefinite :: Bool
+ -- ^ True if this unit has some module holes that need to be instantiated
+ -- with real modules to make the unit usable (a.k.a. Backpack).
+
+ , unitIsExposed :: Bool
+ -- ^ True if the unit is exposed. A unit could be installed in a database
+ -- by "disabled" by not being exposed.
+
+ , unitIsTrusted :: Bool
+ -- ^ True if the unit is trusted (cf Safe Haskell)
+
+ }
+ deriving (Eq, Show)
-- | A convenience constraint synonym for common constraints over parameters
--- to 'InstalledPackageInfo'.
-type RepInstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =
+-- to 'GenericUnitInfo'.
+type RepGenericUnitInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =
(BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,
BinaryStringRep modulename, BinaryStringRep compid,
BinaryStringRep instunitid,
@@ -172,39 +282,39 @@ class BinaryStringRep a where
fromStringRep :: BS.ByteString -> a
toStringRep :: a -> BS.ByteString
-emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d e f g
- => InstalledPackageInfo a b c d e f g
-emptyInstalledPackageInfo =
- InstalledPackageInfo {
- unitId = fromStringRep BS.empty,
- componentId = fromStringRep BS.empty,
- instantiatedWith = [],
- sourcePackageId = fromStringRep BS.empty,
- packageName = fromStringRep BS.empty,
- packageVersion = Version [] [],
- sourceLibName = Nothing,
- abiHash = "",
- depends = [],
- abiDepends = [],
- importDirs = [],
- hsLibraries = [],
- extraLibraries = [],
- extraGHCiLibraries = [],
- libraryDirs = [],
- libraryDynDirs = [],
- frameworks = [],
- frameworkDirs = [],
- ldOptions = [],
- ccOptions = [],
- includes = [],
- includeDirs = [],
- haddockInterfaces = [],
- haddockHTMLs = [],
- exposedModules = [],
- hiddenModules = [],
- indefinite = False,
- exposed = False,
- trusted = False
+emptyGenericUnitInfo :: RepGenericUnitInfo a b c d e f g
+ => GenericUnitInfo a b c d e f g
+emptyGenericUnitInfo =
+ GenericUnitInfo {
+ unitId = fromStringRep BS.empty,
+ unitInstanceOf = fromStringRep BS.empty,
+ unitInstantiations = [],
+ unitPackageId = fromStringRep BS.empty,
+ unitPackageName = fromStringRep BS.empty,
+ unitPackageVersion = Version [] [],
+ unitComponentName = Nothing,
+ unitAbiHash = "",
+ unitDepends = [],
+ unitAbiDepends = [],
+ unitImportDirs = [],
+ unitLibraries = [],
+ unitExtDepLibsSys = [],
+ unitExtDepLibsGhc = [],
+ unitLibraryDirs = [],
+ unitLibraryDynDirs = [],
+ unitExtDepFrameworks = [],
+ unitExtDepFrameworkDirs = [],
+ unitLinkerOptions = [],
+ unitCcOptions = [],
+ unitIncludes = [],
+ unitIncludeDirs = [],
+ unitHaddockInterfaces = [],
+ unitHaddockHTMLs = [],
+ unitExposedModules = [],
+ unitHiddenModules = [],
+ unitIsIndefinite = False,
+ unitIsExposed = False,
+ unitIsTrusted = False
}
-- | Represents a lock of a package db.
@@ -284,8 +394,8 @@ isDbOpenReadMode = \case
-- | Read the part of the package DB that GHC is interested in.
--
-readPackageDbForGhc :: RepInstalledPackageInfo a b c d e f g =>
- FilePath -> IO [InstalledPackageInfo a b c d e f g]
+readPackageDbForGhc :: RepGenericUnitInfo a b c d e f g =>
+ FilePath -> IO [GenericUnitInfo a b c d e f g]
readPackageDbForGhc file =
decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case
(pkgs, DbOpenReadOnly) -> return pkgs
@@ -323,8 +433,8 @@ readPackageDbForGhcPkg file mode =
-- | Write the whole of the package DB, both parts.
--
-writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d e f g) =>
- FilePath -> [InstalledPackageInfo a b c d e f g] ->
+writePackageDb :: (Binary pkgs, RepGenericUnitInfo a b c d e f g) =>
+ FilePath -> [GenericUnitInfo a b c d e f g] ->
pkgs -> IO ()
writePackageDb file ghcPkgs ghcPkgPart =
writeFileAtomic file (runPut putDbForGhcPkg)
@@ -430,106 +540,107 @@ writeFileAtomic targetPath content = do
hClose handle
renameFile tmpPath targetPath)
-instance (RepInstalledPackageInfo a b c d e f g) =>
- Binary (InstalledPackageInfo a b c d e f g) where
- put (InstalledPackageInfo
- unitId componentId instantiatedWith sourcePackageId
- packageName packageVersion
- sourceLibName
- abiHash depends abiDepends importDirs
- hsLibraries extraLibraries extraGHCiLibraries
- libraryDirs libraryDynDirs
- frameworks frameworkDirs
- ldOptions ccOptions
- includes includeDirs
- haddockInterfaces haddockHTMLs
- exposedModules hiddenModules
- indefinite exposed trusted) = do
- put (toStringRep sourcePackageId)
- put (toStringRep packageName)
- put packageVersion
- put (fmap toStringRep sourceLibName)
+instance (RepGenericUnitInfo a b c d e f g) =>
+ Binary (GenericUnitInfo a b c d e f g) where
+ put (GenericUnitInfo
+ unitId unitInstanceOf unitInstantiations
+ unitPackageId
+ unitPackageName unitPackageVersion
+ unitComponentName
+ unitAbiHash unitDepends unitAbiDepends unitImportDirs
+ unitLibraries unitExtDepLibsSys unitExtDepLibsGhc
+ unitLibraryDirs unitLibraryDynDirs
+ unitExtDepFrameworks unitExtDepFrameworkDirs
+ unitLinkerOptions unitCcOptions
+ unitIncludes unitIncludeDirs
+ unitHaddockInterfaces unitHaddockHTMLs
+ unitExposedModules unitHiddenModules
+ unitIsIndefinite unitIsExposed unitIsTrusted) = do
+ put (toStringRep unitPackageId)
+ put (toStringRep unitPackageName)
+ put unitPackageVersion
+ put (fmap toStringRep unitComponentName)
put (toStringRep unitId)
- put (toStringRep componentId)
+ put (toStringRep unitInstanceOf)
put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))
- instantiatedWith)
- put abiHash
- put (map toStringRep depends)
- put (map (\(k,v) -> (toStringRep k, v)) abiDepends)
- put importDirs
- put hsLibraries
- put extraLibraries
- put extraGHCiLibraries
- put libraryDirs
- put libraryDynDirs
- put frameworks
- put frameworkDirs
- put ldOptions
- put ccOptions
- put includes
- put includeDirs
- put haddockInterfaces
- put haddockHTMLs
+ unitInstantiations)
+ put unitAbiHash
+ put (map toStringRep unitDepends)
+ put (map (\(k,v) -> (toStringRep k, v)) unitAbiDepends)
+ put unitImportDirs
+ put unitLibraries
+ put unitExtDepLibsSys
+ put unitExtDepLibsGhc
+ put unitLibraryDirs
+ put unitLibraryDynDirs
+ put unitExtDepFrameworks
+ put unitExtDepFrameworkDirs
+ put unitLinkerOptions
+ put unitCcOptions
+ put unitIncludes
+ put unitIncludeDirs
+ put unitHaddockInterfaces
+ put unitHaddockHTMLs
put (map (\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))
- exposedModules)
- put (map toStringRep hiddenModules)
- put indefinite
- put exposed
- put trusted
+ unitExposedModules)
+ put (map toStringRep unitHiddenModules)
+ put unitIsIndefinite
+ put unitIsExposed
+ put unitIsTrusted
get = do
- sourcePackageId <- get
- packageName <- get
- packageVersion <- get
- sourceLibName <- get
+ unitPackageId <- get
+ unitPackageName <- get
+ unitPackageVersion <- get
+ unitComponentName <- get
unitId <- get
- componentId <- get
- instantiatedWith <- get
- abiHash <- get
- depends <- get
- abiDepends <- get
- importDirs <- get
- hsLibraries <- get
- extraLibraries <- get
- extraGHCiLibraries <- get
+ unitInstanceOf <- get
+ unitInstantiations <- get
+ unitAbiHash <- get
+ unitDepends <- get
+ unitAbiDepends <- get
+ unitImportDirs <- get
+ unitLibraries <- get
+ unitExtDepLibsSys <- get
+ unitExtDepLibsGhc <- get
libraryDirs <- get
libraryDynDirs <- get
frameworks <- get
frameworkDirs <- get
- ldOptions <- get
- ccOptions <- get
- includes <- get
- includeDirs <- get
- haddockInterfaces <- get
- haddockHTMLs <- get
- exposedModules <- get
- hiddenModules <- get
- indefinite <- get
- exposed <- get
- trusted <- get
- return (InstalledPackageInfo
+ unitLinkerOptions <- get
+ unitCcOptions <- get
+ unitIncludes <- get
+ unitIncludeDirs <- get
+ unitHaddockInterfaces <- get
+ unitHaddockHTMLs <- get
+ unitExposedModules <- get
+ unitHiddenModules <- get
+ unitIsIndefinite <- get
+ unitIsExposed <- get
+ unitIsTrusted <- get
+ return (GenericUnitInfo
(fromStringRep unitId)
- (fromStringRep componentId)
+ (fromStringRep unitInstanceOf)
(map (\(mod_name, mod) -> (fromStringRep mod_name, fromDbModule mod))
- instantiatedWith)
- (fromStringRep sourcePackageId)
- (fromStringRep packageName) packageVersion
- (fmap fromStringRep sourceLibName)
- abiHash
- (map fromStringRep depends)
- (map (\(k,v) -> (fromStringRep k, v)) abiDepends)
- importDirs
- hsLibraries extraLibraries extraGHCiLibraries
+ unitInstantiations)
+ (fromStringRep unitPackageId)
+ (fromStringRep unitPackageName) unitPackageVersion
+ (fmap fromStringRep unitComponentName)
+ unitAbiHash
+ (map fromStringRep unitDepends)
+ (map (\(k,v) -> (fromStringRep k, v)) unitAbiDepends)
+ unitImportDirs
+ unitLibraries unitExtDepLibsSys unitExtDepLibsGhc
libraryDirs libraryDynDirs
frameworks frameworkDirs
- ldOptions ccOptions
- includes includeDirs
- haddockInterfaces haddockHTMLs
+ unitLinkerOptions unitCcOptions
+ unitIncludes unitIncludeDirs
+ unitHaddockInterfaces unitHaddockHTMLs
(map (\(mod_name, mb_mod) ->
(fromStringRep mod_name, fmap fromDbModule mb_mod))
- exposedModules)
- (map fromStringRep hiddenModules)
- indefinite exposed trusted)
+ unitExposedModules)
+ (map fromStringRep unitHiddenModules)
+ unitIsIndefinite unitIsExposed unitIsTrusted)
instance (BinaryStringRep modulename, BinaryStringRep compid,
BinaryStringRep instunitid,
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index ed68b3ff04..23ddc5159b 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -1272,7 +1272,7 @@ updateDBCache verbosity db db_stack = do
let definitelyBrokenPackages =
nub
. sort
- . map (unPackageName . GhcPkg.packageName . fst)
+ . map (unPackageName . GhcPkg.unitPackageName . fst)
. filter snd
$ pkgsGhcCacheFormat
when (definitelyBrokenPackages /= []) $ do
@@ -1306,7 +1306,7 @@ updateDBCache verbosity db db_stack = do
case packageDbLock db of
GhcPkg.DbOpenReadWrite lock -> GhcPkg.unlockPackageDb lock
-type PackageCacheFormat = GhcPkg.InstalledPackageInfo
+type PackageCacheFormat = GhcPkg.GenericUnitInfo
ComponentId
PackageIdentifier
PackageName
@@ -1353,49 +1353,49 @@ recomputeValidAbiDeps :: [InstalledPackageInfo]
-> PackageCacheFormat
-> (PackageCacheFormat, Bool)
recomputeValidAbiDeps db pkg =
- (pkg { GhcPkg.abiDepends = newAbiDeps }, abiDepsUpdated)
+ (pkg { GhcPkg.unitAbiDepends = newAbiDeps }, abiDepsUpdated)
where
newAbiDeps =
- catMaybes . flip map (GhcPkg.abiDepends pkg) $ \(k, _) ->
+ catMaybes . flip map (GhcPkg.unitAbiDepends pkg) $ \(k, _) ->
case filter (\d -> installedUnitId d == k) db of
[x] -> Just (k, unAbiHash (abiHash x))
_ -> Nothing
abiDepsUpdated =
- GhcPkg.abiDepends pkg /= newAbiDeps
+ GhcPkg.unitAbiDepends pkg /= newAbiDeps
convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat
convertPackageInfoToCacheFormat pkg =
- GhcPkg.InstalledPackageInfo {
+ GhcPkg.GenericUnitInfo {
GhcPkg.unitId = installedUnitId pkg,
- GhcPkg.componentId = installedComponentId pkg,
- GhcPkg.instantiatedWith = instantiatedWith pkg,
- GhcPkg.sourcePackageId = sourcePackageId pkg,
- GhcPkg.packageName = packageName pkg,
- GhcPkg.packageVersion = Version.Version (versionNumbers (packageVersion pkg)) [],
- GhcPkg.sourceLibName =
+ GhcPkg.unitInstanceOf = installedComponentId pkg,
+ GhcPkg.unitInstantiations = instantiatedWith pkg,
+ GhcPkg.unitPackageId = sourcePackageId pkg,
+ GhcPkg.unitPackageName = packageName pkg,
+ GhcPkg.unitPackageVersion = Version.Version (versionNumbers (packageVersion pkg)) [],
+ GhcPkg.unitComponentName =
fmap (mkPackageName . unUnqualComponentName) (libraryNameString $ sourceLibName pkg),
- GhcPkg.depends = depends pkg,
- GhcPkg.abiDepends = map (\(AbiDependency k v) -> (k,unAbiHash v)) (abiDepends pkg),
- GhcPkg.abiHash = unAbiHash (abiHash pkg),
- GhcPkg.importDirs = importDirs pkg,
- GhcPkg.hsLibraries = hsLibraries pkg,
- GhcPkg.extraLibraries = extraLibraries pkg,
- GhcPkg.extraGHCiLibraries = extraGHCiLibraries pkg,
- GhcPkg.libraryDirs = libraryDirs pkg,
- GhcPkg.libraryDynDirs = libraryDynDirs pkg,
- GhcPkg.frameworks = frameworks pkg,
- GhcPkg.frameworkDirs = frameworkDirs pkg,
- GhcPkg.ldOptions = ldOptions pkg,
- GhcPkg.ccOptions = ccOptions pkg,
- GhcPkg.includes = includes pkg,
- GhcPkg.includeDirs = includeDirs pkg,
- GhcPkg.haddockInterfaces = haddockInterfaces pkg,
- GhcPkg.haddockHTMLs = haddockHTMLs pkg,
- GhcPkg.exposedModules = map convertExposed (exposedModules pkg),
- GhcPkg.hiddenModules = hiddenModules pkg,
- GhcPkg.indefinite = indefinite pkg,
- GhcPkg.exposed = exposed pkg,
- GhcPkg.trusted = trusted pkg
+ GhcPkg.unitDepends = depends pkg,
+ GhcPkg.unitAbiDepends = map (\(AbiDependency k v) -> (k,unAbiHash v)) (abiDepends pkg),
+ GhcPkg.unitAbiHash = unAbiHash (abiHash pkg),
+ GhcPkg.unitImportDirs = importDirs pkg,
+ GhcPkg.unitLibraries = hsLibraries pkg,
+ GhcPkg.unitExtDepLibsSys = extraLibraries pkg,
+ GhcPkg.unitExtDepLibsGhc = extraGHCiLibraries pkg,
+ GhcPkg.unitLibraryDirs = libraryDirs pkg,
+ GhcPkg.unitLibraryDynDirs = libraryDynDirs pkg,
+ GhcPkg.unitExtDepFrameworks = frameworks pkg,
+ GhcPkg.unitExtDepFrameworkDirs = frameworkDirs pkg,
+ GhcPkg.unitLinkerOptions = ldOptions pkg,
+ GhcPkg.unitCcOptions = ccOptions pkg,
+ GhcPkg.unitIncludes = includes pkg,
+ GhcPkg.unitIncludeDirs = includeDirs pkg,
+ GhcPkg.unitHaddockInterfaces = haddockInterfaces pkg,
+ GhcPkg.unitHaddockHTMLs = haddockHTMLs pkg,
+ GhcPkg.unitExposedModules = map convertExposed (exposedModules pkg),
+ GhcPkg.unitHiddenModules = hiddenModules pkg,
+ GhcPkg.unitIsIndefinite = indefinite pkg,
+ GhcPkg.unitIsExposed = exposed pkg,
+ GhcPkg.unitIsTrusted = trusted pkg
}
where
convertExposed (ExposedModule n reexport) = (n, reexport)
diff --git a/utils/haddock b/utils/haddock
-Subproject 2d2587182568cc5aa4b29d401517337c32459c6
+Subproject 75b9b6ebbe8326f3a2b099ab7f130960b456761
View Lorry Controller Status