diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-09-23 12:31:38 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-10-22 19:20:44 -0400 |
commit | 6fd7da745a518a93f6685171701a27283cfe2d4e (patch) | |
tree | 9feb7db12f7d892e960af948b7ebbf271dd0ff3f /compiler/GHC/Unit | |
parent | fa5870d3ac0a64515d3e76af256e81b9dc8590bd (diff) | |
download | haskell-6fd7da745a518a93f6685171701a27283cfe2d4e.tar.gz |
Remove Indefinite
We no longer need it after previous IndefUnitId refactoring.
Diffstat (limited to 'compiler/GHC/Unit')
-rw-r--r-- | compiler/GHC/Unit/Home.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Unit/Info.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Unit/Module.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Unit/Parser.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/Unit/State.hs | 27 | ||||
-rw-r--r-- | compiler/GHC/Unit/Types.hs | 28 | ||||
-rw-r--r-- | compiler/GHC/Unit/Types.hs-boot | 2 |
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 |