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

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")
emitRtsCall rtsUnitId (fsLit "enterFunCCS")
[(CmmReg (CmmGlobal BaseReg), AddrHint),
(costCentreFrom dflags closure, AddrHint)] False
else return () -- top-level function, nothing to do
......@@ -285,7 +285,7 @@ emitSetCCC cc tick push
pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
pushCostCentre result ccs cc
= emitRtsCallWithResult result AddrHint
rtsPackageKey
rtsUnitId
(fsLit "pushCostCentre") [(ccs,AddrHint),
(CmmLit (mkCCostCentre cc), AddrHint)]
False
......@@ -356,7 +356,7 @@ ldvEnter cl_ptr = do
loadEra :: DynFlags -> CmmExpr
loadEra dflags = CmmMachOp (MO_UU_Conv (cIntWidth dflags) (wordWidth dflags))
[CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageKey (fsLit "era")))
[CmmLoad (mkLblExpr (mkCmmDataLabel rtsUnitId (fsLit "era")))
(cInt dflags)]
ldvWord :: DynFlags -> CmmExpr -> CmmExpr
......