diff options
| author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-07-19 17:11:08 +0100 |
|---|---|---|
| committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-07-21 08:45:17 -0700 |
| commit | 4bebab25e4c9a3bfccc491d4dd13c685629cd1de (patch) | |
| tree | 25ad202438a52c814d27cb62e1d02c566d30720b | |
| parent | c26bba843f35ea843c2eafe68daf1e4545572447 (diff) | |
| download | haskell-4bebab25e4c9a3bfccc491d4dd13c685629cd1de.tar.gz | |
Rename PackageId to PackageKey, distinguishing it from Cabal's PackageId.
Summary:
Previously, both Cabal and GHC defined the type PackageId, and we expected
them to be roughly equivalent (but represented differently). This refactoring
separates these two notions.
A package ID is a user-visible identifier; it's the thing you write in a
Cabal file, e.g. containers-0.9. The components of this ID are semantically
meaningful, and decompose into a package name and a package vrsion.
A package key is an opaque identifier used by GHC to generate linking symbols.
Presently, it just consists of a package name and a package version, but
pursuant to #9265 we are planning to extend it to record other information.
Within a single executable, it uniquely identifies a package. It is *not* an
InstalledPackageId, as the choice of a package key affects the ABI of a package
(whereas an InstalledPackageId is computed after compilation.) Cabal computes
a package key for the package and passes it to GHC using -package-name (now
*extremely* misnamed).
As an added bonus, we don't have to worry about shadowing anymore.
As a follow on, we should introduce -current-package-key having the same role as
-package-name, and deprecate the old flag. This commit is just renaming.
The haddock submodule needed to be updated.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate
Reviewers: simonpj, simonmar, hvr, austin
Subscribers: simonmar, relrod, carter
Differential Revision: https://phabricator.haskell.org/D79
Conflicts:
compiler/main/HscTypes.lhs
compiler/main/Packages.lhs
utils/haddock
56 files changed, 362 insertions, 341 deletions
diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index 0dcf98f6c5..771aa303a1 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -942,7 +942,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 (packageIdFS (modulePackageId mod)) ++ +dataConIdentity dc = bytesFS (packageKeyFS (modulePackageKey mod)) ++ fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++ fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name)) where name = dataConName dc diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index bd2d119655..3ec9f6a9b0 100644 --- a/compiler/basicTypes/Module.lhs +++ b/compiler/basicTypes/Module.lhs @@ -23,30 +23,30 @@ module Module mkModuleNameFS, stableModuleNameCmp, - -- * The PackageId type - PackageId, - fsToPackageId, - packageIdFS, - stringToPackageId, - packageIdString, - stablePackageIdCmp, - - -- * Wired-in PackageIds + -- * The PackageKey type + PackageKey, + fsToPackageKey, + packageKeyFS, + stringToPackageKey, + packageKeyString, + stablePackageKeyCmp, + + -- * Wired-in PackageKeys -- $wired_in_packages - primPackageId, - integerPackageId, - basePackageId, - rtsPackageId, - thPackageId, - dphSeqPackageId, - dphParPackageId, - mainPackageId, - thisGhcPackageId, - interactivePackageId, isInteractiveModule, + primPackageKey, + integerPackageKey, + basePackageKey, + rtsPackageKey, + thPackageKey, + dphSeqPackageKey, + dphParPackageKey, + mainPackageKey, + thisGhcPackageKey, + interactivePackageKey, isInteractiveModule, -- * The Module type Module, - modulePackageId, moduleName, + modulePackageKey, moduleName, pprModule, mkModule, stableModuleCmp, @@ -228,15 +228,15 @@ moduleNameColons = dots_to_colons . moduleNameString %************************************************************************ \begin{code} --- | A Module is a pair of a 'PackageId' and a 'ModuleName'. +-- | A Module is a pair of a 'PackageKey' and a 'ModuleName'. data Module = Module { - modulePackageId :: !PackageId, -- pkg-1.0 + modulePackageKey :: !PackageKey, -- pkg-1.0 moduleName :: !ModuleName -- A.B.C } deriving (Eq, Ord, Typeable) instance Uniquable Module where - getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n) + getUnique (Module p n) = getUnique (packageKeyFS p `appendFS` moduleNameFS n) instance Outputable Module where ppr = pprModule @@ -256,25 +256,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 `stablePackageIdCmp` p2) `thenCmp` + = (p1 `stablePackageKeyCmp` p2) `thenCmp` (n1 `stableModuleNameCmp` n2) -mkModule :: PackageId -> ModuleName -> Module +mkModule :: PackageKey -> ModuleName -> Module mkModule = Module pprModule :: Module -> SDoc pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n -pprPackagePrefix :: PackageId -> Module -> SDoc +pprPackagePrefix :: PackageKey -> Module -> SDoc pprPackagePrefix p mod = getPprStyle doc where doc sty | codeStyle sty = - if p == mainPackageId + if p == mainPackageKey then empty -- never qualify the main package in code - else ztext (zEncodeFS (packageIdFS p)) <> char '_' - | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':' + else ztext (zEncodeFS (packageKeyFS p)) <> char '_' + | qualModule sty mod = ftext (packageKeyFS (modulePackageKey mod)) <> char ':' -- the PrintUnqualified tells us which modules have to -- be qualified with package names | otherwise = empty @@ -288,51 +288,51 @@ class HasModule m where %************************************************************************ %* * -\subsection{PackageId} +\subsection{PackageKey} %* * %************************************************************************ \begin{code} -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0 -newtype PackageId = PId FastString deriving( Eq, Typeable ) +newtype PackageKey = PId FastString deriving( Eq, Typeable ) -- here to avoid module loops with PackageConfig -instance Uniquable PackageId where - getUnique pid = getUnique (packageIdFS pid) +instance Uniquable PackageKey where + getUnique pid = getUnique (packageKeyFS pid) -- Note: *not* a stable lexicographic ordering, a faster unique-based -- ordering. -instance Ord PackageId where +instance Ord PackageKey where nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2 -instance Data PackageId where +instance Data PackageKey where -- don't traverse? - toConstr _ = abstractConstr "PackageId" + toConstr _ = abstractConstr "PackageKey" gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNoRepType "PackageId" + dataTypeOf _ = mkNoRepType "PackageKey" -stablePackageIdCmp :: PackageId -> PackageId -> Ordering +stablePackageKeyCmp :: PackageKey -> PackageKey -> Ordering -- ^ Compares package ids lexically, rather than by their 'Unique's -stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2 +stablePackageKeyCmp p1 p2 = packageKeyFS p1 `compare` packageKeyFS p2 -instance Outputable PackageId where - ppr pid = text (packageIdString pid) +instance Outputable PackageKey where + ppr pid = text (packageKeyString pid) -instance Binary PackageId where - put_ bh pid = put_ bh (packageIdFS pid) - get bh = do { fs <- get bh; return (fsToPackageId fs) } +instance Binary PackageKey where + put_ bh pid = put_ bh (packageKeyFS pid) + get bh = do { fs <- get bh; return (fsToPackageKey fs) } -fsToPackageId :: FastString -> PackageId -fsToPackageId = PId +fsToPackageKey :: FastString -> PackageKey +fsToPackageKey = PId -packageIdFS :: PackageId -> FastString -packageIdFS (PId fs) = fs +packageKeyFS :: PackageKey -> FastString +packageKeyFS (PId fs) = fs -stringToPackageId :: String -> PackageId -stringToPackageId = fsToPackageId . mkFastString +stringToPackageKey :: String -> PackageKey +stringToPackageKey = fsToPackageKey . mkFastString -packageIdString :: PackageId -> String -packageIdString = unpackFS . packageIdFS +packageKeyString :: PackageKey -> String +packageKeyString = unpackFS . packageKeyFS -- ----------------------------------------------------------------------------- @@ -348,7 +348,7 @@ packageIdString = unpackFS . packageIdFS -- 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 'PackageId' below when referring to it, +-- will use the unversioned 'PackageKey' 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 @@ -356,27 +356,27 @@ packageIdString = unpackFS . packageIdFS -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here -integerPackageId, primPackageId, - basePackageId, rtsPackageId, - thPackageId, dphSeqPackageId, dphParPackageId, - mainPackageId, thisGhcPackageId, interactivePackageId :: PackageId -primPackageId = fsToPackageId (fsLit "ghc-prim") -integerPackageId = fsToPackageId (fsLit cIntegerLibrary) -basePackageId = fsToPackageId (fsLit "base") -rtsPackageId = fsToPackageId (fsLit "rts") -thPackageId = fsToPackageId (fsLit "template-haskell") -dphSeqPackageId = fsToPackageId (fsLit "dph-seq") -dphParPackageId = fsToPackageId (fsLit "dph-par") -thisGhcPackageId = fsToPackageId (fsLit "ghc") -interactivePackageId = fsToPackageId (fsLit "interactive") +integerPackageKey, primPackageKey, + basePackageKey, rtsPackageKey, + thPackageKey, dphSeqPackageKey, dphParPackageKey, + mainPackageKey, thisGhcPackageKey, interactivePackageKey :: PackageKey +primPackageKey = fsToPackageKey (fsLit "ghc-prim") +integerPackageKey = fsToPackageKey (fsLit cIntegerLibrary) +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") -- | 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. -mainPackageId = fsToPackageId (fsLit "main") +mainPackageKey = fsToPackageKey (fsLit "main") isInteractiveModule :: Module -> Bool -isInteractiveModule mod = modulePackageId mod == interactivePackageId +isInteractiveModule mod = modulePackageKey mod == interactivePackageKey \end{code} %************************************************************************ diff --git a/compiler/basicTypes/Module.lhs-boot b/compiler/basicTypes/Module.lhs-boot index 63839b55bc..6d194d6a2a 100644 --- a/compiler/basicTypes/Module.lhs-boot +++ b/compiler/basicTypes/Module.lhs-boot @@ -3,8 +3,8 @@ module Module where data Module data ModuleName -data PackageId +data PackageKey moduleName :: Module -> ModuleName -modulePackageId :: Module -> PackageId -packageIdString :: PackageId -> String +modulePackageKey :: Module -> PackageKey +packageKeyString :: PackageKey -> String \end{code} diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index c2e7aeabdc..7651c7c749 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -503,7 +503,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 (modulePackageId mod) <> colon -- Module not in + NameNotInScope2 -> ppr (modulePackageKey mod) <> colon -- Module not in <> ppr (moduleName mod) <> dot -- scope either _otherwise -> empty diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index ebfb71aa65..d4afaf10fc 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -817,7 +817,7 @@ data ImpDeclSpec -- the defining module for this thing! -- TODO: either should be Module, or there - -- should be a Maybe PackageId here too. + -- should be a Maybe PackageKey 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 9dccd29135..02ad026249 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -158,14 +158,14 @@ data CLabel -- | A label from a .cmm file that is not associated with a .hs level Id. | CmmLabel - PackageId -- what package the label belongs to. + PackageKey -- 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 PackageId argument. + -- instead and give it an appropriate PackageKey argument. | RtsLabel RtsLabelInfo @@ -237,7 +237,7 @@ data CLabel data ForeignLabelSource -- | Label is in a named package - = ForeignLabelInPackage PackageId + = ForeignLabelInPackage PackageKey -- | Label is in some external, system package that doesn't also -- contain compiled Haskell code, and is not associated with any .hi files. @@ -411,27 +411,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 rtsPackageId (fsLit "__stg_split_marker") CmmCode -mkUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_upd_frame") CmmInfo -mkBHUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" ) CmmInfo -mkIndStaticInfoLabel = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC") CmmInfo -mkMainCapabilityLabel = CmmLabel rtsPackageId (fsLit "MainCapability") CmmData -mkMAP_FROZEN_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo -mkMAP_FROZEN0_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo -mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo -mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR") CmmInfo -mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct") CmmData -mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmInfo -mkCAFBlackHoleEntryLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmEntry -mkArrWords_infoLabel = CmmLabel rtsPackageId (fsLit "stg_ARR_WORDS") CmmInfo -mkSMAP_FROZEN_infoLabel = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo -mkSMAP_FROZEN0_infoLabel = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo -mkSMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo +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 ----- mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel, mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel - :: PackageId -> FastString -> CLabel + :: PackageKey -> FastString -> CLabel mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry @@ -639,7 +639,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 == rtsPackageId = False + | pkgId == rtsPackageKey = False -- For other labels we inline one into the HC file directly. | otherwise = True @@ -849,11 +849,11 @@ idInfoLabelType info = -- @labelDynamic@ returns @True@ if the label is located -- in a DLL, be it a data reference or not. -labelDynamic :: DynFlags -> PackageId -> Module -> CLabel -> Bool +labelDynamic :: DynFlags -> PackageKey -> 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 /= rtsPackageId) + RtsLabel _ -> not (gopt Opt_Static dflags) && (this_pkg /= rtsPackageKey) IdLabel n _ _ -> isDllName dflags this_pkg this_mod n @@ -886,9 +886,9 @@ labelDynamic dflags this_pkg this_mod lbl = -- libraries True - PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m) + PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m) - HpcTicksLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m) + HpcTicksLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m) -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. _ -> False diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 49143170c3..803333001c 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -573,7 +573,7 @@ importName -- A label imported with an explicit packageId. | STRING NAME - { ($2, mkCmmCodeLabel (fsToPackageId (mkFastString $1)) $2) } + { ($2, mkCmmCodeLabel (fsToPackageKey (mkFastString $1)) $2) } names :: { [FastString] } @@ -1101,7 +1101,7 @@ profilingInfo dflags desc_str ty_str else ProfilingInfo (stringToWord8s desc_str) (stringToWord8s ty_str) -staticClosure :: PackageId -> FastString -> FastString -> [CmmLit] -> CmmParse () +staticClosure :: PackageKey -> 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 1a69927b5c..edd064848f 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 rtsPackageId (fsLit "stg_INTLIKE") + = do { let intlike_lbl = mkCmmClosureLabel rtsPackageKey (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 rtsPackageId (fsLit "stg_CHARLIKE") + = do { let charlike_lbl = mkCmmClosureLabel rtsPackageKey (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 df1733978f..5f412b3cf8 100644 --- a/compiler/codeGen/StgCmmExtCode.hs +++ b/compiler/codeGen/StgCmmExtCode.hs @@ -57,7 +57,7 @@ data Named = VarN CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type, -- eg, RtsLabel, ForeignLabel, CmmLabel etc. - | FunN PackageId -- ^ A function name from this package + | FunN PackageKey -- ^ A function name from this package | LabelN BlockId -- ^ A blockid of some code or data. -- | An environment of named things. @@ -153,7 +153,7 @@ newBlockId = code F.newLabelC -- | Add add a local function to the environment. newFunctionName :: FastString -- ^ name of the function - -> PackageId -- ^ package of the current module + -> PackageKey -- ^ package of the current module -> ExtCode newFunctionName name pkg = addDecl name (FunN pkg) @@ -193,7 +193,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 rtsPackageId name)) + _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey name)) -- | Lift an FCode computation into the CmmParse monad diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index d00dc6ec84..7ac2c7a0bd 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -516,7 +516,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 rtsPackageId (fsLit s))) +mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit s))) ------------------------------- heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index 99e926c987..d62101f27e 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -359,10 +359,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 rtsPackageId arg_pat + stg_ap_pat = mkCmmRetInfoLabel rtsPackageKey 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 rtsPackageId (fsLit "stg_restore_cccs") + save_cccs_lbl = mkCmmRetInfoLabel rtsPackageKey (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 cad261bcfb..22c89d7e05 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -494,7 +494,7 @@ withSelfLoop self_loop code = do instance HasDynFlags FCode where getDynFlags = liftM cgd_dflags getInfoDown -getThisPackage :: FCode PackageId +getThisPackage :: FCode PackageKey getThisPackage = liftM thisPackage getDynFlags withInfoDown :: FCode a -> CgInfoDownwards -> FCode a diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index 1aa08a1e58..7249477c9f 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 rtsPackageId (fsLit "enterFunCCS") + emitRtsCall rtsPackageKey (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 - rtsPackageId + rtsPackageKey (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 rtsPackageId (fsLit "era"))) + [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageKey (fsLit "era"))) (cInt dflags)] ldvWord :: DynFlags -> CmmExpr -> CmmExpr diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 6913c9ec15..3652a79979 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 rtsPackageId (fsLit "ticky_entry_ctrs")) + ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageKey (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 rtsPackageId (fsLit "ALLOC_HEAP_tot")) + (mkCmmDataLabel rtsPackageKey (fsLit "ALLOC_HEAP_tot")) bytes, -- Bump the global allocation counter ALLOC_HEAP_ctr if not genuine then mkNop else addToMemLbl (cLong dflags) - (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_ctr")) + (mkCmmDataLabel rtsPackageKey (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 rtsPackageId lbl) +bumpTickyCounter lbl = bumpTickyLbl (mkCmmDataLabel rtsPackageKey lbl) bumpTickyCounterBy :: FastString -> Int -> FCode () -bumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsPackageId lbl) +bumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsPackageKey lbl) bumpTickyCounterByE :: FastString -> CmmExpr -> FCode () -bumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsPackageId lbl) +bumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsPackageKey lbl) bumpTickyEntryCount :: CLabel -> FCode () bumpTickyEntryCount lbl = do diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index bc1a15fe3c..985c6db900 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -175,10 +175,10 @@ tagToClosure dflags tycon tag -- ------------------------------------------------------------------------- -emitRtsCall :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () +emitRtsCall :: PackageKey -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () emitRtsCall pkg fun args safe = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) args safe -emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageId -> FastString +emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageKey -> 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.lhs b/compiler/coreSyn/CorePrep.lhs index c754aae4e7..bbf104b127 100644 --- a/compiler/coreSyn/CorePrep.lhs +++ b/compiler/coreSyn/CorePrep.lhs @@ -1115,9 +1115,9 @@ data CorePrepEnv = CPE { lookupMkIntegerName :: DynFlags -> HscEnv -> IO Id lookupMkIntegerName dflags hsc_env - = if thisPackage dflags == primPackageId + = if thisPackage dflags == primPackageKey then return $ panic "Can't use Integer in ghc-prim" - else if thisPackage dflags == integerPackageId + else if thisPackage dflags == integerPackageKey then return $ panic "Can't use Integer in integer" else liftM tyThingId $ initTcForLookup hsc_env (tcLookupGlobal mkIntegerName) diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index e646667651..fae5f36426 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -154,8 +154,8 @@ writeMixEntries dflags mod count entries filename mod_name = moduleNameString (moduleName mod) hpc_mod_dir - | modulePackageId mod == mainPackageId = hpc_dir - | otherwise = hpc_dir ++ "/" ++ packageIdString (modulePackageId mod) + | modulePackageKey mod == mainPackageKey = hpc_dir + | otherwise = hpc_dir ++ "/" ++ packageKeyString (modulePackageKey mod) tabStop = 8 -- <tab> counts as a normal char in GHC's location ranges. @@ -1233,9 +1233,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 (packageIdFS (modulePackageId this_mod))) + bytesFS (packageKeyFS (modulePackageKey this_mod))) full_name_str - | modulePackageId this_mod == mainPackageId + | modulePackageKey this_mod == mainPackageKey = module_name | otherwise = package_name <> char '/' <> module_name diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index 0654ebc983..c60e9146bc 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -224,9 +224,9 @@ dsFCall fn_id co fcall mDeclHeader = do dflags <- getDynFlags (fcall', cDoc) <- case fcall of - CCall (CCallSpec (StaticTarget cName mPackageId isFun) CApiConv safety) -> + CCall (CCallSpec (StaticTarget cName mPackageKey isFun) CApiConv safety) -> do wrapperName <- mkWrapperName "ghc_wrapper" (unpackFS cName) - let fcall' = CCall (CCallSpec (StaticTarget wrapperName mPackageId True) CApiConv safety) + let fcall' = CCall (CCallSpec (StaticTarget wrapperName mPackageKey True) CApiConv safety) c = includes $$ fun_proto <+> braces (cRet <> semi) includes = vcat [ text "#include <" <> ftext h <> text ">" diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index adfc0f688f..2713f95ab6 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1416,7 +1416,7 @@ globalVar name where mod = ASSERT( isExternalName name) nameModule name name_mod = moduleNameString (moduleName mod) - name_pkg = packageIdString (modulePackageId mod) + name_pkg = packageKeyString (modulePackageKey mod) name_occ = nameOccName name mk_varg | OccName.isDataOcc name_occ = mkNameG_dName | OccName.isVarOcc name_occ = mkNameG_vName @@ -2117,7 +2117,7 @@ thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib") qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote") mkTHModule :: FastString -> Module -mkTHModule m = mkModule thPackageId (mkModuleNameFS m) +mkTHModule m = mkModule thPackageKey (mkModuleNameFS m) libFun, libTc, thFun, thTc, thCon, qqFun :: FastString -> Unique -> Name libFun = mk_known_key_name OccName.varName thLib diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs index d508a1c5aa..cbedb717fe 100644 --- a/compiler/ghci/ByteCodeLink.lhs +++ b/compiler/ghci/ByteCodeLink.lhs @@ -260,13 +260,13 @@ linkFail who what -- HACKS!!! ToDo: cleaner nameToCLabel :: Name -> String{-suffix-} -> String nameToCLabel n suffix - = if pkgid /= mainPackageId + = if pkgid /= mainPackageKey then package_part ++ '_': qual_name else qual_name where - pkgid = modulePackageId mod + pkgid = modulePackageKey mod mod = ASSERT( isExternalName n ) nameModule n - package_part = zString (zEncodeFS (packageIdFS (modulePackageId mod))) + package_part = zString (zEncodeFS (packageKeyFS (modulePackageKey mod))) module_part = zString (zEncodeFS (moduleNameFS (moduleName mod))) occ_part = zString (zEncodeFS (occNameFS (nameOccName n))) qual_name = module_part ++ '_':occ_part ++ '_':suffix diff --git a/compiler/ghci/DebuggerUtils.hs b/compiler/ghci/DebuggerUtils.hs index 67767e41b9..9ccb113314 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 (fsToPackageId pkgFS) (mkModuleNameFS modFS) + modName = mkModule (fsToPackageKey pkgFS) (mkModuleNameFS modFS) return (Left $ showSDoc dflags $ ppr modName <> dot <> ppr occName) `recoverM` (Right `fmap` lookupOrig modName occName) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 0dbab24de7..74dec19d14 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -70,7 +70,7 @@ import System.Directory hiding (findFile) import System.Directory #endif -import Distribution.Package hiding (depends, PackageId) +import Distribution.Package hiding (depends) import Exception \end{code} @@ -124,7 +124,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 :: ![PackageId] + pkgs_loaded :: ![PackageKey] } emptyPLS :: DynFlags -> PersistentLinkerState @@ -140,10 +140,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 = [rtsPackageId] + where init_pkgs = [rtsPackageKey] -extendLoadedPkgs :: [PackageId] -> IO () +extendLoadedPkgs :: [PackageKey] -> IO () extendLoadedPkgs pkgs = modifyPLS_ $ \s -> return s{ pkgs_loaded = pkgs ++ pkgs_loaded s } @@ -527,7 +527,7 @@ getLinkDeps :: HscEnv -> HomePackageTable -> Maybe FilePath -- replace object suffices? -> SrcSpan -- for error messages -> [Module] -- If you need these - -> IO ([Linkable], [PackageId]) -- ... then link these first + -> IO ([Linkable], [PackageKey]) -- ... 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 @@ -565,8 +565,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 PackageId -- accum. package dependencies - -> IO ([ModuleName], [PackageId]) -- result + -> UniqSet PackageKey -- accum. package dependencies + -> IO ([ModuleName], [PackageKey]) -- result follow_deps [] acc_mods acc_pkgs = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs) follow_deps (mod:mods) acc_mods acc_pkgs @@ -580,7 +580,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods when (mi_boot iface) $ link_boot_mod_error mod let - pkg = modulePackageId mod + pkg = modulePackageKey mod deps = mi_deps iface pkg_deps = dep_pkgs deps @@ -1045,7 +1045,7 @@ showLS (Framework nm) = "(framework) " ++ nm -- automatically, and it doesn't matter what order you specify the input -- packages. -- -linkPackages :: DynFlags -> [PackageId] -> IO () +linkPackages :: DynFlags -> [PackageKey] -> 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. -- @@ -1061,7 +1061,7 @@ linkPackages dflags new_pkgs = do modifyPLS_ $ \pls -> do linkPackages' dflags new_pkgs pls -linkPackages' :: DynFlags -> [PackageId] -> PersistentLinkerState +linkPackages' :: DynFlags -> [PackageKey] -> PersistentLinkerState -> IO PersistentLinkerState linkPackages' dflags new_pks pls = do pkgs' <- link (pkgs_loaded pls) new_pks @@ -1070,7 +1070,7 @@ linkPackages' dflags new_pks pls = do pkg_map = pkgIdMap (pkgState dflags) ipid_map = installedPackageIdMap (pkgState dflags) - link :: [PackageId] -> [PackageId] -> IO [PackageId] + link :: [PackageKey] -> [PackageKey] -> IO [PackageKey] link pkgs new_pkgs = foldM link_one pkgs new_pkgs @@ -1088,7 +1088,7 @@ linkPackages' dflags new_pks pls = do ; return (new_pkg : pkgs') } | otherwise - = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ packageIdString new_pkg)) + = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ packageKeyString new_pkg)) linkPackage :: DynFlags -> PackageConfig -> IO () diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs index e22af3b947..d722a402e0 100644 --- a/compiler/hsSyn/Convert.lhs +++ b/compiler/hsSyn/Convert.lhs @@ -1150,8 +1150,8 @@ mk_ghc_ns TH.VarName = OccName.varName mk_mod :: TH.ModName -> ModuleName mk_mod mod = mkModuleName (TH.modString mod) -mk_pkg :: TH.PkgName -> PackageId -mk_pkg pkg = stringToPackageId (TH.pkgString pkg) +mk_pkg :: TH.PkgName -> PackageKey +mk_pkg pkg = stringToPackageKey (TH.pkgString pkg) mk_uniq :: Int# -> Unique mk_uniq u = mkUniqueGrimily (I# u) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 9dd95fc0f2..4ec9ec7cbb 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 = (PackageId, ModuleName, OccName) +type OnDiskName = (PackageKey, 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 (modulePackageId mod, moduleName mod, nameOccName name) + put_ bh (modulePackageKey mod, moduleName mod, nameOccName name) -- Note [Symbol table representation of names] diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 03ce53fff8..4b3a44531e 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -353,13 +353,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 == modulePackageId mod + this_package = thisPackage dflags == modulePackageKey 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 (modulePackageId mod))) + <+> quotes (ppr (modulePackageKey mod))) \end{code} Note [Care with plugin imports] @@ -573,7 +573,7 @@ findAndReadIface doc_str mod hi_boot_file (ml_hi_file loc) -- See Note [Home module load error] - if thisPackage dflags == modulePackageId mod && + if thisPackage dflags == modulePackageKey mod && not (isOneShot (ghcMode dflags)) then return (Failed (homeModError mod loc)) else do r <- read_file file_path diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 460c6076ba..1aba9eee44 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -218,12 +218,12 @@ mkDependencies -- on M.hi-boot, and hence that we should do the hi-boot consistency -- check.) - pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports) + pkgs | th_used = insertList thPackageKey (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 stablePackageIdCmp pkgs + sorted_pkgs = sortBy stablePackageKeyCmp pkgs trust_pkgs = imp_trust_pkgs imports dep_pkgs' = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs @@ -559,7 +559,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls -- dependency tree. We only care about orphan modules in the current -- package, because changes to orphans outside this package will be -- tracked by the usage on the ABI hash of package modules that we import. - let orph_mods = filter ((== this_pkg) . modulePackageId) + let orph_mods = filter ((== this_pkg) . modulePackageKey) $ dep_orphs sorted_deps dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods @@ -661,7 +661,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 (stablePackageIdCmp `on` fst) (dep_pkgs d), + dep_pkgs = sortBy (stablePackageKeyCmp `on` fst) (dep_pkgs d), dep_orphs = sortBy stableModuleCmp (dep_orphs d), dep_finsts = sortBy stableModuleCmp (dep_finsts d) } \end{code} @@ -989,7 +989,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names -- things in *this* module = Nothing - | modulePackageId mod /= this_pkg + | modulePackageKey mod /= this_pkg = Just UsagePackageModule{ usg_mod = mod, usg_mod_hash = mod_hash, usg_safe = imp_safe } @@ -1318,7 +1318,7 @@ checkDependencies hsc_env summary iface return (RecompBecause reason) else return UpToDate - where pkg = modulePackageId mod + where pkg = modulePackageKey mod _otherwise -> return (RecompBecause reason) needInterface :: Module -> (ModIface -> IfG RecompileRequired) @@ -1347,7 +1347,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 :: PackageId -> Usage -> IfG RecompileRequired +checkModUsage :: PackageKey -> Usage -> IfG RecompileRequired checkModUsage _this_pkg UsagePackageModule{ usg_mod = mod, usg_mod_hash = old_mod_hash } diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index c0a609ba2e..11a8a8ec32 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -50,7 +50,7 @@ codeOutput :: DynFlags -> FilePath -> ModLocation -> ForeignStubs - -> [PackageId] + -> [PackageKey] -> 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 () - -> [PackageId] + -> [PackageKey] -> 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 (pkgState dflags) rtsPackageId + let rts = getPackageDetails (pkgState dflags) rtsPackageKey let cc_injects = unlines (map mk_include (includes rts)) mk_include h_file = @@ -210,7 +210,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 (pkgState dflags) rtsPackageId in + let rts_pkg = getPackageDetails (pkgState dflags) rtsPackageKey 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 49126fe738..f33c9b54e7 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -390,7 +390,7 @@ link' dflags batch_attempt_linking hpt return Succeeded -linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [PackageId] -> IO Bool +linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [PackageKey] -> 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 @@ -427,7 +427,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 -> [PackageId] -> FilePath -> IO Bool +checkLinkInfo :: DynFlags -> [PackageKey] -> 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 @@ -1113,7 +1113,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 == basePackageId + thisPackage dflags == basePackageKey then [ "-DCOMPILING_BASE_PACKAGE" ] else []) @@ -1559,7 +1559,7 @@ mkExtraObj dflags extn xs = do cFile <- newTempName dflags extn oFile <- newTempName dflags "o" writeFile cFile xs - let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId + let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageKey SysTools.runCc dflags ([Option "-c", FileOption "" cFile, @@ -1608,7 +1608,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 -> [PackageId] -> IO [FilePath] +mkNoteObjsToLinkIntoBinary :: DynFlags -> [PackageKey] -> IO [FilePath] mkNoteObjsToLinkIntoBinary dflags dep_packages = do link_info <- getLinkInfo dflags dep_packages @@ -1649,7 +1649,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 -> [PackageId] -> IO String +getLinkInfo :: DynFlags -> [PackageKey] -> IO String getLinkInfo dflags dep_packages = do package_link_opts <- getPackageLinkOpts dflags dep_packages pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags) @@ -1727,13 +1727,13 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $ ----------------------------------------------------------------------------- -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file -getHCFilePackages :: FilePath -> IO [PackageId] +getHCFilePackages :: FilePath -> IO [PackageKey] 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 stringToPackageId (words rest)) + return (map stringToPackageKey (words rest)) _other -> return [] @@ -1750,10 +1750,10 @@ getHCFilePackages filename = -- read any interface files), so the user must explicitly specify all -- the packages. -linkBinary :: DynFlags -> [FilePath] -> [PackageId] -> IO () +linkBinary :: DynFlags -> [FilePath] -> [PackageKey] -> IO () linkBinary = linkBinary' False -linkBinary' :: Bool -> DynFlags -> [FilePath] -> [PackageId] -> IO () +linkBinary' :: Bool -> DynFlags -> [FilePath] -> [PackageKey] -> IO () linkBinary' staticLink dflags o_files dep_packages = do let platform = targetPlatform dflags mySettings = settings dflags @@ -2027,7 +2027,7 @@ maybeCreateManifest dflags exe_filename | otherwise = return [] -linkDynLibCheck :: DynFlags -> [String] -> [PackageId] -> IO () +linkDynLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO () linkDynLibCheck dflags o_files dep_packages = do when (haveRtsOptsFlags dflags) $ do @@ -2037,7 +2037,7 @@ linkDynLibCheck dflags o_files dep_packages linkDynLib dflags o_files dep_packages -linkStaticLibCheck :: DynFlags -> [String] -> [PackageId] -> IO () +linkStaticLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO () linkStaticLibCheck dflags o_files dep_packages = do when (platformOS (targetPlatform dflags) `notElem` [OSiOS, OSDarwin]) $ diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 122eafff19..5fbbd3248b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -630,7 +630,7 @@ data DynFlags = DynFlags { ctxtStkDepth :: Int, -- ^ Typechecker context stack depth tyFunStkDepth :: Int, -- ^ Typechecker type function stack depth - thisPackage :: PackageId, -- ^ name of package currently being compiled + thisPackage :: PackageKey, -- ^ name of package currently being compiled -- ways ways :: [Way], -- ^ Way flags from the command line @@ -1352,7 +1352,7 @@ defaultDynFlags mySettings = ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH, tyFunStkDepth = mAX_TYPE_FUNCTION_REDUCTION_DEPTH, - thisPackage = mainPackageId, + thisPackage = mainPackageKey, objectDir = Nothing, dylibInstallName = Nothing, @@ -3346,7 +3346,7 @@ exposePackage' p dflags = dflags { packageFlags = ExposePackage p : packageFlags dflags } setPackageName :: String -> DynFlags -> DynFlags -setPackageName p s = s{ thisPackage = stringToPackageId p } +setPackageName p s = s{ thisPackage = stringToPackageKey p } -- If we're linking a binary, then only targets that produce object -- code are allowed (requests for other target types are ignored). @@ -3398,10 +3398,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 mainPackageId (mkModuleName main_mod) } + mainModIs = mkModule mainPackageKey (mkModuleName main_mod) } | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" - = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) } + = upd $ \d -> d{ mainModIs = mkModule mainPackageKey (mkModuleName arg) } | otherwise -- The arg looked like "baz" = upd $ \d -> d{ mainFunIs = Just arg } diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index cbfd4e4f1c..a403163ac8 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -43,7 +43,7 @@ import Maybes ( expectJust ) import Exception ( evaluate ) import Distribution.Text -import Distribution.Package hiding (PackageId) +import Distribution.Package import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef ) import System.Directory import System.FilePath @@ -80,12 +80,12 @@ flushFinderCaches hsc_env = do fc_ref = hsc_FC hsc_env mlc_ref = hsc_MLC hsc_env -flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO () +flushModLocationCache :: PackageKey -> IORef ModLocationCache -> IO () flushModLocationCache this_pkg ref = do atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ()) _ <- evaluate =<< readIORef ref return () - where is_ext mod _ | modulePackageId mod /= this_pkg = True + where is_ext mod _ | modulePackageKey mod /= this_pkg = True | otherwise = False addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO () @@ -148,7 +148,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 modulePackageId mod == thisPackage dflags + in if modulePackageKey mod == thisPackage dflags then findHomeModule hsc_env (moduleName mod) else findPackageModule hsc_env mod @@ -295,7 +295,7 @@ findPackageModule :: HscEnv -> Module -> IO FindResult findPackageModule hsc_env mod = do let dflags = hsc_dflags hsc_env - pkg_id = modulePackageId mod + pkg_id = modulePackageKey mod pkg_map = pkgIdMap (pkgState dflags) -- case lookupPackage pkg_map pkg_id of @@ -373,7 +373,7 @@ searchPathExts paths mod exts ] search [] = return (NotFound { fr_paths = map fst to_search - , fr_pkg = Just (modulePackageId mod) + , fr_pkg = Just (modulePackageKey mod) , fr_mods_hidden = [], fr_pkgs_hidden = [] , fr_suggestions = [] }) @@ -551,7 +551,7 @@ cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult cantFindErr _ multiple_found _ mod_name (FoundMultiple pkgs) = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( sep [ptext (sLit "it was found in multiple packages:"), - hsep (map (text.packageIdString) pkgs)] + hsep (map (text.packageKeyString) pkgs)] ) cantFindErr cannot_find _ dflags mod_name find_result = ptext cannot_find <+> quotes (ppr mod_name) @@ -615,7 +615,7 @@ cantFindErr cannot_find _ dflags mod_name find_result <> dot $$ cabal_pkg_hidden_hint pkg cabal_pkg_hidden_hint pkg | gopt Opt_BuildingCabalPackage dflags - = case simpleParse (packageIdString pkg) of + = case simpleParse (packageKeyString pkg) of Just pid -> ptext (sLit "Perhaps you need to add") <+> quotes (text (display (pkgName pid))) <+> @@ -635,13 +635,13 @@ cantFindErr cannot_find _ dflags mod_name find_result where (exposed_sugs, hidden_sugs) = partition from_exposed_pkg sugs - from_exposed_pkg m = case lookupPackage pkg_map (modulePackageId m) of + from_exposed_pkg m = case lookupPackage pkg_map (modulePackageKey m) of Just pkg_config -> exposed pkg_config Nothing -> WARN( True, ppr m ) -- Should not happen False pp_exp mod = ppr (moduleName mod) - <+> parens (ptext (sLit "from") <+> ppr (modulePackageId mod)) + <+> parens (ptext (sLit "from") <+> ppr (modulePackageKey mod)) pp_hid mod = ppr (moduleName mod) - <+> parens (ptext (sLit "needs flag -package") <+> ppr (modulePackageId mod)) + <+> parens (ptext (sLit "needs flag -package") <+> ppr (modulePackageKey mod)) \end{code} diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 13d4f87009..e569440fb3 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -133,10 +133,10 @@ module GHC ( -- * Abstract syntax elements -- ** Packages - PackageId, + PackageKey, -- ** Modules - Module, mkModule, pprModule, moduleName, modulePackageId, + Module, mkModule, pprModule, moduleName, modulePackageKey, ModuleName, mkModuleName, moduleNameString, -- ** Names @@ -534,7 +534,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 [PackageId] +setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageKey] setSessionDynFlags dflags = do (dflags', preload) <- liftIO $ initPackages dflags modifySession $ \h -> h{ hsc_dflags = dflags' @@ -543,7 +543,7 @@ setSessionDynFlags dflags = do return preload -- | Sets the program 'DynFlags'. -setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageId] +setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageKey] setProgramDynFlags dflags = do (dflags', preload) <- liftIO $ initPackages dflags modifySession $ \h -> h{ hsc_dflags = dflags' } @@ -1301,7 +1301,7 @@ showRichTokenStream ts = go startLoc ts "" -- ----------------------------------------------------------------------------- -- Interactive evaluation --- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the +-- | Takes a 'ModuleName' and possibly a 'PackageKey', 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 @@ -1311,7 +1311,7 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do this_pkg = thisPackage dflags -- case maybe_pkg of - Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do + Just pkg | fsToPackageKey pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do res <- findImportedModule hsc_env mod_name maybe_pkg case res of Found _ m -> return m @@ -1323,7 +1323,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 | modulePackageId m /= this_pkg -> return m + Found loc m | modulePackageKey m /= this_pkg -> return m | otherwise -> modNotLoadedError dflags m loc err -> throwOneError $ noModError dflags noSrcSpan mod_name err @@ -1368,7 +1368,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, [PackageId]) +moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [PackageKey]) moduleTrustReqs m = withSession $ \hsc_env -> liftIO $ hscGetSafe hsc_env m noSrcSpan diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 694778115d..33f163caed 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1786,7 +1786,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) just_found location mod | otherwise -> -- Drop external-pkg - ASSERT(modulePackageId mod /= thisPackage dflags) + ASSERT(modulePackageKey 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 aef6007fb7..59de3f915b 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -842,7 +842,7 @@ checkSafeImports dflags tcg_env imp_info = tcg_imports tcg_env -- ImportAvails imports = imp_mods imp_info -- ImportedMods imports' = moduleEnvToList imports -- (Module, [ImportedModsVal]) - pkg_reqs = imp_trust_pkgs imp_info -- [PackageId] + pkg_reqs = imp_trust_pkgs imp_info -- [PackageKey] condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport) condense (_, []) = panic "HscMain.condense: Pattern match failure!" @@ -879,7 +879,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, [PackageId]) +hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, [PackageKey]) hscGetSafe hsc_env m l = runHsc hsc_env $ do dflags <- getDynFlags (self, pkgs) <- hscCheckSafe' dflags m l @@ -893,15 +893,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 PackageId, [PackageId]) +hscCheckSafe' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe PackageKey, [PackageKey]) 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 $ modulePackageId m, pkgs) + | otherwise -> return (Just $ modulePackageKey m, pkgs) where - isModSafe :: Module -> SrcSpan -> Hsc (Bool, [PackageId]) + isModSafe :: Module -> SrcSpan -> Hsc (Bool, [PackageKey]) isModSafe m l = do iface <- lookup' m case iface of @@ -933,7 +933,7 @@ hscCheckSafe' dflags m l = do pkgTrustErr = unitBag $ mkPlainErrMsg dflags l $ sep [ ppr (moduleName m) <> text ": Can't be safely imported!" - , text "The package (" <> ppr (modulePackageId m) + , text "The package (" <> ppr (modulePackageKey m) <> text ") the module resides in isn't trusted." ] modTrustErr = unitBag $ mkPlainErrMsg dflags l $ @@ -955,7 +955,7 @@ hscCheckSafe' dflags m l = do packageTrusted _ _ m | isHomePkg m = True | otherwise = trusted $ getPackageDetails (pkgState dflags) - (modulePackageId m) + (modulePackageKey m) lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do @@ -979,11 +979,11 @@ hscCheckSafe' dflags m l = do isHomePkg :: Module -> Bool isHomePkg m - | thisPackage dflags == modulePackageId m = True + | thisPackage dflags == modulePackageKey m = True | otherwise = False -- | Check the list of packages are trusted. -checkPkgTrust :: DynFlags -> [PackageId] -> Hsc () +checkPkgTrust :: DynFlags -> [PackageKey] -> Hsc () checkPkgTrust dflags pkgs = case errors of [] -> return () @@ -1368,7 +1368,7 @@ hscStmtWithLocation hsc_env0 stmt source linenumber = handleWarnings -- Then code-gen, and link it - -- It's important NOT to have package 'interactive' as thisPackageId + -- It's important NOT to have package 'interactive' as thisPackageKey -- 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.lhs b/compiler/main/HscTypes.lhs index 9738f590b6..9a382a81bf 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -634,23 +634,23 @@ type FinderCache = ModuleNameEnv FindResult data FindResult = Found ModLocation Module -- ^ The module was found - | NoPackage PackageId + | NoPackage PackageKey -- ^ The requested package was not found - | FoundMultiple [PackageId] + | FoundMultiple [PackageKey] -- ^ _Error_: both in multiple packages -- | Not found | NotFound { fr_paths :: [FilePath] -- Places where I looked - , fr_pkg :: Maybe PackageId -- Just p => module is in this package's + , fr_pkg :: Maybe PackageKey -- Just p => module is in this package's -- manifest, but couldn't find -- the .hi file - , fr_mods_hidden :: [PackageId] -- Module is in these packages, + , fr_mods_hidden :: [PackageKey] -- Module is in these packages, -- but the *module* is hidden - , fr_pkgs_hidden :: [PackageId] -- Module is in these packages, + , fr_pkgs_hidden :: [PackageKey] -- Module is in these packages, -- but the *package* is hidden , fr_suggestions :: [Module] -- Possible mis-spelled modules @@ -1067,7 +1067,7 @@ data CgGuts -- as part of the code-gen of tycons cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs - cg_dep_pkgs :: ![PackageId], -- ^ Dependent packages, used to + cg_dep_pkgs :: ![PackageKey], -- ^ Dependent packages, used to -- generate #includes for C code gen cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information cg_modBreaks :: !ModBreaks -- ^ Module breakpoints @@ -1106,7 +1106,7 @@ 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.interactivePackageId, and +common package 'interactive' (see Module.interactivePackageKey, and PrelNames.mkInteractiveModule). This scheme deals well with shadowing. For example: @@ -1341,7 +1341,7 @@ extendInteractiveContext ictxt new_tythings setInteractivePackage :: HscEnv -> HscEnv -- Set the 'thisPackage' DynFlag to 'interactive' setInteractivePackage hsc_env - = hsc_env { hsc_dflags = (hsc_dflags hsc_env) { thisPackage = interactivePackageId } } + = hsc_env { hsc_dflags = (hsc_dflags hsc_env) { thisPackage = interactivePackageKey } } setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext setInteractivePrintName ic n = ic{ic_int_print = n} @@ -1446,11 +1446,11 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod) -- current package we can just assume it is unqualified). qual_mod mod - | modulePackageId mod == thisPackage dflags = False + | modulePackageKey mod == thisPackage dflags = False | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup, exposed pkg && exposed_module], - packageConfigId pkgconfig == modulePackageId mod + packageConfigId pkgconfig == modulePackageKey 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 @@ -1904,7 +1904,7 @@ data Dependencies -- I.e. modules that this one imports, or that are in the -- dep_mods of those directly-imported modules - , dep_pkgs :: [(PackageId, Bool)] + , dep_pkgs :: [(PackageKey, 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 cfcc076235..d60cf56eba 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -879,7 +879,7 @@ getContext = withSession $ \HscEnv{ hsc_IC=ic } -> -- its full top-level scope available. moduleIsInterpreted :: GhcMonad m => Module -> m Bool moduleIsInterpreted modl = withSession $ \h -> - if modulePackageId modl /= thisPackage (hsc_dflags h) + if modulePackageKey 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 514a2e004f..9938d7370f 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -9,8 +9,8 @@ module PackageConfig ( -- $package_naming - -- * PackageId - mkPackageId, packageConfigId, + -- * PackageKey + mkPackageKey, packageConfigId, -- * The PackageConfig type: information about a package PackageConfig, @@ -26,7 +26,7 @@ module PackageConfig ( import Distribution.InstalledPackageInfo import Distribution.ModuleName -import Distribution.Package hiding (PackageId) +import Distribution.Package import Distribution.Text import Distribution.Version @@ -43,23 +43,23 @@ defaultPackageConfig :: PackageConfig defaultPackageConfig = emptyInstalledPackageInfo -- ----------------------------------------------------------------------------- --- PackageId (package names with versions) +-- PackageKey (package names with versions) -- $package_naming -- #package_naming# --- Mostly the compiler deals in terms of 'PackageId's, which have the +-- Mostly the compiler deals in terms of 'PackageKey's, which have the -- form @<pkg>-<version>@. You're expected to pass in the version for -- the @-package-name@ 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#. --- | Turn a Cabal 'PackageIdentifier' into a GHC 'PackageId' -mkPackageId :: PackageIdentifier -> PackageId -mkPackageId = stringToPackageId . display +-- | Turn a Cabal 'PackageIdentifier' into a GHC 'PackageKey' +mkPackageKey :: PackageIdentifier -> PackageKey +mkPackageKey = stringToPackageKey . display --- | Get the GHC 'PackageId' right out of a Cabalish 'PackageConfig' -packageConfigId :: PackageConfig -> PackageId -packageConfigId = mkPackageId . sourcePackageId +-- | Get the GHC 'PackageKey' right out of a Cabalish 'PackageConfig' +packageConfigId :: PackageConfig -> PackageKey +packageConfigId = mkPackageKey . sourcePackageId -- | Turn a 'PackageConfig', which contains GHC 'Module.ModuleName's into a Cabal specific -- 'InstalledPackageInfo' which contains Cabal 'Distribution.ModuleName.ModuleName's diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 360519e071..d10b3b9f52 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -110,11 +110,11 @@ import qualified Data.Set as Set -- in a different DLL, by setting the DLL flag. data PackageState = PackageState { - pkgIdMap :: PackageConfigMap, -- PackageId -> PackageConfig + pkgIdMap :: PackageConfigMap, -- PackageKey -> PackageConfig -- The exposed flags are adjusted according to -package and -- -hide-package flags, and -ignore-package removes packages. - preloadPackages :: [PackageId], + preloadPackages :: [PackageKey], -- 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. @@ -128,10 +128,10 @@ data PackageState = PackageState { installedPackageIdMap :: InstalledPackageIdMap } --- | A PackageConfigMap maps a 'PackageId' to a 'PackageConfig' +-- | A PackageConfigMap maps a 'PackageKey' to a 'PackageConfig' type PackageConfigMap = UniqFM PackageConfig -type InstalledPackageIdMap = Map InstalledPackageId PackageId +type InstalledPackageIdMap = Map InstalledPackageId PackageKey type InstalledPackageIndex = Map InstalledPackageId PackageConfig @@ -139,7 +139,7 @@ emptyPackageConfigMap :: PackageConfigMap emptyPackageConfigMap = emptyUFM -- | Find the package we know about with the given id (e.g. \"foo-1.0\"), if any -lookupPackage :: PackageConfigMap -> PackageId -> Maybe PackageConfig +lookupPackage :: PackageConfigMap -> PackageKey -> Maybe PackageConfig lookupPackage = lookupUFM extendPackageConfigMap @@ -150,7 +150,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 :: PackageState -> PackageId -> PackageConfig +getPackageDetails :: PackageState -> PackageKey -> PackageConfig getPackageDetails ps pid = expectJust "getPackageDetails" (lookupPackage (pkgIdMap ps) pid) -- ---------------------------------------------------------------------------- @@ -169,7 +169,7 @@ getPackageDetails ps pid = expectJust "getPackageDetails" (lookupPackage (pkgIdM -- '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, [PackageId]) +initPackages :: DynFlags -> IO (DynFlags, [PackageKey]) initPackages dflags = do pkg_db <- case pkgDatabase dflags of Nothing -> readPackageConfigs dflags @@ -475,15 +475,15 @@ findWiredInPackages dflags pkgs = do -- let wired_in_pkgids :: [String] - wired_in_pkgids = map packageIdString - [ primPackageId, - integerPackageId, - basePackageId, - rtsPackageId, - thPackageId, - thisGhcPackageId, - dphSeqPackageId, - dphParPackageId ] + wired_in_pkgids = map packageKeyString + [ primPackageKey, + integerPackageKey, + basePackageKey, + rtsPackageKey, + thPackageKey, + thisGhcPackageKey, + dphSeqPackageKey, + dphParPackageKey ] matches :: PackageConfig -> String -> Bool pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid @@ -670,11 +670,11 @@ depClosure index ipids = closure Map.empty ipids mkPackageState :: DynFlags -> [PackageConfig] -- initial database - -> [PackageId] -- preloaded packages - -> PackageId -- this package + -> [PackageKey] -- preloaded packages + -> PackageKey -- this package -> IO (PackageState, - [PackageId], -- new packages to preload - PackageId) -- this package, might be modified if the current + [PackageKey], -- new packages to preload + PackageKey) -- this package, might be modified if the current -- package is a wired-in package. mkPackageState dflags pkgs0 preload0 this_package = do @@ -797,7 +797,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do -- add base & rts to the preload packages basicLinkedPackages | gopt Opt_AutoLinkPackages dflags - = filter (flip elemUFM pkg_db) [basePackageId, rtsPackageId] + = filter (flip elemUFM pkg_db) [basePackageKey, rtsPackageKey] | 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 @@ -855,7 +855,7 @@ pprIPkg p = text (display (installedPackageId p)) -- use. -- | Find all the include directories in these and the preload packages -getPackageIncludePath :: DynFlags -> [PackageId] -> IO [String] +getPackageIncludePath :: DynFlags -> [PackageKey] -> IO [String] getPackageIncludePath dflags pkgs = collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs @@ -863,7 +863,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 -> [PackageId] -> IO [String] +getPackageLibraryPath :: DynFlags -> [PackageKey] -> IO [String] getPackageLibraryPath dflags pkgs = collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs @@ -872,7 +872,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 -> [PackageId] -> IO ([String], [String], [String]) +getPackageLinkOpts :: DynFlags -> [PackageKey] -> IO ([String], [String], [String]) getPackageLinkOpts dflags pkgs = collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs @@ -920,19 +920,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 -> [PackageId] -> IO [String] +getPackageExtraCcOpts :: DynFlags -> [PackageKey] -> 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 -> [PackageId] -> IO [String] +getPackageFrameworkPath :: DynFlags -> [PackageKey] -> 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 -> [PackageId] -> IO [String] +getPackageFrameworks :: DynFlags -> [PackageKey] -> IO [String] getPackageFrameworks dflags pkgs = do ps <- getPreloadPackagesAnd dflags pkgs return (concatMap frameworks ps) @@ -974,7 +974,7 @@ lookupModuleWithSuggestions dflags m -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of -- 'PackageConfig's -getPreloadPackagesAnd :: DynFlags -> [PackageId] -> IO [PackageConfig] +getPreloadPackagesAnd :: DynFlags -> [PackageKey] -> IO [PackageConfig] getPreloadPackagesAnd dflags pkgids = let state = pkgState dflags @@ -990,9 +990,9 @@ getPreloadPackagesAnd dflags pkgids = -- in reverse dependency order (a package appears before those it depends on). closeDeps :: DynFlags -> PackageConfigMap - -> Map InstalledPackageId PackageId - -> [(PackageId, Maybe PackageId)] - -> IO [PackageId] + -> Map InstalledPackageId PackageKey + -> [(PackageKey, Maybe PackageKey)] + -> IO [PackageKey] closeDeps dflags pkg_map ipid_map ps = throwErr dflags (closeDepsErr pkg_map ipid_map ps) @@ -1003,22 +1003,22 @@ throwErr dflags m Succeeded r -> return r closeDepsErr :: PackageConfigMap - -> Map InstalledPackageId PackageId - -> [(PackageId,Maybe PackageId)] - -> MaybeErr MsgDoc [PackageId] + -> Map InstalledPackageId PackageKey + -> [(PackageKey,Maybe PackageKey)] + -> MaybeErr MsgDoc [PackageKey] closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps -- internal helper add_package :: PackageConfigMap - -> Map InstalledPackageId PackageId - -> [PackageId] - -> (PackageId,Maybe PackageId) - -> MaybeErr MsgDoc [PackageId] + -> Map InstalledPackageId PackageKey + -> [PackageKey] + -> (PackageKey,Maybe PackageKey) + -> MaybeErr MsgDoc [PackageKey] add_package pkg_db ipid_map ps (p, mb_parent) | p `elem` ps = return ps -- Check if we've already added this package | otherwise = case lookupPackage pkg_db p of - Nothing -> Failed (missingPackageMsg (packageIdString p) <> + Nothing -> Failed (missingPackageMsg (packageKeyString p) <> missingDependencyMsg mb_parent) Just pkg -> do -- Add the package's dependents also @@ -1038,15 +1038,15 @@ missingPackageErr dflags p missingPackageMsg :: String -> SDoc missingPackageMsg p = ptext (sLit "unknown package:") <+> text p -missingDependencyMsg :: Maybe PackageId -> SDoc +missingDependencyMsg :: Maybe PackageKey -> SDoc missingDependencyMsg Nothing = empty missingDependencyMsg (Just parent) - = space <> parens (ptext (sLit "dependency of") <+> ftext (packageIdFS parent)) + = space <> parens (ptext (sLit "dependency of") <+> ftext (packageKeyFS parent)) -- ----------------------------------------------------------------------------- -- | Will the 'Name' come from a dynamically linked library? -isDllName :: DynFlags -> PackageId -> Module -> Name -> Bool +isDllName :: DynFlags -> PackageKey -> 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 diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 641b0cb12f..3b25c91256 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -1316,7 +1316,7 @@ linesPlatform xs = #endif -linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO () +linkDynLib :: DynFlags -> [String] -> [PackageKey] -> IO () linkDynLib dflags0 o_files dep_packages = do let -- This is a rather ugly hack to fix dynamically linked @@ -1362,7 +1362,7 @@ linkDynLib dflags0 o_files dep_packages OSMinGW32 -> pkgs _ -> - filter ((/= rtsPackageId) . packageConfigId) pkgs + filter ((/= rtsPackageKey) . 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 @@ -1464,7 +1464,7 @@ linkDynLib dflags0 o_files dep_packages ------------------------------------------------------------------- let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; } - let buildingRts = thisPackage dflags == rtsPackageId + let buildingRts = thisPackage dflags == rtsPackageKey let bsymbolicFlag = if buildingRts then -- -Bsymbolic breaks the way we implement -- hooks in the RTS diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 7d47330044..6f24e3afb8 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -1019,7 +1019,7 @@ tidyTopBinds hsc_env this_mod unfold_env init_occ_env binds ------------------------ tidyTopBind :: DynFlags - -> PackageId + -> PackageKey -> Module -> Id -> UnfoldEnv @@ -1189,7 +1189,7 @@ it as a CAF. In these cases however, we would need to use an additional CAF list to keep track of non-collectable CAFs. \begin{code} -hasCafRefs :: DynFlags -> PackageId -> Module +hasCafRefs :: DynFlags -> PackageKey -> Module -> (Id, VarEnv Var) -> Arity -> CoreExpr -> CafInfo hasCafRefs dflags this_pkg this_mod p arity expr diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index e53bb11cc3..3c4a551df3 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -1025,15 +1025,15 @@ cmmExprNative referenceKind expr = do CmmReg (CmmGlobal EagerBlackholeInfo) | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ - CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_EAGER_BLACKHOLE_info"))) + CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_EAGER_BLACKHOLE_info"))) CmmReg (CmmGlobal GCEnter1) | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ - CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_gc_enter_1"))) + CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_gc_enter_1"))) CmmReg (CmmGlobal GCFun) | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ - CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_gc_fun"))) + CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_gc_fun"))) other -> return other diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 8e9b49d78d..94b4c15e33 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -41,7 +41,7 @@ import Platform -- Our intermediate code: import BasicTypes import BlockId -import Module ( primPackageId ) +import Module ( primPackageKey ) import PprCmm () import CmmUtils import Cmm @@ -1761,7 +1761,7 @@ genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst] genCCall dflags is32Bit target dest_regs args where size = intSize width - lbl = mkCmmCodeLabel primPackageId (fsLit (popCntLabel width)) + lbl = mkCmmCodeLabel primPackageKey (fsLit (popCntLabel width)) genCCall dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do targetExpr <- cmmMakeDynamicReference dflags @@ -1771,7 +1771,7 @@ genCCall dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do CmmMayReturn) genCCall dflags is32Bit target dest_regs args where - lbl = mkCmmCodeLabel primPackageId (fsLit (word2FloatLabel width)) + lbl = mkCmmCodeLabel primPackageKey (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 fe3d6a5d2b..3917dcfcfc 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -1680,7 +1680,7 @@ getPState = P $ \s -> POk s s instance HasDynFlags P where getDynFlags = P $ \s -> POk s (dflags s) -withThisPackage :: (PackageId -> a) -> P a +withThisPackage :: (PackageKey -> a) -> P a withThisPackage f = do pkg <- liftM thisPackage getDynFlags return $ f pkg diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs index 5072908e6a..232f69f67f 100644 --- a/compiler/prelude/ForeignCall.lhs +++ b/compiler/prelude/ForeignCall.lhs @@ -117,7 +117,7 @@ data CCallTarget = StaticTarget CLabelString -- C-land name of label. - (Maybe PackageId) -- What package the function is in. + (Maybe PackageKey) -- 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.lhs b/compiler/prelude/PrelNames.lhs index 01c5764fd3..2c84e40565 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -461,7 +461,7 @@ rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation mkInteractiveModule :: Int -> Module -- (mkInteractiveMoudule 9) makes module 'interactive:M9' -mkInteractiveModule n = mkModule interactivePackageId (mkModuleName ("Ghci" ++ show n)) +mkInteractiveModule n = mkModule interactivePackageKey (mkModuleName ("Ghci" ++ show n)) pRELUDE_NAME, mAIN_NAME :: ModuleName pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude") @@ -472,28 +472,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 primPackageId (mkModuleNameFS m) +mkPrimModule m = mkModule primPackageKey (mkModuleNameFS m) mkIntegerModule :: FastString -> Module -mkIntegerModule m = mkModule integerPackageId (mkModuleNameFS m) +mkIntegerModule m = mkModule integerPackageKey (mkModuleNameFS m) mkBaseModule :: FastString -> Module -mkBaseModule m = mkModule basePackageId (mkModuleNameFS m) +mkBaseModule m = mkModule basePackageKey (mkModuleNameFS m) mkBaseModule_ :: ModuleName -> Module -mkBaseModule_ m = mkModule basePackageId m +mkBaseModule_ m = mkModule basePackageKey m mkThisGhcModule :: FastString -> Module -mkThisGhcModule m = mkModule thisGhcPackageId (mkModuleNameFS m) +mkThisGhcModule m = mkModule thisGhcPackageKey (mkModuleNameFS m) mkThisGhcModule_ :: ModuleName -> Module -mkThisGhcModule_ m = mkModule thisGhcPackageId m +mkThisGhcModule_ m = mkModule thisGhcPackageKey m mkMainModule :: FastString -> Module -mkMainModule m = mkModule mainPackageId (mkModuleNameFS m) +mkMainModule m = mkModule mainPackageKey (mkModuleNameFS m) mkMainModule_ :: ModuleName -> Module -mkMainModule_ m = mkModule mainPackageId m +mkMainModule_ m = mkModule mainPackageKey m \end{code} %************************************************************************ diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs index 4155a541ba..1261d87dd1 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.lhs @@ -40,7 +40,7 @@ import Unique ( Unique, mkPrimOpIdUnique ) import Outputable import FastTypes import FastString -import Module ( PackageId ) +import Module ( PackageKey ) \end{code} %************************************************************************ @@ -587,7 +587,7 @@ pprPrimOp other_op = pprOccName (primOpOcc other_op) %************************************************************************ \begin{code} -data PrimCall = PrimCall CLabelString PackageId +data PrimCall = PrimCall CLabelString PackageKey instance Outputable PrimCall where ppr (PrimCall lbl pkgId) diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index db4258607a..5071828e4d 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -259,7 +259,7 @@ rnImportDecl this_mod imp_mod : dep_finsts deps | otherwise = dep_finsts deps - pkg = modulePackageId (mi_module iface) + pkg = modulePackageKey (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.lhs b/compiler/rename/RnSource.lhs index 9bc0e44780..a3bd38a3ec 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -384,8 +384,8 @@ rnHsForeignDecl (ForeignImport name ty _ spec) ; (ty', fvs) <- rnLHsType (ForeignDeclCtx name) ty -- Mark any PackageTarget style imports as coming from the current package - ; let packageId = thisPackage $ hsc_dflags topEnv - spec' = patchForeignImport packageId spec + ; let packageKey = thisPackage $ hsc_dflags topEnv + spec' = patchForeignImport packageKey spec ; return (ForeignImport name' ty' noForeignImportCoercionYet spec', fvs) } @@ -402,20 +402,20 @@ rnHsForeignDecl (ForeignExport name ty _ spec) -- package, so if they get inlined across a package boundry we'll still -- know where they're from. -- -patchForeignImport :: PackageId -> ForeignImport -> ForeignImport -patchForeignImport packageId (CImport cconv safety fs spec) - = CImport cconv safety fs (patchCImportSpec packageId spec) +patchForeignImport :: PackageKey -> ForeignImport -> ForeignImport +patchForeignImport packageKey (CImport cconv safety fs spec) + = CImport cconv safety fs (patchCImportSpec packageKey spec) -patchCImportSpec :: PackageId -> CImportSpec -> CImportSpec -patchCImportSpec packageId spec +patchCImportSpec :: PackageKey -> CImportSpec -> CImportSpec +patchCImportSpec packageKey spec = case spec of - CFunction callTarget -> CFunction $ patchCCallTarget packageId callTarget + CFunction callTarget -> CFunction $ patchCCallTarget packageKey callTarget _ -> spec -patchCCallTarget :: PackageId -> CCallTarget -> CCallTarget -patchCCallTarget packageId callTarget = +patchCCallTarget :: PackageKey -> CCallTarget -> CCallTarget +patchCCallTarget packageKey callTarget = case callTarget of - StaticTarget label Nothing isFun -> StaticTarget label (Just packageId) isFun + StaticTarget label Nothing isFun -> StaticTarget label (Just packageKey) isFun _ -> callTarget @@ -883,10 +883,10 @@ packages, it is safe not to add the dependencies on the .hs-boot stuff to B2. See also Note [Grouping of type and class declarations] in TcTyClsDecls. \begin{code} -isInPackage :: PackageId -> Name -> Bool +isInPackage :: PackageKey -> Name -> Bool isInPackage pkgId nm = case nameModule_maybe nm of Nothing -> False - Just m -> pkgId == modulePackageId m + Just m -> pkgId == modulePackageKey m -- We use nameModule_maybe because we might be in a TH splice, in which case -- there is no module name. In that case we cannot have mutual dependencies, -- so it's fine to return False here. diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index 6020797449..d9a412278a 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -819,7 +819,7 @@ mkWrapperName what nameBase thisMod <- getModule let -- Note [Generating fresh names for ccall wrapper] wrapperRef = nextWrapperNum dflags - pkg = packageIdString (modulePackageId thisMod) + pkg = packageKeyString (modulePackageKey thisMod) mod = moduleNameString (moduleName thisMod) wrapperNum <- liftIO $ atomicModifyIORef wrapperRef $ \mod_env -> let num = lookupWithDefaultModuleEnv mod_env 0 thisMod diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 8fe97519e1..c8f3d06997 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -903,7 +903,7 @@ sameOccExtra ty1 ty2 , let n1 = tyConName tc1 n2 = tyConName tc2 same_occ = nameOccName n1 == nameOccName n2 - same_pkg = modulePackageId (nameModule n1) == modulePackageId (nameModule n2) + same_pkg = modulePackageKey (nameModule n1) == modulePackageKey (nameModule n2) , n1 /= n2 -- Different Names , same_occ -- but same OccName = ptext (sLit "NB:") <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2) @@ -917,10 +917,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 == mainPackageId) $ + , ppUnless (same_pkg || pkg == mainPackageKey) $ nest 4 $ ptext (sLit "in package") <+> quotes (ppr pkg) ]) where - pkg = modulePackageId mod + pkg = modulePackageKey mod mod = nameModule nm loc = nameSrcSpan nm \end{code} diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index 960e3faaa3..8848372197 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -1220,10 +1220,10 @@ gen_old_Typeable_binds dflags loc tycon where tycon_name = tyConName tycon modl = nameModule tycon_name - pkg = modulePackageId modl + pkg = modulePackageKey modl modl_fs = moduleNameFS (moduleName modl) - pkg_fs = packageIdFS pkg + pkg_fs = packageKeyFS pkg name_fs = occNameFS (nameOccName tycon_name) tycon_rep = nlHsApps oldMkTyCon_RDR @@ -1277,10 +1277,10 @@ gen_Typeable_binds dflags loc tycon where tycon_name = tyConName tycon modl = nameModule tycon_name - pkg = modulePackageId modl + pkg = modulePackageKey modl modl_fs = moduleNameFS (moduleName modl) - pkg_fs = packageIdFS pkg + pkg_fs = packageKeyFS pkg name_fs = occNameFS (nameOccName tycon_name) tycon_rep = nlHsApps mkTyCon_RDR diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 281db25620..cd27e9d044 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -1738,7 +1738,7 @@ loadUnqualIfaces hsc_env ictxt , let name = gre_name gre , not (isInternalName name) , let mod = nameModule name - , not (modulePackageId mod == this_pkg || isInteractiveModule mod) + , not (modulePackageKey mod == this_pkg || isInteractiveModule mod) -- Don't attempt to load an interface for stuff -- from the command line, or from the home package , isTcOcc (nameOccName name) -- Types and classes only @@ -1791,7 +1791,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 stablePackageIdCmp $ imp_dep_pkgs imports)] + ppr (sortBy stablePackageKeyCmp $ 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/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index bc536c17a8..e838ba7c26 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -806,17 +806,17 @@ data ImportAvails -- compiling M might not need to consult X.hi, but X -- is still listed in M's dependencies. - imp_dep_pkgs :: [PackageId], + imp_dep_pkgs :: [PackageKey], -- ^ 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 :: [PackageId], + imp_trust_pkgs :: [PackageKey], -- ^ 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 (PackageId, Bool) + -- While perhaps making imp_dep_pkgs a tuple of (PackageKey, 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.lhs b/compiler/typecheck/TcSplice.lhs index de3fbdbe89..bb6af8cb95 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -895,7 +895,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 = packageIdString (modulePackageId m) + , TH.loc_package = packageKeyString (modulePackageKey m) , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r) , TH.loc_end = (srcSpanEndLine r, srcSpanEndCol r) }) } @@ -1472,7 +1472,7 @@ reifyName thing where name = getName thing mod = ASSERT( isExternalName name ) nameModule name - pkg_str = packageIdString (modulePackageId mod) + pkg_str = packageKeyString (modulePackageKey mod) mod_str = moduleNameString (moduleName mod) occ_str = occNameString occ occ = nameOccName name @@ -1505,7 +1505,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 (stringToPackageId $ TH.pkgString pn) (mkModuleName $ TH.modString mn) + mkModule (stringToPackageKey $ TH.pkgString pn) (mkModuleName $ TH.modString mn) reifyAnnotations :: Data a => TH.AnnLookup -> TcM [a] reifyAnnotations th_name @@ -1519,13 +1519,13 @@ reifyAnnotations th_name ------------------------------ modToTHMod :: Module -> TH.Module -modToTHMod m = TH.Module (TH.PkgName $ packageIdString $ modulePackageId m) +modToTHMod m = TH.Module (TH.PkgName $ packageKeyString $ modulePackageKey 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 (stringToPackageId pkgString) (mkModuleName mString) + let reifMod = mkModule (stringToPackageKey pkgString) (mkModuleName mString) if (reifMod == this_mod) then reifyThisModule else reifyFromIface reifMod where reifyThisModule = do @@ -1535,10 +1535,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 (modulePackageId reifMod) usage] ] + Just m <- [usageToModule (modulePackageKey reifMod) usage] ] return $ TH.ModuleInfo usages - usageToModule :: PackageId -> Usage -> Maybe Module + usageToModule :: PackageKey -> 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/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml index 8d0545ebf3..0af4c3145b 100644 --- a/docs/users_guide/7.10.1-notes.xml +++ b/docs/users_guide/7.10.1-notes.xml @@ -234,6 +234,27 @@ </sect3> <sect3> + <title>ghc</title> + <itemizedlist> + <listitem> + <para> + Many internal functions in GHC related to package IDs have been + renamed to refer to package keys, e.g. <literal>PackageId</literal> + is now <literal>PackageKey</literal>, the wired-in names + such as <literal>primPackageId</literal> are now + <literal>primPackageKey</literal>, etc. This reflects a distinction + that we are now making: a package ID is, as before, the user-visible + ID from Cabal <literal>foo-1.0</literal>; a package key is now + a compiler-internal entity used for generating linking symbols, and + may not correspond at all to the package ID. In + particular, there may be multiple package keys per + package ID. + </para> + </listitem> + </itemizedlist> + </sect3> + + <sect3> <title>ghc-prim</title> <itemizedlist> <listitem> diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index c66b025739..9ac3be4773 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -1604,21 +1604,21 @@ isSafeModule m = do liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off") when (not $ null good) (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++ - (intercalate ", " $ map packageIdString good)) + (intercalate ", " $ map packageKeyString good)) case msafe && null bad of True -> liftIO $ putStrLn $ mname ++ " is trusted!" False -> do when (not $ null bad) (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): " - ++ (intercalate ", " $ map packageIdString bad)) + ++ (intercalate ", " $ map packageKeyString bad)) liftIO $ putStrLn $ mname ++ " is NOT trusted!" where mname = GHC.moduleNameString $ GHC.moduleName m packageTrusted dflags md - | thisPackage dflags == modulePackageId md = True - | otherwise = trusted $ getPackageDetails (pkgState dflags) (modulePackageId md) + | thisPackage dflags == modulePackageKey md = True + | otherwise = trusted $ getPackageDetails (pkgState dflags) (modulePackageKey md) tallyPkgs dflags deps | not (packageTrustOn dflags) = ([], []) | otherwise = partition part deps @@ -3131,7 +3131,7 @@ lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module lookupModuleName mName = GHC.lookupModule mName Nothing isHomeModule :: Module -> Bool -isHomeModule m = GHC.modulePackageId m == mainPackageId +isHomeModule m = GHC.modulePackageKey m == mainPackageKey -- TODO: won't work if home dir is encoded. -- (changeDirectory may not work either in that case.) @@ -3161,7 +3161,7 @@ wantInterpretedModuleName modname = do modl <- lookupModuleName modname let str = moduleNameString modname dflags <- getDynFlags - when (GHC.modulePackageId modl /= thisPackage dflags) $ + when (GHC.modulePackageKey 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/utils/haddock b/utils/haddock -Subproject cb96b4f1ed0462b4a394b9fda6612c3bea9886b +Subproject 8ac42d3327473939c013551750425cac191ff0f |