summaryrefslogtreecommitdiff
path: root/compiler/GHC/Driver
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-04-03 12:18:57 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-30 01:56:56 -0400
commit10d15f1ec4bab4dd6152d87fc66e61658a705eb3 (patch)
treec25e1b33f62e13db7a3163f4e74330a52add80a2 /compiler/GHC/Driver
parentea717aa4248b2122e1f7550f30239b50ab560e4f (diff)
downloadhaskell-10d15f1ec4bab4dd6152d87fc66e61658a705eb3.tar.gz
Refactoring unit management code
Over the years the unit management code has been modified a lot to keep up with changes in Cabal (e.g. support for several library components in the same package), to integrate BackPack, etc. I found it very hard to understand as the terminology wasn't consistent, was referring to past concepts, etc. The terminology is now explained as clearly as I could in the Note "About Units" and the code is refactored to reflect it. ------------------- Many names were misleading: UnitId is not an Id but could be a virtual unit (an indefinite one instantiated on the fly), IndefUnitId constructor may contain a definite instantiated unit, etc. * Rename IndefUnitId into InstantiatedUnit * Rename IndefModule into InstantiatedModule * Rename UnitId type into Unit * Rename IndefiniteUnitId constructor into VirtUnit * Rename DefiniteUnitId constructor into RealUnit * Rename packageConfigId into mkUnit * Rename getPackageDetails into unsafeGetUnitInfo * Rename InstalledUnitId into UnitId Remove references to misleading ComponentId: a ComponentId is just an indefinite unit-id to be instantiated. * Rename ComponentId into IndefUnitId * Rename ComponentDetails into UnitPprInfo * Fix display of UnitPprInfo with empty version: this is now used for units dynamically generated by BackPack Generalize several types (Module, Unit, etc.) so that they can be used with different unit identifier types: UnitKey, UnitId, Unit, etc. * GenModule: Module, InstantiatedModule and InstalledModule are now instances of this type * Generalize DefUnitId, IndefUnitId, Unit, InstantiatedUnit, PackageDatabase Replace BackPack fake "hole" UnitId by a proper HoleUnit constructor. Add basic support for UnitKey. They should be used more in the future to avoid mixing them up with UnitId as we do now. Add many comments. Update Haddock submodule
Diffstat (limited to 'compiler/GHC/Driver')
-rw-r--r--compiler/GHC/Driver/Backpack.hs106
-rw-r--r--compiler/GHC/Driver/Backpack/Syntax.hs2
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs10
-rw-r--r--compiler/GHC/Driver/Finder.hs59
-rw-r--r--compiler/GHC/Driver/Main.hs24
-rw-r--r--compiler/GHC/Driver/Make.hs49
-rw-r--r--compiler/GHC/Driver/Packages.hs341
-rw-r--r--compiler/GHC/Driver/Packages.hs-boot13
-rw-r--r--compiler/GHC/Driver/Pipeline.hs16
-rw-r--r--compiler/GHC/Driver/Plugins.hs2
-rw-r--r--compiler/GHC/Driver/Session.hs49
-rw-r--r--compiler/GHC/Driver/Types.hs48
12 files changed, 355 insertions, 364 deletions
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 2ced161775..8dfada00af 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -25,7 +25,7 @@ import GHC.Driver.Backpack.Syntax
import GHC.Parser.Annotation
import GHC hiding (Failed, Succeeded)
-import GHC.Driver.Packages
+import GHC.Driver.Packages hiding (packageNameMap)
import GHC.Parser
import GHC.Parser.Lexer
import GHC.Driver.Monad
@@ -96,14 +96,14 @@ doBackpack [src_filename] = do
innerBkpM $ do
let (cid, insts) = computeUnitId lunit
if null insts
- then if cid == ComponentId (fsLit "main") Nothing
+ then if cid == Indefinite (UnitId (fsLit "main")) Nothing
then compileExe lunit
else compileUnit cid []
else typecheckUnit cid insts
doBackpack _ =
throwGhcException (CmdLineError "--backpack can only process a single file")
-computeUnitId :: LHsUnit HsComponentId -> (ComponentId, [(ModuleName, Module)])
+computeUnitId :: LHsUnit HsComponentId -> (IndefUnitId, [(ModuleName, Module)])
computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])
where
cid = hsComponentId (unLoc (hsunitName unit))
@@ -112,7 +112,7 @@ computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])
get_reqs (DeclD HsSrcFile _ _) = emptyUniqDSet
get_reqs (DeclD HsBootFile _ _) = emptyUniqDSet
get_reqs (IncludeD (IncludeDecl (L _ hsuid) _ _)) =
- unitIdFreeHoles (convertHsUnitId hsuid)
+ unitFreeModuleHoles (convertHsComponentId hsuid)
-- | Tiny enum for all types of Backpack operations we may do.
data SessionType
@@ -129,17 +129,17 @@ data SessionType
-- | Create a temporary Session to do some sort of type checking or
-- compilation.
-withBkpSession :: ComponentId
+withBkpSession :: IndefUnitId
-> [(ModuleName, Module)]
- -> [(UnitId, ModRenaming)]
+ -> [(Unit, ModRenaming)]
-> SessionType -- what kind of session are we doing
-> BkpM a -- actual action to run
-> BkpM a
withBkpSession cid insts deps session_type do_this = do
dflags <- getDynFlags
- let (ComponentId cid_fs _) = cid
+ let cid_fs = unitIdFS (indefUnit cid)
is_primary = False
- uid_str = unpackFS (hashUnitId cid insts)
+ uid_str = unpackFS (mkInstantiatedUnitHash cid insts)
cid_str = unpackFS cid_fs
-- There are multiple units in a single Backpack file, so we
-- need to separate out the results in those cases. Right now,
@@ -174,12 +174,12 @@ withBkpSession cid insts deps session_type do_this = do
_ -> hscTarget dflags,
thisUnitIdInsts_ = Just insts,
thisComponentId_ = Just cid,
- thisInstalledUnitId =
+ thisUnitId =
case session_type of
- TcSession -> newInstalledUnitId cid Nothing
+ TcSession -> newUnitId cid Nothing
-- No hash passed if no instances
- _ | null insts -> newInstalledUnitId cid Nothing
- | otherwise -> newInstalledUnitId cid (Just (hashUnitId cid insts)),
+ _ | null insts -> newUnitId cid Nothing
+ | otherwise -> newUnitId cid (Just (mkInstantiatedUnitHash cid insts)),
-- Setup all of the output directories according to our hierarchy
objectDir = Just (outdir objectDir),
hiDir = Just (outdir hiDir),
@@ -192,7 +192,7 @@ withBkpSession cid insts deps session_type do_this = do
importPaths = [],
-- Synthesized the flags
packageFlags = packageFlags dflags ++ map (\(uid0, rn) ->
- let uid = unwireUnitId dflags (improveUnitId (getUnitInfoMap dflags) $ renameHoleUnitId dflags (listToUFM insts) uid0)
+ let uid = unwireUnit dflags (improveUnit (getUnitInfoMap dflags) $ renameHoleUnit dflags (listToUFM insts) uid0)
in ExposePackage
(showSDoc dflags
(text "-unit-id" <+> ppr uid <+> ppr rn))
@@ -204,41 +204,41 @@ withBkpSession cid insts deps session_type do_this = do
_ <- setSessionDynFlags dflags
do_this
-withBkpExeSession :: [(UnitId, ModRenaming)] -> BkpM a -> BkpM a
+withBkpExeSession :: [(Unit, ModRenaming)] -> BkpM a -> BkpM a
withBkpExeSession deps do_this = do
- withBkpSession (ComponentId (fsLit "main") Nothing) [] deps ExeSession do_this
+ withBkpSession (Indefinite (UnitId (fsLit "main")) Nothing) [] deps ExeSession do_this
-getSource :: ComponentId -> BkpM (LHsUnit HsComponentId)
+getSource :: IndefUnitId -> BkpM (LHsUnit HsComponentId)
getSource cid = do
bkp_env <- getBkpEnv
case Map.lookup cid (bkp_table bkp_env) of
Nothing -> pprPanic "missing needed dependency" (ppr cid)
Just lunit -> return lunit
-typecheckUnit :: ComponentId -> [(ModuleName, Module)] -> BkpM ()
+typecheckUnit :: IndefUnitId -> [(ModuleName, Module)] -> BkpM ()
typecheckUnit cid insts = do
lunit <- getSource cid
buildUnit TcSession cid insts lunit
-compileUnit :: ComponentId -> [(ModuleName, Module)] -> BkpM ()
+compileUnit :: IndefUnitId -> [(ModuleName, Module)] -> BkpM ()
compileUnit cid insts = do
- -- Let everyone know we're building this unit ID
- msgUnitId (newUnitId cid insts)
+ -- Let everyone know we're building this unit
+ msgUnitId (mkVirtUnit cid insts)
lunit <- getSource cid
buildUnit CompSession cid insts lunit
-- | Compute the dependencies with instantiations of a syntactic
-- HsUnit; e.g., wherever you see @dependency p[A=<A>]@ in a
--- unit file, return the 'UnitId' corresponding to @p[A=<A>]@.
+-- unit file, return the 'Unit' corresponding to @p[A=<A>]@.
-- The @include_sigs@ parameter controls whether or not we also
-- include @dependency signature@ declarations in this calculation.
--
--- Invariant: this NEVER returns InstalledUnitId.
-hsunitDeps :: Bool {- include sigs -} -> HsUnit HsComponentId -> [(UnitId, ModRenaming)]
+-- Invariant: this NEVER returns UnitId.
+hsunitDeps :: Bool {- include sigs -} -> HsUnit HsComponentId -> [(Unit, ModRenaming)]
hsunitDeps include_sigs unit = concatMap get_dep (hsunitBody unit)
where
get_dep (L _ (IncludeD (IncludeDecl (L _ hsuid) mb_lrn is_sig)))
- | include_sigs || not is_sig = [(convertHsUnitId hsuid, go mb_lrn)]
+ | include_sigs || not is_sig = [(convertHsComponentId hsuid, go mb_lrn)]
| otherwise = []
where
go Nothing = ModRenaming True []
@@ -248,7 +248,7 @@ hsunitDeps include_sigs unit = concatMap get_dep (hsunitBody unit)
convRn (L _ (Renaming (L _ from) (Just (L _ to)))) = (from, to)
get_dep _ = []
-buildUnit :: SessionType -> ComponentId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()
+buildUnit :: SessionType -> IndefUnitId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()
buildUnit session cid insts lunit = do
-- NB: include signature dependencies ONLY when typechecking.
-- If we're compiling, it's not necessary to recursively
@@ -260,7 +260,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 (renameHoleUnitId dflags hsubst) raw_deps
+ deps0 = map (renameHoleUnit 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
@@ -273,7 +273,7 @@ buildUnit session cid insts lunit = do
dflags <- getDynFlags
-- IMPROVE IT
- let deps = map (improveUnitId (getUnitInfoMap dflags)) deps0
+ let deps = map (improveUnit (getUnitInfoMap dflags)) deps0
mb_old_eps <- case session of
TcSession -> fmap Just getEpsGhc
@@ -304,7 +304,7 @@ buildUnit session cid insts lunit = do
getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
obj_files = concatMap getOfiles linkables
- let compat_fs = (case cid of ComponentId fs _ -> fs)
+ let compat_fs = unitIdFS (indefUnit cid)
compat_pn = PackageName compat_fs
return GenericUnitInfo {
@@ -312,8 +312,8 @@ buildUnit session cid insts lunit = do
unitAbiHash = "",
unitPackageId = PackageId compat_fs,
unitPackageName = compat_pn,
- unitPackageVersion = makeVersion [0],
- unitId = toInstalledUnitId (thisPackage dflags),
+ unitPackageVersion = makeVersion [],
+ unitId = toUnitId (thisPackage dflags),
unitComponentName = Nothing,
unitInstanceOf = cid,
unitInstantiations = insts,
@@ -327,8 +327,8 @@ buildUnit session cid insts lunit = do
-- really used for anything, so we leave it
-- blank for now.
TcSession -> []
- _ -> map (toInstalledUnitId . unwireUnitId dflags)
- $ deps ++ [ moduleUnitId mod
+ _ -> map (toUnitId . unwireUnit dflags)
+ $ deps ++ [ moduleUnit mod
| (_, mod) <- insts
, not (isHoleModule mod) ],
unitAbiDepends = [],
@@ -391,21 +391,18 @@ addPackage pkg = do
_ <- GHC.setSessionDynFlags (dflags { pkgDatabase = Just (dbs ++ [newdb]) })
return ()
--- Precondition: UnitId is NOT InstalledUnitId
-compileInclude :: Int -> (Int, UnitId) -> BkpM ()
+compileInclude :: Int -> (Int, Unit) -> BkpM ()
compileInclude n (i, uid) = do
hsc_env <- getSession
let dflags = hsc_dflags hsc_env
msgInclude (i, n) uid
-- Check if we've compiled it already
- case lookupUnit dflags uid of
- Nothing -> do
- case splitUnitIdInsts uid of
- (_, Just indef) ->
- innerBkpM $ compileUnit (indefUnitIdComponentId indef)
- (indefUnitIdInsts indef)
- _ -> return ()
- Just _ -> return ()
+ case uid of
+ HoleUnit -> return ()
+ RealUnit _ -> return ()
+ VirtUnit i -> case lookupUnit dflags uid of
+ Nothing -> innerBkpM $ compileUnit (instUnitInstanceOf i) (instUnitInsts i)
+ Just _ -> return ()
-- ----------------------------------------------------------------------------
-- Backpack monad
@@ -423,7 +420,7 @@ data BkpEnv
-- | The filename of the bkp file we're compiling
bkp_filename :: FilePath,
-- | Table of source units which we know how to compile
- bkp_table :: Map ComponentId (LHsUnit HsComponentId),
+ bkp_table :: Map IndefUnitId (LHsUnit HsComponentId),
-- | When a package we are compiling includes another package
-- which has not been compiled, we bump the level and compile
-- that.
@@ -535,7 +532,7 @@ msgTopPackage (i,n) (HsComponentId (PackageName fs_pn) _) = do
$ showModuleIndex (i, n) ++ "Processing " ++ unpackFS fs_pn
-- | Message when we instantiate a Backpack unit.
-msgUnitId :: UnitId -> BkpM ()
+msgUnitId :: Unit -> BkpM ()
msgUnitId pk = do
dflags <- getDynFlags
level <- getBkpLevel
@@ -545,7 +542,7 @@ msgUnitId pk = do
(ppr pk)
-- | Message when we include a Backpack unit.
-msgInclude :: (Int,Int) -> UnitId -> BkpM ()
+msgInclude :: (Int,Int) -> Unit -> BkpM ()
msgInclude (i,n) uid = do
dflags <- getDynFlags
level <- getBkpLevel
@@ -563,7 +560,7 @@ type PackageNameMap a = Map PackageName a
-- to use this for anything
unitDefines :: PackageState -> LHsUnit PackageName -> (PackageName, HsComponentId)
unitDefines pkgstate (L _ HsUnit{ hsunitName = L _ pn@(PackageName fs) })
- = (pn, HsComponentId pn (mkComponentId pkgstate fs))
+ = (pn, HsComponentId pn (mkIndefUnitId pkgstate fs))
packageNameMap :: PackageState -> [LHsUnit PackageName] -> PackageNameMap HsComponentId
packageNameMap pkgstate units = Map.fromList (map (unitDefines pkgstate) units)
@@ -609,16 +606,16 @@ renameHsUnits pkgstate m units = map (fmap renameHsUnit) units
renameHsModuleId (HsModuleVar lm) = HsModuleVar lm
renameHsModuleId (HsModuleId luid lm) = HsModuleId (fmap renameHsUnitId luid) lm
-convertHsUnitId :: HsUnitId HsComponentId -> UnitId
-convertHsUnitId (HsUnitId (L _ hscid) subst)
- = newUnitId (hsComponentId hscid) (map (convertHsModuleSubst . unLoc) subst)
+convertHsComponentId :: HsUnitId HsComponentId -> Unit
+convertHsComponentId (HsUnitId (L _ hscid) subst)
+ = mkVirtUnit (hsComponentId hscid) (map (convertHsModuleSubst . unLoc) subst)
convertHsModuleSubst :: HsModuleSubst HsComponentId -> (ModuleName, Module)
convertHsModuleSubst (L _ modname, L _ m) = (modname, convertHsModuleId m)
convertHsModuleId :: HsModuleId HsComponentId -> Module
convertHsModuleId (HsModuleVar (L _ modname)) = mkHoleModule modname
-convertHsModuleId (HsModuleId (L _ hsuid) (L _ modname)) = mkModule (convertHsUnitId hsuid) modname
+convertHsModuleId (HsModuleId (L _ hsuid) (L _ modname)) = mkModule (convertHsComponentId hsuid) modname
@@ -824,8 +821,7 @@ hsModuleToModSummary pn hsc_src modname
-- | Create a new, externally provided hashed unit id from
-- a hash.
-newInstalledUnitId :: ComponentId -> Maybe FastString -> InstalledUnitId
-newInstalledUnitId (ComponentId cid_fs _) (Just fs)
- = InstalledUnitId (cid_fs `appendFS` mkFastString "+" `appendFS` fs)
-newInstalledUnitId (ComponentId cid_fs _) Nothing
- = InstalledUnitId cid_fs
+newUnitId :: IndefUnitId -> Maybe FastString -> UnitId
+newUnitId uid mhash = case mhash of
+ Nothing -> indefUnit uid
+ Just hash -> UnitId (unitIdFS (indefUnit uid) `appendFS` mkFastString "+" `appendFS` hash)
diff --git a/compiler/GHC/Driver/Backpack/Syntax.hs b/compiler/GHC/Driver/Backpack/Syntax.hs
index bb459d8e35..e579fe42a1 100644
--- a/compiler/GHC/Driver/Backpack/Syntax.hs
+++ b/compiler/GHC/Driver/Backpack/Syntax.hs
@@ -35,7 +35,7 @@ import GHC.Unit.Info
data HsComponentId = HsComponentId {
hsPackageName :: PackageName,
- hsComponentId :: ComponentId
+ hsComponentId :: IndefUnitId
}
instance Outputable HsComponentId where
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index cba5d1b644..446deb2c99 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -60,7 +60,7 @@ codeOutput :: DynFlags
-> ForeignStubs
-> [(ForeignSrcLang, FilePath)]
-- ^ additional files to be compiled with with the C compiler
- -> [InstalledUnitId]
+ -> [UnitId]
-> Stream IO RawCmmGroup a -- Compiled C--
-> IO (FilePath,
(Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}),
@@ -120,7 +120,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
outputC :: DynFlags
-> FilePath
-> Stream IO RawCmmGroup a
- -> [InstalledUnitId]
+ -> [UnitId]
-> IO a
outputC dflags filenm cmm_stream packages
@@ -133,7 +133,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 = getPackageDetails dflags rtsUnitId
+ let rts = unsafeGetUnitInfo dflags rtsUnitId
let cc_injects = unlines (map mk_include (unitIncludes rts))
mk_include h_file =
@@ -142,7 +142,7 @@ outputC dflags filenm cmm_stream packages
'<':_ -> "#include "++h_file
_ -> "#include \""++h_file++"\""
- let pkg_names = map installedUnitIdString packages
+ let pkg_names = map unitIdString packages
doOutput filenm $ \ h -> do
hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
@@ -225,7 +225,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
+ let rts_pkg = unsafeGetUnitInfo dflags rtsUnitId in
concatMap mk_include (unitIncludes rts_pkg)
mk_include i = "#include \"" ++ i ++ "\"\n"
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index 5eb00e6dd2..1b50d280a6 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -5,6 +5,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
module GHC.Driver.Finder (
flushFinderCaches,
@@ -76,7 +77,7 @@ flushFinderCaches hsc_env =
where
this_pkg = thisPackage (hsc_dflags hsc_env)
fc_ref = hsc_FC hsc_env
- is_ext mod _ | not (installedModuleUnitId mod `installedUnitIdEq` this_pkg) = True
+ is_ext mod _ | not (moduleUnit mod `unitIdEq` this_pkg) = True
| otherwise = False
addToFinderCache :: IORef FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
@@ -135,8 +136,8 @@ findPluginModule hsc_env mod_name =
findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findExactModule hsc_env mod =
let dflags = hsc_dflags hsc_env
- in if installedModuleUnitId mod `installedUnitIdEq` thisPackage dflags
- then findInstalledHomeModule hsc_env (installedModuleName mod)
+ in if moduleUnit mod `unitIdEq` thisPackage dflags
+ then findInstalledHomeModule hsc_env (moduleName mod)
else findPackageModule hsc_env mod
-- -----------------------------------------------------------------------------
@@ -194,7 +195,7 @@ findExposedPluginPackageModule hsc_env mod_name
findLookupResult :: HscEnv -> LookupResult -> IO FindResult
findLookupResult hsc_env r = case r of
LookupFound m pkg_conf -> do
- let im = fst (splitModuleInsts m)
+ let im = fst (getModuleInstantiation m)
r' <- findPackageModule_ hsc_env im pkg_conf
case r' of
-- TODO: ghc -M is unlikely to do the right thing
@@ -202,8 +203,8 @@ findLookupResult hsc_env r = case r of
-- instantiated; you probably also need all of the
-- implicit locations from the instances
InstalledFound loc _ -> return (Found loc m)
- InstalledNoPackage _ -> return (NoPackage (moduleUnitId m))
- InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnitId m)
+ InstalledNoPackage _ -> return (NoPackage (moduleUnit m))
+ InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m)
, fr_pkgs_hidden = []
, fr_mods_hidden = []
, fr_unusables = []
@@ -212,13 +213,13 @@ findLookupResult hsc_env r = case r of
return (FoundMultiple rs)
LookupHidden pkg_hiddens mod_hiddens ->
return (NotFound{ fr_paths = [], fr_pkg = Nothing
- , fr_pkgs_hidden = map (moduleUnitId.fst) pkg_hiddens
- , fr_mods_hidden = map (moduleUnitId.fst) mod_hiddens
+ , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens
+ , fr_mods_hidden = map (moduleUnit.fst) mod_hiddens
, fr_unusables = []
, fr_suggestions = [] })
LookupUnusable unusable ->
let unusables' = map get_unusable unusable
- get_unusable (m, ModUnusable r) = (moduleUnitId m, r)
+ get_unusable (m, ModUnusable r) = (moduleUnit m, r)
get_unusable (_, r) =
pprPanic "findLookupResult: unexpected origin" (ppr r)
in return (NotFound{ fr_paths = [], fr_pkg = Nothing
@@ -245,8 +246,8 @@ modLocationCache hsc_env mod do_this = do
mkHomeInstalledModule :: DynFlags -> ModuleName -> InstalledModule
mkHomeInstalledModule dflags mod_name =
- let iuid = thisInstalledUnitId dflags
- in InstalledModule iuid mod_name
+ let iuid = thisUnitId dflags
+ in Module iuid mod_name
-- This returns a module because it's more convenient for users
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
@@ -339,7 +340,7 @@ findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findPackageModule hsc_env mod = do
let
dflags = hsc_dflags hsc_env
- pkg_id = installedModuleUnitId mod
+ pkg_id = moduleUnit mod
pkgstate = pkgState dflags
--
case lookupInstalledPackage pkgstate pkg_id of
@@ -355,7 +356,7 @@ findPackageModule hsc_env mod = do
-- for the appropriate config.
findPackageModule_ :: HscEnv -> InstalledModule -> UnitInfo -> IO InstalledFindResult
findPackageModule_ hsc_env mod pkg_conf =
- ASSERT2( installedModuleUnitId mod == installedUnitInfoId pkg_conf, ppr (installedModuleUnitId mod) <+> ppr (installedUnitInfoId pkg_conf) )
+ ASSERT2( moduleUnit mod == unitId pkg_conf, ppr (moduleUnit mod) <+> ppr (unitId pkg_conf) )
modLocationCache hsc_env mod $
-- special case for GHC.Prim; we won't find it in the filesystem.
@@ -381,7 +382,7 @@ findPackageModule_ hsc_env mod pkg_conf =
[one] | MkDepend <- ghcMode dflags -> do
-- there's only one place that this .hi file can be, so
-- don't bother looking for it.
- let basename = moduleNameSlashes (installedModuleName mod)
+ let basename = moduleNameSlashes (moduleName mod)
loc <- mk_hi_loc one basename
return (InstalledFound loc mod)
_otherwise ->
@@ -413,7 +414,7 @@ searchPathExts paths mod exts
return result
where
- basename = moduleNameSlashes (installedModuleName mod)
+ basename = moduleNameSlashes (moduleName mod)
to_search :: [(FilePath, IO ModLocation)]
to_search = [ (file, fn path basename)
@@ -424,7 +425,7 @@ searchPathExts paths mod exts
file = base <.> ext
]
- search [] = return (InstalledNotFound (map fst to_search) (Just (installedModuleUnitId mod)))
+ search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod)))
search ((file, mk_result) : rest) = do
b <- doesFileExist file
@@ -649,7 +650,7 @@ cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
where
unambiguousPackages = foldl' unambiguousPackage (Just []) mods
unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
- = Just (moduleUnitId m : xs)
+ = Just (moduleUnit m : xs)
unambiguousPackage _ _ = Nothing
pprMod (m, o) = text "it is bound as" <+> ppr m <+>
@@ -658,10 +659,10 @@ cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
if e == Just True
- then [text "package" <+> ppr (moduleUnitId m)]
+ then [text "package" <+> ppr (moduleUnit m)]
else [] ++
map ((text "a reexport in package" <+>)
- .ppr.packageConfigId) res ++
+ .ppr.mkUnit) res ++
if f then [text "a package flag"] else []
)
@@ -714,7 +715,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
text "try running 'ghc-pkg check'." $$
tried_these files dflags
- pkg_hidden :: UnitId -> SDoc
+ pkg_hidden :: Unit -> SDoc
pkg_hidden uid =
text "It is a member of the hidden package"
<+> quotes (ppr uid)
@@ -758,11 +759,11 @@ cantFindErr cannot_find _ dflags mod_name find_result
fromExposedReexport = res,
fromPackageFlag = f })
| Just True <- e
- = parens (text "from" <+> ppr (moduleUnitId mod))
+ = parens (text "from" <+> ppr (moduleUnit mod))
| f && moduleName mod == m
- = parens (text "from" <+> ppr (moduleUnitId mod))
+ = parens (text "from" <+> ppr (moduleUnit mod))
| (pkg:_) <- res
- = parens (text "from" <+> ppr (packageConfigId pkg)
+ = parens (text "from" <+> ppr (mkUnit pkg)
<> comma <+> text "reexporting" <+> ppr mod)
| f
= parens (text "defined via package flags to be"
@@ -775,10 +776,10 @@ cantFindErr cannot_find _ dflags mod_name find_result
fromHiddenReexport = rhs })
| Just False <- e
= parens (text "needs flag -package-key"
- <+> ppr (moduleUnitId mod))
+ <+> ppr (moduleUnit mod))
| (pkg:_) <- rhs
= parens (text "needs flag -package-id"
- <+> ppr (packageConfigId pkg))
+ <+> ppr (mkUnit pkg))
| otherwise = Outputable.empty
cantFindInstalledErr :: PtrString -> PtrString -> DynFlags -> ModuleName
@@ -794,7 +795,7 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
text "was found" $$ looks_like_srcpkgid pkg
InstalledNotFound files mb_pkg
- | Just pkg <- mb_pkg, not (pkg `installedUnitIdEq` thisPackage dflags)
+ | Just pkg <- mb_pkg, not (pkg `unitIdEq` thisPackage dflags)
-> not_found_in_package pkg files
| null files
@@ -808,13 +809,13 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
build_tag = buildTag dflags
pkgstate = pkgState dflags
- looks_like_srcpkgid :: InstalledUnitId -> SDoc
+ looks_like_srcpkgid :: UnitId -> SDoc
looks_like_srcpkgid 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))
+ | (pkg:pkgs) <- searchPackageId pkgstate (PackageId (unitIdFS pk))
= parens (text "This unit ID looks like the source package ID;" $$
- text "the real unit ID is" <+> quotes (ftext (installedUnitIdFS (unitId pkg))) $$
+ text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$
(if null pkgs then Outputable.empty
else text "and" <+> int (length pkgs) <+> text "other candidates"))
-- Todo: also check if it looks like a package name!
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index d5c5cfedbc..c62b40cf0d 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -475,7 +475,7 @@ hsc_typecheck keep_rn mod_summary mb_rdr_module = do
src_filename = ms_hspp_file mod_summary
real_loc = realSrcLocSpan $ mkRealSrcLoc (mkFastString src_filename) 1 1
keep_rn' = gopt Opt_WriteHie dflags || keep_rn
- MASSERT( moduleUnitId outer_mod == thisPackage dflags )
+ MASSERT( moduleUnit outer_mod == thisPackage dflags )
tc_result <- if hsc_src == HsigFile && not (isHoleModule inner_mod)
then ioMsgMaybe $ tcRnInstantiateSignature hsc_env outer_mod' real_loc
else
@@ -1049,7 +1049,7 @@ checkSafeImports tcg_env
imports = imp_mods impInfo -- ImportedMods
imports1 = moduleEnvToList imports -- (Module, [ImportedBy])
imports' = map (fmap importedByUser) imports1 -- (Module, [ImportedModsVal])
- pkgReqs = imp_trust_pkgs impInfo -- [UnitId]
+ pkgReqs = imp_trust_pkgs impInfo -- [Unit]
condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport)
condense (_, []) = panic "GHC.Driver.Main.condense: Pattern match failure!"
@@ -1069,11 +1069,11 @@ checkSafeImports tcg_env
= return v1
-- easier interface to work with
- checkSafe :: (Module, SrcSpan, a) -> Hsc (Maybe InstalledUnitId)
+ checkSafe :: (Module, SrcSpan, a) -> Hsc (Maybe UnitId)
checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l
-- what pkg's to add to our trust requirements
- pkgTrustReqs :: DynFlags -> Set InstalledUnitId -> Set InstalledUnitId ->
+ pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId ->
Bool -> ImportAvails
pkgTrustReqs dflags req inf infPassed | safeInferOn dflags
&& not (safeHaskellModeEnabled dflags) && infPassed
@@ -1097,7 +1097,7 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do
return $ isEmptyBag errs
-- | Return if a module is trusted and the pkgs it depends on to be trusted.
-hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set InstalledUnitId)
+hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId)
hscGetSafe hsc_env m l = runHsc hsc_env $ do
(self, pkgs) <- hscCheckSafe' m l
good <- isEmptyBag `fmap` getWarnings
@@ -1111,7 +1111,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
-- own package be trusted and a list of other packages required to be trusted
-- (these later ones haven't been checked) but the own package trust has been.
hscCheckSafe' :: Module -> SrcSpan
- -> Hsc (Maybe InstalledUnitId, Set InstalledUnitId)
+ -> Hsc (Maybe UnitId, Set UnitId)
hscCheckSafe' m l = do
dflags <- getDynFlags
(tw, pkgs) <- isModSafe m l
@@ -1120,9 +1120,9 @@ hscCheckSafe' m l = do
True | isHomePkg dflags m -> return (Nothing, pkgs)
-- TODO: do we also have to check the trust of the instantiation?
-- Not necessary if that is reflected in dependencies
- | otherwise -> return (Just $ toInstalledUnitId (moduleUnitId m), pkgs)
+ | otherwise -> return (Just $ toUnitId (moduleUnit m), pkgs)
where
- isModSafe :: Module -> SrcSpan -> Hsc (Bool, Set InstalledUnitId)
+ isModSafe :: Module -> SrcSpan -> Hsc (Bool, Set UnitId)
isModSafe m l = do
dflags <- getDynFlags
iface <- lookup' m
@@ -1170,7 +1170,7 @@ hscCheckSafe' m l = do
pkgTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $
sep [ ppr (moduleName m)
<> text ": Can't be safely imported!"
- , text "The package (" <> ppr (moduleUnitId m)
+ , text "The package (" <> ppr (moduleUnit m)
<> text ") the module resides in isn't trusted."
]
modTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $
@@ -1192,7 +1192,7 @@ hscCheckSafe' m l = do
packageTrusted _ Sf_SafeInferred False _ = True
packageTrusted dflags _ _ m
| isHomePkg dflags m = True
- | otherwise = unitIsTrusted $ getPackageDetails dflags (moduleUnitId m)
+ | otherwise = unitIsTrusted $ unsafeGetUnitInfo dflags (moduleUnit m)
lookup' :: Module -> Hsc (Maybe ModIface)
lookup' m = do
@@ -1212,11 +1212,11 @@ hscCheckSafe' m l = do
isHomePkg :: DynFlags -> Module -> Bool
isHomePkg dflags m
- | thisPackage dflags == moduleUnitId m = True
+ | thisPackage dflags == moduleUnit m = True
| otherwise = False
-- | Check the list of packages are trusted.
-checkPkgTrust :: Set InstalledUnitId -> Hsc ()
+checkPkgTrust :: Set UnitId -> Hsc ()
checkPkgTrust pkgs = do
dflags <- getDynFlags
let errors = S.foldr go [] pkgs
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index dd8d0a217f..866d1a080b 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -309,9 +309,9 @@ warnUnusedPackages = do
pit = eps_PIT eps
let loadedPackages
- = map (getPackageDetails dflags)
+ = map (unsafeGetUnitInfo dflags)
. nub . sort
- . map moduleUnitId
+ . map moduleUnit
. moduleEnvKeys
$ pit
@@ -348,16 +348,16 @@ warnUnusedPackages = do
matching :: DynFlags -> PackageArg -> UnitInfo -> Bool
matching _ (PackageArg str) p = matchingStr str p
- matching dflags (UnitIdArg uid) p = uid == realUnitId dflags p
+ matching dflags (UnitIdArg uid) p = uid == realUnit dflags p
-- For wired-in packages, we have to unwire their id,
-- otherwise they won't match package flags
- realUnitId :: DynFlags -> UnitInfo -> UnitId
- realUnitId dflags
- = unwireUnitId dflags
- . DefiniteUnitId
- . DefUnitId
- . installedUnitInfoId
+ realUnit :: DynFlags -> UnitInfo -> Unit
+ realUnit dflags
+ = unwireUnit dflags
+ . RealUnit
+ . Definite
+ . unitId
-- | Generalized version of 'load' which also supports a custom
-- 'Messager' (for reporting progress) and 'ModuleGraph' (generally
@@ -965,7 +965,7 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
hsc_env <- getSession
let dflags = hsc_dflags hsc_env
- when (not (null (unitIdsToCheck dflags))) $
+ when (not (null (instantiatedUnitsToCheck dflags))) $
throwGhcException (ProgramError "Backpack typechecking not supported with -j")
-- The bits of shared state we'll be using:
@@ -1374,7 +1374,7 @@ upsweep
upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
dflags <- getSessionDynFlags
(res, done) <- upsweep' old_hpt emptyMG sccs 1 (length sccs)
- (unitIdsToCheck dflags) done_holes
+ (instantiatedUnitsToCheck dflags) done_holes
return (res, reverse $ mgModSummaries done)
where
done_holes = emptyUniqSet
@@ -1405,13 +1405,13 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
-> [SCC ModSummary]
-> Int
-> Int
- -> [UnitId]
+ -> [Unit]
-> UniqSet ModuleName
-> m (SuccessFlag, ModuleGraph)
upsweep' _old_hpt done
[] _ _ uids_to_check _
= do hsc_env <- getSession
- liftIO . runHsc hsc_env $ mapM_ (ioMsgMaybe . tcRnCheckUnitId hsc_env) uids_to_check
+ liftIO . runHsc hsc_env $ mapM_ (ioMsgMaybe . tcRnCheckUnit hsc_env) uids_to_check
return (Succeeded, done)
upsweep' _old_hpt done
@@ -1436,13 +1436,13 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
-- our imports when you run --make.
let (ready_uids, uids_to_check')
= partition (\uid -> isEmptyUniqDSet
- (unitIdFreeHoles uid `uniqDSetMinusUniqSet` done_holes))
+ (unitFreeModuleHoles uid `uniqDSetMinusUniqSet` done_holes))
uids_to_check
done_holes'
| ms_hsc_src mod == HsigFile
= addOneToUniqSet done_holes (ms_mod_name mod)
| otherwise = done_holes
- liftIO . runHsc hsc_env $ mapM_ (ioMsgMaybe . tcRnCheckUnitId hsc_env) ready_uids
+ liftIO . runHsc hsc_env $ mapM_ (ioMsgMaybe . tcRnCheckUnit hsc_env) ready_uids
-- Remove unwanted tmp files between compilations
liftIO (cleanup hsc_env)
@@ -1517,16 +1517,17 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
upsweep' old_hpt1 done' mods (mod_index+1) nmods uids_to_check' done_holes'
-unitIdsToCheck :: DynFlags -> [UnitId]
-unitIdsToCheck dflags =
- nubSort $ concatMap goUnitId (explicitPackages (pkgState dflags))
+-- | Return a list of instantiated units to type check from the PackageState.
+--
+-- Use explicit (instantiated) units as roots and also return their
+-- instantiations that are themselves instantiations and so on recursively.
+instantiatedUnitsToCheck :: DynFlags -> [Unit]
+instantiatedUnitsToCheck dflags =
+ nubSort $ concatMap goUnit (explicitPackages (pkgState dflags))
where
- goUnitId uid =
- case splitUnitIdInsts uid of
- (_, Just indef) ->
- let insts = indefUnitIdInsts indef
- in uid : concatMap (goUnitId . moduleUnitId . snd) insts
- _ -> []
+ goUnit HoleUnit = []
+ goUnit (RealUnit _) = []
+ goUnit uid@(VirtUnit i) = uid : concatMap (goUnit . moduleUnit . snd) (instUnitInsts i)
maybeGetIfaceDate :: DynFlags -> ModLocation -> IO (Maybe UTCTime)
maybeGetIfaceDate dflags location
diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs
index 2f0a8b46d4..c6dac71e06 100644
--- a/compiler/GHC/Driver/Packages.hs
+++ b/compiler/GHC/Driver/Packages.hs
@@ -7,7 +7,7 @@ module GHC.Driver.Packages (
module GHC.Unit.Info,
-- * Reading the package config, and processing cmdline args
- PackageState(preloadPackages, explicitPackages, moduleNameProvidersMap, requirementContext),
+ PackageState(..),
PackageDatabase (..),
UnitInfoMap,
emptyPackageState,
@@ -23,12 +23,11 @@ module GHC.Driver.Packages (
lookupUnit',
lookupInstalledPackage,
lookupPackageName,
- improveUnitId,
+ improveUnit,
searchPackageId,
- getPackageDetails,
+ unsafeGetUnitInfo,
getInstalledPackageDetails,
- componentIdString,
- displayInstalledUnitId,
+ displayUnitId,
listVisibleModuleNames,
lookupModuleInAllPackages,
lookupModuleWithSuggestions,
@@ -55,9 +54,9 @@ module GHC.Driver.Packages (
packageHsLibs, getLibs,
-- * Utils
- mkComponentId,
- updateComponentId,
- unwireUnitId,
+ mkIndefUnitId,
+ updateIndefUnitId,
+ unwireUnit,
pprFlag,
pprPackages,
pprPackagesSimple,
@@ -105,7 +104,6 @@ import qualified Data.Semigroup as Semigroup
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapStrict
import qualified Data.Set as Set
-import Data.Version
-- ---------------------------------------------------------------------------
-- The Package state
@@ -194,11 +192,11 @@ instance Outputable ModuleOrigin where
(if null res
then []
else [text "reexport by" <+>
- sep (map (ppr . packageConfigId) res)]) ++
+ sep (map (ppr . mkUnit) res)]) ++
(if null rhs
then []
else [text "hidden reexport by" <+>
- sep (map (ppr . packageConfigId) res)]) ++
+ sep (map (ppr . mkUnit) res)]) ++
(if f then [text "package flag"] else [])
))
@@ -245,24 +243,25 @@ originEmpty :: ModuleOrigin -> Bool
originEmpty (ModOrigin Nothing [] [] False) = True
originEmpty _ = False
--- | 'UniqFM' map from 'InstalledUnitId'
-type InstalledUnitIdMap = UniqDFM
-
--- | 'UniqFM' map from 'UnitId' to 'UnitInfo', plus
--- the transitive closure of preload packages.
-data UnitInfoMap = UnitInfoMap {
- unUnitInfoMap :: InstalledUnitIdMap UnitInfo,
- -- | The set of transitively reachable packages according
- -- to the explicitly provided command line arguments.
- -- See Note [UnitId to InstalledUnitId improvement]
- preloadClosure :: UniqSet InstalledUnitId
- }
+-- | Map from 'UnitId' to 'UnitInfo', plus
+-- the transitive closure of preload units.
+data UnitInfoMap = UnitInfoMap
+ { unUnitInfoMap :: UniqDFM UnitInfo
+ -- ^ Map from 'UnitId' to 'UnitInfo'
+
+ , preloadClosure :: UniqSet UnitId
+ -- ^ The set of transitively reachable units according
+ -- to the explicitly provided command line arguments.
+ -- A fully instantiated VirtUnit may only be replaced by a RealUnit from
+ -- this set.
+ -- See Note [VirtUnit to RealUnit improvement]
+ }
--- | 'UniqFM' map from 'UnitId' to a 'UnitVisibility'.
-type VisibilityMap = Map UnitId UnitVisibility
+-- | 'UniqFM' map from 'Unit' to a 'UnitVisibility'.
+type VisibilityMap = Map Unit UnitVisibility
-- | 'UnitVisibility' records the various aspects of visibility of a particular
--- 'UnitId'.
+-- 'Unit'.
data UnitVisibility = UnitVisibility
{ uv_expose_all :: Bool
-- ^ Should all modules in exposed-modules should be dumped into scope?
@@ -270,10 +269,10 @@ data UnitVisibility = UnitVisibility
-- ^ Any custom renamings that should bring extra 'ModuleName's into
-- scope.
, uv_package_name :: First FastString
- -- ^ The package name is associated with the 'UnitId'. This is used
+ -- ^ The package name associated with the 'Unit'. This is used
-- to implement legacy behavior where @-package foo-0.1@ implicitly
-- hides any packages named @foo@
- , uv_requirements :: Map ModuleName (Set IndefModule)
+ , uv_requirements :: Map ModuleName (Set InstantiatedModule)
-- ^ The signatures which are contributed to the requirements context
-- from this unit ID.
, uv_explicit :: Bool
@@ -312,7 +311,7 @@ instance Monoid UnitVisibility where
mappend = (Semigroup.<>)
type WiredUnitId = DefUnitId
-type PreloadUnitId = InstalledUnitId
+type PreloadUnitId = UnitId
-- | Map from 'ModuleName' to a set of of module providers (i.e. a 'Module' and
-- its 'ModuleOrigin').
@@ -323,16 +322,16 @@ type ModuleNameProvidersMap =
Map ModuleName (Map Module ModuleOrigin)
data PackageState = PackageState {
- -- | A mapping of 'UnitId' to 'UnitInfo'. This list is adjusted
+ -- | A mapping of 'Unit' to 'UnitInfo'. This list is adjusted
-- so that only valid packages are here. 'UnitInfo' reflects
-- what was stored *on disk*, except for the 'trusted' flag, which
-- is adjusted at runtime. (In particular, some packages in this map
-- may have the 'exposed' flag be 'False'.)
unitInfoMap :: UnitInfoMap,
- -- | A mapping of 'PackageName' to 'ComponentId'. This is used when
+ -- | A mapping of 'PackageName' to 'IndefUnitId'. This is used when
-- users refer to packages in Backpack includes.
- packageNameMap :: Map PackageName ComponentId,
+ packageNameMap :: Map PackageName IndefUnitId,
-- | A mapping from wired in names to the original names from the
-- package database.
@@ -345,7 +344,7 @@ data PackageState = PackageState {
-- | Packages which we explicitly depend on (from a command line flag).
-- We'll use this to generate version macros.
- explicitPackages :: [UnitId],
+ explicitPackages :: [Unit],
-- | This is a full map from 'ModuleName' to all modules which may possibly
-- be providing it. These providers may be hidden (but we'll still want
@@ -362,7 +361,7 @@ data PackageState = PackageState {
-- and @r[C=<A>]:C@.
--
-- There's an entry in this map for each hole in our home library.
- requirementContext :: Map ModuleName [IndefModule]
+ requirementContext :: Map ModuleName [InstantiatedModule]
}
emptyPackageState :: PackageState
@@ -378,47 +377,46 @@ emptyPackageState = PackageState {
}
-- | Package database
-data PackageDatabase = PackageDatabase
+data PackageDatabase unit = PackageDatabase
{ packageDatabasePath :: FilePath
- , packageDatabaseUnits :: [UnitInfo]
+ , packageDatabaseUnits :: [GenUnitInfo unit]
}
-type InstalledPackageIndex = Map InstalledUnitId UnitInfo
+type InstalledPackageIndex = Map UnitId UnitInfo
-- | Empty package configuration map
emptyUnitInfoMap :: UnitInfoMap
emptyUnitInfoMap = UnitInfoMap emptyUDFM emptyUniqSet
-- | Find the unit we know about with the given unit id, if any
-lookupUnit :: DynFlags -> UnitId -> Maybe UnitInfo
+lookupUnit :: DynFlags -> Unit -> Maybe UnitInfo
lookupUnit dflags = lookupUnit' (isIndefinite dflags) (unitInfoMap (pkgState dflags))
-- | A more specialized interface, which takes a boolean specifying
-- whether or not to look for on-the-fly renamed interfaces, and
-- just a 'UnitInfoMap' rather than a 'DynFlags' (so it can
-- be used while we're initializing 'DynFlags'
-lookupUnit' :: Bool -> UnitInfoMap -> UnitId -> Maybe UnitInfo
-lookupUnit' False (UnitInfoMap pkg_map _) uid = lookupUDFM pkg_map uid
-lookupUnit' True m@(UnitInfoMap pkg_map _) uid =
- case splitUnitIdInsts uid of
- (iuid, Just indef) ->
- fmap (renamePackage m (indefUnitIdInsts indef))
- (lookupUDFM pkg_map iuid)
- (_, Nothing) -> lookupUDFM pkg_map uid
+lookupUnit' :: Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
+lookupUnit' False (UnitInfoMap pkg_map _) uid = lookupUDFM pkg_map uid
+lookupUnit' True m@(UnitInfoMap pkg_map _) uid = case uid of
+ HoleUnit -> error "Hole unit"
+ RealUnit _ -> lookupUDFM pkg_map uid
+ VirtUnit i -> fmap (renamePackage m (instUnitInsts i))
+ (lookupUDFM pkg_map (instUnitInstanceOf i))
{-
--- | Find the indefinite package for a given 'ComponentId'.
+-- | Find the indefinite package for a given 'IndefUnitId'.
-- The way this works is just by fiat'ing that every indefinite package's
-- unit key is precisely its component ID; and that they share uniques.
-lookupComponentId :: PackageState -> ComponentId -> Maybe UnitInfo
-lookupComponentId pkgstate (ComponentId cid_fs) = lookupUDFM pkg_map cid_fs
+lookupIndefUnitId :: PackageState -> IndefUnitId -> Maybe UnitInfo
+lookupIndefUnitId pkgstate (IndefUnitId cid_fs) = lookupUDFM pkg_map cid_fs
where
UnitInfoMap pkg_map = unitInfoMap pkgstate
-}
-- | Find the package we know about with the given package name (e.g. @foo@), if any
-- (NB: there might be a locally defined unit name which overrides this)
-lookupPackageName :: PackageState -> PackageName -> Maybe ComponentId
+lookupPackageName :: PackageState -> PackageName -> Maybe IndefUnitId
lookupPackageName pkgstate n = Map.lookup n (packageNameMap pkgstate)
-- | Search for packages with a given package ID (e.g. \"foo-0.1\")
@@ -431,26 +429,26 @@ extendUnitInfoMap
:: UnitInfoMap -> [UnitInfo] -> UnitInfoMap
extendUnitInfoMap (UnitInfoMap pkg_map closure) new_pkgs
= UnitInfoMap (foldl' add pkg_map new_pkgs) closure
- -- We also add the expanded version of the packageConfigId, so that
- -- 'improveUnitId' can find it.
+ -- We also add the expanded version of the mkUnit, so that
+ -- 'improveUnit' can find it.
where add pkg_map p = addToUDFM (addToUDFM pkg_map (expandedUnitInfoId p) p)
- (installedUnitInfoId p) p
+ (unitId p) p
-- | Looks up the package with the given id in the package state, panicing if it is
-- not found
-getPackageDetails :: HasDebugCallStack => DynFlags -> UnitId -> UnitInfo
-getPackageDetails dflags pid =
+unsafeGetUnitInfo :: HasDebugCallStack => DynFlags -> Unit -> UnitInfo
+unsafeGetUnitInfo dflags pid =
case lookupUnit dflags pid of
Just config -> config
- Nothing -> pprPanic "getPackageDetails" (ppr pid)
+ Nothing -> pprPanic "unsafeGetUnitInfo" (ppr pid)
-lookupInstalledPackage :: PackageState -> InstalledUnitId -> Maybe UnitInfo
+lookupInstalledPackage :: PackageState -> UnitId -> Maybe UnitInfo
lookupInstalledPackage pkgstate uid = lookupInstalledPackage' (unitInfoMap pkgstate) uid
-lookupInstalledPackage' :: UnitInfoMap -> InstalledUnitId -> Maybe UnitInfo
+lookupInstalledPackage' :: UnitInfoMap -> UnitId -> Maybe UnitInfo
lookupInstalledPackage' (UnitInfoMap db _) uid = lookupUDFM db uid
-getInstalledPackageDetails :: HasDebugCallStack => PackageState -> InstalledUnitId -> UnitInfo
+getInstalledPackageDetails :: HasDebugCallStack => PackageState -> UnitId -> UnitInfo
getInstalledPackageDetails pkgstate uid =
case lookupInstalledPackage pkgstate uid of
Just config -> config
@@ -508,7 +506,7 @@ initPackages dflags = withTiming dflags
-- -----------------------------------------------------------------------------
-- Reading the package database(s)
-readPackageDatabases :: DynFlags -> IO [PackageDatabase]
+readPackageDatabases :: DynFlags -> IO [PackageDatabase UnitId]
readPackageDatabases dflags = do
conf_refs <- getPackageConfRefs dflags
confs <- liftM catMaybes $ mapM (resolvePackageDatabase dflags) conf_refs
@@ -564,7 +562,7 @@ resolvePackageDatabase dflags UserPkgDb = runMaybeT $ do
if exist then return pkgconf else mzero
resolvePackageDatabase _ (PkgDbPath name) = return $ Just name
-readPackageDatabase :: DynFlags -> FilePath -> IO PackageDatabase
+readPackageDatabase :: DynFlags -> FilePath -> IO (PackageDatabase UnitId)
readPackageDatabase dflags conf_file = do
isdir <- doesDirectoryExist conf_file
@@ -591,7 +589,7 @@ readPackageDatabase dflags conf_file = do
conf_file' = dropTrailingPathSeparator conf_file
top_dir = topDir dflags
pkgroot = takeDirectory conf_file'
- pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . toUnitInfo)
+ pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . mapUnitInfo (\(UnitKey x) -> UnitId x) unitIdFS . mkUnitKeyInfo)
proto_pkg_configs
--
return $ PackageDatabase conf_file' pkg_configs1
@@ -694,7 +692,7 @@ applyTrustFlag dflags prec_map unusable pkgs flag =
-- | A little utility to tell if the 'thisPackage' is indefinite
-- (if it is not, we should never use on-the-fly renaming.)
isIndefinite :: DynFlags -> Bool
-isIndefinite dflags = not (unitIdIsDefinite (thisPackage dflags))
+isIndefinite dflags = not (unitIsDefinite (thisPackage dflags))
applyPackageFlag
:: DynFlags
@@ -725,19 +723,18 @@ applyPackageFlag dflags prec_map pkg_db unusable no_hide_others pkgs vm flag =
reqs | UnitIdArg orig_uid <- arg = collectHoles orig_uid
| otherwise = Map.empty
- collectHoles uid = case splitUnitIdInsts uid of
- (_, Just indef) ->
+ collectHoles uid = case uid of
+ HoleUnit -> Map.empty
+ RealUnit {} -> Map.empty -- definite units don't have holes
+ VirtUnit indef ->
let local = [ Map.singleton
(moduleName mod)
- (Set.singleton $ IndefModule indef mod_name)
- | (mod_name, mod) <- indefUnitIdInsts indef
+ (Set.singleton $ Module indef mod_name)
+ | (mod_name, mod) <- instUnitInsts indef
, isHoleModule mod ]
- recurse = [ collectHoles (moduleUnitId mod)
- | (_, mod) <- indefUnitIdInsts indef ]
+ recurse = [ collectHoles (moduleUnit mod)
+ | (_, mod) <- instUnitInsts indef ]
in Map.unionsWith Set.union $ local ++ recurse
- -- Other types of unit identities don't have holes
- (_, Nothing) -> Map.empty
-
uv = UnitVisibility
{ uv_expose_all = b
@@ -746,7 +743,7 @@ applyPackageFlag dflags prec_map pkg_db unusable no_hide_others pkgs vm flag =
, uv_requirements = reqs
, uv_explicit = True
}
- vm' = Map.insertWith mappend (packageConfigId p) uv vm_cleared
+ vm' = Map.insertWith mappend (mkUnit p) uv vm_cleared
-- In the old days, if you said `ghc -package p-0.1 -package p-0.2`
-- (or if p-0.1 was registered in the pkgdb as exposed: True),
-- the second package flag would override the first one and you
@@ -771,7 +768,7 @@ applyPackageFlag dflags prec_map pkg_db unusable no_hide_others pkgs vm flag =
-- NB: renamings never clear
| (_:_) <- rns = vm
| otherwise = Map.filterWithKey
- (\k uv -> k == packageConfigId p
+ (\k uv -> k == mkUnit p
|| First (Just n) /= uv_package_name uv) vm
_ -> panic "applyPackageFlag"
@@ -779,7 +776,7 @@ applyPackageFlag dflags prec_map pkg_db unusable no_hide_others pkgs vm flag =
case findPackages prec_map pkg_db (PackageArg str) pkgs unusable of
Left ps -> packageFlagErr dflags flag ps
Right ps -> return vm'
- where vm' = foldl' (flip Map.delete) vm (map packageConfigId ps)
+ where vm' = foldl' (flip Map.delete) vm (map mkUnit ps)
-- | Like 'selectPackages', but doesn't return a list of unmatched
-- packages. Furthermore, any packages it returns are *renamed*
@@ -801,12 +798,14 @@ findPackages prec_map pkg_db arg pkgs unusable
then Just p
else Nothing
finder (UnitIdArg uid) p
- = let (iuid, mb_indef) = splitUnitIdInsts uid
- in if iuid == installedUnitInfoId p
- then Just (case mb_indef of
- Nothing -> p
- Just indef -> renamePackage pkg_db (indefUnitIdInsts indef) p)
- else Nothing
+ = case uid of
+ RealUnit (Definite iuid)
+ | iuid == unitId p
+ -> Just p
+ VirtUnit inst
+ | indefUnit (instUnitInstanceOf inst) == unitId p
+ -> Just (renamePackage pkg_db (instUnitInsts inst) p)
+ _ -> Nothing
selectPackages :: PackagePrecedenceIndex -> PackageArg -> [UnitInfo]
-> UnusablePackages
@@ -840,12 +839,12 @@ matchingStr str p
= str == unitPackageIdString p
|| str == unitPackageNameString p
-matchingId :: InstalledUnitId -> UnitInfo -> Bool
-matchingId uid p = uid == installedUnitInfoId p
+matchingId :: UnitId -> UnitInfo -> Bool
+matchingId uid p = uid == unitId p
matching :: PackageArg -> UnitInfo -> Bool
matching (PackageArg str) = matchingStr str
-matching (UnitIdArg (DefiniteUnitId (DefUnitId uid))) = matchingId uid
+matching (UnitIdArg (RealUnit (Definite uid))) = matchingId uid
matching (UnitIdArg _) = \_ -> False -- TODO: warn in this case
-- | This sorts a list of packages, putting "preferred" packages first.
@@ -950,7 +949,7 @@ type WiredInUnitId = String
type WiredPackagesMap = Map WiredUnitId WiredUnitId
wired_in_unitids :: [WiredInUnitId]
-wired_in_unitids = map unitIdString wiredInUnitIds
+wired_in_unitids = map unitString wiredInUnitIds
findWiredInPackages
:: DynFlags
@@ -969,7 +968,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
matches :: UnitInfo -> WiredInUnitId -> Bool
pc `matches` pid
-- See Note [The integer library] in GHC.Builtin.Names
- | pid == unitIdString integerUnitId
+ | pid == unitString integerUnitId
= unitPackageNameString pc `elem` ["integer-gmp", "integer-simple"]
pc `matches` pid = unitPackageNameString pc == pid
@@ -996,7 +995,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ]
all_exposed_ps =
[ p | p <- all_ps
- , Map.member (packageConfigId p) vis_map ] in
+ , Map.member (mkUnit p) vis_map ] in
case all_exposed_ps of
[] -> case all_ps of
[] -> notfound
@@ -1040,7 +1039,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap = Map.fromList
- [ (key, DefUnitId (stringToInstalledUnitId wiredInUnitId))
+ [ (key, Definite (stringToUnitId wiredInUnitId))
| (wiredInUnitId, pkg) <- wired_in_pkgs
, Just key <- pure $ definiteUnitInfoId pkg
]
@@ -1049,16 +1048,16 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
where upd_pkg pkg
| Just def_uid <- definiteUnitInfoId pkg
, Just wiredInUnitId <- Map.lookup def_uid wiredInMap
- = let fs = installedUnitIdFS (unDefUnitId wiredInUnitId)
+ = let fs = unitIdFS (unDefinite wiredInUnitId)
in pkg {
- unitId = fsToInstalledUnitId fs,
- unitInstanceOf = mkComponentId pkgstate fs
+ unitId = fsToUnitId fs,
+ unitInstanceOf = mkIndefUnitId pkgstate fs
}
| otherwise
= pkg
upd_deps pkg = pkg {
-- temporary harmless DefUnitId invariant violation
- unitDepends = map (unDefUnitId . upd_wired_in wiredInMap . DefUnitId) (unitDepends pkg),
+ unitDepends = map (unDefinite . upd_wired_in wiredInMap . Definite) (unitDepends pkg),
unitExposedModules
= map (\(k,v) -> (k, fmap (upd_wired_in_mod wiredInMap) v))
(unitExposedModules pkg)
@@ -1067,8 +1066,8 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
return (updateWiredInDependencies pkgs, wiredInMap)
--- Helper functions for rewiring Module and UnitId. These
--- rewrite UnitIds of modules in wired-in packages to the form known to the
+-- Helper functions for rewiring Module and Unit. These
+-- rewrite Units of modules in wired-in packages to the form known to the
-- compiler, as described in Note [Wired-in packages] in GHC.Types.Module.
--
-- For instance, base-4.9.0.0 will be rewritten to just base, to match
@@ -1077,13 +1076,14 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
upd_wired_in_mod :: WiredPackagesMap -> Module -> Module
upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m
-upd_wired_in_uid :: WiredPackagesMap -> UnitId -> UnitId
-upd_wired_in_uid wiredInMap (DefiniteUnitId def_uid) =
- DefiniteUnitId (upd_wired_in wiredInMap def_uid)
-upd_wired_in_uid wiredInMap (IndefiniteUnitId indef_uid) =
- IndefiniteUnitId $ newIndefUnitId
- (indefUnitIdComponentId indef_uid)
- (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (indefUnitIdInsts indef_uid))
+upd_wired_in_uid :: WiredPackagesMap -> Unit -> Unit
+upd_wired_in_uid wiredInMap u = case u of
+ HoleUnit -> HoleUnit
+ RealUnit def_uid -> RealUnit (upd_wired_in wiredInMap def_uid)
+ VirtUnit indef_uid ->
+ VirtUnit $ mkInstantiatedUnit
+ (instUnitInstanceOf indef_uid)
+ (map (\(x,y) -> (x,upd_wired_in_mod wiredInMap y)) (instUnitInsts indef_uid))
upd_wired_in :: WiredPackagesMap -> DefUnitId -> DefUnitId
upd_wired_in wiredInMap key
@@ -1092,10 +1092,10 @@ upd_wired_in wiredInMap key
updateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap
updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap)
- where f vm (from, to) = case Map.lookup (DefiniteUnitId from) vis_map of
+ where f vm (from, to) = case Map.lookup (RealUnit from) vis_map of
Nothing -> vm
- Just r -> Map.insert (DefiniteUnitId to) r
- (Map.delete (DefiniteUnitId from) vm)
+ Just r -> Map.insert (RealUnit to) r
+ (Map.delete (RealUnit from) vm)
-- ----------------------------------------------------------------------------
@@ -1106,17 +1106,17 @@ data UnusablePackageReason
IgnoredWithFlag
-- | This package transitively depends on a package that was never present
-- in any of the provided databases.
- | BrokenDependencies [InstalledUnitId]
+ | BrokenDependencies [UnitId]
-- | This package transitively depends on a package involved in a cycle.
- -- Note that the list of 'InstalledUnitId' reports the direct dependencies
+ -- Note that the list of 'UnitId' reports the direct dependencies
-- of this package that (transitively) depended on the cycle, and not
-- the actual cycle itself (which we report separately at high verbosity.)
- | CyclicDependencies [InstalledUnitId]
+ | CyclicDependencies [UnitId]
-- | This package transitively depends on a package which was ignored.
- | IgnoredDependencies [InstalledUnitId]
+ | IgnoredDependencies [UnitId]
-- | This package transitively depends on a package which was
-- shadowed by an ABI-incompatible package.
- | ShadowedDependencies [InstalledUnitId]
+ | ShadowedDependencies [UnitId]
instance Outputable UnusablePackageReason where
ppr IgnoredWithFlag = text "[ignored with flag]"
@@ -1125,7 +1125,7 @@ instance Outputable UnusablePackageReason where
ppr (IgnoredDependencies uids) = brackets (text "ignored" <+> ppr uids)
ppr (ShadowedDependencies uids) = brackets (text "shadowed" <+> ppr uids)
-type UnusablePackages = Map InstalledUnitId
+type UnusablePackages = Map UnitId
(UnitInfo, UnusablePackageReason)
pprReason :: SDoc -> UnusablePackageReason -> SDoc
@@ -1168,9 +1168,9 @@ reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
-- Utilities on the database
--
--- | A reverse dependency index, mapping an 'InstalledUnitId' to
--- the 'InstalledUnitId's which have a dependency on it.
-type RevIndex = Map InstalledUnitId [InstalledUnitId]
+-- | A reverse dependency index, mapping an 'UnitId' to
+-- the 'UnitId's which have a dependency on it.
+type RevIndex = Map UnitId [UnitId]
-- | Compute the reverse dependency index of a package database.
reverseDeps :: InstalledPackageIndex -> RevIndex
@@ -1179,12 +1179,12 @@ reverseDeps db = Map.foldl' go Map.empty db
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,
+-- | Given a list of 'UnitId's to remove, a database,
-- and a reverse dependency index (as computed by 'reverseDeps'),
-- remove those packages, plus any packages which depend on them.
-- Returns the pruned database, as well as a list of 'UnitInfo's
-- that was removed.
-removePackages :: [InstalledUnitId] -> RevIndex
+removePackages :: [UnitId] -> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [UnitInfo])
removePackages uids index m = go uids (m,[])
@@ -1203,7 +1203,7 @@ removePackages uids index m = go uids (m,[])
-- that do not exist in the index.
depsNotAvailable :: InstalledPackageIndex
-> UnitInfo
- -> [InstalledUnitId]
+ -> [UnitId]
depsNotAvailable pkg_map pkg = filter (not . (`Map.member` pkg_map)) (unitDepends pkg)
-- | Given a 'UnitInfo' from some 'InstalledPackageIndex'
@@ -1211,7 +1211,7 @@ depsNotAvailable pkg_map pkg = filter (not . (`Map.member` pkg_map)) (unitDepend
-- that do not exist, OR have mismatching ABIs.
depsAbiMismatch :: InstalledPackageIndex
-> UnitInfo
- -> [InstalledUnitId]
+ -> [UnitId]
depsAbiMismatch pkg_map pkg = map fst . filter (not . abiMatch) $ unitAbiDepends pkg
where
abiMatch (dep_uid, abi)
@@ -1244,13 +1244,13 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
-- the command line. We use this mapping to make sure we prefer
-- packages that were defined later on the command line, if there
-- is an ambiguity.
-type PackagePrecedenceIndex = Map InstalledUnitId Int
+type PackagePrecedenceIndex = Map UnitId Int
-- | Given a list of databases, merge them together, where
-- packages with the same unit id in later databases override
-- earlier ones. This does NOT check if the resulting database
-- makes sense (that's done by 'validateDatabase').
-mergeDatabases :: DynFlags -> [PackageDatabase]
+mergeDatabases :: DynFlags -> [PackageDatabase UnitId]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
mergeDatabases dflags = foldM merge (Map.empty, Map.empty) . zip [1..]
where
@@ -1269,7 +1269,7 @@ mergeDatabases dflags = foldM merge (Map.empty, Map.empty) . zip [1..]
-- The set of UnitIds which appear in both db and pkgs. These are the
-- ones that get overridden. Compute this just to give some
-- helpful debug messages at -v2
- override_set :: Set InstalledUnitId
+ override_set :: Set UnitId
override_set = Set.intersection (Map.keysSet db_map)
(Map.keysSet pkg_map)
@@ -1344,7 +1344,7 @@ mkPackageState
:: DynFlags
-- initial databases, in the order they were specified on
-- the command line (later databases shadow earlier ones)
- -> [PackageDatabase]
+ -> [PackageDatabase UnitId]
-> [PreloadUnitId] -- preloaded packages
-> IO (PackageState,
[PreloadUnitId], -- new packages to preload
@@ -1463,8 +1463,8 @@ 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 unitIsExposed p && unitIdIsDefinite (packageConfigId p) && mostPreferable p
- then Map.insert (packageConfigId p)
+ if unitIsExposed p && unitIsDefinite (mkUnit p) && mostPreferable p
+ then Map.insert (mkUnit p)
UnitVisibility {
uv_expose_all = True,
uv_renamings = [],
@@ -1568,7 +1568,7 @@ mkPackageState dflags dbs preload0 = do
$ (basicLinkedPackages ++ preload2)
-- Close the preload packages with their dependencies
- dep_preload <- closeDeps dflags pkg_db (zip (map toInstalledUnitId preload3) (repeat Nothing))
+ dep_preload <- closeDeps dflags pkg_db (zip (map toUnitId preload3) (repeat Nothing))
let new_dep_preload = filter (`notElem` preload0) dep_preload
let mod_map1 = mkModuleNameProvidersMap dflags pkg_db vis_map
@@ -1593,12 +1593,12 @@ mkPackageState dflags dbs preload0 = do
let new_insts = fmap (map (fmap (upd_wired_in_mod wired_map))) (thisUnitIdInsts_ dflags)
return (pstate, new_dep_preload, new_insts)
--- | Given a wired-in 'UnitId', "unwire" it into the 'UnitId'
+-- | Given a wired-in 'Unit', "unwire" it into the 'Unit'
-- that it was recorded as in the package database.
-unwireUnitId :: DynFlags -> UnitId -> UnitId
-unwireUnitId dflags uid@(DefiniteUnitId def_uid) =
- maybe uid DefiniteUnitId (Map.lookup def_uid (unwireMap (pkgState dflags)))
-unwireUnitId _ uid = uid
+unwireUnit :: DynFlags -> Unit-> Unit
+unwireUnit dflags uid@(RealUnit def_uid) =
+ maybe uid RealUnit (Map.lookup def_uid (unwireMap (pkgState dflags)))
+unwireUnit _ uid = uid
-- -----------------------------------------------------------------------------
-- | Makes the mapping from module to package info
@@ -1635,7 +1635,7 @@ mkModuleNameProvidersMap dflags pkg_db vis_map =
vis_map_extended = Map.union vis_map {- preferred -} default_vis
default_vis = Map.fromList
- [ (packageConfigId pkg, mempty)
+ [ (mkUnit pkg, mempty)
| pkg <- eltsUDFM (unUnitInfoMap pkg_db)
-- Exclude specific instantiations of an indefinite
-- package
@@ -1684,7 +1684,7 @@ mkModuleNameProvidersMap dflags pkg_db vis_map =
hiddens = [(m, mkModMap pk m ModHidden) | m <- hidden_mods]
- pk = packageConfigId pkg
+ pk = mkUnit pkg
unit_lookup uid = lookupUnit' (isIndefinite dflags) pkg_db uid
`orElse` pprPanic "unit_lookup" (ppr uid)
@@ -1701,7 +1701,7 @@ mkUnusableModuleNameProvidersMap unusables =
bindings = exposed ++ hidden
origin = ModUnusable reason
- pkg_id = packageConfigId pkg
+ pkg_id = mkUnit pkg
exposed = map get_exposed exposed_mods
hidden = [(m, mkModMap pkg_id m origin) | m <- hidden_mods]
@@ -1725,7 +1725,7 @@ addListTo = foldl' merge
where merge m (k, v) = MapStrict.insertWith (Map.unionWith mappend) k v m
-- | Create a singleton module mapping
-mkModMap :: UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
+mkModMap :: Unit -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap pkg mod = Map.singleton (mkModule pkg mod)
-- -----------------------------------------------------------------------------
@@ -1870,7 +1870,7 @@ lookupModuleInAllPackages dflags m
LookupFound a b -> [(a,b)]
LookupMultiple rs -> map f rs
where f (m,_) = (m, expectJust "lookupModule" (lookupUnit dflags
- (moduleUnitId m)))
+ (moduleUnit m)))
_ -> []
-- | The result of performing a lookup
@@ -1941,7 +1941,7 @@ lookupModuleWithSuggestions' dflags mod_map m mb_pn
-> (x:hidden_pkg, hidden_mod, unusable, exposed)
unit_lookup p = lookupUnit dflags p `orElse` pprPanic "lookupModuleWithSuggestions" (ppr p <+> ppr m)
- mod_unit = unit_lookup . moduleUnitId
+ mod_unit = unit_lookup . moduleUnit
-- Filters out origins which are not associated with the given package
-- qualifier. No-op if there is no package qualifier. Test if this
@@ -1996,7 +1996,7 @@ getPreloadPackagesAnd dflags pkgids0 =
-- Fixes #14525
if isIndefinite dflags
then []
- else map (toInstalledUnitId . moduleUnitId . snd)
+ else map (toUnitId . moduleUnit . snd)
(thisUnitIdInsts dflags)
state = pkgState dflags
pkg_map = unitInfoMap state
@@ -2010,8 +2010,8 @@ getPreloadPackagesAnd dflags pkgids0 =
-- in reverse dependency order (a package appears before those it depends on).
closeDeps :: DynFlags
-> UnitInfoMap
- -> [(InstalledUnitId, Maybe InstalledUnitId)]
- -> IO [InstalledUnitId]
+ -> [(UnitId, Maybe UnitId)]
+ -> IO [UnitId]
closeDeps dflags pkg_map ps
= throwErr dflags (closeDepsErr dflags pkg_map ps)
@@ -2023,8 +2023,8 @@ throwErr dflags m
closeDepsErr :: DynFlags
-> UnitInfoMap
- -> [(InstalledUnitId,Maybe InstalledUnitId)]
- -> MaybeErr MsgDoc [InstalledUnitId]
+ -> [(UnitId,Maybe UnitId)]
+ -> MaybeErr MsgDoc [UnitId]
closeDepsErr dflags pkg_map ps = foldM (add_package dflags pkg_map) [] ps
-- internal helper
@@ -2050,25 +2050,16 @@ add_package dflags pkg_db ps (p, mb_parent)
missingPackageMsg :: Outputable pkgid => pkgid -> SDoc
missingPackageMsg p = text "unknown package:" <+> ppr p
-missingDependencyMsg :: Maybe InstalledUnitId -> SDoc
+missingDependencyMsg :: Maybe UnitId -> SDoc
missingDependencyMsg Nothing = Outputable.empty
missingDependencyMsg (Just parent)
- = space <> parens (text "dependency of" <+> ftext (installedUnitIdFS parent))
+ = space <> parens (text "dependency of" <+> ftext (unitIdFS parent))
-- -----------------------------------------------------------------------------
-componentIdString :: ComponentId -> String
-componentIdString (ComponentId raw Nothing) = unpackFS raw
-componentIdString (ComponentId _raw (Just details)) =
- case componentName details of
- Nothing -> componentSourcePkdId details
- Just cname -> componentPackageName details
- ++ "-" ++ showVersion (componentPackageVersion details)
- ++ ":" ++ cname
-
-- Cabal packages may contain several components (programs, libraries, etc.).
-- As far as GHC is concerned, installed package components ("units") are
--- identified by an opaque ComponentId string provided by Cabal. As the string
+-- identified by an opaque IndefUnitId string provided by Cabal. As the string
-- contains a hash, we don't want to display it to users so GHC queries the
-- database to retrieve some infos about the original source package (name,
-- version, component name).
@@ -2078,26 +2069,26 @@ componentIdString (ComponentId _raw (Just details)) =
-- Component name is only displayed if it isn't the default library
--
-- To do this we need to query the database (cached in DynFlags). We cache
--- these details in the ComponentId itself because we don't want to query
--- DynFlags each time we pretty-print the ComponentId
+-- these details in the IndefUnitId itself because we don't want to query
+-- DynFlags each time we pretty-print the IndefUnitId
--
-mkComponentId :: PackageState -> FastString -> ComponentId
-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
+mkIndefUnitId :: PackageState -> FastString -> IndefUnitId
+mkIndefUnitId pkgstate raw =
+ let uid = UnitId raw
+ in case lookupInstalledPackage pkgstate uid of
+ Nothing -> Indefinite uid Nothing -- we didn't find the unit at all
+ Just c -> Indefinite uid $ Just $ UnitPprInfo
(unitPackageNameString c)
(unitPackageVersion c)
((unpackFS . unPackageName) <$> unitComponentName c)
- (unitPackageIdString c)
-- | Update component ID details from the database
-updateComponentId :: PackageState -> ComponentId -> ComponentId
-updateComponentId pkgstate (ComponentId raw _) = mkComponentId pkgstate raw
+updateIndefUnitId :: PackageState -> IndefUnitId -> IndefUnitId
+updateIndefUnitId pkgstate uid = mkIndefUnitId pkgstate (unitIdFS (indefUnit uid))
-displayInstalledUnitId :: PackageState -> InstalledUnitId -> Maybe String
-displayInstalledUnitId pkgstate uid =
+displayUnitId :: PackageState -> UnitId -> Maybe String
+displayUnitId pkgstate uid =
fmap unitPackageIdString (lookupInstalledPackage pkgstate uid)
-- | Will the 'Name' come from a dynamically linked package?
@@ -2125,7 +2116,7 @@ isDynLinkName platform this_mod name
-- I much rather have dynamic TH not supported than the entire Dynamic linking
-- not due to a hack.
-- Also not sure this would break on Windows anyway.
- OSMinGW32 -> moduleUnitId mod /= moduleUnitId this_mod
+ OSMinGW32 -> moduleUnit mod /= moduleUnit this_mod
-- For the other platforms, still perform the hack
_ -> mod /= this_mod
@@ -2149,7 +2140,7 @@ pprPackagesWith pprIPI pkgstate =
-- be different from the package databases (exposure, trust)
pprPackagesSimple :: PackageState -> SDoc
pprPackagesSimple = pprPackagesWith pprIPI
- where pprIPI ipi = let i = installedUnitIdFS (unitId ipi)
+ where pprIPI ipi = let i = unitIdFS (unitId ipi)
e = if unitIsExposed ipi then text "E" else text " "
t = if unitIsTrusted ipi then text "T" else text " "
in e <> t <> text " " <> ftext i
@@ -2162,7 +2153,7 @@ pprModuleMap mod_map =
pprLine (m,e) = ppr m $$ nest 50 (vcat (map (pprEntry m) (Map.toList e)))
pprEntry :: Outputable a => ModuleName -> (Module, a) -> SDoc
pprEntry m (m',o)
- | m == moduleName m' = ppr (moduleUnitId m') <+> parens (ppr o)
+ | m == moduleName m' = ppr (moduleUnit m') <+> parens (ppr o)
| otherwise = ppr m' <+> parens (ppr o)
fsPackageName :: UnitInfo -> FastString
@@ -2170,20 +2161,20 @@ 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.
-improveUnitId :: UnitInfoMap -> UnitId -> UnitId
-improveUnitId _ uid@(DefiniteUnitId _) = uid -- short circuit
-improveUnitId pkg_map uid =
+-- | Given a fully instantiated 'InstnatiatedUnit', improve it into a
+-- 'RealUnit' if we can find it in the package database.
+improveUnit :: UnitInfoMap -> Unit -> Unit
+improveUnit _ uid@(RealUnit _) = uid -- short circuit
+improveUnit pkg_map uid =
-- Do NOT lookup indefinite ones, they won't be useful!
case lookupUnit' False pkg_map uid of
Nothing -> uid
Just pkg ->
-- Do NOT improve if the indefinite unit id is not
-- part of the closure unique set. See
- -- Note [UnitId to InstalledUnitId improvement]
- if installedUnitInfoId pkg `elementOfUniqSet` preloadClosure pkg_map
- then packageConfigId pkg
+ -- Note [VirtUnit to RealUnit improvement]
+ if unitId pkg `elementOfUniqSet` preloadClosure pkg_map
+ then mkUnit pkg
else uid
-- | Retrieve the 'UnitInfoMap' from 'DynFlags'; used
diff --git a/compiler/GHC/Driver/Packages.hs-boot b/compiler/GHC/Driver/Packages.hs-boot
index eab2ebd60f..368057e2d3 100644
--- a/compiler/GHC/Driver/Packages.hs-boot
+++ b/compiler/GHC/Driver/Packages.hs-boot
@@ -2,14 +2,15 @@ module GHC.Driver.Packages where
import GHC.Prelude
import GHC.Data.FastString
import {-# SOURCE #-} GHC.Driver.Session (DynFlags)
-import {-# SOURCE #-} GHC.Types.Module(ComponentId, UnitId, InstalledUnitId)
+import {-# SOURCE #-} GHC.Types.Module(IndefUnitId, Unit, UnitId)
data PackageState
data UnitInfoMap
-data PackageDatabase
+data PackageDatabase unit
emptyPackageState :: PackageState
-componentIdString :: ComponentId -> String
-mkComponentId :: PackageState -> FastString -> ComponentId
-displayInstalledUnitId :: PackageState -> InstalledUnitId -> Maybe String
-improveUnitId :: UnitInfoMap -> UnitId -> UnitId
+mkIndefUnitId :: PackageState -> FastString -> IndefUnitId
+displayUnitId :: PackageState -> UnitId -> Maybe String
+improveUnit :: UnitInfoMap -> Unit -> Unit
getUnitInfoMap :: DynFlags -> UnitInfoMap
+unitInfoMap :: PackageState -> UnitInfoMap
getPackageState :: DynFlags -> PackageState
+updateIndefUnitId :: PackageState -> IndefUnitId -> IndefUnitId
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 0f8f52798b..6656b2d98a 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -490,7 +490,7 @@ link' dflags batch_attempt_linking hpt
return Succeeded
-linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [InstalledUnitId] -> IO Bool
+linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [UnitId] -> IO Bool
linkingNeeded dflags staticLink linkables pkg_deps = do
-- if the modification time on the executable is later than the
-- modification times on all of the objects and libraries, then omit
@@ -1611,13 +1611,13 @@ getLocation src_flavour mod_name = do
-----------------------------------------------------------------------------
-- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
-getHCFilePackages :: FilePath -> IO [InstalledUnitId]
+getHCFilePackages :: FilePath -> IO [UnitId]
getHCFilePackages filename =
Exception.bracket (openFile filename ReadMode) hClose $ \h -> do
l <- hGetLine h
case l of
'/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
- return (map stringToInstalledUnitId (words rest))
+ return (map stringToUnitId (words rest))
_other ->
return []
@@ -1648,10 +1648,10 @@ it is supported by both gcc and clang. Anecdotally nvcc supports
-Xlinker, but not -Wl.
-}
-linkBinary :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
+linkBinary :: DynFlags -> [FilePath] -> [UnitId] -> IO ()
linkBinary = linkBinary' False
-linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
+linkBinary' :: Bool -> DynFlags -> [FilePath] -> [UnitId] -> IO ()
linkBinary' staticLink dflags o_files dep_packages = do
let platform = targetPlatform dflags
toolSettings' = toolSettings dflags
@@ -1908,7 +1908,7 @@ maybeCreateManifest dflags exe_filename
| otherwise = return []
-linkDynLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
+linkDynLibCheck :: DynFlags -> [String] -> [UnitId] -> IO ()
linkDynLibCheck dflags o_files dep_packages
= do
when (haveRtsOptsFlags dflags) $ do
@@ -1922,7 +1922,7 @@ linkDynLibCheck dflags o_files dep_packages
-- | 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] -> [InstalledUnitId] -> IO ()
+linkStaticLib :: DynFlags -> [String] -> [UnitId] -> IO ()
linkStaticLib dflags o_files dep_packages = do
let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
modules = o_files ++ extra_ld_inputs
@@ -2220,7 +2220,7 @@ getGhcVersionPathName dflags = do
candidates <- case ghcVersionFile dflags of
Just path -> return [path]
Nothing -> (map (</> "ghcversion.h")) <$>
- (getPackageIncludePath dflags [toInstalledUnitId rtsUnitId])
+ (getPackageIncludePath dflags [toUnitId rtsUnitId])
found <- filterM doesFileExist candidates
case found of
diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs
index 4d4f9eab77..f10dafda27 100644
--- a/compiler/GHC/Driver/Plugins.hs
+++ b/compiler/GHC/Driver/Plugins.hs
@@ -58,7 +58,7 @@ import GHC.Driver.Session
import GHC.Driver.Types
import GHC.Driver.Monad
import GHC.Driver.Phases
-import GHC.Types.Module ( ModuleName, Module(moduleName))
+import GHC.Types.Module
import GHC.Utils.Fingerprint
import Data.List (sort)
import GHC.Utils.Outputable (Outputable(..), text, (<+>))
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index ec217590ff..5c39848a8d 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -246,7 +246,7 @@ import GHC.Types.Module
import {-# SOURCE #-} GHC.Driver.Plugins
import {-# SOURCE #-} GHC.Driver.Hooks
import {-# SOURCE #-} GHC.Builtin.Names ( mAIN )
-import {-# SOURCE #-} GHC.Driver.Packages (PackageState, emptyPackageState, PackageDatabase, mkComponentId)
+import {-# SOURCE #-} GHC.Driver.Packages (PackageState, emptyPackageState, PackageDatabase, mkIndefUnitId, updateIndefUnitId)
import GHC.Driver.Phases ( Phase(..), phaseInputExt )
import GHC.Driver.Flags
import GHC.Driver.Ways
@@ -520,8 +520,8 @@ data DynFlags = DynFlags {
solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver
-- Typically only 1 is needed
- thisInstalledUnitId :: InstalledUnitId, -- ^ Target unit-id
- thisComponentId_ :: Maybe ComponentId, -- ^ Unit-id to instantiate
+ thisUnitId :: UnitId, -- ^ Target unit-id
+ thisComponentId_ :: Maybe IndefUnitId, -- ^ Unit-id to instantiate
thisUnitIdInsts_ :: Maybe [(ModuleName, Module)], -- ^ How to instantiate the unit-id above
-- ways
@@ -626,7 +626,7 @@ data DynFlags = DynFlags {
packageEnv :: Maybe FilePath,
-- ^ Filepath to the package environment file (if overriding default)
- pkgDatabase :: Maybe [PackageDatabase],
+ pkgDatabase :: Maybe [PackageDatabase UnitId],
-- ^ Stack of package databases for the target platform.
--
-- A "package database" is a misleading name as it is really a Unit
@@ -1088,8 +1088,9 @@ isNoLink _ = False
-- is used.
data PackageArg =
PackageArg String -- ^ @-package@, by 'PackageName'
- | UnitIdArg UnitId -- ^ @-package-id@, by 'UnitId'
+ | UnitIdArg Unit -- ^ @-package-id@, by 'Unit'
deriving (Eq, Show)
+
instance Outputable PackageArg where
ppr (PackageArg pn) = text "package" <+> text pn
ppr (UnitIdArg uid) = text "unit" <+> ppr uid
@@ -1320,7 +1321,7 @@ defaultDynFlags mySettings llvmConfig =
reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH,
solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS,
- thisInstalledUnitId = toInstalledUnitId mainUnitId,
+ thisUnitId = toUnitId mainUnitId,
thisUnitIdInsts_ = Nothing,
thisComponentId_ = Nothing,
@@ -1952,16 +1953,16 @@ setOutputHi f d = d { outputHi = f}
setJsonLogAction :: DynFlags -> DynFlags
setJsonLogAction d = d { log_action = jsonLogAction }
-thisComponentId :: DynFlags -> ComponentId
+thisComponentId :: DynFlags -> IndefUnitId
thisComponentId dflags =
let pkgstate = pkgState dflags
in case thisComponentId_ dflags of
- Just (ComponentId raw _) -> mkComponentId pkgstate raw
+ Just uid -> updateIndefUnitId pkgstate uid
Nothing ->
case thisUnitIdInsts_ dflags of
Just _ ->
throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")
- Nothing -> mkComponentId pkgstate (unitIdFS (thisPackage dflags))
+ Nothing -> mkIndefUnitId pkgstate (unitFS (thisPackage dflags))
thisUnitIdInsts :: DynFlags -> [(ModuleName, Module)]
thisUnitIdInsts dflags =
@@ -1969,36 +1970,36 @@ thisUnitIdInsts dflags =
Just insts -> insts
Nothing -> []
-thisPackage :: DynFlags -> UnitId
+thisPackage :: DynFlags -> Unit
thisPackage dflags =
case thisUnitIdInsts_ dflags of
Nothing -> default_uid
Just insts
| all (\(x,y) -> mkHoleModule x == y) insts
- -> newUnitId (thisComponentId dflags) insts
+ -> mkVirtUnit (thisComponentId dflags) insts
| otherwise
-> default_uid
where
- default_uid = DefiniteUnitId (DefUnitId (thisInstalledUnitId dflags))
+ default_uid = RealUnit (Definite (thisUnitId dflags))
-parseUnitIdInsts :: String -> [(ModuleName, Module)]
-parseUnitIdInsts str = case filter ((=="").snd) (readP_to_S parse str) of
+parseUnitInsts :: String -> Instantiations
+parseUnitInsts str = case filter ((=="").snd) (readP_to_S parse str) of
[(r, "")] -> r
_ -> throwGhcException $ CmdLineError ("Can't parse -instantiated-with: " ++ str)
where parse = sepBy parseEntry (R.char ',')
parseEntry = do
n <- parseModuleName
_ <- R.char '='
- m <- parseModuleId
+ m <- parseHoleyModule
return (n, m)
setUnitIdInsts :: String -> DynFlags -> DynFlags
setUnitIdInsts s d =
- d { thisUnitIdInsts_ = Just (parseUnitIdInsts s) }
+ d { thisUnitIdInsts_ = Just (parseUnitInsts s) }
setComponentId :: String -> DynFlags -> DynFlags
setComponentId s d =
- d { thisComponentId_ = Just (ComponentId (fsLit s) Nothing) }
+ d { thisComponentId_ = Just (Indefinite (UnitId (fsLit s)) Nothing) }
addPluginModuleName :: String -> DynFlags -> DynFlags
addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }
@@ -4554,13 +4555,13 @@ exposePackage, exposePackageId, hidePackage,
exposePackage p = upd (exposePackage' p)
exposePackageId p =
upd (\s -> s{ packageFlags =
- parsePackageFlag "-package-id" parseUnitIdArg p : packageFlags s })
+ parsePackageFlag "-package-id" parseUnitArg p : packageFlags s })
exposePluginPackage p =
upd (\s -> s{ pluginPackageFlags =
parsePackageFlag "-plugin-package" parsePackageArg p : pluginPackageFlags s })
exposePluginPackageId p =
upd (\s -> s{ pluginPackageFlags =
- parsePackageFlag "-plugin-package-id" parseUnitIdArg p : pluginPackageFlags s })
+ parsePackageFlag "-plugin-package-id" parseUnitArg p : pluginPackageFlags s })
hidePackage p =
upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
ignorePackage p =
@@ -4580,12 +4581,12 @@ parsePackageArg :: ReadP PackageArg
parsePackageArg =
fmap PackageArg (munch1 (\c -> isAlphaNum c || c `elem` ":-_."))
-parseUnitIdArg :: ReadP PackageArg
-parseUnitIdArg =
- fmap UnitIdArg parseUnitId
+parseUnitArg :: ReadP PackageArg
+parseUnitArg =
+ fmap UnitIdArg parseUnit
setUnitId :: String -> DynFlags -> DynFlags
-setUnitId p d = d { thisInstalledUnitId = stringToInstalledUnitId p }
+setUnitId p d = d { thisUnitId = stringToUnitId p }
-- | Given a 'ModuleName' of a signature in the home library, find
-- out how it is instantiated. E.g., the canonical form of
@@ -4598,7 +4599,7 @@ canonicalizeHomeModule dflags mod_name =
canonicalizeModuleIfHome :: DynFlags -> Module -> Module
canonicalizeModuleIfHome dflags mod
- = if thisPackage dflags == moduleUnitId mod
+ = if thisPackage dflags == moduleUnit mod
then canonicalizeHomeModule dflags (moduleName mod)
else mod
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index 2bddbe8a54..07e7cd7001 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -872,8 +872,8 @@ type FinderCache = InstalledModuleEnv InstalledFindResult
data InstalledFindResult
= InstalledFound ModLocation InstalledModule
- | InstalledNoPackage InstalledUnitId
- | InstalledNotFound [FilePath] (Maybe InstalledUnitId)
+ | InstalledNoPackage UnitId
+ | InstalledNotFound [FilePath] (Maybe UnitId)
-- | The result of searching for an imported module.
--
@@ -883,29 +883,29 @@ data InstalledFindResult
data FindResult
= Found ModLocation Module
-- ^ The module was found
- | NoPackage UnitId
- -- ^ The requested package was not found
+ | NoPackage Unit
+ -- ^ The requested unit was not found
| FoundMultiple [(Module, ModuleOrigin)]
-- ^ _Error_: both in multiple packages
-- | Not found
| NotFound
- { fr_paths :: [FilePath] -- Places where I looked
+ { fr_paths :: [FilePath] -- ^ Places where I looked
- , fr_pkg :: Maybe UnitId -- Just p => module is in this package's
- -- manifest, but couldn't find
- -- the .hi file
+ , fr_pkg :: Maybe Unit -- ^ Just p => module is in this unit's
+ -- manifest, but couldn't find the
+ -- .hi file
- , fr_mods_hidden :: [UnitId] -- Module is in these packages,
+ , fr_mods_hidden :: [Unit] -- ^ Module is in these units,
-- but the *module* is hidden
- , fr_pkgs_hidden :: [UnitId] -- Module is in these packages,
- -- but the *package* is hidden
+ , fr_pkgs_hidden :: [Unit] -- ^ Module is in these units,
+ -- but the *unit* is hidden
- -- Modules are in these packages, but it is unusable
- , fr_unusables :: [(UnitId, UnusablePackageReason)]
+ -- | Module is in these units, but it is unusable
+ , fr_unusables :: [(Unit, UnusablePackageReason)]
- , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
+ , fr_suggestions :: [ModuleSuggestion] -- ^ Possible mis-spelled modules
}
{-
@@ -1134,11 +1134,11 @@ mi_semantic_module iface = case mi_sig_of iface of
-- 'ModIface' depends on.
mi_free_holes :: ModIface -> UniqDSet ModuleName
mi_free_holes iface =
- case splitModuleInsts (mi_module iface) of
+ case getModuleInstantiation (mi_module iface) of
(_, Just indef)
-- A mini-hack: we rely on the fact that 'renameFreeHoles'
-- drops things that aren't holes.
- -> renameFreeHoles (mkUniqDSet cands) (indefUnitIdInsts (indefModuleUnitId indef))
+ -> renameFreeHoles (mkUniqDSet cands) (instUnitInsts (moduleUnit indef))
_ -> emptyUniqDSet
where
cands = map fst (dep_mods (mi_deps iface))
@@ -1517,7 +1517,7 @@ data CgGuts
cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
cg_foreign_files :: ![(ForeignSrcLang, FilePath)],
- cg_dep_pkgs :: ![InstalledUnitId], -- ^ Dependent packages, used to
+ cg_dep_pkgs :: ![UnitId], -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information
cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
@@ -1850,7 +1850,7 @@ setInteractivePackage :: HscEnv -> HscEnv
-- Set the 'thisPackage' DynFlag to 'interactive'
setInteractivePackage hsc_env
= hsc_env { hsc_dflags = (hsc_dflags hsc_env)
- { thisInstalledUnitId = toInstalledUnitId interactiveUnitId } }
+ { thisUnitId = toUnitId interactiveUnitId } }
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName ic n = ic{ic_int_print = n}
@@ -1944,8 +1944,8 @@ Note [Printing unit ids]
In the old days, original names were tied to PackageIds, which directly
corresponded to the entities that users wrote in Cabal files, and were perfectly
suitable for printing when we need to disambiguate packages. However, with
-UnitId, the situation can be different: if the key is instantiated with
-some holes, we should try to give the user some more useful information.
+instantiated units, the situation can be different: if the key is instantiated
+with some holes, we should try to give the user some more useful information.
-}
-- | Creates some functions that work out the best ways to format
@@ -2011,10 +2011,10 @@ mkPrintUnqualified dflags env = QueryQualify qual_name
-- is only one exposed package which exports this module, don't qualify.
mkQualModule :: DynFlags -> QueryQualifyModule
mkQualModule dflags mod
- | moduleUnitId mod == thisPackage dflags = False
+ | moduleUnit mod == thisPackage dflags = False
| [(_, pkgconfig)] <- lookup,
- packageConfigId pkgconfig == moduleUnitId mod
+ mkUnit pkgconfig == moduleUnit mod
-- this says: we are given a module P:M, is there just one exposed package
-- that exposes a module M, and is it package P?
= False
@@ -2509,7 +2509,7 @@ data Dependencies
-- I.e. modules that this one imports, or that are in the
-- dep_mods of those directly-imported modules
- , dep_pkgs :: [(InstalledUnitId, Bool)]
+ , dep_pkgs :: [(UnitId, Bool)]
-- ^ All packages transitively below this module
-- I.e. packages to which this module's direct imports belong,
-- or that are in the dep_pkgs of those modules
@@ -2932,7 +2932,7 @@ data ModSummary
}
ms_installed_mod :: ModSummary -> InstalledModule
-ms_installed_mod = fst . splitModuleInsts . ms_mod
+ms_installed_mod = fst . getModuleInstantiation . ms_mod
ms_mod_name :: ModSummary -> ModuleName
ms_mod_name = moduleName . ms_mod
View Lorry Controller Status