summaryrefslogtreecommitdiff
path: root/compiler/GHC/Unit
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Unit')
-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
7 files changed, 26 insertions, 51 deletions
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
View Lorry Controller Status