Commit b92a51f5 authored by Edward Z. Yang's avatar Edward Z. Yang

Rename package key to unit ID, and installed package ID to component ID.

Comes with Haddock submodule update.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 5b0191f7
......@@ -1027,7 +1027,7 @@ dataConRepArgTys (MkData { dcRep = rep
-- to its info table and used by the GHCi debugger and the heap profiler
dataConIdentity :: DataCon -> [Word8]
-- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
dataConIdentity dc = bytesFS (packageKeyFS (modulePackageKey mod)) ++
dataConIdentity dc = bytesFS (unitIdFS (moduleUnitId mod)) ++
fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
where name = dataConName dc
......
......@@ -25,32 +25,32 @@ module Module
mkModuleNameFS,
stableModuleNameCmp,
-- * The PackageKey type
PackageKey,
fsToPackageKey,
packageKeyFS,
stringToPackageKey,
packageKeyString,
stablePackageKeyCmp,
-- * Wired-in PackageKeys
-- * The UnitId type
UnitId,
fsToUnitId,
unitIdFS,
stringToUnitId,
unitIdString,
stableUnitIdCmp,
-- * Wired-in UnitIds
-- $wired_in_packages
primPackageKey,
integerPackageKey,
basePackageKey,
rtsPackageKey,
thPackageKey,
dphSeqPackageKey,
dphParPackageKey,
mainPackageKey,
thisGhcPackageKey,
holePackageKey, isHoleModule,
interactivePackageKey, isInteractiveModule,
wiredInPackageKeys,
primUnitId,
integerUnitId,
baseUnitId,
rtsUnitId,
thUnitId,
dphSeqUnitId,
dphParUnitId,
mainUnitId,
thisGhcUnitId,
holeUnitId, isHoleModule,
interactiveUnitId, isInteractiveModule,
wiredInUnitIds,
-- * The Module type
Module(Module),
modulePackageKey, moduleName,
moduleUnitId, moduleName,
pprModule,
mkModule,
stableModuleCmp,
......@@ -216,7 +216,7 @@ moduleNameString (ModuleName mod) = unpackFS mod
-- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"
moduleStableString :: Module -> String
moduleStableString Module{..} =
"$" ++ packageKeyString modulePackageKey ++ "$" ++ moduleNameString moduleName
"$" ++ unitIdString moduleUnitId ++ "$" ++ moduleNameString moduleName
mkModuleName :: String -> ModuleName
mkModuleName s = ModuleName (mkFastString s)
......@@ -244,15 +244,15 @@ moduleNameColons = dots_to_colons . moduleNameString
************************************************************************
-}
-- | A Module is a pair of a 'PackageKey' and a 'ModuleName'.
-- | A Module is a pair of a 'UnitId' and a 'ModuleName'.
data Module = Module {
modulePackageKey :: !PackageKey, -- pkg-1.0
moduleUnitId :: !UnitId, -- pkg-1.0
moduleName :: !ModuleName -- A.B.C
}
deriving (Eq, Ord, Typeable)
instance Uniquable Module where
getUnique (Module p n) = getUnique (packageKeyFS p `appendFS` moduleNameFS n)
getUnique (Module p n) = getUnique (unitIdFS p `appendFS` moduleNameFS n)
instance Outputable Module where
ppr = pprModule
......@@ -272,25 +272,25 @@ instance Data Module where
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp (Module p1 n1) (Module p2 n2)
= (p1 `stablePackageKeyCmp` p2) `thenCmp`
= (p1 `stableUnitIdCmp` p2) `thenCmp`
(n1 `stableModuleNameCmp` n2)
mkModule :: PackageKey -> ModuleName -> Module
mkModule :: UnitId -> ModuleName -> Module
mkModule = Module
pprModule :: Module -> SDoc
pprModule mod@(Module p n) =
pprPackagePrefix p mod <> pprModuleName n
pprPackagePrefix :: PackageKey -> Module -> SDoc
pprPackagePrefix :: UnitId -> Module -> SDoc
pprPackagePrefix p mod = getPprStyle doc
where
doc sty
| codeStyle sty =
if p == mainPackageKey
if p == mainUnitId
then empty -- never qualify the main package in code
else ztext (zEncodeFS (packageKeyFS p)) <> char '_'
| qualModule sty mod = ppr (modulePackageKey mod) <> char ':'
else ztext (zEncodeFS (unitIdFS p)) <> char '_'
| qualModule sty mod = ppr (moduleUnitId mod) <> char ':'
-- the PrintUnqualified tells us which modules have to
-- be qualified with package names
| otherwise = empty
......@@ -304,7 +304,7 @@ class HasModule m where
{-
************************************************************************
* *
\subsection{PackageKey}
\subsection{UnitId}
* *
************************************************************************
-}
......@@ -313,56 +313,56 @@ class HasModule m where
-- it is just the package name, but for user compiled packages, it is a hash.
-- ToDo: when the key is a hash, we can do more clever things than store
-- the hex representation and hash-cons those strings.
newtype PackageKey = PId FastString deriving( Eq, Typeable )
newtype UnitId = PId FastString deriving( Eq, Typeable )
-- here to avoid module loops with PackageConfig
instance Uniquable PackageKey where
getUnique pid = getUnique (packageKeyFS pid)
instance Uniquable UnitId where
getUnique pid = getUnique (unitIdFS pid)
-- Note: *not* a stable lexicographic ordering, a faster unique-based
-- ordering.
instance Ord PackageKey where
instance Ord UnitId where
nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
instance Data PackageKey where
instance Data UnitId where
-- don't traverse?
toConstr _ = abstractConstr "PackageKey"
toConstr _ = abstractConstr "UnitId"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "PackageKey"
dataTypeOf _ = mkNoRepType "UnitId"
stablePackageKeyCmp :: PackageKey -> PackageKey -> Ordering
stableUnitIdCmp :: UnitId -> UnitId -> Ordering
-- ^ Compares package ids lexically, rather than by their 'Unique's
stablePackageKeyCmp p1 p2 = packageKeyFS p1 `compare` packageKeyFS p2
stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2
instance Outputable PackageKey where
instance Outputable UnitId where
ppr pk = getPprStyle $ \sty -> sdocWithDynFlags $ \dflags ->
case packageKeyPackageIdString dflags pk of
Nothing -> ftext (packageKeyFS pk)
case unitIdPackageIdString dflags pk of
Nothing -> ftext (unitIdFS pk)
Just pkg -> text pkg
-- Don't bother qualifying if it's wired in!
<> (if qualPackage sty pk && not (pk `elem` wiredInPackageKeys)
then char '@' <> ftext (packageKeyFS pk)
<> (if qualPackage sty pk && not (pk `elem` wiredInUnitIds)
then char '@' <> ftext (unitIdFS pk)
else empty)
instance Binary PackageKey where
put_ bh pid = put_ bh (packageKeyFS pid)
get bh = do { fs <- get bh; return (fsToPackageKey fs) }
instance Binary UnitId where
put_ bh pid = put_ bh (unitIdFS pid)
get bh = do { fs <- get bh; return (fsToUnitId fs) }
instance BinaryStringRep PackageKey where
fromStringRep = fsToPackageKey . mkFastStringByteString
toStringRep = fastStringToByteString . packageKeyFS
instance BinaryStringRep UnitId where
fromStringRep = fsToUnitId . mkFastStringByteString
toStringRep = fastStringToByteString . unitIdFS
fsToPackageKey :: FastString -> PackageKey
fsToPackageKey = PId
fsToUnitId :: FastString -> UnitId
fsToUnitId = PId
packageKeyFS :: PackageKey -> FastString
packageKeyFS (PId fs) = fs
unitIdFS :: UnitId -> FastString
unitIdFS (PId fs) = fs
stringToPackageKey :: String -> PackageKey
stringToPackageKey = fsToPackageKey . mkFastString
stringToUnitId :: String -> UnitId
stringToUnitId = fsToUnitId . mkFastString
packageKeyString :: PackageKey -> String
packageKeyString = unpackFS . packageKeyFS
unitIdString :: UnitId -> String
unitIdString = unpackFS . unitIdFS
-- -----------------------------------------------------------------------------
......@@ -378,7 +378,7 @@ packageKeyString = unpackFS . packageKeyFS
-- versions of them installed. However, for each invocation of GHC,
-- only a single instance of each wired-in package will be recognised
-- (the desired one is selected via @-package@\/@-hide-package@), and GHC
-- will use the unversioned 'PackageKey' below when referring to it,
-- will use the unversioned 'UnitId' below when referring to it,
-- including in .hi files and object file symbols. Unselected
-- versions of wired-in packages will be ignored, as will any other
-- package that depends directly or indirectly on it (much as if you
......@@ -386,49 +386,49 @@ packageKeyString = unpackFS . packageKeyFS
-- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
integerPackageKey, primPackageKey,
basePackageKey, rtsPackageKey,
thPackageKey, dphSeqPackageKey, dphParPackageKey,
mainPackageKey, thisGhcPackageKey, interactivePackageKey :: PackageKey
primPackageKey = fsToPackageKey (fsLit "ghc-prim")
integerPackageKey = fsToPackageKey (fsLit n)
integerUnitId, primUnitId,
baseUnitId, rtsUnitId,
thUnitId, dphSeqUnitId, dphParUnitId,
mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
primUnitId = fsToUnitId (fsLit "ghc-prim")
integerUnitId = fsToUnitId (fsLit n)
where
n = case cIntegerLibraryType of
IntegerGMP -> "integer-gmp"
IntegerSimple -> "integer-simple"
basePackageKey = fsToPackageKey (fsLit "base")
rtsPackageKey = fsToPackageKey (fsLit "rts")
thPackageKey = fsToPackageKey (fsLit "template-haskell")
dphSeqPackageKey = fsToPackageKey (fsLit "dph-seq")
dphParPackageKey = fsToPackageKey (fsLit "dph-par")
thisGhcPackageKey = fsToPackageKey (fsLit "ghc")
interactivePackageKey = fsToPackageKey (fsLit "interactive")
baseUnitId = fsToUnitId (fsLit "base")
rtsUnitId = fsToUnitId (fsLit "rts")
thUnitId = fsToUnitId (fsLit "template-haskell")
dphSeqUnitId = fsToUnitId (fsLit "dph-seq")
dphParUnitId = fsToUnitId (fsLit "dph-par")
thisGhcUnitId = fsToUnitId (fsLit "ghc")
interactiveUnitId = fsToUnitId (fsLit "interactive")
-- | This is the package Id for the current program. It is the default
-- package Id if you don't specify a package name. We don't add this prefix
-- to symbol names, since there can be only one main package per program.
mainPackageKey = fsToPackageKey (fsLit "main")
mainUnitId = fsToUnitId (fsLit "main")
-- | This is a fake package id used to provide identities to any un-implemented
-- signatures. The set of hole identities is global over an entire compilation.
holePackageKey :: PackageKey
holePackageKey = fsToPackageKey (fsLit "hole")
holeUnitId :: UnitId
holeUnitId = fsToUnitId (fsLit "hole")
isInteractiveModule :: Module -> Bool
isInteractiveModule mod = modulePackageKey mod == interactivePackageKey
isInteractiveModule mod = moduleUnitId mod == interactiveUnitId
isHoleModule :: Module -> Bool
isHoleModule mod = modulePackageKey mod == holePackageKey
wiredInPackageKeys :: [PackageKey]
wiredInPackageKeys = [ primPackageKey,
integerPackageKey,
basePackageKey,
rtsPackageKey,
thPackageKey,
thisGhcPackageKey,
dphSeqPackageKey,
dphParPackageKey ]
isHoleModule mod = moduleUnitId mod == holeUnitId
wiredInUnitIds :: [UnitId]
wiredInUnitIds = [ primUnitId,
integerUnitId,
baseUnitId,
rtsUnitId,
thUnitId,
thisGhcUnitId,
dphSeqUnitId,
dphParUnitId ]
{-
************************************************************************
......
......@@ -2,7 +2,7 @@ module Module where
data Module
data ModuleName
data PackageKey
data UnitId
moduleName :: Module -> ModuleName
modulePackageKey :: Module -> PackageKey
packageKeyString :: PackageKey -> String
moduleUnitId :: Module -> UnitId
unitIdString :: UnitId -> String
......@@ -265,16 +265,16 @@ nameIsHomePackageImport this_mod
= \nm -> case nameModule_maybe nm of
Nothing -> False
Just nm_mod -> nm_mod /= this_mod
&& modulePackageKey nm_mod == this_pkg
&& moduleUnitId nm_mod == this_pkg
where
this_pkg = modulePackageKey this_mod
this_pkg = moduleUnitId this_mod
-- | Returns True if the Name comes from some other package: neither this
-- pacakge nor the interactive package.
nameIsFromExternalPackage :: PackageKey -> Name -> Bool
nameIsFromExternalPackage :: UnitId -> Name -> Bool
nameIsFromExternalPackage this_pkg name
| Just mod <- nameModule_maybe name
, modulePackageKey mod /= this_pkg -- Not this package
, moduleUnitId mod /= this_pkg -- Not this package
, not (isInteractiveModule mod) -- Not the 'interactive' package
= True
| otherwise
......@@ -557,7 +557,7 @@ pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
case qualName sty mod occ of -- See Outputable.QualifyName:
NameQual modname -> ppr modname <> dot -- Name is in scope
NameNotInScope1 -> ppr mod <> dot -- Not in scope
NameNotInScope2 -> ppr (modulePackageKey mod) <> colon -- Module not in
NameNotInScope2 -> ppr (moduleUnitId mod) <> colon -- Module not in
<> ppr (moduleName mod) <> dot -- scope either
NameUnqual -> empty -- In scope unqualified
......
......@@ -638,12 +638,12 @@ mkMaxTagOcc = mk_simple_deriv varName "$maxtag_"
-- Generic deriving mechanism
-- | Generate a module-unique name, to be used e.g. while generating new names
-- for Generics types. We use module package key to avoid name clashes when
-- for Generics types. We use module unit id to avoid name clashes when
-- package imports is used.
mkModPrefix :: Module -> String
mkModPrefix mod = pk ++ "_" ++ mn
where
pk = packageKeyString (modulePackageKey mod)
pk = unitIdString (moduleUnitId mod)
mn = moduleNameString (moduleName mod)
mkGenD :: Module -> OccName -> OccName
......
......@@ -868,7 +868,7 @@ data ImpDeclSpec
-- the defining module for this thing!
-- TODO: either should be Module, or there
-- should be a Maybe PackageKey here too.
-- should be a Maybe UnitId here too.
is_as :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
is_qual :: Bool, -- ^ Was this import qualified?
is_dloc :: SrcSpan -- ^ The location of the entire import declaration
......
......@@ -161,14 +161,14 @@ data CLabel
-- | A label from a .cmm file that is not associated with a .hs level Id.
| CmmLabel
PackageKey -- what package the label belongs to.
UnitId -- what package the label belongs to.
FastString -- identifier giving the prefix of the label
CmmLabelInfo -- encodes the suffix of the label
-- | A label with a baked-in \/ algorithmically generated name that definitely
-- comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
-- If it doesn't have an algorithmically generated name then use a CmmLabel
-- instead and give it an appropriate PackageKey argument.
-- instead and give it an appropriate UnitId argument.
| RtsLabel
RtsLabelInfo
......@@ -244,7 +244,7 @@ data CLabel
data ForeignLabelSource
-- | Label is in a named package
= ForeignLabelInPackage PackageKey
= ForeignLabelInPackage UnitId
-- | Label is in some external, system package that doesn't also
-- contain compiled Haskell code, and is not associated with any .hi files.
......@@ -418,27 +418,27 @@ mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
mkSMAP_DIRTY_infoLabel :: CLabel
mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
mkSplitMarkerLabel = CmmLabel rtsPackageKey (fsLit "__stg_split_marker") CmmCode
mkUpdInfoLabel = CmmLabel rtsPackageKey (fsLit "stg_upd_frame") CmmInfo
mkBHUpdInfoLabel = CmmLabel rtsPackageKey (fsLit "stg_bh_upd_frame" ) CmmInfo
mkIndStaticInfoLabel = CmmLabel rtsPackageKey (fsLit "stg_IND_STATIC") CmmInfo
mkMainCapabilityLabel = CmmLabel rtsPackageKey (fsLit "MainCapability") CmmData
mkMAP_FROZEN_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo
mkMAP_FROZEN0_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_EMPTY_MVAR") CmmInfo
mkTopTickyCtrLabel = CmmLabel rtsPackageKey (fsLit "top_ct") CmmData
mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageKey (fsLit "stg_CAF_BLACKHOLE") CmmInfo
mkCAFBlackHoleEntryLabel = CmmLabel rtsPackageKey (fsLit "stg_CAF_BLACKHOLE") CmmEntry
mkArrWords_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_ARR_WORDS") CmmInfo
mkSMAP_FROZEN_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
mkSMAP_FROZEN0_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkSMAP_DIRTY_infoLabel = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
mkSplitMarkerLabel = CmmLabel rtsUnitId (fsLit "__stg_split_marker") CmmCode
mkUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_upd_frame") CmmInfo
mkBHUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_bh_upd_frame" ) CmmInfo
mkIndStaticInfoLabel = CmmLabel rtsUnitId (fsLit "stg_IND_STATIC") CmmInfo
mkMainCapabilityLabel = CmmLabel rtsUnitId (fsLit "MainCapability") CmmData
mkMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo
mkMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
mkEMPTY_MVAR_infoLabel = CmmLabel rtsUnitId (fsLit "stg_EMPTY_MVAR") CmmInfo
mkTopTickyCtrLabel = CmmLabel rtsUnitId (fsLit "top_ct") CmmData
mkCAFBlackHoleInfoTableLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
mkCAFBlackHoleEntryLabel = CmmLabel rtsUnitId (fsLit "stg_CAF_BLACKHOLE") CmmEntry
mkArrWords_infoLabel = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS") CmmInfo
mkSMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
mkSMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
-----
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel
:: PackageKey -> FastString -> CLabel
:: UnitId -> FastString -> CLabel
mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo
mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry
......@@ -652,7 +652,7 @@ needsCDecl (RtsLabel _) = False
needsCDecl (CmmLabel pkgId _ _)
-- Prototypes for labels defined in the runtime system are imported
-- into HC files via includes/Stg.h.
| pkgId == rtsPackageKey = False
| pkgId == rtsUnitId = False
-- For other labels we inline one into the HC file directly.
| otherwise = True
......@@ -858,11 +858,11 @@ idInfoLabelType info =
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.
labelDynamic :: DynFlags -> PackageKey -> Module -> CLabel -> Bool
labelDynamic :: DynFlags -> UnitId -> Module -> CLabel -> Bool
labelDynamic dflags this_pkg this_mod lbl =
case lbl of
-- is the RTS in a DLL or not?
RtsLabel _ -> not (gopt Opt_Static dflags) && (this_pkg /= rtsPackageKey)
RtsLabel _ -> not (gopt Opt_Static dflags) && (this_pkg /= rtsUnitId)
IdLabel n _ _ -> isDllName dflags this_pkg this_mod n
......@@ -895,7 +895,7 @@ labelDynamic dflags this_pkg this_mod lbl =
-- libraries
True
PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m)
PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (moduleUnitId m)
HpcTicksLabel m -> not (gopt Opt_Static dflags) && this_mod /= m
......
......@@ -574,7 +574,7 @@ importName
-- A label imported with an explicit packageId.
| STRING NAME
{ ($2, mkCmmCodeLabel (fsToPackageKey (mkFastString $1)) $2) }
{ ($2, mkCmmCodeLabel (fsToUnitId (mkFastString $1)) $2) }
names :: { [FastString] }
......@@ -1119,7 +1119,7 @@ profilingInfo dflags desc_str ty_str
else ProfilingInfo (stringToWord8s desc_str)
(stringToWord8s ty_str)
staticClosure :: PackageKey -> FastString -> FastString -> [CmmLit] -> CmmParse ()
staticClosure :: UnitId -> FastString -> FastString -> [CmmLit] -> CmmParse ()
staticClosure pkg cl_label info payload
= do dflags <- getDynFlags
let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
......
......@@ -190,7 +190,7 @@ buildDynCon' dflags platform binder _ _cc con [arg]
, StgLitArg (MachInt val) <- arg
, val <= fromIntegral (mAX_INTLIKE dflags) -- Comparisons at type Integer!
, val >= fromIntegral (mIN_INTLIKE dflags) -- ...ditto...
= do { let intlike_lbl = mkCmmClosureLabel rtsPackageKey (fsLit "stg_INTLIKE")
= do { let intlike_lbl = mkCmmClosureLabel rtsUnitId (fsLit "stg_INTLIKE")
val_int = fromIntegral val :: Int
offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSizeW dflags + 1)
-- INTLIKE closures consist of a header and one word payload
......@@ -205,7 +205,7 @@ buildDynCon' dflags platform binder _ _cc con [arg]
, let val_int = ord val :: Int
, val_int <= mAX_CHARLIKE dflags
, val_int >= mIN_CHARLIKE dflags
= do { let charlike_lbl = mkCmmClosureLabel rtsPackageKey (fsLit "stg_CHARLIKE")
= do { let charlike_lbl = mkCmmClosureLabel rtsUnitId (fsLit "stg_CHARLIKE")
offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSizeW dflags + 1)
-- CHARLIKE closures consist of a header and one word payload
charlike_amode = cmmLabelOffW dflags charlike_lbl offsetW
......
......@@ -63,7 +63,7 @@ data Named
= VarN CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
-- eg, RtsLabel, ForeignLabel, CmmLabel etc.
| FunN PackageKey -- ^ A function name from this package
| FunN UnitId -- ^ A function name from this package
| LabelN BlockId -- ^ A blockid of some code or data.
-- | An environment of named things.
......@@ -167,7 +167,7 @@ newBlockId = code F.newLabelC
-- | Add add a local function to the environment.
newFunctionName
:: FastString -- ^ name of the function
-> PackageKey -- ^ package of the current module
-> UnitId -- ^ package of the current module
-> ExtCode
newFunctionName name pkg = addDecl name (FunN pkg)
......@@ -207,7 +207,7 @@ lookupName name = do
case lookupUFM env name of
Just (VarN e) -> e
Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name))
_other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey name))
_other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId name))
-- | Lift an FCode computation into the CmmParse monad
......
......@@ -523,7 +523,7 @@ generic_gc = mkGcLabel "stg_gc_noregs"
-- | Create a CLabel for calling a garbage collector entry point
mkGcLabel :: String -> CmmExpr
mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit s)))
mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId (fsLit s)))
-------------------------------
heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a
......
......@@ -366,10 +366,10 @@ slowArgs dflags args -- careful: reps contains voids (V), but args does not
(arg_pat, n) = slowCallPattern (map fst args)
(call_args, rest_args) = splitAt n args
stg_ap_pat = mkCmmRetInfoLabel rtsPackageKey arg_pat
stg_ap_pat = mkCmmRetInfoLabel rtsUnitId arg_pat
this_pat = (N, Just (mkLblExpr stg_ap_pat)) : call_args
save_cccs = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just curCCS)]
save_cccs_lbl = mkCmmRetInfoLabel rtsPackageKey (fsLit "stg_restore_cccs")
save_cccs_lbl = mkCmmRetInfoLabel rtsUnitId (fsLit "stg_restore_cccs")
-------------------------------------------------------------------------
---- Laying out objects on the heap and stack
......
......@@ -498,7 +498,7 @@ withSelfLoop self_loop code = do
instance HasDynFlags FCode where
getDynFlags = liftM cgd_dflags getInfoDown
getThisPackage :: FCode PackageKey
getThisPackage :: FCode UnitId
getThisPackage = liftM thisPackage getDynFlags
withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
......
......@@ -183,7 +183,7 @@ enterCostCentreFun ccs closure =
ifProfiling $ do
if isCurrentCCS ccs
then do dflags <- getDynFlags
emitRtsCall rtsPackageKey (fsLit "enterFunCCS")