diff options
76 files changed, 481 insertions, 481 deletions
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 07ed069c51..6a35e1c5d6 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -1027,7 +1027,7 @@ dataConRepArgTys (MkData { dcRep = rep -- to its info table and used by the GHCi debugger and the heap profiler dataConIdentity :: DataCon -> [Word8] -- We want this string to be UTF-8, so we get the bytes directly from the FastStrings. -dataConIdentity dc = bytesFS (packageKeyFS (modulePackageKey mod)) ++ +dataConIdentity dc = bytesFS (unitIdFS (moduleUnitId mod)) ++ fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++ fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name)) where name = dataConName dc diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs index 7725633447..8015a254d0 100644 --- a/compiler/basicTypes/Module.hs +++ b/compiler/basicTypes/Module.hs @@ -25,32 +25,32 @@ module Module mkModuleNameFS, stableModuleNameCmp, - -- * The PackageKey type - PackageKey, - fsToPackageKey, - packageKeyFS, - stringToPackageKey, - packageKeyString, - stablePackageKeyCmp, - - -- * Wired-in PackageKeys + -- * The UnitId type + UnitId, + fsToUnitId, + unitIdFS, + stringToUnitId, + unitIdString, + stableUnitIdCmp, + + -- * Wired-in UnitIds -- $wired_in_packages - primPackageKey, - integerPackageKey, - basePackageKey, - rtsPackageKey, - thPackageKey, - dphSeqPackageKey, - dphParPackageKey, - mainPackageKey, - thisGhcPackageKey, - holePackageKey, isHoleModule, - interactivePackageKey, isInteractiveModule, - wiredInPackageKeys, + primUnitId, + integerUnitId, + baseUnitId, + rtsUnitId, + thUnitId, + dphSeqUnitId, + dphParUnitId, + mainUnitId, + thisGhcUnitId, + holeUnitId, isHoleModule, + interactiveUnitId, isInteractiveModule, + wiredInUnitIds, -- * The Module type Module(Module), - modulePackageKey, moduleName, + moduleUnitId, moduleName, pprModule, mkModule, stableModuleCmp, @@ -216,7 +216,7 @@ moduleNameString (ModuleName mod) = unpackFS mod -- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal" moduleStableString :: Module -> String moduleStableString Module{..} = - "$" ++ packageKeyString modulePackageKey ++ "$" ++ moduleNameString moduleName + "$" ++ unitIdString moduleUnitId ++ "$" ++ moduleNameString moduleName mkModuleName :: String -> ModuleName mkModuleName s = ModuleName (mkFastString s) @@ -244,15 +244,15 @@ moduleNameColons = dots_to_colons . moduleNameString ************************************************************************ -} --- | A Module is a pair of a 'PackageKey' and a 'ModuleName'. +-- | A Module is a pair of a 'UnitId' and a 'ModuleName'. data Module = Module { - modulePackageKey :: !PackageKey, -- pkg-1.0 + moduleUnitId :: !UnitId, -- pkg-1.0 moduleName :: !ModuleName -- A.B.C } deriving (Eq, Ord, Typeable) instance Uniquable Module where - getUnique (Module p n) = getUnique (packageKeyFS p `appendFS` moduleNameFS n) + getUnique (Module p n) = getUnique (unitIdFS p `appendFS` moduleNameFS n) instance Outputable Module where ppr = pprModule @@ -272,25 +272,25 @@ instance Data Module where -- not be stable from run to run of the compiler. stableModuleCmp :: Module -> Module -> Ordering stableModuleCmp (Module p1 n1) (Module p2 n2) - = (p1 `stablePackageKeyCmp` p2) `thenCmp` + = (p1 `stableUnitIdCmp` p2) `thenCmp` (n1 `stableModuleNameCmp` n2) -mkModule :: PackageKey -> ModuleName -> Module +mkModule :: UnitId -> ModuleName -> Module mkModule = Module pprModule :: Module -> SDoc pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n -pprPackagePrefix :: PackageKey -> Module -> SDoc +pprPackagePrefix :: UnitId -> Module -> SDoc pprPackagePrefix p mod = getPprStyle doc where doc sty | codeStyle sty = - if p == mainPackageKey + if p == mainUnitId then empty -- never qualify the main package in code - else ztext (zEncodeFS (packageKeyFS p)) <> char '_' - | qualModule sty mod = ppr (modulePackageKey mod) <> char ':' + else ztext (zEncodeFS (unitIdFS p)) <> char '_' + | qualModule sty mod = ppr (moduleUnitId mod) <> char ':' -- the PrintUnqualified tells us which modules have to -- be qualified with package names | otherwise = empty @@ -304,7 +304,7 @@ class HasModule m where {- ************************************************************************ * * -\subsection{PackageKey} +\subsection{UnitId} * * ************************************************************************ -} @@ -313,56 +313,56 @@ class HasModule m where -- it is just the package name, but for user compiled packages, it is a hash. -- ToDo: when the key is a hash, we can do more clever things than store -- the hex representation and hash-cons those strings. -newtype PackageKey = PId FastString deriving( Eq, Typeable ) +newtype UnitId = PId FastString deriving( Eq, Typeable ) -- here to avoid module loops with PackageConfig -instance Uniquable PackageKey where - getUnique pid = getUnique (packageKeyFS pid) +instance Uniquable UnitId where + getUnique pid = getUnique (unitIdFS pid) -- Note: *not* a stable lexicographic ordering, a faster unique-based -- ordering. -instance Ord PackageKey where +instance Ord UnitId where nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2 -instance Data PackageKey where +instance Data UnitId where -- don't traverse? - toConstr _ = abstractConstr "PackageKey" + toConstr _ = abstractConstr "UnitId" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNoRepType "PackageKey" + dataTypeOf _ = mkNoRepType "UnitId" -stablePackageKeyCmp :: PackageKey -> PackageKey -> Ordering +stableUnitIdCmp :: UnitId -> UnitId -> Ordering -- ^ Compares package ids lexically, rather than by their 'Unique's -stablePackageKeyCmp p1 p2 = packageKeyFS p1 `compare` packageKeyFS p2 +stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2 -instance Outputable PackageKey where +instance Outputable UnitId where ppr pk = getPprStyle $ \sty -> sdocWithDynFlags $ \dflags -> - case packageKeyPackageIdString dflags pk of - Nothing -> ftext (packageKeyFS pk) + case unitIdPackageIdString dflags pk of + Nothing -> ftext (unitIdFS pk) Just pkg -> text pkg -- Don't bother qualifying if it's wired in! - <> (if qualPackage sty pk && not (pk `elem` wiredInPackageKeys) - then char '@' <> ftext (packageKeyFS pk) + <> (if qualPackage sty pk && not (pk `elem` wiredInUnitIds) + then char '@' <> ftext (unitIdFS pk) else empty) -instance Binary PackageKey where - put_ bh pid = put_ bh (packageKeyFS pid) - get bh = do { fs <- get bh; return (fsToPackageKey fs) } +instance Binary UnitId where + put_ bh pid = put_ bh (unitIdFS pid) + get bh = do { fs <- get bh; return (fsToUnitId fs) } -instance BinaryStringRep PackageKey where - fromStringRep = fsToPackageKey . mkFastStringByteString - toStringRep = fastStringToByteString . packageKeyFS +instance BinaryStringRep UnitId where + fromStringRep = fsToUnitId . mkFastStringByteString + toStringRep = fastStringToByteString . unitIdFS -fsToPackageKey :: FastString -> PackageKey -fsToPackageKey = PId +fsToUnitId :: FastString -> UnitId +fsToUnitId = PId -packageKeyFS :: PackageKey -> FastString -packageKeyFS (PId fs) = fs +unitIdFS :: UnitId -> FastString +unitIdFS (PId fs) = fs -stringToPackageKey :: String -> PackageKey -stringToPackageKey = fsToPackageKey . mkFastString +stringToUnitId :: String -> UnitId +stringToUnitId = fsToUnitId . mkFastString -packageKeyString :: PackageKey -> String -packageKeyString = unpackFS . packageKeyFS +unitIdString :: UnitId -> String +unitIdString = unpackFS . unitIdFS -- ----------------------------------------------------------------------------- @@ -378,7 +378,7 @@ packageKeyString = unpackFS . packageKeyFS -- versions of them installed. However, for each invocation of GHC, -- only a single instance of each wired-in package will be recognised -- (the desired one is selected via @-package@\/@-hide-package@), and GHC --- will use the unversioned 'PackageKey' below when referring to it, +-- will use the unversioned 'UnitId' below when referring to it, -- including in .hi files and object file symbols. Unselected -- versions of wired-in packages will be ignored, as will any other -- package that depends directly or indirectly on it (much as if you @@ -386,49 +386,49 @@ packageKeyString = unpackFS . packageKeyFS -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here -integerPackageKey, primPackageKey, - basePackageKey, rtsPackageKey, - thPackageKey, dphSeqPackageKey, dphParPackageKey, - mainPackageKey, thisGhcPackageKey, interactivePackageKey :: PackageKey -primPackageKey = fsToPackageKey (fsLit "ghc-prim") -integerPackageKey = fsToPackageKey (fsLit n) +integerUnitId, primUnitId, + baseUnitId, rtsUnitId, + thUnitId, dphSeqUnitId, dphParUnitId, + mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId +primUnitId = fsToUnitId (fsLit "ghc-prim") +integerUnitId = fsToUnitId (fsLit n) where n = case cIntegerLibraryType of IntegerGMP -> "integer-gmp" IntegerSimple -> "integer-simple" -basePackageKey = fsToPackageKey (fsLit "base") -rtsPackageKey = fsToPackageKey (fsLit "rts") -thPackageKey = fsToPackageKey (fsLit "template-haskell") -dphSeqPackageKey = fsToPackageKey (fsLit "dph-seq") -dphParPackageKey = fsToPackageKey (fsLit "dph-par") -thisGhcPackageKey = fsToPackageKey (fsLit "ghc") -interactivePackageKey = fsToPackageKey (fsLit "interactive") +baseUnitId = fsToUnitId (fsLit "base") +rtsUnitId = fsToUnitId (fsLit "rts") +thUnitId = fsToUnitId (fsLit "template-haskell") +dphSeqUnitId = fsToUnitId (fsLit "dph-seq") +dphParUnitId = fsToUnitId (fsLit "dph-par") +thisGhcUnitId = fsToUnitId (fsLit "ghc") +interactiveUnitId = fsToUnitId (fsLit "interactive") -- | This is the package Id for the current program. It is the default -- package Id if you don't specify a package name. We don't add this prefix -- to symbol names, since there can be only one main package per program. -mainPackageKey = fsToPackageKey (fsLit "main") +mainUnitId = fsToUnitId (fsLit "main") -- | This is a fake package id used to provide identities to any un-implemented -- signatures. The set of hole identities is global over an entire compilation. -holePackageKey :: PackageKey -holePackageKey = fsToPackageKey (fsLit "hole") +holeUnitId :: UnitId +holeUnitId = fsToUnitId (fsLit "hole") isInteractiveModule :: Module -> Bool -isInteractiveModule mod = modulePackageKey mod == interactivePackageKey +isInteractiveModule mod = moduleUnitId mod == interactiveUnitId isHoleModule :: Module -> Bool -isHoleModule mod = modulePackageKey mod == holePackageKey - -wiredInPackageKeys :: [PackageKey] -wiredInPackageKeys = [ primPackageKey, - integerPackageKey, - basePackageKey, - rtsPackageKey, - thPackageKey, - thisGhcPackageKey, - dphSeqPackageKey, - dphParPackageKey ] +isHoleModule mod = moduleUnitId mod == holeUnitId + +wiredInUnitIds :: [UnitId] +wiredInUnitIds = [ primUnitId, + integerUnitId, + baseUnitId, + rtsUnitId, + thUnitId, + thisGhcUnitId, + dphSeqUnitId, + dphParUnitId ] {- ************************************************************************ diff --git a/compiler/basicTypes/Module.hs-boot b/compiler/basicTypes/Module.hs-boot index 8a73d38256..d8b7a61e11 100644 --- a/compiler/basicTypes/Module.hs-boot +++ b/compiler/basicTypes/Module.hs-boot @@ -2,7 +2,7 @@ module Module where data Module data ModuleName -data PackageKey +data UnitId moduleName :: Module -> ModuleName -modulePackageKey :: Module -> PackageKey -packageKeyString :: PackageKey -> String +moduleUnitId :: Module -> UnitId +unitIdString :: UnitId -> String diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 46c23b91bf..c557889606 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -265,16 +265,16 @@ nameIsHomePackageImport this_mod = \nm -> case nameModule_maybe nm of Nothing -> False Just nm_mod -> nm_mod /= this_mod - && modulePackageKey nm_mod == this_pkg + && moduleUnitId nm_mod == this_pkg where - this_pkg = modulePackageKey this_mod + this_pkg = moduleUnitId this_mod -- | Returns True if the Name comes from some other package: neither this -- pacakge nor the interactive package. -nameIsFromExternalPackage :: PackageKey -> Name -> Bool +nameIsFromExternalPackage :: UnitId -> Name -> Bool nameIsFromExternalPackage this_pkg name | Just mod <- nameModule_maybe name - , modulePackageKey mod /= this_pkg -- Not this package + , moduleUnitId mod /= this_pkg -- Not this package , not (isInteractiveModule mod) -- Not the 'interactive' package = True | otherwise @@ -557,7 +557,7 @@ pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags -> case qualName sty mod occ of -- See Outputable.QualifyName: NameQual modname -> ppr modname <> dot -- Name is in scope NameNotInScope1 -> ppr mod <> dot -- Not in scope - NameNotInScope2 -> ppr (modulePackageKey mod) <> colon -- Module not in + NameNotInScope2 -> ppr (moduleUnitId mod) <> colon -- Module not in <> ppr (moduleName mod) <> dot -- scope either NameUnqual -> empty -- In scope unqualified diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index fa9d6ed7e6..391b0ecaff 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -638,12 +638,12 @@ mkMaxTagOcc = mk_simple_deriv varName "$maxtag_" -- Generic deriving mechanism -- | Generate a module-unique name, to be used e.g. while generating new names --- for Generics types. We use module package key to avoid name clashes when +-- for Generics types. We use module unit id to avoid name clashes when -- package imports is used. mkModPrefix :: Module -> String mkModPrefix mod = pk ++ "_" ++ mn where - pk = packageKeyString (modulePackageKey mod) + pk = unitIdString (moduleUnitId mod) mn = moduleNameString (moduleName mod) mkGenD :: Module -> OccName -> OccName diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index b6ae0723fb..b252d8389b 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -868,7 +868,7 @@ data ImpDeclSpec -- the defining module for this thing! -- TODO: either should be Module, or there - -- should be a Maybe PackageKey here too. + -- should be a Maybe UnitId here too. is_as :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause) is_qual :: Bool, -- ^ Was this import qualified? is_dloc :: SrcSpan -- ^ The location of the entire import declaration diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 826d1f8c7a..0f1d61bada 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -161,14 +161,14 @@ data CLabel -- | A label from a .cmm file that is not associated with a .hs level Id. | CmmLabel - PackageKey -- what package the label belongs to. + UnitId -- what package the label belongs to. FastString -- identifier giving the prefix of the label CmmLabelInfo -- encodes the suffix of the label -- | A label with a baked-in \/ algorithmically generated name that definitely -- comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so -- If it doesn't have an algorithmically generated name then use a CmmLabel - -- instead and give it an appropriate PackageKey argument. + -- instead and give it an appropriate UnitId argument. | RtsLabel RtsLabelInfo @@ -244,7 +244,7 @@ data CLabel data ForeignLabelSource -- | Label is in a named package - = ForeignLabelInPackage PackageKey + = ForeignLabelInPackage UnitId -- | Label is in some external, system package that doesn't also -- contain compiled Haskell code, and is not associated with any .hi files. @@ -418,27 +418,27 @@ mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel, mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel, mkSMAP_DIRTY_infoLabel :: CLabel mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction -mkSplitMarkerLabel = CmmLabel rtsPackageKey (fsLit "__stg_split_marker") CmmCode -mkUpdInfoLabel = CmmLabel rtsPackageKey (fsLit "stg_upd_frame") CmmInfo -mkBHUpdInfoLabel = CmmLabel rtsPackageKey (fsLit "stg_bh_upd_frame" ) CmmInfo -mkIndStaticInfoLabel = CmmLabel rtsPackageKey (fsLit "stg_IND_STATIC") CmmInfo -mkMainCapabilityLabel = CmmLabel rtsPackageKey (fsLit "MainCapability") CmmData -mkMAP_FROZEN_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo -mkMAP_FROZEN0_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo -mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo -mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_EMPTY_MVAR") CmmInfo -mkTopTickyCtrLabel = CmmLabel rtsPackageKey (fsLit "top_ct") CmmData -mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageKey (fsLit "stg_CAF_BLACKHOLE") CmmInfo -mkCAFBlackHoleEntryLabel = CmmLabel rtsPackageKey (fsLit "stg_CAF_BLACKHOLE") CmmEntry -mkArrWords_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_ARR_WORDS") CmmInfo -mkSMAP_FROZEN_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo -mkSMAP_FROZEN0_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo -mkSMAP_DIRTY_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo +mkSplitMarkerLabel = CmmLabel rtsUnitId (fsLit "__stg_split_marker") CmmCode +mkUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_upd_frame") CmmInfo +mkBHUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" ) CmmInfo +mkIndStaticInfoLabel = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC") CmmInfo +mkMainCapabilityLabel = CmmLabel rtsUnitId (fsLit "MainCapability") CmmData +mkMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo +mkMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo +mkMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo +mkEMPTY_MVAR_infoLabel = CmmLabel rtsUnitId (fsLit "stg_EMPTY_MVAR") CmmInfo +mkTopTickyCtrLabel = CmmLabel rtsUnitId (fsLit "top_ct") CmmData +mkCAFBlackHoleInfoTableLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmInfo +mkCAFBlackHoleEntryLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmEntry +mkArrWords_infoLabel = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS") CmmInfo +mkSMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo +mkSMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo +mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo ----- mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel, mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel - :: PackageKey -> FastString -> CLabel + :: UnitId -> FastString -> CLabel mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry @@ -652,7 +652,7 @@ needsCDecl (RtsLabel _) = False needsCDecl (CmmLabel pkgId _ _) -- Prototypes for labels defined in the runtime system are imported -- into HC files via includes/Stg.h. - | pkgId == rtsPackageKey = False + | pkgId == rtsUnitId = False -- For other labels we inline one into the HC file directly. | otherwise = True @@ -858,11 +858,11 @@ idInfoLabelType info = -- @labelDynamic@ returns @True@ if the label is located -- in a DLL, be it a data reference or not. -labelDynamic :: DynFlags -> PackageKey -> Module -> CLabel -> Bool +labelDynamic :: DynFlags -> UnitId -> Module -> CLabel -> Bool labelDynamic dflags this_pkg this_mod lbl = case lbl of -- is the RTS in a DLL or not? - RtsLabel _ -> not (gopt Opt_Static dflags) && (this_pkg /= rtsPackageKey) + RtsLabel _ -> not (gopt Opt_Static dflags) && (this_pkg /= rtsUnitId) IdLabel n _ _ -> isDllName dflags this_pkg this_mod n @@ -895,7 +895,7 @@ labelDynamic dflags this_pkg this_mod lbl = -- libraries True - PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m) + PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (moduleUnitId m) HpcTicksLabel m -> not (gopt Opt_Static dflags) && this_mod /= m diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index dbd5d06872..000f805b5d 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -574,7 +574,7 @@ importName -- A label imported with an explicit packageId. | STRING NAME - { ($2, mkCmmCodeLabel (fsToPackageKey (mkFastString $1)) $2) } + { ($2, mkCmmCodeLabel (fsToUnitId (mkFastString $1)) $2) } names :: { [FastString] } @@ -1119,7 +1119,7 @@ profilingInfo dflags desc_str ty_str else ProfilingInfo (stringToWord8s desc_str) (stringToWord8s ty_str) -staticClosure :: PackageKey -> FastString -> FastString -> [CmmLit] -> CmmParse () +staticClosure :: UnitId -> FastString -> FastString -> [CmmLit] -> CmmParse () staticClosure pkg cl_label info payload = do dflags <- getDynFlags let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] [] diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index edd064848f..745dd720eb 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -190,7 +190,7 @@ buildDynCon' dflags platform binder _ _cc con [arg] , StgLitArg (MachInt val) <- arg , val <= fromIntegral (mAX_INTLIKE dflags) -- Comparisons at type Integer! , val >= fromIntegral (mIN_INTLIKE dflags) -- ...ditto... - = do { let intlike_lbl = mkCmmClosureLabel rtsPackageKey (fsLit "stg_INTLIKE") + = do { let intlike_lbl = mkCmmClosureLabel rtsUnitId (fsLit "stg_INTLIKE") val_int = fromIntegral val :: Int offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSizeW dflags + 1) -- INTLIKE closures consist of a header and one word payload @@ -205,7 +205,7 @@ buildDynCon' dflags platform binder _ _cc con [arg] , let val_int = ord val :: Int , val_int <= mAX_CHARLIKE dflags , val_int >= mIN_CHARLIKE dflags - = do { let charlike_lbl = mkCmmClosureLabel rtsPackageKey (fsLit "stg_CHARLIKE") + = do { let charlike_lbl = mkCmmClosureLabel rtsUnitId (fsLit "stg_CHARLIKE") offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSizeW dflags + 1) -- CHARLIKE closures consist of a header and one word payload charlike_amode = cmmLabelOffW dflags charlike_lbl offsetW diff --git a/compiler/codeGen/StgCmmExtCode.hs b/compiler/codeGen/StgCmmExtCode.hs index 03f6a47d87..2091d9b358 100644 --- a/compiler/codeGen/StgCmmExtCode.hs +++ b/compiler/codeGen/StgCmmExtCode.hs @@ -63,7 +63,7 @@ data Named = VarN CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type, -- eg, RtsLabel, ForeignLabel, CmmLabel etc. - | FunN PackageKey -- ^ A function name from this package + | FunN UnitId -- ^ A function name from this package | LabelN BlockId -- ^ A blockid of some code or data. -- | An environment of named things. @@ -167,7 +167,7 @@ newBlockId = code F.newLabelC -- | Add add a local function to the environment. newFunctionName :: FastString -- ^ name of the function - -> PackageKey -- ^ package of the current module + -> UnitId -- ^ package of the current module -> ExtCode newFunctionName name pkg = addDecl name (FunN pkg) @@ -207,7 +207,7 @@ lookupName name = do case lookupUFM env name of Just (VarN e) -> e Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name)) - _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey name)) + _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId name)) -- | Lift an FCode computation into the CmmParse monad diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 6aaa10083e..bcc5221275 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -523,7 +523,7 @@ generic_gc = mkGcLabel "stg_gc_noregs" -- | Create a CLabel for calling a garbage collector entry point mkGcLabel :: String -> CmmExpr -mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit s))) +mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit s))) ------------------------------- heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index 593dd6cc18..03c11cc19b 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -366,10 +366,10 @@ slowArgs dflags args -- careful: reps contains voids (V), but args does not (arg_pat, n) = slowCallPattern (map fst args) (call_args, rest_args) = splitAt n args - stg_ap_pat = mkCmmRetInfoLabel rtsPackageKey arg_pat + stg_ap_pat = mkCmmRetInfoLabel rtsUnitId arg_pat this_pat = (N, Just (mkLblExpr stg_ap_pat)) : call_args save_cccs = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just curCCS)] - save_cccs_lbl = mkCmmRetInfoLabel rtsPackageKey (fsLit "stg_restore_cccs") + save_cccs_lbl = mkCmmRetInfoLabel rtsUnitId (fsLit "stg_restore_cccs") ------------------------------------------------------------------------- ---- Laying out objects on the heap and stack diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 1acf31b327..3d055e75bb 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -498,7 +498,7 @@ withSelfLoop self_loop code = do instance HasDynFlags FCode where getDynFlags = liftM cgd_dflags getInfoDown -getThisPackage :: FCode PackageKey +getThisPackage :: FCode UnitId getThisPackage = liftM thisPackage getDynFlags withInfoDown :: FCode a -> CgInfoDownwards -> FCode a diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index 7249477c9f..a7384c725b 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -183,7 +183,7 @@ enterCostCentreFun ccs closure = ifProfiling $ do if isCurrentCCS ccs then do dflags <- getDynFlags - emitRtsCall rtsPackageKey (fsLit "enterFunCCS") + emitRtsCall rtsUnitId (fsLit "enterFunCCS") [(CmmReg (CmmGlobal BaseReg), AddrHint), (costCentreFrom dflags closure, AddrHint)] False else return () -- top-level function, nothing to do @@ -285,7 +285,7 @@ emitSetCCC cc tick push pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode () pushCostCentre result ccs cc = emitRtsCallWithResult result AddrHint - rtsPackageKey + rtsUnitId (fsLit "pushCostCentre") [(ccs,AddrHint), (CmmLit (mkCCostCentre cc), AddrHint)] False @@ -356,7 +356,7 @@ ldvEnter cl_ptr = do loadEra :: DynFlags -> CmmExpr loadEra dflags = CmmMachOp (MO_UU_Conv (cIntWidth dflags) (wordWidth dflags)) - [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageKey (fsLit "era"))) + [CmmLoad (mkLblExpr (mkCmmDataLabel rtsUnitId (fsLit "era"))) (cInt dflags)] ldvWord :: DynFlags -> CmmExpr -> CmmExpr diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 3652a79979..03a936fad0 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -327,7 +327,7 @@ registerTickyCtr ctr_lbl = do , mkStore (CmmLit (cmmLabelOffB ctr_lbl (oFFSET_StgEntCounter_registeredp dflags))) (mkIntExpr dflags 1) ] - ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageKey (fsLit "ticky_entry_ctrs")) + ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsUnitId (fsLit "ticky_entry_ctrs")) emit =<< mkCmmIfThen test (catAGraphs register_stmts) tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode () @@ -472,12 +472,12 @@ tickyAllocHeap genuine hp bytes, -- Bump the global allocation total ALLOC_HEAP_tot addToMemLbl (cLong dflags) - (mkCmmDataLabel rtsPackageKey (fsLit "ALLOC_HEAP_tot")) + (mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_tot")) bytes, -- Bump the global allocation counter ALLOC_HEAP_ctr if not genuine then mkNop else addToMemLbl (cLong dflags) - (mkCmmDataLabel rtsPackageKey (fsLit "ALLOC_HEAP_ctr")) + (mkCmmDataLabel rtsUnitId (fsLit "ALLOC_HEAP_ctr")) 1 ]} @@ -541,13 +541,13 @@ ifTickyDynThunk :: FCode () -> FCode () ifTickyDynThunk code = tickyDynThunkIsOn >>= \b -> when b code bumpTickyCounter :: FastString -> FCode () -bumpTickyCounter lbl = bumpTickyLbl (mkCmmDataLabel rtsPackageKey lbl) +bumpTickyCounter lbl = bumpTickyLbl (mkCmmDataLabel rtsUnitId lbl) bumpTickyCounterBy :: FastString -> Int -> FCode () -bumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsPackageKey lbl) +bumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsUnitId lbl) bumpTickyCounterByE :: FastString -> CmmExpr -> FCode () -bumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsPackageKey lbl) +bumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsUnitId lbl) bumpTickyEntryCount :: CLabel -> FCode () bumpTickyEntryCount lbl = do diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index a03625262c..ccfab85a5a 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -167,10 +167,10 @@ tagToClosure dflags tycon tag -- ------------------------------------------------------------------------- -emitRtsCall :: PackageKey -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () +emitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCall pkg fun args safe = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) args safe -emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageKey -> FastString +emitRtsCallWithResult :: LocalReg -> ForeignHint -> UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCallWithResult res hint pkg fun args safe = emitRtsCallGen [(res,hint)] (mkCmmCodeLabel pkg fun) args safe diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index d8fd59e43e..23afcdfb04 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -1168,9 +1168,9 @@ lookupIntegerSDataConName dflags hsc_env = case cIntegerLibraryType of -- | Helper for 'lookupMkIntegerName' and 'lookupIntegerSDataConName' guardIntegerUse :: DynFlags -> IO a -> IO a guardIntegerUse dflags act - | thisPackage dflags == primPackageKey + | thisPackage dflags == primUnitId = return $ panic "Can't use Integer in ghc-prim" - | thisPackage dflags == integerPackageKey + | thisPackage dflags == integerUnitId = return $ panic "Can't use Integer in integer-*" | otherwise = act diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index 4ee205ec4c..9ab8d20b17 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -153,8 +153,8 @@ writeMixEntries dflags mod count entries filename mod_name = moduleNameString (moduleName mod) hpc_mod_dir - | modulePackageKey mod == mainPackageKey = hpc_dir - | otherwise = hpc_dir ++ "/" ++ packageKeyString (modulePackageKey mod) + | moduleUnitId mod == mainUnitId = hpc_dir + | otherwise = hpc_dir ++ "/" ++ unitIdString (moduleUnitId mod) tabStop = 8 -- <tab> counts as a normal char in GHC's location ranges. @@ -1285,9 +1285,9 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo) module_name = hcat (map (text.charToC) $ bytesFS (moduleNameFS (Module.moduleName this_mod))) package_name = hcat (map (text.charToC) $ - bytesFS (packageKeyFS (modulePackageKey this_mod))) + bytesFS (unitIdFS (moduleUnitId this_mod))) full_name_str - | modulePackageKey this_mod == mainPackageKey + | moduleUnitId this_mod == mainUnitId = module_name | otherwise = package_name <> char '/' <> module_name diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index b8df7b801c..4fa09cb42a 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -980,10 +980,10 @@ dsEvTypeable ev = where tycon_name = tyConName tc modl = nameModule tycon_name - pkg = modulePackageKey modl + pkg = moduleUnitId modl modl_fs = moduleNameFS (moduleName modl) - pkg_fs = packageKeyFS pkg + pkg_fs = unitIdFS pkg name_fs = occNameFS (nameOccName tycon_name) hash_name_fs | isPromotedTyCon tc = appendFS (mkFastString "$k") name_fs @@ -1025,7 +1025,7 @@ dsEvCallStack cs = do let srcLocTy = mkTyConTy srcLocTyCon let mkSrcLoc l = liftM (mkCoreConApps srcLocDataCon) - (sequence [ mkStringExpr (showPpr df $ modulePackageKey m) + (sequence [ mkStringExpr (showPpr df $ moduleUnitId m) , mkStringExprFS (moduleNameFS $ moduleName m) , mkStringExprFS (srcSpanFile l) , return $ mkIntExprInt df (srcSpanStartLine l) diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 32bd27b495..fe528a143a 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -436,7 +436,7 @@ dsExpr (HsStatic expr@(L loc _)) = do info <- mkConApp staticPtrInfoDataCon <$> (++[srcLoc]) <$> mapM mkStringExprFS - [ packageKeyFS $ modulePackageKey $ nameModule n' + [ unitIdFS $ moduleUnitId $ nameModule n' , moduleNameFS $ moduleName $ nameModule n' , occNameFS $ nameOccName n' ] @@ -462,7 +462,7 @@ dsExpr (HsStatic expr@(L loc _)) = do fingerprintName :: Name -> Fingerprint fingerprintName n = fingerprintString $ unpackFS $ concatFS - [ packageKeyFS $ modulePackageKey $ nameModule n + [ unitIdFS $ moduleUnitId $ nameModule n , fsLit ":" , moduleNameFS (moduleName $ nameModule n) , fsLit "." diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs index 7c6e62cda1..acea47c57b 100644 --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -223,12 +223,12 @@ dsFCall fn_id co fcall mDeclHeader = do dflags <- getDynFlags (fcall', cDoc) <- case fcall of - CCall (CCallSpec (StaticTarget _ cName mPackageKey isFun) + CCall (CCallSpec (StaticTarget _ cName mUnitId isFun) CApiConv safety) -> do wrapperName <- mkWrapperName "ghc_wrapper" (unpackFS cName) let fcall' = CCall (CCallSpec (StaticTarget (unpackFS wrapperName) - wrapperName mPackageKey + wrapperName mUnitId True) CApiConv safety) c = includes diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 39eab05a80..d27590c0a9 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1568,7 +1568,7 @@ globalVar name where mod = ASSERT( isExternalName name) nameModule name name_mod = moduleNameString (moduleName mod) - name_pkg = packageKeyString (modulePackageKey mod) + name_pkg = unitIdString (moduleUnitId mod) name_occ = nameOccName name mk_varg | OccName.isDataOcc name_occ = mkNameG_dName | OccName.isVarOcc name_occ = mkNameG_vName diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index f068eb2458..fdf8c92edc 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -101,7 +101,7 @@ Library Include-Dirs: . parser utils if impl( ghc >= 7.9 ) - -- We need to set the package key to ghc (without a version number) + -- We need to set the unit id to ghc (without a version number) -- as it's magic. But we can't set it for old versions of GHC (e.g. -- when bootstrapping) because those versions of GHC don't understand -- that GHC is wired-in. diff --git a/compiler/ghc.mk b/compiler/ghc.mk index c957fdc571..8172ca6516 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -445,9 +445,9 @@ compiler_stage1_PACKAGE_KEY = $(subst .$(ProjectPatchLevel),,$(compiler_stage1_P compiler_stage1_LIB_NAME = $(subst .$(ProjectPatchLevel),,$(compiler_stage1_LIB_NAME)) endef -# NB: the PACKAGE_KEY munging has no effect for new-style package keys +# NB: the PACKAGE_KEY munging has no effect for new-style unit ids # (which indeed, have nothing version like in them, but are important for -# old-style package keys which do.) The subst operation is idempotent, so +# old-style unit ids which do.) The subst operation is idempotent, so # as long as we do it at least once we should be good. # Don't register the non-munged package diff --git a/compiler/ghci/ByteCodeLink.hs b/compiler/ghci/ByteCodeLink.hs index 5090f99065..b977f370d3 100644 --- a/compiler/ghci/ByteCodeLink.hs +++ b/compiler/ghci/ByteCodeLink.hs @@ -250,12 +250,12 @@ nameToCLabel :: Name -> String -> String nameToCLabel n suffix = label where encodeZ = zString . zEncodeFS (Module pkgKey modName) = ASSERT( isExternalName n ) nameModule n - packagePart = encodeZ (packageKeyFS pkgKey) + packagePart = encodeZ (unitIdFS pkgKey) modulePart = encodeZ (moduleNameFS modName) occPart = encodeZ (occNameFS (nameOccName n)) label = concat - [ if pkgKey == mainPackageKey then "" else packagePart ++ "_" + [ if pkgKey == mainUnitId then "" else packagePart ++ "_" , modulePart , '_':occPart , '_':suffix diff --git a/compiler/ghci/DebuggerUtils.hs b/compiler/ghci/DebuggerUtils.hs index cafc3759bf..1bca75cedd 100644 --- a/compiler/ghci/DebuggerUtils.hs +++ b/compiler/ghci/DebuggerUtils.hs @@ -46,7 +46,7 @@ dataConInfoPtrToName x = do modFS = mkFastStringByteList mod occFS = mkFastStringByteList occ occName = mkOccNameFS OccName.dataName occFS - modName = mkModule (fsToPackageKey pkgFS) (mkModuleNameFS modFS) + modName = mkModule (fsToUnitId pkgFS) (mkModuleNameFS modFS) return (Left $ showSDoc dflags $ ppr modName <> dot <> ppr occName) `recoverM` (Right `fmap` lookupOrig modName occName) diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs index 6a07e44a93..f62998ce86 100644 --- a/compiler/ghci/Linker.hs +++ b/compiler/ghci/Linker.hs @@ -117,7 +117,7 @@ data PersistentLinkerState -- The currently-loaded packages; always object code -- Held, as usual, in dependency order; though I am not sure if -- that is really important - pkgs_loaded :: ![PackageKey], + pkgs_loaded :: ![UnitId], -- we need to remember the name of previous temporary DLL/.so -- libraries so we can link them (see #10322) @@ -138,10 +138,10 @@ emptyPLS _ = PersistentLinkerState { -- -- The linker's symbol table is populated with RTS symbols using an -- explicit list. See rts/Linker.c for details. - where init_pkgs = [rtsPackageKey] + where init_pkgs = [rtsUnitId] -extendLoadedPkgs :: [PackageKey] -> IO () +extendLoadedPkgs :: [UnitId] -> IO () extendLoadedPkgs pkgs = modifyPLS_ $ \s -> return s{ pkgs_loaded = pkgs ++ pkgs_loaded s } @@ -540,7 +540,7 @@ getLinkDeps :: HscEnv -> HomePackageTable -> Maybe FilePath -- replace object suffices? -> SrcSpan -- for error messages -> [Module] -- If you need these - -> IO ([Linkable], [PackageKey]) -- ... then link these first + -> IO ([Linkable], [UnitId]) -- ... then link these first -- Fails with an IO exception if it can't find enough files getLinkDeps hsc_env hpt pls replace_osuf span mods @@ -578,8 +578,8 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods -- tree recursively. See bug #936, testcase ghci/prog007. follow_deps :: [Module] -- modules to follow -> UniqSet ModuleName -- accum. module dependencies - -> UniqSet PackageKey -- accum. package dependencies - -> IO ([ModuleName], [PackageKey]) -- result + -> UniqSet UnitId -- accum. package dependencies + -> IO ([ModuleName], [UnitId]) -- result follow_deps [] acc_mods acc_pkgs = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs @@ -593,7 +593,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods when (mi_boot iface) $ link_boot_mod_error mod let - pkg = modulePackageKey mod + pkg = moduleUnitId mod deps = mi_deps iface pkg_deps = dep_pkgs deps @@ -1059,7 +1059,7 @@ showLS (Framework nm) = "(framework) " ++ nm -- automatically, and it doesn't matter what order you specify the input -- packages. -- -linkPackages :: DynFlags -> [PackageKey] -> IO () +linkPackages :: DynFlags -> [UnitId] -> IO () -- NOTE: in fact, since each module tracks all the packages it depends on, -- we don't really need to use the package-config dependencies. -- @@ -1075,13 +1075,13 @@ linkPackages dflags new_pkgs = do modifyPLS_ $ \pls -> do linkPackages' dflags new_pkgs pls -linkPackages' :: DynFlags -> [PackageKey] -> PersistentLinkerState +linkPackages' :: DynFlags -> [UnitId] -> PersistentLinkerState -> IO PersistentLinkerState linkPackages' dflags new_pks pls = do pkgs' <- link (pkgs_loaded pls) new_pks return $! pls { pkgs_loaded = pkgs' } where - link :: [PackageKey] -> [PackageKey] -> IO [PackageKey] + link :: [UnitId] -> [UnitId] -> IO [UnitId] link pkgs new_pkgs = foldM link_one pkgs new_pkgs @@ -1097,7 +1097,7 @@ linkPackages' dflags new_pks pls = do ; return (new_pkg : pkgs') } | otherwise - = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ packageKeyString new_pkg)) + = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unitIdString new_pkg)) linkPackage :: DynFlags -> PackageConfig -> IO () diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 0d4eaea1ab..0615c1f91c 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1304,8 +1304,8 @@ mk_ghc_ns TH.VarName = OccName.varName mk_mod :: TH.ModName -> ModuleName mk_mod mod = mkModuleName (TH.modString mod) -mk_pkg :: TH.PkgName -> PackageKey -mk_pkg pkg = stringToPackageKey (TH.pkgString pkg) +mk_pkg :: TH.PkgName -> UnitId +mk_pkg pkg = stringToUnitId (TH.pkgString pkg) mk_uniq :: Int -> Unique mk_uniq u = mkUniqueGrimily u diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 3c1633d94f..13a6649140 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -260,7 +260,7 @@ getSymbolTable bh ncu = do mapAccumR (fromOnDiskName arr) namecache od_names in (namecache', arr) -type OnDiskName = (PackageKey, ModuleName, OccName) +type OnDiskName = (UnitId, ModuleName, OccName) fromOnDiskName :: Array Int Name -> NameCache -> OnDiskName -> (NameCache, Name) fromOnDiskName _ nc (pid, mod_name, occ) = @@ -277,7 +277,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) = serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO () serialiseName bh name _ = do let mod = ASSERT2( isExternalName name, ppr name ) nameModule name - put_ bh (modulePackageKey mod, moduleName mod, nameOccName name) + put_ bh (moduleUnitId mod, moduleName mod, nameOccName name) -- Note [Symbol table representation of names] diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index ddbd80347f..72bffea6af 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -515,13 +515,13 @@ wantHiBootFile dflags eps mod from -- The boot-ness of the requested interface, -- based on the dependencies in directly-imported modules where - this_package = thisPackage dflags == modulePackageKey mod + this_package = thisPackage dflags == moduleUnitId mod badSourceImport :: Module -> SDoc badSourceImport mod = hang (ptext (sLit "You cannot {-# SOURCE #-} import a module from another package")) 2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package") - <+> quotes (ppr (modulePackageKey mod))) + <+> quotes (ppr (moduleUnitId mod))) ----------------------------------------------------- -- Loading type/class/value decls @@ -710,7 +710,7 @@ findAndReadIface doc_str mod hi_boot_file (ml_hi_file loc) -- See Note [Home module load error] - if thisPackage dflags == modulePackageKey mod && + if thisPackage dflags == moduleUnitId mod && not (isOneShot (ghcMode dflags)) then return (Failed (homeModError mod loc)) else do r <- read_file file_path diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 0fc45cc8b9..66790bc82f 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -243,12 +243,12 @@ mkDependencies -- on M.hi-boot, and hence that we should do the hi-boot consistency -- check.) - pkgs | th_used = insertList thPackageKey (imp_dep_pkgs imports) + pkgs | th_used = insertList thUnitId (imp_dep_pkgs imports) | otherwise = imp_dep_pkgs imports -- Set the packages required to be Safe according to Safe Haskell. -- See Note [RnNames . Tracking Trust Transitively] - sorted_pkgs = sortBy stablePackageKeyCmp pkgs + sorted_pkgs = sortBy stableUnitIdCmp pkgs trust_pkgs = imp_trust_pkgs imports dep_pkgs' = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs @@ -571,7 +571,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls -- tracked by the usage on the ABI hash of package modules that we import. let orph_mods = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot] - . filter ((== this_pkg) . modulePackageKey) + . filter ((== this_pkg) . moduleUnitId) $ dep_orphs sorted_deps dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods @@ -683,7 +683,7 @@ getOrphanHashes hsc_env mods = do sortDependencies :: Dependencies -> Dependencies sortDependencies d = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d), - dep_pkgs = sortBy (stablePackageKeyCmp `on` fst) (dep_pkgs d), + dep_pkgs = sortBy (stableUnitIdCmp `on` fst) (dep_pkgs d), dep_orphs = sortBy stableModuleCmp (dep_orphs d), dep_finsts = sortBy stableModuleCmp (dep_finsts d) } @@ -994,7 +994,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names -- things in *this* module = Nothing - | modulePackageKey mod /= this_pkg + | moduleUnitId mod /= this_pkg = Just UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } @@ -1322,7 +1322,7 @@ checkDependencies hsc_env summary iface return (RecompBecause reason) else return UpToDate - where pkg = modulePackageKey mod + where pkg = moduleUnitId mod _otherwise -> return (RecompBecause reason) needInterface :: Module -> (ModIface -> IfG RecompileRequired) @@ -1351,7 +1351,7 @@ needInterface mod continue -- | Given the usage information extracted from the old -- M.hi file for the module being compiled, figure out -- whether M needs to be recompiled. -checkModUsage :: PackageKey -> Usage -> IfG RecompileRequired +checkModUsage :: UnitId -> Usage -> IfG RecompileRequired checkModUsage _this_pkg UsagePackageModule{ usg_mod = mod, usg_mod_hash = old_mod_hash } diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs index f55a15a842..00a0801c47 100644 --- a/compiler/main/CodeOutput.hs +++ b/compiler/main/CodeOutput.hs @@ -50,7 +50,7 @@ codeOutput :: DynFlags -> FilePath -> ModLocation -> ForeignStubs - -> [PackageKey] + -> [UnitId] -> Stream IO RawCmmGroup () -- Compiled C-- -> IO (FilePath, (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-})) @@ -100,7 +100,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action outputC :: DynFlags -> FilePath -> Stream IO RawCmmGroup () - -> [PackageKey] + -> [UnitId] -> IO () outputC dflags filenm cmm_stream packages @@ -115,7 +115,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 rtsPackageKey + let rts = getPackageDetails dflags rtsUnitId let cc_injects = unlines (map mk_include (includes rts)) mk_include h_file = @@ -124,7 +124,7 @@ outputC dflags filenm cmm_stream packages '<':_ -> "#include "++h_file _ -> "#include \""++h_file++"\"" - let pkg_names = map packageKeyString packages + let pkg_names = map unitIdString packages doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") @@ -208,7 +208,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 rtsPackageKey in + let rts_pkg = getPackageDetails dflags rtsUnitId in concatMap mk_include (includes rts_pkg) mk_include i = "#include \"" ++ i ++ "\"\n" diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 5aaf4754e6..e83f7d66a3 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -397,7 +397,7 @@ link' dflags batch_attempt_linking hpt return Succeeded -linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [PackageKey] -> 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 @@ -433,7 +433,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do -- Returns 'False' if it was, and we can avoid linking, because the -- previous binary was linked with "the same options". -checkLinkInfo :: DynFlags -> [PackageKey] -> FilePath -> IO Bool +checkLinkInfo :: DynFlags -> [UnitId] -> FilePath -> IO Bool checkLinkInfo dflags pkg_deps exe_file | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags))) -- ToDo: Windows and OS X do not use the ELF binary format, so @@ -1181,7 +1181,7 @@ runPhase (RealPhase cc_phase) input_fn dflags -- way we do the import depends on whether we're currently compiling -- the base package or not. ++ (if platformOS platform == OSMinGW32 && - thisPackage dflags == basePackageKey + thisPackage dflags == baseUnitId then [ "-DCOMPILING_BASE_PACKAGE" ] else []) @@ -1593,7 +1593,7 @@ mkExtraObj dflags extn xs = do cFile <- newTempName dflags extn oFile <- newTempName dflags "o" writeFile cFile xs - let rtsDetails = getPackageDetails dflags rtsPackageKey + let rtsDetails = getPackageDetails dflags rtsUnitId pic_c_flags = picCCOpts dflags SysTools.runCc dflags ([Option "-c", @@ -1648,7 +1648,7 @@ mkExtraObjToLinkIntoBinary dflags = do -- this was included as inline assembly in the main.c file but this -- is pretty fragile. gas gets upset trying to calculate relative offsets -- that span the .note section (notably .text) when debug info is present -mkNoteObjsToLinkIntoBinary :: DynFlags -> [PackageKey] -> IO [FilePath] +mkNoteObjsToLinkIntoBinary :: DynFlags -> [UnitId] -> IO [FilePath] mkNoteObjsToLinkIntoBinary dflags dep_packages = do link_info <- getLinkInfo dflags dep_packages @@ -1689,7 +1689,7 @@ mkNoteObjsToLinkIntoBinary dflags dep_packages = do -- link. We save this information in the binary, and the next time we -- link, if nothing else has changed, we use the link info stored in -- the existing binary to decide whether to re-link or not. -getLinkInfo :: DynFlags -> [PackageKey] -> IO String +getLinkInfo :: DynFlags -> [UnitId] -> IO String getLinkInfo dflags dep_packages = do package_link_opts <- getPackageLinkOpts dflags dep_packages pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags) @@ -1710,13 +1710,13 @@ getLinkInfo dflags dep_packages = do ----------------------------------------------------------------------------- -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file -getHCFilePackages :: FilePath -> IO [PackageKey] +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 stringToPackageKey (words rest)) + return (map stringToUnitId (words rest)) _other -> return [] @@ -1733,10 +1733,10 @@ getHCFilePackages filename = -- read any interface files), so the user must explicitly specify all -- the packages. -linkBinary :: DynFlags -> [FilePath] -> [PackageKey] -> IO () +linkBinary :: DynFlags -> [FilePath] -> [UnitId] -> IO () linkBinary = linkBinary' False -linkBinary' :: Bool -> DynFlags -> [FilePath] -> [PackageKey] -> IO () +linkBinary' :: Bool -> DynFlags -> [FilePath] -> [UnitId] -> IO () linkBinary' staticLink dflags o_files dep_packages = do let platform = targetPlatform dflags mySettings = settings dflags @@ -1980,7 +1980,7 @@ maybeCreateManifest dflags exe_filename | otherwise = return [] -linkDynLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO () +linkDynLibCheck :: DynFlags -> [String] -> [UnitId] -> IO () linkDynLibCheck dflags o_files dep_packages = do when (haveRtsOptsFlags dflags) $ do @@ -1990,7 +1990,7 @@ linkDynLibCheck dflags o_files dep_packages linkDynLib dflags o_files dep_packages -linkStaticLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO () +linkStaticLibCheck :: DynFlags -> [String] -> [UnitId] -> IO () linkStaticLibCheck dflags o_files dep_packages = do when (platformOS (targetPlatform dflags) `notElem` [OSiOS, OSDarwin]) $ @@ -2175,7 +2175,7 @@ haveRtsOptsFlags dflags = -- | Find out path to @ghcversion.h@ file getGhcVersionPathName :: DynFlags -> IO FilePath getGhcVersionPathName dflags = do - dirs <- getPackageIncludePath dflags [rtsPackageKey] + dirs <- getPackageIncludePath dflags [rtsUnitId] found <- filterM doesFileExist (map (</> "ghcversion.h") dirs) case found of diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c03f076ef0..003211520d 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -92,7 +92,7 @@ module DynFlags ( getVerbFlags, updOptLevel, setTmpDir, - setPackageKey, + setUnitId, interpretPackageEnv, -- ** Parsing DynFlags @@ -704,7 +704,7 @@ data DynFlags = DynFlags { solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver -- Typically only 1 is needed - thisPackage :: PackageKey, -- ^ key of package currently being compiled + thisPackage :: UnitId, -- ^ key of package currently being compiled -- ways ways :: [Way], -- ^ Way flags from the command line @@ -1117,7 +1117,7 @@ isNoLink _ = False data PackageArg = PackageArg String -- ^ @-package@, by 'PackageName' | PackageIdArg String -- ^ @-package-id@, by 'SourcePackageId' - | PackageKeyArg String -- ^ @-package-key@, by 'InstalledPackageId' + | UnitIdArg String -- ^ @-package-key@, by 'ComponentId' deriving (Eq, Show) -- | Represents the renaming that may be associated with an exposed @@ -1435,7 +1435,7 @@ defaultDynFlags mySettings = reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH, solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS, - thisPackage = mainPackageKey, + thisPackage = mainUnitId, objectDir = Nothing, dylibInstallName = Nothing, @@ -1916,7 +1916,7 @@ parseSigOf str = case filter ((=="").snd) (readP_to_S parse str) of pk <- munch1 (\c -> isAlphaNum c || c `elem` "-_.") _ <- R.char ':' m <- parseModuleName - return (mkModule (stringToPackageKey pk) m) + return (mkModule (stringToUnitId pk) m) tok m = skipSpaces >> m setSigOf :: String -> DynFlags -> DynFlags @@ -2725,12 +2725,12 @@ package_flags = [ deprecate "Use -no-user-package-db instead") , defGhcFlag "package-name" (HasArg $ \name -> do - upd (setPackageKey name) + upd (setUnitId name) deprecate "Use -this-package-key instead") - , defGhcFlag "this-package-key" (hasArg setPackageKey) + , defGhcFlag "this-package-key" (hasArg setUnitId) , defFlag "package-id" (HasArg exposePackageId) , defFlag "package" (HasArg exposePackage) - , defFlag "package-key" (HasArg exposePackageKey) + , defFlag "package-key" (HasArg exposeUnitId) , defFlag "hide-package" (HasArg hidePackage) , defFlag "hide-all-packages" (NoArg (setGeneralFlag Opt_HideAllPackages)) , defFlag "package-env" (HasArg setPackageEnv) @@ -3706,15 +3706,15 @@ parsePackageFlag constr str = case filter ((=="").snd) (readP_to_S parse str) of return (orig, orig)) tok m = m >>= \x -> skipSpaces >> return x -exposePackage, exposePackageId, exposePackageKey, hidePackage, ignorePackage, +exposePackage, exposePackageId, exposeUnitId, hidePackage, ignorePackage, trustPackage, distrustPackage :: String -> DynP () exposePackage p = upd (exposePackage' p) exposePackageId p = upd (\s -> s{ packageFlags = parsePackageFlag PackageIdArg p : packageFlags s }) -exposePackageKey p = +exposeUnitId p = upd (\s -> s{ packageFlags = - parsePackageFlag PackageKeyArg p : packageFlags s }) + parsePackageFlag UnitIdArg p : packageFlags s }) hidePackage p = upd (\s -> s{ packageFlags = HidePackage p : packageFlags s }) ignorePackage p = @@ -3729,8 +3729,8 @@ exposePackage' p dflags = dflags { packageFlags = parsePackageFlag PackageArg p : packageFlags dflags } -setPackageKey :: String -> DynFlags -> DynFlags -setPackageKey p s = s{ thisPackage = stringToPackageKey p } +setUnitId :: String -> DynFlags -> DynFlags +setUnitId p s = s{ thisPackage = stringToUnitId p } -- ----------------------------------------------------------------------------- -- | Find the package environment (if one exists) @@ -3879,10 +3879,10 @@ setMainIs arg | not (null main_fn) && isLower (head main_fn) -- The arg looked like "Foo.Bar.baz" = upd $ \d -> d{ mainFunIs = Just main_fn, - mainModIs = mkModule mainPackageKey (mkModuleName main_mod) } + mainModIs = mkModule mainUnitId (mkModuleName main_mod) } | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" - = upd $ \d -> d{ mainModIs = mkModule mainPackageKey (mkModuleName arg) } + = upd $ \d -> d{ mainModIs = mkModule mainUnitId (mkModuleName arg) } | otherwise -- The arg looked like "baz" = upd $ \d -> d{ mainFunIs = Just arg } diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs index d9851c6b94..1ccf33f668 100644 --- a/compiler/main/Finder.hs +++ b/compiler/main/Finder.hs @@ -72,7 +72,7 @@ flushFinderCaches hsc_env = where this_pkg = thisPackage (hsc_dflags hsc_env) fc_ref = hsc_FC hsc_env - is_ext mod _ | modulePackageKey mod /= this_pkg = True + is_ext mod _ | moduleUnitId mod /= this_pkg = True | otherwise = False addToFinderCache :: IORef FinderCache -> Module -> FindResult -> IO () @@ -121,7 +121,7 @@ findImportedModule hsc_env mod_name mb_pkg = findExactModule :: HscEnv -> Module -> IO FindResult findExactModule hsc_env mod = let dflags = hsc_dflags hsc_env - in if modulePackageKey mod == thisPackage dflags + in if moduleUnitId mod == thisPackage dflags then findHomeModule hsc_env (moduleName mod) else findPackageModule hsc_env mod @@ -167,8 +167,8 @@ findExposedPackageModule hsc_env mod_name mb_pkg return (FoundMultiple rs) LookupHidden pkg_hiddens mod_hiddens -> return (NotFound{ fr_paths = [], fr_pkg = Nothing - , fr_pkgs_hidden = map (modulePackageKey.fst) pkg_hiddens - , fr_mods_hidden = map (modulePackageKey.fst) mod_hiddens + , fr_pkgs_hidden = map (moduleUnitId.fst) pkg_hiddens + , fr_mods_hidden = map (moduleUnitId.fst) mod_hiddens , fr_suggestions = [] }) LookupNotFound suggest -> return (NotFound{ fr_paths = [], fr_pkg = Nothing @@ -211,7 +211,7 @@ uncacheModule hsc_env mod = do -- 2. When you have a package qualified import with package name "this", -- we shortcut to the home module. -- --- 3. When we look up an exact 'Module', if the package key associated with +-- 3. When we look up an exact 'Module', if the unit id associated with -- the module is the current home module do a look up in the home module. -- -- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to @@ -258,7 +258,7 @@ findPackageModule :: HscEnv -> Module -> IO FindResult findPackageModule hsc_env mod = do let dflags = hsc_dflags hsc_env - pkg_id = modulePackageKey mod + pkg_id = moduleUnitId mod -- case lookupPackage dflags pkg_id of Nothing -> return (NoPackage pkg_id) @@ -268,12 +268,12 @@ findPackageModule hsc_env mod = do -- requires a few invariants to be upheld: (1) the 'Module' in question must -- be the module identifier of the *original* implementation of a module, -- not a reexport (this invariant is upheld by @Packages.hs@) and (2) --- the 'PackageConfig' must be consistent with the package key in the 'Module'. +-- the 'PackageConfig' must be consistent with the unit id in the 'Module'. -- The redundancy is to avoid an extra lookup in the package state -- for the appropriate config. findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult findPackageModule_ hsc_env mod pkg_conf = - ASSERT( modulePackageKey mod == packageConfigId pkg_conf ) + ASSERT( moduleUnitId mod == packageConfigId pkg_conf ) modLocationCache hsc_env mod $ -- special case for GHC.Prim; we won't find it in the filesystem. @@ -343,7 +343,7 @@ searchPathExts paths mod exts ] search [] = return (NotFound { fr_paths = map fst to_search - , fr_pkg = Just (modulePackageKey mod) + , fr_pkg = Just (moduleUnitId mod) , fr_mods_hidden = [], fr_pkgs_hidden = [] , fr_suggestions = [] }) @@ -531,7 +531,7 @@ cantFindErr _ multiple_found _ mod_name (FoundMultiple mods) where unambiguousPackages = foldl' unambiguousPackage (Just []) mods unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) - = Just (modulePackageKey m : xs) + = Just (moduleUnitId m : xs) unambiguousPackage _ _ = Nothing pprMod (m, o) = ptext (sLit "it is bound as") <+> ppr m <+> @@ -539,7 +539,7 @@ cantFindErr _ multiple_found _ mod_name (FoundMultiple mods) pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( if e == Just True - then [ptext (sLit "package") <+> ppr (modulePackageKey m)] + then [ptext (sLit "package") <+> ppr (moduleUnitId m)] else [] ++ map ((ptext (sLit "a reexport in package") <+>) .ppr.packageConfigId) res ++ @@ -553,7 +553,7 @@ cantFindErr cannot_find _ dflags mod_name find_result more_info = case find_result of NoPackage pkg - -> ptext (sLit "no package key matching") <+> quotes (ppr pkg) <+> + -> ptext (sLit "no unit id matching") <+> quotes (ppr pkg) <+> ptext (sLit "was found") $$ looks_like_srcpkgid pkg NotFound { fr_paths = files, fr_pkg = mb_pkg @@ -600,11 +600,11 @@ cantFindErr cannot_find _ dflags mod_name find_result | otherwise = hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files) - pkg_hidden :: PackageKey -> SDoc + pkg_hidden :: UnitId -> SDoc pkg_hidden pkgid = ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkgid) - --FIXME: we don't really want to show the package key here we should + --FIXME: we don't really want to show the unit id here we should -- show the source package id or installed package id if it's ambiguous <> dot $$ cabal_pkg_hidden_hint pkgid cabal_pkg_hidden_hint pkgid @@ -615,13 +615,13 @@ cantFindErr cannot_find _ dflags mod_name find_result ptext (sLit "to the build-depends in your .cabal file.") | otherwise = Outputable.empty - looks_like_srcpkgid :: PackageKey -> SDoc + looks_like_srcpkgid :: UnitId -> SDoc looks_like_srcpkgid pk - -- Unsafely coerce a package key FastString into a source package ID + -- Unsafely coerce a unit id FastString into a source package ID -- FastString and see if it means anything. - | (pkg:pkgs) <- searchPackageId dflags (SourcePackageId (packageKeyFS pk)) - = parens (text "This package key looks like the source package ID;" $$ - text "the real package key is" <+> quotes (ftext (packageKeyFS (packageKey pkg))) $$ + | (pkg:pkgs) <- searchPackageId dflags (SourcePackageId (unitIdFS pk)) + = parens (text "This unit ID looks like the source package ID;" $$ + 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! @@ -645,9 +645,9 @@ cantFindErr cannot_find _ dflags mod_name find_result fromExposedReexport = res, fromPackageFlag = f }) | Just True <- e - = parens (ptext (sLit "from") <+> ppr (modulePackageKey mod)) + = parens (ptext (sLit "from") <+> ppr (moduleUnitId mod)) | f && moduleName mod == m - = parens (ptext (sLit "from") <+> ppr (modulePackageKey mod)) + = parens (ptext (sLit "from") <+> ppr (moduleUnitId mod)) | (pkg:_) <- res = parens (ptext (sLit "from") <+> ppr (packageConfigId pkg) <> comma <+> ptext (sLit "reexporting") <+> ppr mod) @@ -661,7 +661,7 @@ cantFindErr cannot_find _ dflags mod_name find_result fromHiddenReexport = rhs }) | Just False <- e = parens (ptext (sLit "needs flag -package-key") - <+> ppr (modulePackageKey mod)) + <+> ppr (moduleUnitId mod)) | (pkg:_) <- rhs = parens (ptext (sLit "needs flag -package-id") <+> ppr (packageConfigId pkg)) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 17e03591e1..fe7361e2ab 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -155,10 +155,10 @@ module GHC ( -- * Abstract syntax elements -- ** Packages - PackageKey, + UnitId, -- ** Modules - Module, mkModule, pprModule, moduleName, modulePackageKey, + Module, mkModule, pprModule, moduleName, moduleUnitId, ModuleName, mkModuleName, moduleNameString, -- ** Names @@ -568,7 +568,7 @@ checkBrokenTablesNextToCode' dflags -- flags. If you are not doing linking or doing static linking, you -- can ignore the list of packages returned. -- -setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageKey] +setSessionDynFlags :: GhcMonad m => DynFlags -> m [UnitId] setSessionDynFlags dflags = do dflags' <- checkNewDynFlags dflags (dflags'', preload) <- liftIO $ initPackages dflags' @@ -578,7 +578,7 @@ setSessionDynFlags dflags = do return preload -- | Sets the program 'DynFlags'. -setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageKey] +setProgramDynFlags :: GhcMonad m => DynFlags -> m [UnitId] setProgramDynFlags dflags = do dflags' <- checkNewDynFlags dflags (dflags'', preload) <- liftIO $ initPackages dflags' @@ -1357,7 +1357,7 @@ showRichTokenStream ts = go startLoc ts "" -- ----------------------------------------------------------------------------- -- Interactive evaluation --- | Takes a 'ModuleName' and possibly a 'PackageKey', and consults the +-- | Takes a 'ModuleName' and possibly a 'UnitId', and consults the -- filesystem and package database to find the corresponding 'Module', -- using the algorithm that is used for an @import@ declaration. findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module @@ -1367,7 +1367,7 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do this_pkg = thisPackage dflags -- case maybe_pkg of - Just pkg | fsToPackageKey pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do + Just pkg | fsToUnitId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do res <- findImportedModule hsc_env mod_name maybe_pkg case res of Found _ m -> return m @@ -1379,7 +1379,7 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do Nothing -> liftIO $ do res <- findImportedModule hsc_env mod_name maybe_pkg case res of - Found loc m | modulePackageKey m /= this_pkg -> return m + Found loc m | moduleUnitId m /= this_pkg -> return m | otherwise -> modNotLoadedError dflags m loc err -> throwOneError $ noModError dflags noSrcSpan mod_name err @@ -1424,7 +1424,7 @@ isModuleTrusted m = withSession $ \hsc_env -> liftIO $ hscCheckSafe hsc_env m noSrcSpan -- | Return if a module is trusted and the pkgs it depends on to be trusted. -moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [PackageKey]) +moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [UnitId]) moduleTrustReqs m = withSession $ \hsc_env -> liftIO $ hscGetSafe hsc_env m noSrcSpan diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 123cc9e212..65df44b83d 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1625,7 +1625,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots calcDeps summ | HsBootFile <- ms_hsc_src summ , Just m <- getSigOf (hsc_dflags hsc_env) (moduleName (ms_mod summ)) - , modulePackageKey m == thisPackage (hsc_dflags hsc_env) + , moduleUnitId m == thisPackage (hsc_dflags hsc_env) = (noLoc (moduleName m), NotBoot) : msDeps summ | otherwise = msDeps summ @@ -1920,7 +1920,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) just_found location mod | otherwise -> -- Drop external-pkg - ASSERT(modulePackageKey mod /= thisPackage dflags) + ASSERT(moduleUnitId mod /= thisPackage dflags) return Nothing err -> return $ Just $ Left $ noModError dflags loc wanted_mod err diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 1a35af1738..64143e0c03 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -965,7 +965,7 @@ checkSafeImports dflags tcg_env impInfo = tcg_imports tcg_env -- ImportAvails imports = imp_mods impInfo -- ImportedMods imports' = moduleEnvToList imports -- (Module, [ImportedModsVal]) - pkgReqs = imp_trust_pkgs impInfo -- [PackageKey] + pkgReqs = imp_trust_pkgs impInfo -- [UnitId] condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport) condense (_, []) = panic "HscMain.condense: Pattern match failure!" @@ -1008,7 +1008,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, [PackageKey]) +hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, [UnitId]) hscGetSafe hsc_env m l = runHsc hsc_env $ do dflags <- getDynFlags (self, pkgs) <- hscCheckSafe' dflags m l @@ -1022,15 +1022,15 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do -- Return (regardless of trusted or not) if the trust type requires the modules -- 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' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe PackageKey, [PackageKey]) +hscCheckSafe' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe UnitId, [UnitId]) hscCheckSafe' dflags m l = do (tw, pkgs) <- isModSafe m l case tw of False -> return (Nothing, pkgs) True | isHomePkg m -> return (Nothing, pkgs) - | otherwise -> return (Just $ modulePackageKey m, pkgs) + | otherwise -> return (Just $ moduleUnitId m, pkgs) where - isModSafe :: Module -> SrcSpan -> Hsc (Bool, [PackageKey]) + isModSafe :: Module -> SrcSpan -> Hsc (Bool, [UnitId]) isModSafe m l = do iface <- lookup' m case iface of @@ -1062,7 +1062,7 @@ hscCheckSafe' dflags m l = do pkgTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $ sep [ ppr (moduleName m) <> text ": Can't be safely imported!" - , text "The package (" <> ppr (modulePackageKey m) + , text "The package (" <> ppr (moduleUnitId m) <> text ") the module resides in isn't trusted." ] modTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $ @@ -1082,7 +1082,7 @@ hscCheckSafe' dflags m l = do packageTrusted Sf_Safe False _ = True packageTrusted _ _ m | isHomePkg m = True - | otherwise = trusted $ getPackageDetails dflags (modulePackageKey m) + | otherwise = trusted $ getPackageDetails dflags (moduleUnitId m) lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do @@ -1106,11 +1106,11 @@ hscCheckSafe' dflags m l = do isHomePkg :: Module -> Bool isHomePkg m - | thisPackage dflags == modulePackageKey m = True + | thisPackage dflags == moduleUnitId m = True | otherwise = False -- | Check the list of packages are trusted. -checkPkgTrust :: DynFlags -> [PackageKey] -> Hsc () +checkPkgTrust :: DynFlags -> [UnitId] -> Hsc () checkPkgTrust dflags pkgs = case errors of [] -> return () @@ -1524,7 +1524,7 @@ hscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do handleWarnings -- Then code-gen, and link it - -- It's important NOT to have package 'interactive' as thisPackageKey + -- It's important NOT to have package 'interactive' as thisUnitId -- for linking, else we try to link 'main' and can't find it. -- Whereas the linker already knows to ignore 'interactive' let src_span = srcLocSpan interactiveSrcLoc diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 31d22eb3f0..0edc752932 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -451,7 +451,7 @@ instance Outputable TargetId where -- | Helps us find information about modules in the home package type HomePackageTable = ModuleNameEnv HomeModInfo -- Domain = modules in the home package that have been fully compiled - -- "home" package key cached here for convenience + -- "home" unit id cached here for convenience -- | Helps us find information about modules in the imported packages type PackageIfaceTable = ModuleEnv ModIface @@ -683,7 +683,7 @@ type FinderCache = ModuleEnv FindResult data FindResult = Found ModLocation Module -- ^ The module was found - | NoPackage PackageKey + | NoPackage UnitId -- ^ The requested package was not found | FoundMultiple [(Module, ModuleOrigin)] -- ^ _Error_: both in multiple packages @@ -692,14 +692,14 @@ data FindResult | NotFound { fr_paths :: [FilePath] -- Places where I looked - , fr_pkg :: Maybe PackageKey -- Just p => module is in this package's + , fr_pkg :: Maybe UnitId -- Just p => module is in this package's -- manifest, but couldn't find -- the .hi file - , fr_mods_hidden :: [PackageKey] -- Module is in these packages, + , fr_mods_hidden :: [UnitId] -- Module is in these packages, -- but the *module* is hidden - , fr_pkgs_hidden :: [PackageKey] -- Module is in these packages, + , fr_pkgs_hidden :: [UnitId] -- Module is in these packages, -- but the *package* is hidden , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules @@ -1123,7 +1123,7 @@ data CgGuts -- as part of the code-gen of tycons cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs - cg_dep_pkgs :: ![PackageKey], -- ^ 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 :: !ModBreaks -- ^ Module breakpoints @@ -1162,7 +1162,7 @@ as if they were defined in modules interactive:Ghci2 ...etc... with each bunch of declarations using a new module, all sharing a -common package 'interactive' (see Module.interactivePackageKey, and +common package 'interactive' (see Module.interactiveUnitId, and PrelNames.mkInteractiveModule). This scheme deals well with shadowing. For example: @@ -1454,7 +1454,7 @@ shadowed_by ids = shadowed setInteractivePackage :: HscEnv -> HscEnv -- Set the 'thisPackage' DynFlag to 'interactive' setInteractivePackage hsc_env - = hsc_env { hsc_dflags = (hsc_dflags hsc_env) { thisPackage = interactivePackageKey } } + = hsc_env { hsc_dflags = (hsc_dflags hsc_env) { thisPackage = interactiveUnitId } } setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext setInteractivePrintName ic n = ic{ic_int_print = n} @@ -1538,12 +1538,12 @@ exposed (say P2), so we use M.T for that, and P1:M.T for the other one. This is handled by the qual_mod component of PrintUnqualified, inside the (ppr mod) of case (3), in Name.pprModulePrefix -Note [Printing package keys] +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 -PackageKey, the situation can be different: if the key is instantiated 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. -} @@ -1556,7 +1556,7 @@ mkPrintUnqualified dflags env = QueryQualify qual_name where qual_name mod occ | [] <- unqual_gres - , modulePackageKey mod `elem` [primPackageKey, basePackageKey, thPackageKey] + , moduleUnitId mod `elem` [primUnitId, baseUnitId, thUnitId] , not (isDerivedOccName occ) = NameUnqual -- For names from ubiquitous packages that come with GHC, if -- there are no entities called unqualified 'occ', then @@ -1602,10 +1602,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 - | modulePackageKey mod == thisPackage dflags = False + | moduleUnitId mod == thisPackage dflags = False | [(_, pkgconfig)] <- lookup, - packageConfigId pkgconfig == modulePackageKey mod + packageConfigId pkgconfig == moduleUnitId 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 @@ -1615,10 +1615,10 @@ mkQualModule dflags mod -- | Creates a function for formatting packages based on two heuristics: -- (1) don't qualify if the package in question is "main", and (2) only qualify --- with a package key if the package ID would be ambiguous. +-- with a unit id if the package ID would be ambiguous. mkQualPackage :: DynFlags -> QueryQualifyPackage mkQualPackage dflags pkg_key - | pkg_key == mainPackageKey || pkg_key == interactivePackageKey + | pkg_key == mainUnitId || pkg_key == interactiveUnitId -- Skip the lookup if it's main, since it won't be in the package -- database! = False @@ -2077,7 +2077,7 @@ data Dependencies -- I.e. modules that this one imports, or that are in the -- dep_mods of those directly-imported modules - , dep_pkgs :: [(PackageKey, 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 diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 6b0c4851e1..2b2fdaf9e8 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -927,7 +927,7 @@ getContext = withSession $ \HscEnv{ hsc_IC=ic } -> -- its full top-level scope available. moduleIsInterpreted :: GhcMonad m => Module -> m Bool moduleIsInterpreted modl = withSession $ \h -> - if modulePackageKey modl /= thisPackage (hsc_dflags h) + if moduleUnitId modl /= thisPackage (hsc_dflags h) then return False else case lookupUFM (hsc_HPT h) (moduleName modl) of Just details -> return (isJust (mi_globals (hm_iface details))) diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index 4ba8344e77..3fdb0af1d3 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -9,18 +9,18 @@ module PackageConfig ( -- $package_naming - -- * PackageKey + -- * UnitId packageConfigId, -- * The PackageConfig type: information about a package PackageConfig, InstalledPackageInfo(..), - InstalledPackageId(..), + ComponentId(..), SourcePackageId(..), PackageName(..), Version(..), defaultPackageConfig, - installedPackageIdString, + componentIdString, sourcePackageIdString, packageNameString, pprPackageConfig, @@ -41,23 +41,23 @@ import Unique -- which is similar to a subset of the InstalledPackageInfo type from Cabal. type PackageConfig = InstalledPackageInfo - InstalledPackageId + ComponentId SourcePackageId PackageName - Module.PackageKey + Module.UnitId Module.ModuleName -- TODO: there's no need for these to be FastString, as we don't need the uniq -- feature, but ghc doesn't currently have convenient support for any -- other compact string types, e.g. plain ByteString or Text. -newtype InstalledPackageId = InstalledPackageId FastString deriving (Eq, Ord) +newtype ComponentId = ComponentId FastString deriving (Eq, Ord) newtype SourcePackageId = SourcePackageId FastString deriving (Eq, Ord) newtype PackageName = PackageName FastString deriving (Eq, Ord) -instance BinaryStringRep InstalledPackageId where - fromStringRep = InstalledPackageId . mkFastStringByteString - toStringRep (InstalledPackageId s) = fastStringToByteString s +instance BinaryStringRep ComponentId where + fromStringRep = ComponentId . mkFastStringByteString + toStringRep (ComponentId s) = fastStringToByteString s instance BinaryStringRep SourcePackageId where fromStringRep = SourcePackageId . mkFastStringByteString @@ -67,8 +67,8 @@ instance BinaryStringRep PackageName where fromStringRep = PackageName . mkFastStringByteString toStringRep (PackageName s) = fastStringToByteString s -instance Uniquable InstalledPackageId where - getUnique (InstalledPackageId n) = getUnique n +instance Uniquable ComponentId where + getUnique (ComponentId n) = getUnique n instance Uniquable SourcePackageId where getUnique (SourcePackageId n) = getUnique n @@ -76,8 +76,8 @@ instance Uniquable SourcePackageId where instance Uniquable PackageName where getUnique (PackageName n) = getUnique n -instance Outputable InstalledPackageId where - ppr (InstalledPackageId str) = ftext str +instance Outputable ComponentId where + ppr (ComponentId str) = ftext str instance Outputable SourcePackageId where ppr (SourcePackageId str) = ftext str @@ -107,10 +107,10 @@ pprOriginalModule (OriginalModule originalPackageId originalModuleName) = defaultPackageConfig :: PackageConfig defaultPackageConfig = emptyInstalledPackageInfo -installedPackageIdString :: PackageConfig -> String -installedPackageIdString pkg = unpackFS str +componentIdString :: PackageConfig -> String +componentIdString pkg = unpackFS str where - InstalledPackageId str = installedPackageId pkg + ComponentId str = componentId pkg sourcePackageIdString :: PackageConfig -> String sourcePackageIdString pkg = unpackFS str @@ -127,7 +127,7 @@ pprPackageConfig InstalledPackageInfo {..} = vcat [ field "name" (ppr packageName), field "version" (text (showVersion packageVersion)), - field "id" (ppr installedPackageId), + field "id" (ppr componentId), field "exposed" (ppr exposed), field "exposed-modules" (if all isExposedModule exposedModules @@ -157,16 +157,16 @@ pprPackageConfig InstalledPackageInfo {..} = -- ----------------------------------------------------------------------------- --- PackageKey (package names, versions and dep hash) +-- UnitId (package names, versions and dep hash) -- $package_naming -- #package_naming# --- Mostly the compiler deals in terms of 'PackageKey's, which are md5 hashes +-- Mostly the compiler deals in terms of 'UnitId's, which are md5 hashes -- of a package ID, keys of its dependencies, and Cabal flags. You're expected --- to pass in the package key in the @-this-package-key@ flag. However, for +-- to pass in the unit id in the @-this-package-key@ flag. However, for -- wired-in packages like @base@ & @rts@, we don't necessarily know what the -- version is, so these are handled specially; see #wired_in_packages#. --- | Get the GHC 'PackageKey' right out of a Cabalish 'PackageConfig' -packageConfigId :: PackageConfig -> PackageKey -packageConfigId = packageKey +-- | Get the GHC 'UnitId' right out of a Cabalish 'PackageConfig' +packageConfigId :: PackageConfig -> UnitId +packageConfigId = unitId diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 3b9526129f..0437d17dcf 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -40,7 +40,7 @@ module Packages ( packageHsLibs, -- * Utils - packageKeyPackageIdString, + unitIdPackageIdString, pprFlag, pprPackages, pprPackagesSimple, @@ -213,18 +213,18 @@ originEmpty :: ModuleOrigin -> Bool originEmpty (ModOrigin Nothing [] [] False) = True originEmpty _ = False --- | 'UniqFM' map from 'PackageKey' -type PackageKeyMap = UniqFM +-- | 'UniqFM' map from 'UnitId' +type UnitIdMap = UniqFM --- | 'UniqFM' map from 'PackageKey' to 'PackageConfig' -type PackageConfigMap = PackageKeyMap PackageConfig +-- | 'UniqFM' map from 'UnitId' to 'PackageConfig' +type PackageConfigMap = UnitIdMap PackageConfig --- | 'UniqFM' map from 'PackageKey' to (1) whether or not all modules which +-- | 'UniqFM' map from 'UnitId' to (1) whether or not all modules which -- are exposed should be dumped into scope, (2) any custom renamings that -- should also be apply, and (3) what package name is associated with the -- key, if it might be hidden type VisibilityMap = - PackageKeyMap (Bool, [(ModuleName, ModuleName)], FastString) + UnitIdMap (Bool, [(ModuleName, ModuleName)], FastString) -- | Map from 'ModuleName' to 'Module' to all the origins of the bindings -- in scope. The 'PackageConf' is not cached, mostly for convenience reasons @@ -233,7 +233,7 @@ type ModuleToPkgConfAll = Map ModuleName (Map Module ModuleOrigin) data PackageState = PackageState { - -- | A mapping of 'PackageKey' to 'PackageConfig'. This list is adjusted + -- | A mapping of 'UnitId' to 'PackageConfig'. This list is adjusted -- so that only valid packages are here. 'PackageConfig' reflects -- what was stored *on disk*, except for the 'trusted' flag, which -- is adjusted at runtime. (In particular, some packages in this map @@ -243,7 +243,7 @@ data PackageState = PackageState { -- | The packages we're going to link in eagerly. This list -- should be in reverse dependency order; that is, a package -- is always mentioned before the packages it depends on. - preloadPackages :: [PackageKey], + preloadPackages :: [UnitId], -- | 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 @@ -258,17 +258,17 @@ emptyPackageState = PackageState { moduleToPkgConfAll = Map.empty } -type InstalledPackageIndex = Map PackageKey PackageConfig +type InstalledPackageIndex = Map UnitId PackageConfig -- | Empty package configuration map emptyPackageConfigMap :: PackageConfigMap emptyPackageConfigMap = emptyUFM -- | Find the package we know about with the given key (e.g. @foo_HASH@), if any -lookupPackage :: DynFlags -> PackageKey -> Maybe PackageConfig +lookupPackage :: DynFlags -> UnitId -> Maybe PackageConfig lookupPackage dflags = lookupPackage' (pkgIdMap (pkgState dflags)) -lookupPackage' :: PackageConfigMap -> PackageKey -> Maybe PackageConfig +lookupPackage' :: PackageConfigMap -> UnitId -> Maybe PackageConfig lookupPackage' = lookupUFM -- | Search for packages with a given package ID (e.g. \"foo-0.1\") @@ -285,7 +285,7 @@ extendPackageConfigMap pkg_map new_pkgs -- | Looks up the package with the given id in the package state, panicing if it is -- not found -getPackageDetails :: DynFlags -> PackageKey -> PackageConfig +getPackageDetails :: DynFlags -> UnitId -> PackageConfig getPackageDetails dflags pid = expectJust "getPackageDetails" (lookupPackage dflags pid) @@ -312,7 +312,7 @@ listPackageConfigMap dflags = eltsUFM (pkgIdMap (pkgState dflags)) -- 'packageFlags' field of the 'DynFlags', and it will update the -- 'pkgState' in 'DynFlags' and return a list of packages to -- link in. -initPackages :: DynFlags -> IO (DynFlags, [PackageKey]) +initPackages :: DynFlags -> IO (DynFlags, [UnitId]) initPackages dflags = do pkg_db <- case pkgDatabase dflags of Nothing -> readPackageConfigs dflags @@ -549,15 +549,15 @@ matchingStr str p || str == packageNameString p matchingId :: String -> PackageConfig -> Bool -matchingId str p = str == installedPackageIdString p +matchingId str p = str == componentIdString p matchingKey :: String -> PackageConfig -> Bool -matchingKey str p = str == packageKeyString (packageConfigId p) +matchingKey str p = str == unitIdString (packageConfigId p) matching :: PackageArg -> PackageConfig -> Bool matching (PackageArg str) = matchingStr str matching (PackageIdArg str) = matchingId str -matching (PackageKeyArg str) = matchingKey str +matching (UnitIdArg str) = matchingKey str sortByVersion :: [PackageConfig] -> [PackageConfig] sortByVersion = sortBy (flip (comparing packageVersion)) @@ -588,7 +588,7 @@ packageFlagErr dflags flag reasons text "(use -v for more information)") ppr_reasons = vcat (map ppr_reason reasons) ppr_reason (p, reason) = - pprReason (ppr (packageKey p) <+> text "is") reason + pprReason (ppr (unitId p) <+> text "is") reason pprFlag :: PackageFlag -> SDoc pprFlag flag = case flag of @@ -600,7 +600,7 @@ pprFlag flag = case flag of where ppr_arg arg = case arg of PackageArg p -> text "-package " <> text p PackageIdArg p -> text "-package-id " <> text p - PackageKeyArg p -> text "-package-key " <> text p + UnitIdArg p -> text "-package-key " <> text p ppr_rns (ModRenaming True []) = Outputable.empty ppr_rns (ModRenaming b rns) = if b then text "with" else Outputable.empty <+> @@ -612,9 +612,9 @@ pprFlag flag = case flag of -- Wired-in packages wired_in_pkgids :: [String] -wired_in_pkgids = map packageKeyString wiredInPackageKeys +wired_in_pkgids = map unitIdString wiredInUnitIds -type WiredPackagesMap = Map PackageKey PackageKey +type WiredPackagesMap = Map UnitId UnitId findWiredInPackages :: DynFlags @@ -674,14 +674,14 @@ findWiredInPackages dflags pkgs vis_map = do ptext (sLit "wired-in package ") <> text wired_pkg <> ptext (sLit " mapped to ") - <> ppr (packageKey pkg) + <> ppr (unitId pkg) return (Just pkg) mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wired_in_pkgids let wired_in_pkgs = catMaybes mb_wired_in_pkgs - wired_in_ids = map packageKey wired_in_pkgs + wired_in_ids = map unitId wired_in_pkgs -- this is old: we used to assume that if there were -- multiple versions of wired-in packages installed that @@ -696,19 +696,19 @@ findWiredInPackages dflags pkgs vis_map = do && package p `notElem` map fst wired_in_ids -} - wiredInMap :: Map PackageKey PackageKey + wiredInMap :: Map UnitId UnitId wiredInMap = foldl' add_mapping Map.empty pkgs where add_mapping m pkg - | let key = packageKey pkg + | let key = unitId pkg , key `elem` wired_in_ids - = Map.insert key (stringToPackageKey (packageNameString pkg)) m + = Map.insert key (stringToUnitId (packageNameString pkg)) m | otherwise = m updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs where upd_pkg pkg - | packageKey pkg `elem` wired_in_ids + | unitId pkg `elem` wired_in_ids = pkg { - packageKey = stringToPackageKey (packageNameString pkg) + unitId = stringToUnitId (packageNameString pkg) } | otherwise = pkg @@ -722,7 +722,7 @@ findWiredInPackages dflags pkgs vis_map = do updateVisibilityMap vis_map = foldl' f vis_map wired_in_pkgs where f vm p = case lookupUFM vis_map (packageConfigId p) of Nothing -> vm - Just r -> addToUFM vm (stringToPackageKey + Just r -> addToUFM vm (stringToUnitId (packageNameString p)) r @@ -732,9 +732,9 @@ findWiredInPackages dflags pkgs vis_map = do data UnusablePackageReason = IgnoredWithFlag - | MissingDependencies [PackageKey] + | MissingDependencies [UnitId] -type UnusablePackages = Map PackageKey +type UnusablePackages = Map UnitId (PackageConfig, UnusablePackageReason) pprReason :: SDoc -> UnusablePackageReason -> SDoc @@ -769,17 +769,17 @@ findBroken pkgs = go [] Map.empty pkgs go avail ipids not_avail = case partitionWith (depsAvailable ipids) not_avail of ([], not_avail) -> - Map.fromList [ (packageKey p, (p, MissingDependencies deps)) + Map.fromList [ (unitId p, (p, MissingDependencies deps)) | (p,deps) <- not_avail ] (new_avail, not_avail) -> go (new_avail ++ avail) new_ipids (map fst not_avail) where new_ipids = Map.insertList - [ (packageKey p, p) | p <- new_avail ] + [ (unitId p, p) | p <- new_avail ] ipids depsAvailable :: InstalledPackageIndex -> PackageConfig - -> Either PackageConfig (PackageConfig, [PackageKey]) + -> Either PackageConfig (PackageConfig, [UnitId]) depsAvailable ipids pkg | null dangling = Left pkg | otherwise = Right (pkg, dangling) @@ -793,7 +793,7 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags) where doit (IgnorePackage str) = case partition (matchingStr str) pkgs of - (ps, _) -> [ (packageKey p, (p, IgnoredWithFlag)) + (ps, _) -> [ (unitId p, (p, IgnoredWithFlag)) | p <- ps ] -- missing package is not an error for -ignore-package, -- because a common usage is to -ignore-package P as @@ -807,16 +807,16 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags) mkPackageState :: DynFlags -> [PackageConfig] -- initial database - -> [PackageKey] -- preloaded packages + -> [UnitId] -- preloaded packages -> IO (PackageState, - [PackageKey], -- new packages to preload - PackageKey) -- this package, might be modified if the current + [UnitId], -- new packages to preload + UnitId) -- this package, might be modified if the current -- package is a wired-in package. mkPackageState dflags0 pkgs0 preload0 = do dflags <- interpretPackageEnv dflags0 - -- Compute the package key + -- Compute the unit id let this_package = thisPackage dflags {- @@ -854,7 +854,7 @@ mkPackageState dflags0 pkgs0 preload0 = do where del p (s,ps,a) | key `Set.member` s = (s,ps,a') | otherwise = (Set.insert key s, p:ps, a') - where key = packageKey p + where key = unitId p a' = Map.insertWith Set.union key (Set.singleton (abiHash p)) a failed_abis = [ (key, Set.toList as) @@ -875,13 +875,13 @@ mkPackageState dflags0 pkgs0 preload0 = do ignored = ignorePackages ignore_flags pkgs0_unique - isBroken = (`Map.member` ignored).packageKey + isBroken = (`Map.member` ignored).unitId pkgs0' = filter (not . isBroken) pkgs0_unique broken = findBroken pkgs0' unusable = ignored `Map.union` broken - pkgs1 = filter (not . (`Map.member` unusable) . packageKey) pkgs0' + pkgs1 = filter (not . (`Map.member` unusable) . unitId) pkgs0' reportUnusable dflags unusable @@ -916,7 +916,7 @@ mkPackageState dflags0 pkgs0 preload0 = do -- -- Sort out which packages are wired in. This has to be done last, since - -- it modifies the package keys of wired in packages, but when we process + -- it modifies the unit ids of wired in packages, but when we process -- package arguments we need to key against the old versions. We also -- have to update the visibility map in the process. -- @@ -929,7 +929,7 @@ mkPackageState dflags0 pkgs0 preload0 = do -- should contain at least rts & base, which is why we pretend that -- the command line contains -package rts & -package base. -- - let preload1 = [ let key = packageKey p + let preload1 = [ let key = unitId p in fromMaybe key (Map.lookup key wired_map) | f <- flags, p <- get_exposed f ] @@ -947,7 +947,7 @@ mkPackageState dflags0 pkgs0 preload0 = do basicLinkedPackages | gopt Opt_AutoLinkPackages dflags = filter (flip elemUFM pkg_db) - [basePackageKey, rtsPackageKey] + [baseUnitId, rtsUnitId] | otherwise = [] -- but in any case remove the current package from the set of -- preloaded packages so that base/rts does not end up in the @@ -1040,7 +1040,7 @@ mkModuleToPkgConfAll dflags pkg_db vis_map = -- use. -- | Find all the include directories in these and the preload packages -getPackageIncludePath :: DynFlags -> [PackageKey] -> IO [String] +getPackageIncludePath :: DynFlags -> [UnitId] -> IO [String] getPackageIncludePath dflags pkgs = collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs @@ -1048,7 +1048,7 @@ collectIncludeDirs :: [PackageConfig] -> [FilePath] collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps)) -- | Find all the library paths in these and the preload packages -getPackageLibraryPath :: DynFlags -> [PackageKey] -> IO [String] +getPackageLibraryPath :: DynFlags -> [UnitId] -> IO [String] getPackageLibraryPath dflags pkgs = collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs @@ -1057,7 +1057,7 @@ collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps)) -- | Find all the link options in these and the preload packages, -- returning (package hs lib options, extra library options, other flags) -getPackageLinkOpts :: DynFlags -> [PackageKey] -> IO ([String], [String], [String]) +getPackageLinkOpts :: DynFlags -> [UnitId] -> IO ([String], [String], [String]) getPackageLinkOpts dflags pkgs = collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs @@ -1106,19 +1106,19 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) | otherwise = '_':t -- | Find all the C-compiler options in these and the preload packages -getPackageExtraCcOpts :: DynFlags -> [PackageKey] -> IO [String] +getPackageExtraCcOpts :: DynFlags -> [UnitId] -> IO [String] getPackageExtraCcOpts dflags pkgs = do ps <- getPreloadPackagesAnd dflags pkgs return (concatMap ccOptions ps) -- | Find all the package framework paths in these and the preload packages -getPackageFrameworkPath :: DynFlags -> [PackageKey] -> IO [String] +getPackageFrameworkPath :: DynFlags -> [UnitId] -> IO [String] getPackageFrameworkPath dflags pkgs = do ps <- getPreloadPackagesAnd dflags pkgs return (nub (filter notNull (concatMap frameworkDirs ps))) -- | Find all the package frameworks in these and the preload packages -getPackageFrameworks :: DynFlags -> [PackageKey] -> IO [String] +getPackageFrameworks :: DynFlags -> [UnitId] -> IO [String] getPackageFrameworks dflags pkgs = do ps <- getPreloadPackagesAnd dflags pkgs return (concatMap frameworks ps) @@ -1136,7 +1136,7 @@ lookupModuleInAllPackages dflags m LookupFound a b -> [(a,b)] LookupMultiple rs -> map f rs where f (m,_) = (m, expectJust "lookupModule" (lookupPackage dflags - (modulePackageKey m))) + (moduleUnitId m))) _ -> [] -- | The result of performing a lookup @@ -1180,7 +1180,7 @@ lookupModuleWithSuggestions dflags m mb_pn pkg_lookup = expectJust "lookupModuleWithSuggestions" . lookupPackage dflags pkg_state = pkgState dflags - mod_pkg = pkg_lookup . modulePackageKey + mod_pkg = pkg_lookup . moduleUnitId -- Filters out origins which are not associated with the given package -- qualifier. No-op if there is no package qualifier. Test if this @@ -1225,7 +1225,7 @@ listVisibleModuleNames dflags = -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of -- 'PackageConfig's -getPreloadPackagesAnd :: DynFlags -> [PackageKey] -> IO [PackageConfig] +getPreloadPackagesAnd :: DynFlags -> [UnitId] -> IO [PackageConfig] getPreloadPackagesAnd dflags pkgids = let state = pkgState dflags @@ -1240,8 +1240,8 @@ getPreloadPackagesAnd dflags pkgids = -- in reverse dependency order (a package appears before those it depends on). closeDeps :: DynFlags -> PackageConfigMap - -> [(PackageKey, Maybe PackageKey)] - -> IO [PackageKey] + -> [(UnitId, Maybe UnitId)] + -> IO [UnitId] closeDeps dflags pkg_map ps = throwErr dflags (closeDepsErr pkg_map ps) @@ -1252,15 +1252,15 @@ throwErr dflags m Succeeded r -> return r closeDepsErr :: PackageConfigMap - -> [(PackageKey,Maybe PackageKey)] - -> MaybeErr MsgDoc [PackageKey] + -> [(UnitId,Maybe UnitId)] + -> MaybeErr MsgDoc [UnitId] closeDepsErr pkg_map ps = foldM (add_package pkg_map) [] ps -- internal helper add_package :: PackageConfigMap - -> [PackageKey] - -> (PackageKey,Maybe PackageKey) - -> MaybeErr MsgDoc [PackageKey] + -> [UnitId] + -> (UnitId,Maybe UnitId) + -> MaybeErr MsgDoc [UnitId] add_package pkg_db ps (p, mb_parent) | p `elem` ps = return ps -- Check if we've already added this package | otherwise = @@ -1278,20 +1278,20 @@ add_package pkg_db ps (p, mb_parent) missingPackageMsg :: Outputable pkgid => pkgid -> SDoc missingPackageMsg p = ptext (sLit "unknown package:") <+> ppr p -missingDependencyMsg :: Maybe PackageKey -> SDoc +missingDependencyMsg :: Maybe UnitId -> SDoc missingDependencyMsg Nothing = Outputable.empty missingDependencyMsg (Just parent) - = space <> parens (ptext (sLit "dependency of") <+> ftext (packageKeyFS parent)) + = space <> parens (ptext (sLit "dependency of") <+> ftext (unitIdFS parent)) -- ----------------------------------------------------------------------------- -packageKeyPackageIdString :: DynFlags -> PackageKey -> Maybe String -packageKeyPackageIdString dflags pkg_key - | pkg_key == mainPackageKey = Just "main" +unitIdPackageIdString :: DynFlags -> UnitId -> Maybe String +unitIdPackageIdString dflags pkg_key + | pkg_key == mainUnitId = Just "main" | otherwise = fmap sourcePackageIdString (lookupPackage dflags pkg_key) -- | Will the 'Name' come from a dynamically linked library? -isDllName :: DynFlags -> PackageKey -> Module -> Name -> Bool +isDllName :: DynFlags -> UnitId -> Module -> Name -> Bool -- Despite the "dll", I think this function just means that -- the synbol comes from another dynamically-linked package, -- and applies on all platforms, not just Windows @@ -1340,7 +1340,7 @@ pprPackagesWith pprIPI dflags = -- be different from the package databases (exposure, trust) pprPackagesSimple :: DynFlags -> SDoc pprPackagesSimple = pprPackagesWith pprIPI - where pprIPI ipi = let i = packageKeyFS (packageKey ipi) + where pprIPI ipi = let i = unitIdFS (unitId ipi) e = if exposed ipi then text "E" else text " " t = if trusted ipi then text "T" else text " " in e <> t <> text " " <> ftext i @@ -1352,7 +1352,7 @@ pprModuleMap dflags = where pprLine (m,e) = ppr m $$ nest 50 (vcat (map (pprEntry m) (Map.toList e))) pprEntry m (m',o) - | m == moduleName m' = ppr (modulePackageKey m') <+> parens (ppr o) + | m == moduleName m' = ppr (moduleUnitId m') <+> parens (ppr o) | otherwise = ppr m' <+> parens (ppr o) fsPackageName :: PackageConfig -> FastString diff --git a/compiler/main/Packages.hs-boot b/compiler/main/Packages.hs-boot index bac04bc20a..1197fadb57 100644 --- a/compiler/main/Packages.hs-boot +++ b/compiler/main/Packages.hs-boot @@ -1,7 +1,7 @@ module Packages where -- Well, this is kind of stupid... -import {-# SOURCE #-} Module (PackageKey) +import {-# SOURCE #-} Module (UnitId) import {-# SOURCE #-} DynFlags (DynFlags) data PackageState -packageKeyPackageIdString :: DynFlags -> PackageKey -> Maybe String +unitIdPackageIdString :: DynFlags -> UnitId -> Maybe String emptyPackageState :: PackageState diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs index 20f172b7d8..1a1d4b50f5 100644 --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -1541,7 +1541,7 @@ linesPlatform xs = #endif -linkDynLib :: DynFlags -> [String] -> [PackageKey] -> IO () +linkDynLib :: DynFlags -> [String] -> [UnitId] -> IO () linkDynLib dflags0 o_files dep_packages = do let -- This is a rather ugly hack to fix dynamically linked @@ -1587,7 +1587,7 @@ linkDynLib dflags0 o_files dep_packages OSMinGW32 -> pkgs _ -> - filter ((/= rtsPackageKey) . packageConfigId) pkgs + filter ((/= rtsUnitId) . packageConfigId) pkgs let pkg_link_opts = let (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs_no_rts in package_hs_libs ++ extra_libs ++ other_flags @@ -1597,7 +1597,7 @@ linkDynLib dflags0 o_files dep_packages -- frameworks pkg_framework_opts <- getPkgFrameworkOpts dflags platform - (map packageKey pkgs) + (map unitId pkgs) let framework_opts = getFrameworkOpts dflags platform case os of @@ -1718,7 +1718,7 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_link_opts ) -getPkgFrameworkOpts :: DynFlags -> Platform -> [PackageKey] -> IO [String] +getPkgFrameworkOpts :: DynFlags -> Platform -> [UnitId] -> IO [String] getPkgFrameworkOpts dflags platform dep_packages | platformUsesFrameworks platform = do pkg_framework_path_opts <- do diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs index efc6148b5a..e2a772f8d4 100644 --- a/compiler/main/TidyPgm.hs +++ b/compiler/main/TidyPgm.hs @@ -1123,7 +1123,7 @@ tidyTopBinds hsc_env this_mod unfold_env init_occ_env binds ------------------------ tidyTopBind :: DynFlags - -> PackageKey + -> UnitId -> Module -> (Integer -> CoreExpr) -> UnfoldEnv @@ -1311,7 +1311,7 @@ type CafRefEnv = (VarEnv Id, Integer -> CoreExpr) -- The Integer -> CoreExpr is the desugaring function for Integer literals -- See Note [Disgusting computation of CafRefs] -hasCafRefs :: DynFlags -> PackageKey -> Module +hasCafRefs :: DynFlags -> UnitId -> Module -> CafRefEnv -> Arity -> CoreExpr -> CafInfo hasCafRefs dflags this_pkg this_mod p@(_,cvt_integer) arity expr diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs index 2ea63eec47..d84578805b 100644 --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -1122,15 +1122,15 @@ cmmExprNative referenceKind expr = do CmmReg (CmmGlobal EagerBlackholeInfo) | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ - CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_EAGER_BLACKHOLE_info"))) + CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_EAGER_BLACKHOLE_info"))) CmmReg (CmmGlobal GCEnter1) | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ - CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_gc_enter_1"))) + CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_enter_1"))) CmmReg (CmmGlobal GCFun) | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ - CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_gc_fun"))) + CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit "__stg_gc_fun"))) other -> return other diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index d582b53f5a..1d517b95dd 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -42,7 +42,7 @@ import Platform -- Our intermediate code: import BasicTypes import BlockId -import Module ( primPackageKey ) +import Module ( primUnitId ) import PprCmm () import CmmUtils import CmmSwitch @@ -1818,7 +1818,7 @@ genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] genCCall dflags is32Bit target dest_regs args where format = intFormat width - lbl = mkCmmCodeLabel primPackageKey (fsLit (popCntLabel width)) + lbl = mkCmmCodeLabel primUnitId (fsLit (popCntLabel width)) genCCall dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] | is32Bit && width == W64 = do @@ -1850,7 +1850,7 @@ genCCall dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bw = widthInBits width platform = targetPlatform dflags format = if width == W8 then II16 else intFormat width - lbl = mkCmmCodeLabel primPackageKey (fsLit (clzLabel width)) + lbl = mkCmmCodeLabel primUnitId (fsLit (clzLabel width)) genCCall dflags is32Bit (PrimTarget (MO_Ctz width)) [dst] [src] | is32Bit, width == W64 = do @@ -1914,7 +1914,7 @@ genCCall dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do CmmMayReturn) genCCall dflags is32Bit target dest_regs args where - lbl = mkCmmCodeLabel primPackageKey (fsLit (word2FloatLabel width)) + lbl = mkCmmCodeLabel primUnitId (fsLit (word2FloatLabel width)) genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = do Amode amode addr_code <- diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index ae2e966090..db2d8473cc 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -1765,7 +1765,7 @@ getPState = P $ \s -> POk s s instance HasDynFlags P where getDynFlags = P $ \s -> POk s (dflags s) -withThisPackage :: (PackageKey -> a) -> P a +withThisPackage :: (UnitId -> a) -> P a withThisPackage f = do pkg <- liftM thisPackage getDynFlags return $ f pkg diff --git a/compiler/prelude/ForeignCall.hs b/compiler/prelude/ForeignCall.hs index bec849f728..a08f64b621 100644 --- a/compiler/prelude/ForeignCall.hs +++ b/compiler/prelude/ForeignCall.hs @@ -114,7 +114,7 @@ data CCallTarget -- See note [Pragma source text] in BasicTypes CLabelString -- C-land name of label. - (Maybe PackageKey) -- What package the function is in. + (Maybe UnitId) -- What package the function is in. -- If Nothing, then it's taken to be in the current package. -- Note: This information is only used for PrimCalls on Windows. -- See CLabel.labelDynamic and CoreToStg.coreToStgApp diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs index f1212a38f1..3808c4ecb8 100644 --- a/compiler/prelude/PrelNames.hs +++ b/compiler/prelude/PrelNames.hs @@ -476,7 +476,7 @@ rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation mkInteractiveModule :: Int -> Module -- (mkInteractiveMoudule 9) makes module 'interactive:M9' -mkInteractiveModule n = mkModule interactivePackageKey (mkModuleName ("Ghci" ++ show n)) +mkInteractiveModule n = mkModule interactiveUnitId (mkModuleName ("Ghci" ++ show n)) pRELUDE_NAME, mAIN_NAME :: ModuleName pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude") @@ -487,28 +487,28 @@ dATA_ARRAY_PARALLEL_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel") dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim") mkPrimModule :: FastString -> Module -mkPrimModule m = mkModule primPackageKey (mkModuleNameFS m) +mkPrimModule m = mkModule primUnitId (mkModuleNameFS m) mkIntegerModule :: FastString -> Module -mkIntegerModule m = mkModule integerPackageKey (mkModuleNameFS m) +mkIntegerModule m = mkModule integerUnitId (mkModuleNameFS m) mkBaseModule :: FastString -> Module -mkBaseModule m = mkModule basePackageKey (mkModuleNameFS m) +mkBaseModule m = mkModule baseUnitId (mkModuleNameFS m) mkBaseModule_ :: ModuleName -> Module -mkBaseModule_ m = mkModule basePackageKey m +mkBaseModule_ m = mkModule baseUnitId m mkThisGhcModule :: FastString -> Module -mkThisGhcModule m = mkModule thisGhcPackageKey (mkModuleNameFS m) +mkThisGhcModule m = mkModule thisGhcUnitId (mkModuleNameFS m) mkThisGhcModule_ :: ModuleName -> Module -mkThisGhcModule_ m = mkModule thisGhcPackageKey m +mkThisGhcModule_ m = mkModule thisGhcUnitId m mkMainModule :: FastString -> Module -mkMainModule m = mkModule mainPackageKey (mkModuleNameFS m) +mkMainModule m = mkModule mainUnitId (mkModuleNameFS m) mkMainModule_ :: ModuleName -> Module -mkMainModule_ m = mkModule mainPackageKey m +mkMainModule_ m = mkModule mainUnitId m {- ************************************************************************ diff --git a/compiler/prelude/PrimOp.hs b/compiler/prelude/PrimOp.hs index 6b012ee5ea..202fd815d5 100644 --- a/compiler/prelude/PrimOp.hs +++ b/compiler/prelude/PrimOp.hs @@ -39,7 +39,7 @@ import ForeignCall ( CLabelString ) import Unique ( Unique, mkPrimOpIdUnique ) import Outputable import FastString -import Module ( PackageKey ) +import Module ( UnitId ) {- ************************************************************************ @@ -617,7 +617,7 @@ pprPrimOp other_op = pprOccName (primOpOcc other_op) ************************************************************************ -} -data PrimCall = PrimCall CLabelString PackageKey +data PrimCall = PrimCall CLabelString UnitId instance Outputable PrimCall where ppr (PrimCall lbl pkgId) diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs index d3deb49ba2..9c39564147 100644 --- a/compiler/prelude/THNames.hs +++ b/compiler/prelude/THNames.hs @@ -7,7 +7,7 @@ module THNames where import PrelNames( mk_known_key_name ) -import Module( Module, mkModuleNameFS, mkModule, thPackageKey ) +import Module( Module, mkModuleNameFS, mkModule, thUnitId ) import Name( Name ) import OccName( tcName, clsName, dataName, varName ) import RdrName( RdrName, nameRdrName ) @@ -145,7 +145,7 @@ thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib") qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote") mkTHModule :: FastString -> Module -mkTHModule m = mkModule thPackageKey (mkModuleNameFS m) +mkTHModule m = mkModule thUnitId (mkModuleNameFS m) libFun, libTc, thFun, thTc, thCls, thCon, qqFun :: FastString -> Unique -> Name libFun = mk_known_key_name OccName.varName thLib diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 0cdf38c693..a92c8d9c6a 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -217,7 +217,7 @@ rnImportDecl this_mod -- c.f. GHC.findModule, and Trac #9997 Nothing -> True Just (StringLiteral _ pkg_fs) -> pkg_fs == fsLit "this" || - fsToPackageKey pkg_fs == modulePackageKey this_mod)) + fsToUnitId pkg_fs == moduleUnitId this_mod)) (addErr (ptext (sLit "A module cannot import itself:") <+> ppr imp_mod_name)) -- Check for a missing import list (Opt_WarnMissingImportList also @@ -332,7 +332,7 @@ calculateAvails dflags iface mod_safe' want_boot = imp_mod : dep_finsts deps | otherwise = dep_finsts deps - pkg = modulePackageKey (mi_module iface) + pkg = moduleUnitId (mi_module iface) -- Does this import mean we now require our own pkg -- to be trusted? See Note [Trust Own Package] diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 820f0b045a..19f05c3ca2 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -402,8 +402,8 @@ rnHsForeignDecl (ForeignImport name ty _ spec) ; (ty', fvs) <- rnLHsType (ForeignDeclCtx name) ty -- Mark any PackageTarget style imports as coming from the current package - ; let packageKey = thisPackage $ hsc_dflags topEnv - spec' = patchForeignImport packageKey spec + ; let unitId = thisPackage $ hsc_dflags topEnv + spec' = patchForeignImport unitId spec ; return (ForeignImport name' ty' noForeignImportCoercionYet spec', fvs) } @@ -420,21 +420,21 @@ rnHsForeignDecl (ForeignExport name ty _ spec) -- package, so if they get inlined across a package boundry we'll still -- know where they're from. -- -patchForeignImport :: PackageKey -> ForeignImport -> ForeignImport -patchForeignImport packageKey (CImport cconv safety fs spec src) - = CImport cconv safety fs (patchCImportSpec packageKey spec) src +patchForeignImport :: UnitId -> ForeignImport -> ForeignImport +patchForeignImport unitId (CImport cconv safety fs spec src) + = CImport cconv safety fs (patchCImportSpec unitId spec) src -patchCImportSpec :: PackageKey -> CImportSpec -> CImportSpec -patchCImportSpec packageKey spec +patchCImportSpec :: UnitId -> CImportSpec -> CImportSpec +patchCImportSpec unitId spec = case spec of - CFunction callTarget -> CFunction $ patchCCallTarget packageKey callTarget + CFunction callTarget -> CFunction $ patchCCallTarget unitId callTarget _ -> spec -patchCCallTarget :: PackageKey -> CCallTarget -> CCallTarget -patchCCallTarget packageKey callTarget = +patchCCallTarget :: UnitId -> CCallTarget -> CCallTarget +patchCCallTarget unitId callTarget = case callTarget of StaticTarget src label Nothing isFun - -> StaticTarget src label (Just packageKey) isFun + -> StaticTarget src label (Just unitId) isFun _ -> callTarget {- diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 9605ed57f8..aed7f5d8cf 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -814,7 +814,7 @@ mkWrapperName what nameBase thisMod <- getModule let -- Note [Generating fresh names for ccall wrapper] wrapperRef = nextWrapperNum dflags - pkg = packageKeyString (modulePackageKey thisMod) + pkg = unitIdString (moduleUnitId thisMod) mod = moduleNameString (moduleName thisMod) wrapperNum <- liftIO $ atomicModifyIORef' wrapperRef $ \mod_env -> let num = lookupWithDefaultModuleEnv mod_env 0 thisMod diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index cc26c02122..c0a3350b46 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -1379,7 +1379,7 @@ sameOccExtra ty1 ty2 , let n1 = tyConName tc1 n2 = tyConName tc2 same_occ = nameOccName n1 == nameOccName n2 - same_pkg = modulePackageKey (nameModule n1) == modulePackageKey (nameModule n2) + same_pkg = moduleUnitId (nameModule n1) == moduleUnitId (nameModule n2) , n1 /= n2 -- Different Names , same_occ -- but same OccName = ptext (sLit "NB:") <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2) @@ -1393,10 +1393,10 @@ sameOccExtra ty1 ty2 | otherwise -- Imported things have an UnhelpfulSrcSpan = hang (quotes (ppr nm)) 2 (sep [ ptext (sLit "is defined in") <+> quotes (ppr (moduleName mod)) - , ppUnless (same_pkg || pkg == mainPackageKey) $ + , ppUnless (same_pkg || pkg == mainUnitId) $ nest 4 $ ptext (sLit "in package") <+> quotes (ppr pkg) ]) where - pkg = modulePackageKey mod + pkg = moduleUnitId mod mod = nameModule nm loc = nameSrcSpan nm diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs index eb9c00d16b..e964901aaa 100644 --- a/compiler/typecheck/TcGenDeriv.hs +++ b/compiler/typecheck/TcGenDeriv.hs @@ -45,7 +45,7 @@ import MkCore ( eRROR_ID ) import PrelNames hiding (error_RDR) import THNames import Module ( moduleName, moduleNameString - , modulePackageKey, packageKeyString ) + , moduleUnitId, unitIdString ) import MkId ( coerceId ) import PrimOp import SrcLoc @@ -1951,7 +1951,7 @@ gen_Lift_binds loc tycon (primLitOp (mkBoxExp (nlHsVar a))) where (primLitOp, mkBoxExp) = primLitOps "Lift" tycon ty - pkg_name = packageKeyString . modulePackageKey + pkg_name = unitIdString . moduleUnitId . nameModule $ tycon_name mod_name = moduleNameString . moduleName . nameModule $ tycon_name con_name = occNameString . nameOccName . dataConName $ data_con diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs index 3514393baa..85c181d4de 100644 --- a/compiler/typecheck/TcGenGenerics.hs +++ b/compiler/typecheck/TcGenGenerics.hs @@ -24,7 +24,7 @@ import TyCon import FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom ) import FamInst import Module ( Module, moduleName, moduleNameString - , modulePackageKey, packageKeyString, getModule ) + , moduleUnitId, unitIdString, getModule ) import IfaceEnv ( newGlobalBinder ) import Name hiding ( varName ) import RdrName @@ -748,7 +748,7 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds) $ tyConName_user moduleName_matches = mkStringLHS . moduleNameString . moduleName . nameModule . tyConName $ tycon - pkgName_matches = mkStringLHS . packageKeyString . modulePackageKey + pkgName_matches = mkStringLHS . unitIdString . moduleUnitId . nameModule . tyConName $ tycon isNewtype_matches = [mkSimpleHsAlt nlWildPat (nlHsVar true_RDR)] diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index e2c8d4c124..5fe16d78f0 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -2073,7 +2073,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , ptext (sLit "Dependent modules:") <+> ppr (sortBy cmp_mp $ eltsUFM (imp_dep_mods imports)) , ptext (sLit "Dependent packages:") <+> - ppr (sortBy stablePackageKeyCmp $ imp_dep_pkgs imports)] + ppr (sortBy stableUnitIdCmp $ imp_dep_pkgs imports)] where -- The two uses of sortBy are just to reduce unnecessary -- wobbling in testsuite output cmp_mp (mod_name1, is_boot1) (mod_name2, is_boot2) diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 2dbabfc8fd..4a24dd51e4 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -124,7 +124,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this tcg_rdr_env = emptyGlobalRdrEnv, tcg_fix_env = emptyNameEnv, tcg_field_env = RecFields emptyNameEnv emptyNameSet, - tcg_default = if modulePackageKey mod == primPackageKey + tcg_default = if moduleUnitId mod == primUnitId then Just [] -- See Note [Default types] else Nothing, tcg_type_env = emptyNameEnv, diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index b5da234818..d94abe9951 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -996,17 +996,17 @@ data ImportAvails -- compiling M might not need to consult X.hi, but X -- is still listed in M's dependencies. - imp_dep_pkgs :: [PackageKey], + imp_dep_pkgs :: [UnitId], -- ^ Packages needed by the module being compiled, whether directly, -- or via other modules in this package, or via modules imported -- from other packages. - imp_trust_pkgs :: [PackageKey], + imp_trust_pkgs :: [UnitId], -- ^ This is strictly a subset of imp_dep_pkgs and records the -- packages the current module needs to trust for Safe Haskell -- compilation to succeed. A package is required to be trusted if -- we are dependent on a trustworthy module in that package. - -- While perhaps making imp_dep_pkgs a tuple of (PackageKey, Bool) + -- While perhaps making imp_dep_pkgs a tuple of (UnitId, Bool) -- where True for the bool indicates the package is required to be -- trusted is the more logical design, doing so complicates a lot -- of code not concerned with Safe Haskell. diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index c8eb9f8850..dc4a23f85e 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -773,7 +773,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where RealSrcSpan s -> return s ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r) , TH.loc_module = moduleNameString (moduleName m) - , TH.loc_package = packageKeyString (modulePackageKey m) + , TH.loc_package = unitIdString (moduleUnitId m) , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r) , TH.loc_end = (srcSpanEndLine r, srcSpanEndCol r) }) } @@ -1514,7 +1514,7 @@ reifyName thing where name = getName thing mod = ASSERT( isExternalName name ) nameModule name - pkg_str = packageKeyString (modulePackageKey mod) + pkg_str = unitIdString (moduleUnitId mod) mod_str = moduleNameString (moduleName mod) occ_str = occNameString occ occ = nameOccName name @@ -1545,7 +1545,7 @@ lookupThAnnLookup :: TH.AnnLookup -> TcM CoreAnnTarget lookupThAnnLookup (TH.AnnLookupName th_nm) = fmap NamedTarget (lookupThName th_nm) lookupThAnnLookup (TH.AnnLookupModule (TH.Module pn mn)) = return $ ModuleTarget $ - mkModule (stringToPackageKey $ TH.pkgString pn) (mkModuleName $ TH.modString mn) + mkModule (stringToUnitId $ TH.pkgString pn) (mkModuleName $ TH.modString mn) reifyAnnotations :: Data a => TH.AnnLookup -> TcM [a] reifyAnnotations th_name @@ -1559,13 +1559,13 @@ reifyAnnotations th_name ------------------------------ modToTHMod :: Module -> TH.Module -modToTHMod m = TH.Module (TH.PkgName $ packageKeyString $ modulePackageKey m) +modToTHMod m = TH.Module (TH.PkgName $ unitIdString $ moduleUnitId m) (TH.ModName $ moduleNameString $ moduleName m) reifyModule :: TH.Module -> TcM TH.ModuleInfo reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do this_mod <- getModule - let reifMod = mkModule (stringToPackageKey pkgString) (mkModuleName mString) + let reifMod = mkModule (stringToUnitId pkgString) (mkModuleName mString) if (reifMod == this_mod) then reifyThisModule else reifyFromIface reifMod where reifyThisModule = do @@ -1575,10 +1575,10 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do reifyFromIface reifMod = do iface <- loadInterfaceForModule (ptext (sLit "reifying module from TH for") <+> ppr reifMod) reifMod let usages = [modToTHMod m | usage <- mi_usages iface, - Just m <- [usageToModule (modulePackageKey reifMod) usage] ] + Just m <- [usageToModule (moduleUnitId reifMod) usage] ] return $ TH.ModuleInfo usages - usageToModule :: PackageKey -> Usage -> Maybe Module + usageToModule :: UnitId -> Usage -> Maybe Module usageToModule _ (UsageFile {}) = Nothing usageToModule this_pkg (UsageHomeModule { usg_mod_name = mn }) = Just $ mkModule this_pkg mn usageToModule _ (UsagePackageModule { usg_mod = m }) = Just m diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index a730cdfdcf..23fa37d77a 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -82,7 +82,7 @@ import {-# SOURCE #-} DynFlags( DynFlags, targetPlatform, pprUserLength, pprCols, useUnicode, useUnicodeSyntax, unsafeGlobalDynFlags ) -import {-# SOURCE #-} Module( PackageKey, Module, ModuleName, moduleName ) +import {-# SOURCE #-} Module( UnitId, Module, ModuleName, moduleName ) import {-# SOURCE #-} OccName( OccName ) import {-# SOURCE #-} StaticFlags( opt_PprStyle_Debug, opt_NoDebugOutput ) @@ -169,8 +169,8 @@ type QueryQualifyName = Module -> OccName -> QualifyName type QueryQualifyModule = Module -> Bool -- | For a given package, we need to know whether to print it with --- the package key to disambiguate it. -type QueryQualifyPackage = PackageKey -> Bool +-- the unit id to disambiguate it. +type QueryQualifyPackage = UnitId -> Bool -- See Note [Printing original names] in HscTypes data QualifyName -- Given P:M.T diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst index a58f10ed87..b9e017ac2a 100644 --- a/docs/users_guide/packages.rst +++ b/docs/users_guide/packages.rst @@ -224,7 +224,7 @@ The GHC command line options that control packages are: .. index:: single: -this-package-key - Tells GHC the the module being compiled forms part of package key + Tells GHC the the module being compiled forms part of unit ID ⟨pkg-key⟩; internally, these keys are used to determine type equality and linker symbols. @@ -237,7 +237,7 @@ The GHC command line options that control packages are: determined by Cabal; a usual recipe for a library name is that it is the hash source package identifier of a package, as well as the version hashes of all its textual dependencies. GHC will then use - this library name to generate more package keys. + this library name to generate more unit IDs. ``-trust ⟨pkg⟩`` .. index:: @@ -834,7 +834,7 @@ Additionally, the following flags are accepted by ``ghc-pkg``: .. index:: single: --package-key; ghc-pkg option - Causes ``ghc-pkg`` to interpret arguments as package keys (e.g., an + Causes ``ghc-pkg`` to interpret arguments as unit IDs (e.g., an identifier like ``I5BErHzyOm07EBNpKBEeUv``). Package keys are used to prefix symbol names GHC produces (e.g., ``6VWy06pWzzJq9evDvK2d4w6_DataziByteStringziInternal_unsafePackLenChars_info``), diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst index ec5b5d95b3..11ce8c80d1 100644 --- a/docs/users_guide/separate_compilation.rst +++ b/docs/users_guide/separate_compilation.rst @@ -758,7 +758,7 @@ implementation backing a signature: To specify multiple signatures, use a comma-separated list. The ``-sig-of`` parameter is required to specify the backing implementations of all home modules, even in one-shot compilation mode. At the moment, -you must specify the full module name (package key, colon, and then +you must specify the full module name (unit ID, colon, and then module name), although in the future we may support more user-friendly syntax. diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 80c1483863..f3d2035b05 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -1720,8 +1720,8 @@ isSafeModule m = do mname = GHC.moduleNameString $ GHC.moduleName m packageTrusted dflags md - | thisPackage dflags == modulePackageKey md = True - | otherwise = trusted $ getPackageDetails dflags (modulePackageKey md) + | thisPackage dflags == moduleUnitId md = True + | otherwise = trusted $ getPackageDetails dflags (moduleUnitId md) tallyPkgs dflags deps | not (packageTrustOn dflags) = ([], []) | otherwise = partition part deps @@ -3255,7 +3255,7 @@ lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module lookupModuleName mName = GHC.lookupModule mName Nothing isHomeModule :: Module -> Bool -isHomeModule m = GHC.modulePackageKey m == mainPackageKey +isHomeModule m = GHC.moduleUnitId m == mainUnitId -- TODO: won't work if home dir is encoded. -- (changeDirectory may not work either in that case.) @@ -3279,7 +3279,7 @@ wantInterpretedModuleName modname = do modl <- lookupModuleName modname let str = moduleNameString modname dflags <- getDynFlags - when (GHC.modulePackageKey modl /= thisPackage dflags) $ + when (GHC.moduleUnitId modl /= thisPackage dflags) $ throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module")) is_interpreted <- GHC.moduleIsInterpreted modl when (not is_interpreted) $ diff --git a/ghc/Main.hs b/ghc/Main.hs index 9fb0718f13..4ef44f20ca 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -839,8 +839,8 @@ Generates a combined hash of the ABI for modules Data.Foo and System.Bar. The modules must already be compiled, and appropriate -i options may be necessary in order to find the .hi files. -This is used by Cabal for generating the InstalledPackageId for a -package. The InstalledPackageId must change when the visible ABI of +This is used by Cabal for generating the ComponentId for a +package. The ComponentId must change when the visible ABI of the package chagnes, so during registration Cabal calls ghc --abi-hash to get a hash of the package's ABI. -} diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index 302d027c0a..117d70525a 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -83,7 +83,7 @@ foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a) -- | Miscelaneous information available for debugging purposes. data StaticPtrInfo = StaticPtrInfo { -- | Package key of the package where the static pointer is defined - spInfoPackageKey :: String + spInfoUnitId :: String -- | Name of the module where the static pointer is defined , spInfoModuleName :: String -- | An internal name that is distinct for every static pointer defined in diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index 6545db5901..326f4579fd 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -342,6 +342,6 @@ Library GHC.Event.TimerManager GHC.Event.Unique - -- We need to set the package key to base (without a version number) + -- We need to set the unit id to base (without a version number) -- as it's magic. ghc-options: -this-package-key base diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs index 1f6b54f151..fcb24d8a46 100644 --- a/libraries/ghc-boot/GHC/PackageDb.hs +++ b/libraries/ghc-boot/GHC/PackageDb.hs @@ -68,11 +68,11 @@ import System.Directory -- data InstalledPackageInfo instpkgid srcpkgid srcpkgname pkgkey modulename = InstalledPackageInfo { - installedPackageId :: instpkgid, + componentId :: instpkgid, sourcePackageId :: srcpkgid, packageName :: srcpkgname, packageVersion :: Version, - packageKey :: pkgkey, + unitId :: pkgkey, abiHash :: String, depends :: [pkgkey], importDirs :: [FilePath], @@ -146,11 +146,11 @@ emptyInstalledPackageInfo :: (BinaryStringRep a, BinaryStringRep b, => InstalledPackageInfo a b c d e emptyInstalledPackageInfo = InstalledPackageInfo { - installedPackageId = fromStringRep BS.empty, + componentId = fromStringRep BS.empty, sourcePackageId = fromStringRep BS.empty, packageName = fromStringRep BS.empty, packageVersion = Version [] [], - packageKey = fromStringRep BS.empty, + unitId = fromStringRep BS.empty, abiHash = "", depends = [], importDirs = [], @@ -301,8 +301,8 @@ instance (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c, BinaryStringRep d, BinaryStringRep e) => Binary (InstalledPackageInfo a b c d e) where put (InstalledPackageInfo - installedPackageId sourcePackageId - packageName packageVersion packageKey + componentId sourcePackageId + packageName packageVersion unitId abiHash depends importDirs hsLibraries extraLibraries extraGHCiLibraries libraryDirs frameworks frameworkDirs @@ -311,11 +311,11 @@ instance (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c, haddockInterfaces haddockHTMLs exposedModules hiddenModules instantiatedWith exposed trusted) = do - put (toStringRep installedPackageId) + put (toStringRep componentId) put (toStringRep sourcePackageId) put (toStringRep packageName) put packageVersion - put (toStringRep packageKey) + put (toStringRep unitId) put abiHash put (map toStringRep depends) put importDirs @@ -338,11 +338,11 @@ instance (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c, put trusted get = do - installedPackageId <- get + componentId <- get sourcePackageId <- get packageName <- get packageVersion <- get - packageKey <- get + unitId <- get abiHash <- get depends <- get importDirs <- get @@ -364,10 +364,10 @@ instance (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c, exposed <- get trusted <- get return (InstalledPackageInfo - (fromStringRep installedPackageId) + (fromStringRep componentId) (fromStringRep sourcePackageId) (fromStringRep packageName) packageVersion - (fromStringRep packageKey) + (fromStringRep unitId) abiHash (map fromStringRep depends) importDirs diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal index 58b6ee0a03..ab59a938d4 100644 --- a/libraries/ghc-prim/ghc-prim.cabal +++ b/libraries/ghc-prim/ghc-prim.cabal @@ -64,6 +64,6 @@ Library cbits/popcnt.c cbits/word2float.c - -- We need to set the package key to ghc-prim (without a version number) + -- We need to set the unit ID to ghc-prim (without a version number) -- as it's magic. ghc-options: -this-package-key ghc-prim diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index dd31604e95..f1265d494e 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -51,7 +51,7 @@ Library ghc-boot, pretty == 1.1.* - -- We need to set the package key to template-haskell (without a + -- We need to set the unit ID to template-haskell (without a -- version number) as it's magic. ghc-options: -Wall diff --git a/testsuite/tests/deSugar/should_run/DsStaticPointers.stdout b/testsuite/tests/deSugar/should_run/DsStaticPointers.stdout index 962352684f..0a223db3e2 100644 --- a/testsuite/tests/deSugar/should_run/DsStaticPointers.stdout +++ b/testsuite/tests/deSugar/should_run/DsStaticPointers.stdout @@ -1,5 +1,5 @@ -StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:1", spInfoSrcLoc = (10,32)} -StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:2", spInfoSrcLoc = (11,33)} -StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:0", spInfoSrcLoc = (21,13)} -StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:3", spInfoSrcLoc = (13,33)} -StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:4", spInfoSrcLoc = (14,33)} +StaticPtrInfo {spInfoUnitId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:1", spInfoSrcLoc = (10,32)} +StaticPtrInfo {spInfoUnitId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:2", spInfoSrcLoc = (11,33)} +StaticPtrInfo {spInfoUnitId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:0", spInfoSrcLoc = (21,13)} +StaticPtrInfo {spInfoUnitId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:3", spInfoSrcLoc = (13,33)} +StaticPtrInfo {spInfoUnitId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:4", spInfoSrcLoc = (14,33)} diff --git a/testsuite/tests/th/T10279.stderr b/testsuite/tests/th/T10279.stderr index c5f7834eae..21688ae836 100644 --- a/testsuite/tests/th/T10279.stderr +++ b/testsuite/tests/th/T10279.stderr @@ -1,8 +1,8 @@ T10279.hs:10:10: error: Failed to load interface for ‘A’ - no package key matching ‘rts-1.0’ was found - (This package key looks like the source package ID; - the real package key is ‘rts’) + no unit id matching ‘rts-1.0’ was found + (This unit ID looks like the source package ID; + the real unit ID is ‘rts’) In the expression: (rts-1.0:A.Foo) In an equation for ‘blah’: blah = (rts-1.0:A.Foo) diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 8095cc434a..4bc603459a 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -1076,17 +1076,17 @@ type PackageCacheFormat = GhcPkg.InstalledPackageInfo String -- installed package id String -- src package id String -- package name - String -- package key + String -- unit id ModuleName -- module name convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat convertPackageInfoToCacheFormat pkg = GhcPkg.InstalledPackageInfo { - GhcPkg.installedPackageId = display (installedComponentId pkg), + GhcPkg.componentId = display (installedComponentId pkg), GhcPkg.sourcePackageId = display (sourcePackageId pkg), GhcPkg.packageName = display (packageName pkg), GhcPkg.packageVersion = packageVersion pkg, - GhcPkg.packageKey = display (installedComponentId pkg), + GhcPkg.unitId = display (installedComponentId pkg), GhcPkg.depends = map display (depends pkg), GhcPkg.abiHash = let AbiHash abi = abiHash pkg in abi, @@ -1328,7 +1328,7 @@ showPackageDot verbosity myflags = do -- ----------------------------------------------------------------------------- -- Prints the highest (hidden or exposed) version of a package --- ToDo: This is no longer well-defined with package keys, because the +-- ToDo: This is no longer well-defined with unit ids, because the -- dependencies may be varying versions latestPackage :: Verbosity -> [Flag] -> PackageIdentifier -> IO () latestPackage verbosity my_flags pkgid = do diff --git a/utils/haddock b/utils/haddock -Subproject e083daa4a46ae2f9a244b6bcedc5951b3a78f26 +Subproject c7a8a8b32c9075873d666f7d0fc8a99828e1734 |