summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Driver/Backpack.hs32
-rw-r--r--compiler/GHC/Driver/Backpack/Syntax.hs2
-rw-r--r--compiler/GHC/Iface/Recomp.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs4
-rw-r--r--compiler/GHC/Unit.hs8
-rw-r--r--compiler/GHC/Unit/Home.hs2
-rw-r--r--compiler/GHC/Unit/Info.hs7
-rw-r--r--compiler/GHC/Unit/Module.hs2
-rw-r--r--compiler/GHC/Unit/Parser.hs9
-rw-r--r--compiler/GHC/Unit/State.hs27
-rw-r--r--compiler/GHC/Unit/Types.hs28
-rw-r--r--compiler/GHC/Unit/Types.hs-boot2
-rw-r--r--libraries/ghc-boot/GHC/Unit/Database.hs19
-rw-r--r--utils/ghc-pkg/Main.hs5
14 files changed, 60 insertions, 89 deletions
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index c4594329eb..57a7d1909f 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -122,14 +122,14 @@ doBackpack [src_filename] = do
innerBkpM $ do
let (cid, insts) = computeUnitId lunit
if null insts
- then if cid == Indefinite (UnitId (fsLit "main"))
+ then if cid == UnitId (fsLit "main")
then compileExe lunit
else compileUnit cid []
else typecheckUnit cid insts
doBackpack _ =
throwGhcException (CmdLineError "--backpack can only process a single file")
-computeUnitId :: LHsUnit HsComponentId -> (IndefUnitId, [(ModuleName, Module)])
+computeUnitId :: LHsUnit HsComponentId -> (UnitId, [(ModuleName, Module)])
computeUnitId (L _ unit) = (cid, [ (r, mkHoleModule r) | r <- reqs ])
where
cid = hsComponentId (unLoc (hsunitName unit))
@@ -155,7 +155,7 @@ data SessionType
-- | Create a temporary Session to do some sort of type checking or
-- compilation.
-withBkpSession :: IndefUnitId
+withBkpSession :: UnitId
-> [(ModuleName, Module)]
-> [(Unit, ModRenaming)]
-> SessionType -- what kind of session are we doing
@@ -163,7 +163,7 @@ withBkpSession :: IndefUnitId
-> BkpM a
withBkpSession cid insts deps session_type do_this = do
dflags <- getDynFlags
- let cid_fs = unitFS (indefUnit cid)
+ let cid_fs = unitFS cid
is_primary = False
uid_str = unpackFS (mkInstantiatedUnitHash cid insts)
cid_str = unpackFS cid_fs
@@ -193,7 +193,7 @@ withBkpSession cid insts deps session_type do_this = do
-- if we don't have any instantiation, don't
-- fill `homeUnitInstanceOfId` as it makes no
-- sense (we're not instantiating anything)
- , homeUnitInstanceOf_ = if null insts then Nothing else Just (indefUnit cid)
+ , homeUnitInstanceOf_ = if null insts then Nothing else Just cid
, homeUnitId_ = case session_type of
TcSession -> newUnitId cid Nothing
-- No hash passed if no instances
@@ -245,21 +245,21 @@ withBkpSession cid insts deps session_type do_this = do
withBkpExeSession :: [(Unit, ModRenaming)] -> BkpM a -> BkpM a
withBkpExeSession deps do_this =
- withBkpSession (Indefinite (UnitId (fsLit "main"))) [] deps ExeSession do_this
+ withBkpSession (UnitId (fsLit "main")) [] deps ExeSession do_this
-getSource :: IndefUnitId -> BkpM (LHsUnit HsComponentId)
+getSource :: UnitId -> 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 :: IndefUnitId -> [(ModuleName, Module)] -> BkpM ()
+typecheckUnit :: UnitId -> [(ModuleName, Module)] -> BkpM ()
typecheckUnit cid insts = do
lunit <- getSource cid
buildUnit TcSession cid insts lunit
-compileUnit :: IndefUnitId -> [(ModuleName, Module)] -> BkpM ()
+compileUnit :: UnitId -> [(ModuleName, Module)] -> BkpM ()
compileUnit cid insts = do
-- Let everyone know we're building this unit
msgUnitId (mkVirtUnit cid insts)
@@ -287,7 +287,7 @@ hsunitDeps include_sigs unit = concatMap get_dep (hsunitBody unit)
convRn (L _ (Renaming (L _ from) (Just (L _ to)))) = (from, to)
get_dep _ = []
-buildUnit :: SessionType -> IndefUnitId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()
+buildUnit :: SessionType -> UnitId -> [(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
@@ -342,7 +342,7 @@ buildUnit session cid insts lunit = do
obj_files = concatMap getOfiles linkables
state = hsc_units hsc_env
- let compat_fs = unitIdFS (indefUnit cid)
+ let compat_fs = unitIdFS cid
compat_pn = PackageName compat_fs
unit_id = homeUnitId (hsc_home_unit hsc_env)
@@ -475,7 +475,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 IndefUnitId (LHsUnit HsComponentId),
+ bkp_table :: Map UnitId (LHsUnit HsComponentId),
-- | When a package we are compiling includes another package
-- which has not been compiled, we bump the level and compile
-- that.
@@ -631,7 +631,7 @@ type PackageNameMap a = UniqFM PackageName a
-- to use this for anything
unitDefines :: LHsUnit PackageName -> (PackageName, HsComponentId)
unitDefines (L _ HsUnit{ hsunitName = L _ pn@(PackageName fs) })
- = (pn, HsComponentId pn (Indefinite (UnitId fs)))
+ = (pn, HsComponentId pn (UnitId fs))
bkpPackageNameMap :: [LHsUnit PackageName] -> PackageNameMap HsComponentId
bkpPackageNameMap units = listToUFM (map unitDefines units)
@@ -924,7 +924,7 @@ hsModuleToModSummary pn hsc_src modname
-- | Create a new, externally provided hashed unit id from
-- a hash.
-newUnitId :: IndefUnitId -> Maybe FastString -> UnitId
+newUnitId :: UnitId -> Maybe FastString -> UnitId
newUnitId uid mhash = case mhash of
- Nothing -> indefUnit uid
- Just hash -> UnitId (unitIdFS (indefUnit uid) `appendFS` mkFastString "+" `appendFS` hash)
+ Nothing -> uid
+ Just hash -> UnitId (unitIdFS uid `appendFS` mkFastString "+" `appendFS` hash)
diff --git a/compiler/GHC/Driver/Backpack/Syntax.hs b/compiler/GHC/Driver/Backpack/Syntax.hs
index edaf5200d3..a0529fce2e 100644
--- a/compiler/GHC/Driver/Backpack/Syntax.hs
+++ b/compiler/GHC/Driver/Backpack/Syntax.hs
@@ -39,7 +39,7 @@ import GHC.Utils.Outputable
data HsComponentId = HsComponentId {
hsPackageName :: PackageName,
- hsComponentId :: IndefUnitId
+ hsComponentId :: UnitId
}
instance Outputable HsComponentId where
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 5e7e687087..0f7b3f353c 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -553,7 +553,7 @@ checkDependencies hsc_env summary iface
prev_dep_mods = map gwib_mod $ Set.toAscList $ dep_direct_mods (mi_deps iface)
prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface))
(dep_plugin_pkgs (mi_deps iface)))
- bkpk_units = map (("Signature",) . indefUnit . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface)))
+ bkpk_units = map (("Signature",) . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface)))
implicit_deps = map ("Implicit",) (implicitPackageDeps dflags)
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index bb0140d5e8..5948f5a931 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -626,7 +626,7 @@ mergeSignatures
let insts = instUnitInsts iuid
isFromSignaturePackage =
let inst_uid = instUnitInstanceOf iuid
- pkg = unsafeLookupUnitId unit_state (indefUnit inst_uid)
+ pkg = unsafeLookupUnitId unit_state inst_uid
in null (unitExposedModules pkg)
-- 3(a). Rename the exports according to how the dependency
-- was instantiated. The resulting export list will be accurate
@@ -1076,7 +1076,7 @@ instantiateSignature = do
-- the local one just to get the information? Hmm...
massert (isHomeModule home_unit outer_mod )
massert (isHomeUnitInstantiating home_unit)
- let uid = Indefinite (homeUnitInstanceOf home_unit)
+ let uid = homeUnitInstanceOf home_unit
inner_mod `checkImplements`
Module
(mkInstantiatedUnit uid (homeUnitInstantiations home_unit))
diff --git a/compiler/GHC/Unit.hs b/compiler/GHC/Unit.hs
index 2c33314429..d5d338e549 100644
--- a/compiler/GHC/Unit.hs
+++ b/compiler/GHC/Unit.hs
@@ -153,10 +153,6 @@ synonyms, classes, etc.) to typecheck modules depending on them but not
enough to compile them. As such, indefinite units found in databases only
provide module interfaces (the .hi ones this time), not object code.
-To distinguish between indefinite and definite unit ids at the type level, we
-respectively use 'IndefUnitId' and 'DefUnitId' datatypes that are basically
-wrappers over 'UnitId'.
-
Unit instantiation / on-the-fly instantiation
---------------------------------------------
@@ -224,7 +220,7 @@ on-the-fly:
'InstantiatedUnit' has two interesting fields:
- * instUnitInstanceOf :: IndefUnitId
+ * instUnitInstanceOf :: UnitId
-- ^ the indefinite unit that is instantiated
* instUnitInsts :: [(ModuleName,(Unit,ModuleName)]
@@ -267,7 +263,7 @@ themselves. It is a reminiscence of previous terminology (when "instanceOf" was
, ...
}
-TODO: We should probably have `instanceOf :: Maybe IndefUnitId` instead.
+TODO: We should probably have `instanceOf :: Maybe UnitId` instead.
Note [Pretty-printing UnitId]
diff --git a/compiler/GHC/Unit/Home.hs b/compiler/GHC/Unit/Home.hs
index fa8a0b1d6f..02b60e64c9 100644
--- a/compiler/GHC/Unit/Home.hs
+++ b/compiler/GHC/Unit/Home.hs
@@ -103,7 +103,7 @@ homeUnitInstanceOfMaybe _ = Nothing
-- produce any code object that rely on the unit id of this virtual unit.
homeUnitAsUnit :: HomeUnit -> Unit
homeUnitAsUnit (DefiniteHomeUnit u _) = RealUnit (Definite u)
-homeUnitAsUnit (IndefiniteHomeUnit u is) = mkVirtUnit (Indefinite u) is
+homeUnitAsUnit (IndefiniteHomeUnit u is) = mkVirtUnit u is
-- | Map over the unit identifier for instantiating units
homeUnitMap :: IsUnitId v => (u -> v) -> GenHomeUnit u -> GenHomeUnit v
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs
index 2f4a9a607c..b8a238927b 100644
--- a/compiler/GHC/Unit/Info.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -60,7 +60,7 @@ import Data.List (isPrefixOf, stripPrefix)
--
-- These two identifiers are different for wired-in packages. See Note [About
-- Units] in "GHC.Unit"
-type GenUnitInfo unit = GenericUnitInfo (Indefinite unit) PackageId PackageName unit ModuleName (GenModule (GenUnit unit))
+type GenUnitInfo unit = GenericUnitInfo PackageId PackageName unit ModuleName (GenModule (GenUnit unit))
-- | Information about an installed unit (units are identified by their database
-- UnitKey)
@@ -74,7 +74,6 @@ type UnitInfo = GenUnitInfo UnitId
mkUnitKeyInfo :: DbUnitInfo -> UnitKeyInfo
mkUnitKeyInfo = mapGenericUnitInfo
mkUnitKey'
- mkIndefUnitKey'
mkPackageIdentifier'
mkPackageName'
mkModuleName'
@@ -84,9 +83,8 @@ mkUnitKeyInfo = mapGenericUnitInfo
mkPackageName' = PackageName . mkFastStringByteString
mkUnitKey' = UnitKey . mkFastStringByteString
mkModuleName' = mkModuleNameFS . mkFastStringByteString
- mkIndefUnitKey' cid = Indefinite (mkUnitKey' cid)
mkVirtUnitKey' i = case i of
- DbInstUnitId cid insts -> mkVirtUnit (mkIndefUnitKey' cid) (fmap (bimap mkModuleName' mkModule') insts)
+ DbInstUnitId cid insts -> mkVirtUnit (mkUnitKey' cid) (fmap (bimap mkModuleName' mkModule') insts)
DbUnitId uid -> RealUnit (Definite (mkUnitKey' uid))
mkModule' m = case m of
DbModule uid n -> mkModule (mkVirtUnitKey' uid) (mkModuleName' n)
@@ -96,7 +94,6 @@ mkUnitKeyInfo = mapGenericUnitInfo
mapUnitInfo :: IsUnitId v => (u -> v) -> GenUnitInfo u -> GenUnitInfo v
mapUnitInfo f = mapGenericUnitInfo
f -- unit identifier
- (fmap f) -- indefinite unit identifier
id -- package identifier
id -- package name
id -- module name
diff --git a/compiler/GHC/Unit/Module.hs b/compiler/GHC/Unit/Module.hs
index 6431aaeae2..0ebfa73d16 100644
--- a/compiler/GHC/Unit/Module.hs
+++ b/compiler/GHC/Unit/Module.hs
@@ -106,7 +106,7 @@ getModuleInstantiation m =
-- | Return the unit-id this unit is an instance of and the module instantiations (if any).
getUnitInstantiations :: Unit -> (UnitId, Maybe InstantiatedUnit)
-getUnitInstantiations (VirtUnit iuid) = (indefUnit (instUnitInstanceOf iuid), Just iuid)
+getUnitInstantiations (VirtUnit iuid) = (instUnitInstanceOf iuid, Just iuid)
getUnitInstantiations (RealUnit (Definite uid)) = (uid, Nothing)
getUnitInstantiations HoleUnit = error "Hole unit"
diff --git a/compiler/GHC/Unit/Parser.hs b/compiler/GHC/Unit/Parser.hs
index fddd594e8e..f9735306de 100644
--- a/compiler/GHC/Unit/Parser.hs
+++ b/compiler/GHC/Unit/Parser.hs
@@ -1,7 +1,7 @@
-- | Parsers for unit/module identifiers
module GHC.Unit.Parser
( parseUnit
- , parseIndefUnitId
+ , parseUnitId
, parseHoleyModule
, parseModSubst
)
@@ -21,7 +21,7 @@ parseUnit :: ReadP Unit
parseUnit = parseVirtUnitId <++ parseDefUnitId
where
parseVirtUnitId = do
- uid <- parseIndefUnitId
+ uid <- parseUnitId
insts <- parseModSubst
return (mkVirtUnit uid insts)
parseDefUnitId = do
@@ -33,11 +33,6 @@ parseUnitId = do
s <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
return (UnitId (mkFastString s))
-parseIndefUnitId :: ReadP IndefUnitId
-parseIndefUnitId = do
- uid <- parseUnitId
- return (Indefinite uid)
-
parseHoleyModule :: ReadP Module
parseHoleyModule = parseModuleVar <++ parseModule
where
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 59cc444dc9..e7ddf779f5 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -412,9 +412,11 @@ data UnitState = UnitState {
-- See Note [VirtUnit to RealUnit improvement]
preloadClosure :: PreloadUnitClosure,
- -- | A mapping of 'PackageName' to 'IndefUnitId'. This is used when
- -- users refer to packages in Backpack includes.
- packageNameMap :: UniqFM PackageName IndefUnitId,
+ -- | A mapping of 'PackageName' to 'UnitId'. If several units have the same
+ -- package name (e.g. different instantiations), then we return one of them...
+ -- This is used when users refer to packages in Backpack includes.
+ -- And also to resolve package qualifiers with the PackageImports extension.
+ packageNameMap :: UniqFM PackageName UnitId,
-- | A mapping from database unit keys to wired in unit ids.
wireMap :: Map UnitId UnitId,
@@ -498,7 +500,7 @@ lookupUnit' allowOnTheFlyInst pkg_map closure u = case u of
-> -- lookup UnitInfo of the indefinite unit to be instantiated and
-- instantiate it on-the-fly
fmap (renameUnitInfo pkg_map closure (instUnitInsts i))
- (Map.lookup (indefUnit (instUnitInstanceOf i)) pkg_map)
+ (Map.lookup (instUnitInstanceOf i) pkg_map)
| otherwise
-> -- lookup UnitInfo by virtual UnitId. This is used to find indefinite
@@ -531,7 +533,7 @@ unsafeLookupUnitId state uid = case lookupUnitId state uid of
-- | Find the unit 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 :: UnitState -> PackageName -> Maybe IndefUnitId
+lookupPackageName :: UnitState -> PackageName -> Maybe UnitId
lookupPackageName pkgstate n = lookupUFM (packageNameMap pkgstate) n
-- | Search for units with a given package ID (e.g. \"foo-0.1\")
@@ -936,7 +938,7 @@ findPackages prec_map pkg_map closure arg pkgs unusable
| iuid == unitId p
-> Just p
VirtUnit inst
- | indefUnit (instUnitInstanceOf inst) == unitId p
+ | instUnitInstanceOf inst == unitId p
-> Just (renameUnitInfo pkg_map closure (instUnitInsts inst) p)
_ -> Nothing
@@ -1108,7 +1110,7 @@ findWiredInUnits logger prec_map pkgs vis_map = do
where upd_pkg pkg
| Just wiredInUnitId <- Map.lookup (unitId pkg) wiredInMap
= pkg { unitId = wiredInUnitId
- , unitInstanceOf = fmap (const wiredInUnitId) (unitInstanceOf pkg)
+ , unitInstanceOf = wiredInUnitId
-- every non instantiated unit is an instance of
-- itself (required by Backpack...)
--
@@ -2002,14 +2004,7 @@ instance Outputable UnitErr where
-- to form @mod_name@, or @[]@ if this is not a requirement.
requirementMerges :: UnitState -> ModuleName -> [InstantiatedModule]
requirementMerges pkgstate mod_name =
- fmap fixupModule $ fromMaybe [] (Map.lookup mod_name (requirementContext pkgstate))
- where
- -- update IndefUnitId ppr info as they may have changed since the
- -- time the IndefUnitId was created
- fixupModule (Module iud name) = Module iud' name
- where
- iud' = iud { instUnitInstanceOf = cid' }
- cid' = instUnitInstanceOf iud
+ fromMaybe [] (Map.lookup mod_name (requirementContext pkgstate))
-- -----------------------------------------------------------------------------
@@ -2017,7 +2012,7 @@ requirementMerges pkgstate mod_name =
--
-- Cabal packages may contain several components (programs, libraries, etc.).
-- As far as GHC is concerned, installed package components ("units") are
--- identified by an opaque IndefUnitId string provided by Cabal. As the string
+-- identified by an opaque UnitId 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).
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 890e92b008..39efeb6e60 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -28,7 +28,6 @@ module GHC.Unit.Types
, UnitKey (..)
, GenInstantiatedUnit (..)
, InstantiatedUnit
- , IndefUnitId
, DefUnitId
, Instantiations
, GenInstantiations
@@ -54,7 +53,6 @@ module GHC.Unit.Types
-- * Utils
, Definite (..)
- , Indefinite (..)
-- * Wired-in units
, primUnitId
@@ -248,7 +246,7 @@ data GenUnit uid
-- see Note [VirtUnit to RealUnit improvement].
--
-- An indefinite unit identifier pretty-prints to something like
--- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'IndefUnitId', and the
+-- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'UnitId', and the
-- brackets enclose the module substitution).
data GenInstantiatedUnit unit
= InstantiatedUnit {
@@ -258,8 +256,8 @@ data GenInstantiatedUnit unit
instUnitFS :: !FastString,
-- | Cached unique of 'unitFS'.
instUnitKey :: !Unique,
- -- | The indefinite unit being instantiated.
- instUnitInstanceOf :: !(Indefinite unit),
+ -- | The (indefinite) unit being instantiated.
+ instUnitInstanceOf :: !unit,
-- | The sorted (by 'ModuleName') instantiations of this unit.
instUnitInsts :: !(GenInstantiations unit),
-- | A cache of the free module holes of 'instUnitInsts'.
@@ -375,7 +373,7 @@ moduleFreeHoles (Module u _ ) = unitFreeModuleHoles u
-- | Create a new 'GenInstantiatedUnit' given an explicit module substitution.
-mkInstantiatedUnit :: IsUnitId u => Indefinite u -> GenInstantiations u -> GenInstantiatedUnit u
+mkInstantiatedUnit :: IsUnitId u => u -> GenInstantiations u -> GenInstantiatedUnit u
mkInstantiatedUnit cid insts =
InstantiatedUnit {
instUnitInstanceOf = cid,
@@ -390,8 +388,8 @@ mkInstantiatedUnit cid insts =
-- | Smart constructor for instantiated GenUnit
-mkVirtUnit :: IsUnitId u => Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
-mkVirtUnit uid [] = RealUnit $ Definite (indefUnit uid) -- huh? indefinite unit without any instantiation/hole?
+mkVirtUnit :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
+mkVirtUnit uid [] = RealUnit $ Definite uid
mkVirtUnit uid insts = VirtUnit $ mkInstantiatedUnit uid insts
-- | Generate a uniquely identifying hash (internal unit-id) for an instantiated
@@ -402,7 +400,7 @@ mkVirtUnit uid insts = VirtUnit $ mkInstantiatedUnit uid insts
-- This hash is completely internal to GHC and is not used for symbol names or
-- file paths. It is different from the hash Cabal would produce for the same
-- instantiated unit.
-mkInstantiatedUnitHash :: IsUnitId u => Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
+mkInstantiatedUnitHash :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
mkInstantiatedUnitHash cid sorted_holes =
mkFastStringByteString
. fingerprintUnitId (bytesFS (unitFS cid))
@@ -451,7 +449,7 @@ mapGenUnit f = go
RealUnit d -> RealUnit (fmap f d)
VirtUnit i ->
VirtUnit $ mkInstantiatedUnit
- (fmap f (instUnitInstanceOf i))
+ (f (instUnitInstanceOf i))
(fmap (second (fmap go)) (instUnitInsts i))
-- | Map over the unit identifier of unit instantiations.
@@ -462,7 +460,7 @@ mapInstantiations f = map (second (fmap (mapGenUnit f)))
-- the UnitId of the indefinite unit this unit is an instance of.
toUnitId :: Unit -> UnitId
toUnitId (RealUnit (Definite iuid)) = iuid
-toUnitId (VirtUnit indef) = indefUnit (instUnitInstanceOf indef)
+toUnitId (VirtUnit indef) = instUnitInstanceOf indef
toUnitId HoleUnit = error "Hole unit"
-- | Return the virtual UnitId of an on-the-fly instantiated unit.
@@ -535,14 +533,6 @@ newtype Definite unit = Definite { unDefinite :: unit }
deriving (Functor)
deriving newtype (Eq, Ord, Outputable, Binary, Uniquable, IsUnitId)
--- | An 'IndefUnitId' is an 'UnitId' with the invariant that it only
--- refers to an indefinite library; i.e., one that can be instantiated.
-type IndefUnitId = Indefinite UnitId
-
-newtype Indefinite unit = Indefinite { indefUnit :: unit }
- deriving (Functor)
- deriving newtype (Eq, Ord, Outputable, Binary, Uniquable, IsUnitId)
-
---------------------------------------------------------------------
-- WIRED-IN UNITS
---------------------------------------------------------------------
diff --git a/compiler/GHC/Unit/Types.hs-boot b/compiler/GHC/Unit/Types.hs-boot
index fa4dde3feb..0fe5302123 100644
--- a/compiler/GHC/Unit/Types.hs-boot
+++ b/compiler/GHC/Unit/Types.hs-boot
@@ -9,11 +9,9 @@ import Data.Kind (Type)
data UnitId
data GenModule (unit :: Type)
data GenUnit (uid :: Type)
-data Indefinite (unit :: Type)
type Module = GenModule Unit
type Unit = GenUnit UnitId
-type IndefUnitId = Indefinite UnitId
moduleName :: GenModule a -> ModuleName
moduleUnit :: GenModule a -> a
diff --git a/libraries/ghc-boot/GHC/Unit/Database.hs b/libraries/ghc-boot/GHC/Unit/Database.hs
index 084ba226db..9a182941d7 100644
--- a/libraries/ghc-boot/GHC/Unit/Database.hs
+++ b/libraries/ghc-boot/GHC/Unit/Database.hs
@@ -99,7 +99,7 @@ import GHC.IO.Handle.Lock
import System.Directory
-- | @ghc-boot@'s UnitInfo, serialized to the database.
-type DbUnitInfo = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule
+type DbUnitInfo = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule
-- | Information about an unit (a unit is an installed module library).
--
@@ -109,14 +109,16 @@ type DbUnitInfo = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString
-- Some types are left as parameters to be instantiated differently in ghc-pkg
-- and in ghc itself.
--
-data GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
+data GenericUnitInfo srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
{ unitId :: uid
-- ^ Unique unit identifier that is used during compilation (e.g. to
-- generate symbols).
- , unitInstanceOf :: compid
+ , unitInstanceOf :: uid
-- ^ Identifier of an indefinite unit (i.e. with module holes) that this
-- unit is an instance of.
+ --
+ -- For non instantiated units, unitInstanceOf=unitId
, unitInstantiations :: [(modulename, mod)]
-- ^ How this unit instantiates some of its module holes. Map hole module
@@ -252,16 +254,15 @@ type FilePathST = ST.ShortText
-- | Convert between GenericUnitInfo instances
mapGenericUnitInfo
:: (uid1 -> uid2)
- -> (cid1 -> cid2)
-> (srcpkg1 -> srcpkg2)
-> (srcpkgname1 -> srcpkgname2)
-> (modname1 -> modname2)
-> (mod1 -> mod2)
- -> (GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
- -> GenericUnitInfo cid2 srcpkg2 srcpkgname2 uid2 modname2 mod2)
-mapGenericUnitInfo fuid fcid fsrcpkg fsrcpkgname fmodname fmod g@(GenericUnitInfo {..}) =
+ -> (GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
+ -> GenericUnitInfo srcpkg2 srcpkgname2 uid2 modname2 mod2)
+mapGenericUnitInfo fuid fsrcpkg fsrcpkgname fmodname fmod g@(GenericUnitInfo {..}) =
g { unitId = fuid unitId
- , unitInstanceOf = fcid unitInstanceOf
+ , unitInstanceOf = fuid unitInstanceOf
, unitInstantiations = fmap (bimap fmodname fmod) unitInstantiations
, unitPackageId = fsrcpkg unitPackageId
, unitPackageName = fsrcpkgname unitPackageName
@@ -711,7 +712,7 @@ mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)
-- Also perform a similar substitution for the older GHC-specific
-- "$topdir" variable. The "topdir" is the location of the ghc
-- installation (obtained from the -B option).
-mungeUnitInfoPaths :: FilePathST -> FilePathST -> GenericUnitInfo a b c d e f -> GenericUnitInfo a b c d e f
+mungeUnitInfoPaths :: FilePathST -> FilePathST -> GenericUnitInfo a b c d e -> GenericUnitInfo a b c d e
mungeUnitInfoPaths top_dir pkgroot pkg =
-- TODO: similar code is duplicated in utils/ghc-pkg/Main.hs
pkg
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index a83f60b87a..4df73001d5 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -1315,7 +1315,6 @@ updateDBCache verbosity db db_stack = do
GhcPkg.DbOpenReadWrite lock -> GhcPkg.unlockPackageDb lock
type PackageCacheFormat = GhcPkg.GenericUnitInfo
- ComponentId
PackageIdentifier
PackageName
UnitId
@@ -1375,7 +1374,7 @@ recomputeValidAbiDeps db pkg =
-- Ghc.PackageDb to store into the database)
fromPackageCacheFormat :: PackageCacheFormat -> GhcPkg.DbUnitInfo
fromPackageCacheFormat = GhcPkg.mapGenericUnitInfo
- mkUnitId' mkComponentId' mkPackageIdentifier' mkPackageName' mkModuleName' mkModule'
+ mkUnitId' mkPackageIdentifier' mkPackageName' mkModuleName' mkModule'
where
displayBS :: Pretty a => a -> BS.ByteString
displayBS = toUTF8BS . display
@@ -1396,7 +1395,7 @@ convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat
convertPackageInfoToCacheFormat pkg =
GhcPkg.GenericUnitInfo {
GhcPkg.unitId = installedUnitId pkg,
- GhcPkg.unitInstanceOf = installedComponentId pkg,
+ GhcPkg.unitInstanceOf = mkUnitId (unComponentId (installedComponentId pkg)),
GhcPkg.unitInstantiations = instantiatedWith pkg,
GhcPkg.unitPackageId = sourcePackageId pkg,
GhcPkg.unitPackageName = packageName pkg,
View Lorry Controller Status