summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-05-12 11:40:03 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-06-13 02:13:02 -0400
commite7272d53e67e72580caceae40e766c4bfeb1c398 (patch)
tree5e0d06cf3fc31e737ea385b53efe22e5916e847a /compiler
parentf6be6e432e53108075905c1fc7785d8b1f18a33f (diff)
downloadhaskell-e7272d53e67e72580caceae40e766c4bfeb1c398.tar.gz
Enhance UnitId use
* use UnitId instead of String to identify wired-in units * use UnitId instead of Unit in the backend (Unit are only use by Backpack to produce type-checked interfaces, not real code) * rename lookup functions for consistency * documentation
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Builtin/Names.hs18
-rw-r--r--compiler/GHC/Builtin/Names/TH.hs2
-rw-r--r--compiler/GHC/ByteCode/Linker.hs2
-rw-r--r--compiler/GHC/Cmm/CLabel.hs10
-rw-r--r--compiler/GHC/Cmm/Parser.y24
-rw-r--r--compiler/GHC/CoreToStg/Prep.hs10
-rw-r--r--compiler/GHC/Driver/Backpack.hs2
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs4
-rw-r--r--compiler/GHC/Driver/Finder.hs2
-rw-r--r--compiler/GHC/Driver/Main.hs2
-rw-r--r--compiler/GHC/Driver/Pipeline.hs6
-rw-r--r--compiler/GHC/Driver/Session.hs8
-rw-r--r--compiler/GHC/Driver/Types.hs4
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs4
-rw-r--r--compiler/GHC/HsToCore/Usage.hs2
-rw-r--r--compiler/GHC/Parser/Lexer.x16
-rw-r--r--compiler/GHC/Runtime/Linker.hs4
-rw-r--r--compiler/GHC/StgToCmm/ExtCode.hs6
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs4
-rw-r--r--compiler/GHC/StgToCmm/Utils.hs4
-rw-r--r--compiler/GHC/SysTools.hs2
-rw-r--r--compiler/GHC/SysTools/ExtraObj.hs2
-rw-r--r--compiler/GHC/Tc/Errors.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs2
-rw-r--r--compiler/GHC/Unit/Info.hs6
-rw-r--r--compiler/GHC/Unit/State.hs80
-rw-r--r--compiler/GHC/Unit/Types.hs51
28 files changed, 152 insertions, 129 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 36aba77356..a3d1fa5d5b 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -614,7 +614,7 @@ rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation
mkInteractiveModule :: Int -> Module
-- (mkInteractiveMoudule 9) makes module 'interactive:M9'
-mkInteractiveModule n = mkModule interactiveUnitId (mkModuleName ("Ghci" ++ show n))
+mkInteractiveModule n = mkModule interactiveUnit (mkModuleName ("Ghci" ++ show n))
pRELUDE_NAME, mAIN_NAME :: ModuleName
pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude")
@@ -625,28 +625,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 primUnitId (mkModuleNameFS m)
+mkPrimModule m = mkModule primUnit (mkModuleNameFS m)
mkIntegerModule :: FastString -> Module
-mkIntegerModule m = mkModule integerUnitId (mkModuleNameFS m)
+mkIntegerModule m = mkModule integerUnit (mkModuleNameFS m)
mkBaseModule :: FastString -> Module
-mkBaseModule m = mkModule baseUnitId (mkModuleNameFS m)
+mkBaseModule m = mkBaseModule_ (mkModuleNameFS m)
mkBaseModule_ :: ModuleName -> Module
-mkBaseModule_ m = mkModule baseUnitId m
+mkBaseModule_ m = mkModule baseUnit m
mkThisGhcModule :: FastString -> Module
-mkThisGhcModule m = mkModule thisGhcUnitId (mkModuleNameFS m)
+mkThisGhcModule m = mkThisGhcModule_ (mkModuleNameFS m)
mkThisGhcModule_ :: ModuleName -> Module
-mkThisGhcModule_ m = mkModule thisGhcUnitId m
+mkThisGhcModule_ m = mkModule thisGhcUnit m
mkMainModule :: FastString -> Module
-mkMainModule m = mkModule mainUnitId (mkModuleNameFS m)
+mkMainModule m = mkModule mainUnit (mkModuleNameFS m)
mkMainModule_ :: ModuleName -> Module
-mkMainModule_ m = mkModule mainUnitId m
+mkMainModule_ m = mkModule mainUnit m
{-
************************************************************************
diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs
index 3cd55b566d..4dd1b43e83 100644
--- a/compiler/GHC/Builtin/Names/TH.hs
+++ b/compiler/GHC/Builtin/Names/TH.hs
@@ -170,7 +170,7 @@ thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib.Internal")
qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
mkTHModule :: FastString -> Module
-mkTHModule m = mkModule thUnitId (mkModuleNameFS m)
+mkTHModule m = mkModule thUnit (mkModuleNameFS m)
libFun, libTc, thFun, thTc, thCls, thCon, qqFun :: FastString -> Unique -> Name
libFun = mk_known_key_name varName thLib
diff --git a/compiler/GHC/ByteCode/Linker.hs b/compiler/GHC/ByteCode/Linker.hs
index 1fab779619..03c03fbf2b 100644
--- a/compiler/GHC/ByteCode/Linker.hs
+++ b/compiler/GHC/ByteCode/Linker.hs
@@ -169,7 +169,7 @@ nameToCLabel n suffix = mkFastString label
occPart = encodeZ (occNameFS (nameOccName n))
label = concat
- [ if pkgKey == mainUnitId then "" else packagePart ++ "_"
+ [ if pkgKey == mainUnit then "" else packagePart ++ "_"
, modulePart
, '_':occPart
, '_':suffix
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 8d85c5aed0..a0f8c6340d 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -186,7 +186,7 @@ data CLabel
-- | A label from a .cmm file that is not associated with a .hs level Id.
| CmmLabel
- Unit -- 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
@@ -552,7 +552,7 @@ mkSRTInfoLabel n = CmmLabel rtsUnitId lbl CmmInfo
-----
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
mkCmmCodeLabel, mkCmmDataLabel, mkCmmClosureLabel
- :: Unit -> FastString -> CLabel
+ :: UnitId -> FastString -> CLabel
mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo
mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry
@@ -583,7 +583,7 @@ mkApEntryLabel upd off = RtsLabel (RtsApEntry upd off)
-- A call to some primitive hand written Cmm code
mkPrimCallLabel :: PrimCall -> CLabel
mkPrimCallLabel (PrimCall str pkg)
- = CmmLabel pkg str CmmPrimCall
+ = CmmLabel (toUnitId pkg) str CmmPrimCall
-- Constructing ForeignLabels
@@ -1032,7 +1032,7 @@ labelDynamic config this_mod lbl =
case lbl of
-- is the RTS in a DLL or not?
RtsLabel _ ->
- externalDynamicRefs && (this_pkg /= rtsUnitId)
+ externalDynamicRefs && (this_pkg /= rtsUnit)
IdLabel n _ _ ->
externalDynamicRefs && isDynLinkName platform this_mod n
@@ -1040,7 +1040,7 @@ labelDynamic config this_mod lbl =
-- When compiling in the "dyn" way, each package is to be linked into
-- its own shared library.
CmmLabel pkg _ _
- | os == OSMinGW32 -> externalDynamicRefs && (this_pkg /= pkg)
+ | os == OSMinGW32 -> externalDynamicRefs && (toUnitId this_pkg /= pkg)
| otherwise -> externalDynamicRefs
LocalBlockLabel _ -> False
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index eb1ccae3c6..bb502f8cbe 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -377,7 +377,7 @@ cmmtop :: { CmmParse () }
| cmmdata { $1 }
| decl { $1 }
| 'CLOSURE' '(' NAME ',' NAME lits ')' ';'
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
do lits <- sequence $6;
staticClosure pkg $3 $5 (map getLit lits) }
@@ -398,7 +398,7 @@ cmmdata :: { CmmParse () }
data_label :: { CmmParse CLabel }
: NAME ':'
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
return (mkCmmDataLabel pkg $1) }
statics :: { [CmmParse [CmmStatic]] }
@@ -455,14 +455,14 @@ maybe_body :: { CmmParse () }
info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
: NAME
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
do newFunctionName $1 pkg
return (mkCmmCodeLabel pkg $1, Nothing, []) }
| 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
-- ptrs, nptrs, closure type, description, type
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
do dflags <- getDynFlags
let prof = profilingInfo dflags $11 $13
rep = mkRTSRep (fromIntegral $9) $
@@ -478,7 +478,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
-- ptrs, nptrs, closure type, description, type, fun type
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
do dflags <- getDynFlags
let prof = profilingInfo dflags $11 $13
ty = Fun 0 (ArgSpec (fromIntegral $15))
@@ -496,7 +496,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
| 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
-- ptrs, nptrs, tag, closure type, description, type
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
do dflags <- getDynFlags
let prof = profilingInfo dflags $13 $15
ty = Constr (fromIntegral $9) -- Tag
@@ -515,7 +515,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
| 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
-- selector, closure type, description, type
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
do dflags <- getDynFlags
let prof = profilingInfo dflags $9 $11
ty = ThunkSelector (fromIntegral $5)
@@ -529,7 +529,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
-- closure type (no live regs)
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
do let prof = NoProfilingInfo
rep = mkRTSRep (fromIntegral $5) $ mkStackRep []
return (mkCmmRetLabel pkg $3,
@@ -540,7 +540,7 @@ info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
-- closure type, live regs
- {% liftP . withHomeUnit $ \pkg ->
+ {% liftP . withHomeUnitId $ \pkg ->
do dflags <- getDynFlags
let platform = targetPlatform dflags
live <- sequence $7
@@ -583,9 +583,9 @@ importName
| 'CLOSURE' NAME
{ ($2, mkForeignLabel $2 Nothing ForeignLabelInExternalPackage IsData) }
- -- A label imported with an explicit packageId.
+ -- A label imported with an explicit UnitId.
| STRING NAME
- { ($2, mkCmmCodeLabel (fsToUnit (mkFastString $1)) $2) }
+ { ($2, mkCmmCodeLabel (UnitId (mkFastString $1)) $2) }
names :: { [FastString] }
@@ -1163,7 +1163,7 @@ profilingInfo dflags desc_str ty_str
then NoProfilingInfo
else ProfilingInfo (BS8.pack desc_str) (BS8.pack ty_str)
-staticClosure :: Unit -> FastString -> FastString -> [CmmLit] -> CmmParse ()
+staticClosure :: UnitId -> FastString -> FastString -> [CmmLit] -> CmmParse ()
staticClosure pkg cl_label info payload
= do dflags <- getDynFlags
let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index cc408ca46f..44e34aedbf 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -1556,9 +1556,9 @@ lookupNaturalSDataConName dflags hsc_env = case integerLibrary dflags of
-- | Helper for 'lookupMkIntegerName', 'lookupIntegerSDataConName'
guardIntegerUse :: DynFlags -> IO a -> IO a
guardIntegerUse dflags act
- | homeUnit dflags == primUnitId
+ | homeUnitId dflags == primUnitId
= return $ panic "Can't use Integer in ghc-prim"
- | homeUnit dflags == integerUnitId
+ | homeUnitId dflags == integerUnitId
= return $ panic "Can't use Integer in integer-*"
| otherwise = act
@@ -1568,11 +1568,11 @@ guardIntegerUse dflags act
-- literals in `base`. If we do, we get interface loading error for GHC.Natural.
guardNaturalUse :: DynFlags -> IO a -> IO a
guardNaturalUse dflags act
- | homeUnit dflags == primUnitId
+ | homeUnitId dflags == primUnitId
= return $ panic "Can't use Natural in ghc-prim"
- | homeUnit dflags == integerUnitId
+ | homeUnitId dflags == integerUnitId
= return $ panic "Can't use Natural in integer-*"
- | homeUnit dflags == baseUnitId
+ | homeUnitId dflags == baseUnitId
= return $ panic "Can't use Natural in base"
| otherwise = act
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 2c04fb8b37..9dd5aeba85 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -366,7 +366,7 @@ buildUnit session cid insts lunit = do
compileExe :: LHsUnit HsComponentId -> BkpM ()
compileExe lunit = do
- msgUnitId mainUnitId
+ msgUnitId mainUnit
let deps_w_rns = hsunitDeps False (unLoc lunit)
deps = map fst deps_w_rns
-- no renaming necessary
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index db9b331d34..e9ac354090 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -131,7 +131,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 = unsafeLookupUnit (pkgState dflags) rtsUnitId
+ let rts = unsafeLookupUnitId (pkgState dflags) rtsUnitId
let cc_injects = unlines (map mk_include (unitIncludes rts))
mk_include h_file =
@@ -223,7 +223,7 @@ outputForeignStubs dflags mod location stubs
-- we need the #includes from the rts package for the stub files
let rts_includes =
- let rts_pkg = unsafeLookupUnit (pkgState dflags) rtsUnitId in
+ let rts_pkg = unsafeLookupUnitId (pkgState dflags) rtsUnitId in
concatMap mk_include (unitIncludes rts_pkg)
mk_include i = "#include \"" ++ i ++ "\"\n"
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index 09ef8e2d25..c3332a663c 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -345,7 +345,7 @@ findPackageModule hsc_env mod = do
pkg_id = moduleUnit mod
pkgstate = pkgState dflags
--
- case lookupInstalledPackage pkgstate pkg_id of
+ case lookupUnitId pkgstate pkg_id of
Nothing -> return (InstalledNoPackage pkg_id)
Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index e5381e188f..5d9abc254a 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1218,7 +1218,7 @@ checkPkgTrust pkgs = do
let errors = S.foldr go [] pkgs
state = pkgState dflags
go pkg acc
- | unitIsTrusted $ getInstalledPackageDetails state pkg
+ | unitIsTrusted $ unsafeLookupUnitId state pkg
= acc
| otherwise
= (:acc) $ mkErrMsg dflags noSrcSpan (pkgQual state)
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index bbc44a4653..5465ebefd9 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -515,7 +515,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
-- not extra_libraries or -l things from the command line.
let pkgstate = pkgState dflags
let pkg_hslibs = [ (collectLibraryPaths dflags [c], lib)
- | Just c <- map (lookupInstalledPackage pkgstate) pkg_deps,
+ | Just c <- map (lookupUnitId pkgstate) pkg_deps,
lib <- packageHsLibs dflags c ]
pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs
@@ -1312,7 +1312,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 &&
- homeUnit dflags == baseUnitId
+ homeUnitId dflags == baseUnitId
then [ "-DCOMPILING_BASE_PACKAGE" ]
else [])
@@ -2223,7 +2223,7 @@ getGhcVersionPathName dflags = do
candidates <- case ghcVersionFile dflags of
Just path -> return [path]
Nothing -> (map (</> "ghcversion.h")) <$>
- (getPackageIncludePath dflags [toUnitId rtsUnitId])
+ (getPackageIncludePath dflags [rtsUnitId])
found <- filterM doesFileExist candidates
case found of
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 694874a179..9f4c30096e 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -1329,7 +1329,7 @@ defaultDynFlags mySettings llvmConfig =
reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH,
solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS,
- homeUnitId = toUnitId mainUnitId,
+ homeUnitId = mainUnitId,
homeUnitInstanceOfId = Nothing,
homeUnitInstantiations = [],
@@ -1980,7 +1980,7 @@ homeUnit dflags =
-- detect fully indefinite units: all their instantiations are hole
-- modules and the home unit id is the same as the instantiating unit
-- id (see Note [About units] in GHC.Unit)
- | all (isHoleModule . snd) is && u == homeUnitId dflags
+ | all (isHoleModule . snd) is && indefUnit u == homeUnitId dflags
-> mkVirtUnit (updateIndefUnitId (pkgState dflags) u) is
-- otherwise it must be that we compile a fully definite units
-- TODO: error when the unit is partially instantiated??
@@ -4637,10 +4637,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 mainUnitId (mkModuleName main_mod) }
+ mainModIs = mkModule mainUnit (mkModuleName main_mod) }
| isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar"
- = upd $ \d -> d { mainModIs = mkModule mainUnitId (mkModuleName arg) }
+ = upd $ \d -> d { mainModIs = mkModule mainUnit (mkModuleName arg) }
| otherwise -- The arg looked like "baz"
= upd $ \d -> d { mainFunIs = Just arg }
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index 1b5591793b..3ddd4b1b26 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -1852,7 +1852,7 @@ shadowed_by ids = shadowed
setInteractivePackage :: HscEnv -> HscEnv
setInteractivePackage hsc_env
= hsc_env { hsc_dflags = (hsc_dflags hsc_env)
- { homeUnitId = toUnitId interactiveUnitId } }
+ { homeUnitId = interactiveUnitId } }
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName ic n = ic{ic_int_print = n}
@@ -2030,7 +2030,7 @@ mkQualModule dflags mod
-- with a unit id if the package ID would be ambiguous.
mkQualPackage :: PackageState -> QueryQualifyPackage
mkQualPackage pkgs uid
- | uid == mainUnitId || uid == interactiveUnitId
+ | uid == mainUnit || uid == interactiveUnit
-- Skip the lookup if it's main, since it won't be in the package
-- database!
= False
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 81b95fba67..816768cc09 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -180,7 +180,7 @@ writeMixEntries dflags mod count entries filename
mod_name = moduleNameString (moduleName mod)
hpc_mod_dir
- | moduleUnit mod == mainUnitId = hpc_dir
+ | moduleUnit mod == mainUnit = hpc_dir
| otherwise = hpc_dir ++ "/" ++ unitString (moduleUnit mod)
tabStop = 8 -- <tab> counts as a normal char in GHC's
@@ -1337,7 +1337,7 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo)
package_name = hcat (map (text.charToC) $ BS.unpack $
bytesFS (unitFS (moduleUnit this_mod)))
full_name_str
- | moduleUnit this_mod == mainUnitId
+ | moduleUnit this_mod == mainUnit
= module_name
| otherwise
= package_name <> char '/' <> module_name
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 97ab4ba89a..c68248744f 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -86,7 +86,7 @@ mkDependencies iuid pluginModules
raw_pkgs = foldr Set.insert (imp_dep_pkgs imports) plugin_dep_pkgs
- pkgs | th_used = Set.insert (toUnitId thUnitId) raw_pkgs
+ pkgs | th_used = Set.insert thUnitId raw_pkgs
| otherwise = raw_pkgs
-- Set the packages required to be Safe according to Safe Haskell.
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 542af41557..6778d5aa3f 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -55,7 +55,7 @@ module GHC.Parser.Lexer (
appendError,
allocateComments,
MonadP(..),
- getRealSrcLoc, getPState, withHomeUnit,
+ getRealSrcLoc, getPState, withHomeUnitId,
failMsgP, failLocMsgP, srcParseFail,
getErrorMessages, getMessages,
popContext, pushModuleContext, setLastToken, setSrcLoc,
@@ -2088,7 +2088,7 @@ warnopt f options = f `EnumSet.member` pWarningFlags options
-- See 'mkParserFlags' or 'mkParserFlags'' for ways to construct this.
data ParserFlags = ParserFlags {
pWarningFlags :: EnumSet WarningFlag
- , pHomeUnit :: Unit -- ^ unit currently being compiled
+ , pHomeUnitId :: UnitId -- ^ unit currently being compiled
, pExtsBitmap :: !ExtsBitmap -- ^ bitmap of permitted extensions
}
@@ -2183,8 +2183,8 @@ failLocMsgP loc1 loc2 str =
getPState :: P PState
getPState = P $ \s -> POk s s
-withHomeUnit :: (Unit -> a) -> P a
-withHomeUnit f = P $ \s@(PState{options = o}) -> POk s (f (pHomeUnit o))
+withHomeUnitId :: (UnitId -> a) -> P a
+withHomeUnitId f = P $ \s@(PState{options = o}) -> POk s (f (pHomeUnitId o))
getExts :: P ExtsBitmap
getExts = P $ \s -> POk s (pExtsBitmap . options $ s)
@@ -2500,7 +2500,7 @@ pragState dynflags buf loc = (mkPState dynflags buf loc) {
mkParserFlags'
:: EnumSet WarningFlag -- ^ warnings flags enabled
-> EnumSet LangExt.Extension -- ^ permitted language extensions enabled
- -> Unit -- ^ key of package currently being compiled
+ -> UnitId -- ^ id of the unit currently being compiled
-> Bool -- ^ are safe imports on?
-> Bool -- ^ keeping Haddock comment tokens
-> Bool -- ^ keep regular comment tokens
@@ -2512,11 +2512,11 @@ mkParserFlags'
-> ParserFlags
-- ^ Given exactly the information needed, set up the 'ParserFlags'
-mkParserFlags' warningFlags extensionFlags homeUnit
+mkParserFlags' warningFlags extensionFlags homeUnitId
safeImports isHaddock rawTokStream usePosPrags =
ParserFlags {
pWarningFlags = warningFlags
- , pHomeUnit = homeUnit
+ , pHomeUnitId = homeUnitId
, pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits
}
where
@@ -2578,7 +2578,7 @@ mkParserFlags =
mkParserFlags'
<$> DynFlags.warningFlags
<*> DynFlags.extensionFlags
- <*> DynFlags.homeUnit
+ <*> DynFlags.homeUnitId
<*> safeImportsOn
<*> gopt Opt_Haddock
<*> gopt Opt_KeepRawTokenStream
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 22cd871fad..e45fce9bcc 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -143,7 +143,7 @@ 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 = map toUnitId [rtsUnitId]
+ where init_pkgs = [rtsUnitId]
extendLoadedPkgs :: DynLinker -> [UnitId] -> IO ()
extendLoadedPkgs dl pkgs =
@@ -1261,7 +1261,7 @@ linkPackages' hsc_env new_pks pls = do
| new_pkg `elem` pkgs -- Already linked
= return pkgs
- | Just pkg_cfg <- lookupInstalledPackage pkgstate new_pkg
+ | Just pkg_cfg <- lookupUnitId pkgstate new_pkg
= do { -- Link dependents first
pkgs' <- link pkgs (unitDepends pkg_cfg)
-- Now link the package itself
diff --git a/compiler/GHC/StgToCmm/ExtCode.hs b/compiler/GHC/StgToCmm/ExtCode.hs
index 49f6a21b9c..e0b20021b3 100644
--- a/compiler/GHC/StgToCmm/ExtCode.hs
+++ b/compiler/GHC/StgToCmm/ExtCode.hs
@@ -61,7 +61,7 @@ data Named
= VarN CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
-- eg, RtsLabel, ForeignLabel, CmmLabel etc.
- | FunN Unit -- ^ A function name from this package
+ | FunN UnitId -- ^ A function name from this unit
| LabelN BlockId -- ^ A blockid of some code or data.
-- | An environment of named things.
@@ -165,7 +165,7 @@ newLabel name = do
-- | Add add a local function to the environment.
newFunctionName
:: FastString -- ^ name of the function
- -> Unit -- ^ package of the current module
+ -> UnitId -- ^ package of the current module
-> ExtCode
newFunctionName name pkg = addDecl name (FunN pkg)
@@ -204,7 +204,7 @@ lookupName name = do
return $
case lookupUFM env name of
Just (VarN e) -> e
- Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name))
+ Just (FunN uid) -> CmmLit (CmmLabel (mkCmmCodeLabel uid name))
_other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsUnitId name))
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index b0f9fddad6..e70f50ee84 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -42,7 +42,7 @@ import GHC.Cmm.BlockId
import GHC.Cmm.Graph
import GHC.Stg.Syntax
import GHC.Cmm
-import GHC.Unit ( rtsUnitId )
+import GHC.Unit ( rtsUnit )
import GHC.Core.Type ( Type, tyConAppTyCon )
import GHC.Core.TyCon
import GHC.Cmm.CLabel
@@ -3043,7 +3043,7 @@ emitCopyUpdRemSetPush platform hdr_size dst dst_off n =
emit graph
where
lbl = mkLblExpr $ mkPrimCallLabel
- $ PrimCall (fsLit "stg_copyArray_barrier") rtsUnitId
+ $ PrimCall (fsLit "stg_copyArray_barrier") rtsUnit
args =
[ mkIntExpr platform hdr_size
, dst
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 3815c2b698..6367f5e839 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -180,10 +180,10 @@ tagToClosure platform tycon tag
--
-------------------------------------------------------------------------
-emitRtsCall :: Unit -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
+emitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
emitRtsCall pkg fun args safe = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) args safe
-emitRtsCallWithResult :: LocalReg -> ForeignHint -> Unit -> FastString
+emitRtsCallWithResult :: LocalReg -> ForeignHint -> UnitId -> FastString
-> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
emitRtsCallWithResult res hint pkg fun args safe
= emitRtsCallGen [(res,hint)] (mkCmmCodeLabel pkg fun) args safe
diff --git a/compiler/GHC/SysTools.hs b/compiler/GHC/SysTools.hs
index 036220b7c1..04bfea46ce 100644
--- a/compiler/GHC/SysTools.hs
+++ b/compiler/GHC/SysTools.hs
@@ -276,7 +276,7 @@ linkDynLib dflags0 o_files dep_packages
OSMinGW32 ->
pkgs
_ ->
- filter ((/= rtsUnitId) . mkUnit) pkgs
+ filter ((/= rtsUnitId) . unitId) 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
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs
index ef04468ebd..789a3ed661 100644
--- a/compiler/GHC/SysTools/ExtraObj.hs
+++ b/compiler/GHC/SysTools/ExtraObj.hs
@@ -57,7 +57,7 @@ mkExtraObj dflags extn xs
-- set of include directories and PIC flags.
cOpts = map Option (picCCOpts dflags)
++ map (FileOption "-I")
- (unitIncludeDirs $ unsafeLookupUnit pkgs rtsUnitId)
+ (unitIncludeDirs $ unsafeLookupUnit pkgs rtsUnit)
-- When compiling assembler code, we drop the usual C options, and if the
-- compiler is Clang, we add an extra argument to tell Clang to ignore
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 41bc8cd269..d38b7adcbd 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -2174,7 +2174,7 @@ sameOccExtra ty1 ty2
| otherwise -- Imported things have an UnhelpfulSrcSpan
= hang (quotes (ppr nm))
2 (sep [ text "is defined in" <+> quotes (ppr (moduleName mod))
- , ppUnless (same_pkg || pkg == mainUnitId) $
+ , ppUnless (same_pkg || pkg == mainUnit) $
nest 4 $ text "in package" <+> quotes (ppr pkg) ])
where
pkg = moduleUnit mod
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 66733b0618..5643ec05fb 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -568,7 +568,7 @@ mergeSignatures
let insts = instUnitInsts iuid
isFromSignaturePackage =
let inst_uid = instUnitInstanceOf iuid
- pkg = getInstalledPackageDetails pkgstate (indefUnit inst_uid)
+ pkg = unsafeLookupUnitId pkgstate (indefUnit inst_uid)
in null (unitExposedModules pkg)
-- 3(a). Rename the exports according to how the dependency
-- was instantiated. The resulting export list will be accurate
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 5030c61fd3..ca85a087b6 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -265,7 +265,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_rdr_env = emptyGlobalRdrEnv,
tcg_fix_env = emptyNameEnv,
tcg_field_env = emptyNameEnv,
- tcg_default = if moduleUnit mod == primUnitId
+ tcg_default = if moduleUnit mod == primUnit
then Just [] -- See Note [Default types]
else Nothing,
tcg_type_env = emptyNameEnv,
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs
index 917c55bca6..d348f7e9e2 100644
--- a/compiler/GHC/Unit/Info.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -167,9 +167,9 @@ expandedUnitInfoId p =
definiteUnitInfoId :: UnitInfo -> Maybe DefUnitId
definiteUnitInfoId p =
- case mkUnit p of
- RealUnit def_uid -> Just def_uid
- _ -> Nothing
+ if unitIsIndefinite p
+ then Nothing
+ else Just (Definite (unitId p))
-- | Create a UnitPprInfo from a UnitInfo
mkUnitPprInfo :: GenUnitInfo u -> UnitPprInfo
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 64c4fdaee2..7f81605435 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -21,12 +21,14 @@ module GHC.Unit.State (
-- * Querying the package config
lookupUnit,
lookupUnit',
- lookupInstalledPackage,
+ unsafeLookupUnit,
+ lookupUnitId,
+ lookupUnitId',
+ unsafeLookupUnitId,
+
lookupPackageName,
improveUnit,
searchPackageId,
- unsafeLookupUnit,
- getInstalledPackageDetails,
displayUnitId,
listVisibleModuleNames,
lookupModuleInAllPackages,
@@ -393,7 +395,7 @@ type InstalledPackageIndex = Map UnitId UnitInfo
emptyUnitInfoMap :: UnitInfoMap
emptyUnitInfoMap = UnitInfoMap emptyUDFM emptyUniqSet
--- | Find the unit we know about with the given unit id, if any
+-- | Find the unit we know about with the given unit, if any
lookupUnit :: PackageState -> Unit -> Maybe UnitInfo
lookupUnit pkgs = lookupUnit' (allowVirtualUnits pkgs) (unitInfoMap pkgs)
@@ -409,6 +411,28 @@ lookupUnit' True m@(UnitInfoMap pkg_map _) uid = case uid of
VirtUnit i -> fmap (renamePackage m (instUnitInsts i))
(lookupUDFM pkg_map (instUnitInstanceOf i))
+-- | Find the unit we know about with the given unit id, if any
+lookupUnitId :: PackageState -> UnitId -> Maybe UnitInfo
+lookupUnitId state uid = lookupUnitId' (unitInfoMap state) uid
+
+-- | Find the unit we know about with the given unit id, if any
+lookupUnitId' :: UnitInfoMap -> UnitId -> Maybe UnitInfo
+lookupUnitId' (UnitInfoMap db _) uid = lookupUDFM db uid
+
+
+-- | Looks up the given unit in the package state, panicing if it is not found
+unsafeLookupUnit :: HasDebugCallStack => PackageState -> Unit -> UnitInfo
+unsafeLookupUnit state u = case lookupUnit state u of
+ Just info -> info
+ Nothing -> pprPanic "unsafeLookupUnit" (ppr u)
+
+-- | Looks up the given unit id in the package state, panicing if it is not found
+unsafeLookupUnitId :: HasDebugCallStack => PackageState -> UnitId -> UnitInfo
+unsafeLookupUnitId state uid = case lookupUnitId state uid of
+ Just info -> info
+ Nothing -> pprPanic "unsafeLookupUnitId" (ppr uid)
+
+
-- | Find the package we know about with the given package name (e.g. @foo@), if any
-- (NB: there might be a locally defined unit name which overrides this)
lookupPackageName :: PackageState -> PackageName -> Maybe IndefUnitId
@@ -429,26 +453,6 @@ extendUnitInfoMap (UnitInfoMap pkg_map closure) new_pkgs
where add pkg_map p = addToUDFM (addToUDFM pkg_map (expandedUnitInfoId p) p)
(unitId p) p
--- | Looks up the package with the given id in the package state, panicing if it is
--- not found
-unsafeLookupUnit :: HasDebugCallStack => PackageState -> Unit -> UnitInfo
-unsafeLookupUnit pkgs pid =
- case lookupUnit pkgs pid of
- Just info -> info
- Nothing -> pprPanic "unsafeLookupUnit" (ppr pid)
-
-lookupInstalledPackage :: PackageState -> UnitId -> Maybe UnitInfo
-lookupInstalledPackage pkgstate uid = lookupInstalledPackage' (unitInfoMap pkgstate) uid
-
-lookupInstalledPackage' :: UnitInfoMap -> UnitId -> Maybe UnitInfo
-lookupInstalledPackage' (UnitInfoMap db _) uid = lookupUDFM db uid
-
-getInstalledPackageDetails :: HasDebugCallStack => PackageState -> UnitId -> UnitInfo
-getInstalledPackageDetails pkgstate uid =
- case lookupInstalledPackage pkgstate uid of
- Just config -> config
- Nothing -> pprPanic "getInstalledPackageDetails" (ppr uid)
-
-- | Get a list of entries from the package database. NB: be careful with
-- this function, although all packages in this map are "visible", this
-- does not imply that the exposed-modules of the package are available
@@ -945,12 +949,9 @@ pprTrustFlag flag = case flag of
--
-- See Note [Wired-in units] in GHC.Unit.Module
-type WiredInUnitId = String
+type WiredInUnitId = UnitId
type WiredPackagesMap = Map WiredUnitId WiredUnitId
-wired_in_unitids :: [WiredInUnitId]
-wired_in_unitids = map unitString wiredInUnitIds
-
findWiredInPackages
:: DynFlags
-> PackagePrecedenceIndex
@@ -968,9 +969,9 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
matches :: UnitInfo -> WiredInUnitId -> Bool
pc `matches` pid
-- See Note [The integer library] in GHC.Builtin.Names
- | pid == unitString integerUnitId
+ | pid == integerUnitId
= unitPackageNameString pc `elem` ["integer-gmp", "integer-simple"]
- pc `matches` pid = unitPackageNameString pc == pid
+ pc `matches` pid = unitPackageName pc == PackageName (unitIdFS pid)
-- find which package corresponds to each wired-in package
-- delete any other packages with the same name
@@ -1005,7 +1006,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
notfound = do
debugTraceMsg dflags 2 $
text "wired-in package "
- <> text wired_pkg
+ <> ftext (unitIdFS wired_pkg)
<> text " not found."
return Nothing
pick :: UnitInfo
@@ -1013,20 +1014,20 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
pick pkg = do
debugTraceMsg dflags 2 $
text "wired-in package "
- <> text wired_pkg
+ <> ftext (unitIdFS wired_pkg)
<> text " mapped to "
<> ppr (unitId pkg)
return (Just (wired_pkg, pkg))
- mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wired_in_unitids
+ mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wiredInUnitIds
let
wired_in_pkgs = catMaybes mb_wired_in_pkgs
pkgstate = pkgState dflags
wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap = Map.fromList
- [ (key, Definite (stringToUnitId wiredInUnitId))
+ [ (key, Definite wiredInUnitId)
| (wiredInUnitId, pkg) <- wired_in_pkgs
, Just key <- pure $ definiteUnitInfoId pkg
]
@@ -1542,7 +1543,8 @@ mkPackageState dflags dbs preload0 = do
-- add base & rts to the preload packages
basicLinkedPackages
| gopt Opt_AutoLinkPackages dflags
- = filter (flip elemUDFM (unUnitInfoMap pkg_db))
+ = fmap (RealUnit . Definite) $
+ filter (flip elemUDFM (unUnitInfoMap pkg_db))
[baseUnitId, rtsUnitId]
| otherwise = []
-- but in any case remove the current package from the set of
@@ -1991,7 +1993,7 @@ getPreloadPackagesAnd dflags pkgids0 =
pairs = zip pkgids (repeat Nothing)
in do
all_pkgs <- throwErr dflags (foldM (add_package dflags pkg_map) preload pairs)
- return (map (getInstalledPackageDetails state) all_pkgs)
+ return (map (unsafeLookupUnitId state) all_pkgs)
-- Takes a list of packages, and returns the list with dependencies included,
-- in reverse dependency order (a package appears before those it depends on).
@@ -2023,7 +2025,7 @@ add_package :: DynFlags
add_package dflags pkg_db ps (p, mb_parent)
| p `elem` ps = return ps -- Check if we've already added this package
| otherwise =
- case lookupInstalledPackage' pkg_db p of
+ case lookupUnitId' pkg_db p of
Nothing -> Failed (missingPackageMsg p <>
missingDependencyMsg mb_parent)
Just pkg -> do
@@ -2062,7 +2064,7 @@ missingDependencyMsg (Just parent)
mkIndefUnitId :: PackageState -> FastString -> IndefUnitId
mkIndefUnitId pkgstate raw =
let uid = UnitId raw
- in case lookupInstalledPackage pkgstate uid of
+ in case lookupUnitId pkgstate uid of
Nothing -> Indefinite uid Nothing -- we didn't find the unit at all
Just c -> Indefinite uid $ Just $ mkUnitPprInfo c
@@ -2073,7 +2075,7 @@ updateIndefUnitId pkgstate uid = mkIndefUnitId pkgstate (unitIdFS (indefUnit uid
displayUnitId :: PackageState -> UnitId -> Maybe String
displayUnitId pkgstate uid =
- fmap unitPackageIdString (lookupInstalledPackage pkgstate uid)
+ fmap unitPackageIdString (lookupUnitId pkgstate uid)
-- -----------------------------------------------------------------------------
-- Displaying packages
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 6e04526607..63816d5b09 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -62,6 +62,16 @@ module GHC.Unit.Types
, mainUnitId
, thisGhcUnitId
, interactiveUnitId
+
+ , primUnit
+ , integerUnit
+ , baseUnit
+ , rtsUnit
+ , thUnit
+ , mainUnit
+ , thisGhcUnit
+ , interactiveUnit
+
, isInteractiveModule
, wiredInUnitIds
@@ -162,7 +172,7 @@ pprModule mod@(Module p n) = getPprStyle doc
where
doc sty
| codeStyle sty =
- (if p == mainUnitId
+ (if p == mainUnit
then empty -- never qualify the main package in code
else ztext (zEncodeFS (unitFS p)) <> char '_')
<> pprModuleName n
@@ -612,27 +622,38 @@ For `integer-gmp`/`integer-simple` we also change the base name to
See Note [The integer library] in "GHC.Builtin.Names".
-}
-integerUnitId, primUnitId,
- baseUnitId, rtsUnitId,
- thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: Unit
-primUnitId = fsToUnit (fsLit "ghc-prim")
-integerUnitId = fsToUnit (fsLit "integer-wired-in")
- -- See Note [The integer library] in "GHC.Builtin.Names"
-baseUnitId = fsToUnit (fsLit "base")
-rtsUnitId = fsToUnit (fsLit "rts")
-thUnitId = fsToUnit (fsLit "template-haskell")
-thisGhcUnitId = fsToUnit (fsLit "ghc")
-interactiveUnitId = fsToUnit (fsLit "interactive")
+integerUnitId, primUnitId, baseUnitId, rtsUnitId,
+ thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
+
+integerUnit, primUnit, baseUnit, rtsUnit,
+ thUnit, mainUnit, thisGhcUnit, interactiveUnit :: Unit
+
+primUnitId = UnitId (fsLit "ghc-prim")
+integerUnitId = UnitId (fsLit "integer-wired-in")
+baseUnitId = UnitId (fsLit "base")
+rtsUnitId = UnitId (fsLit "rts")
+thisGhcUnitId = UnitId (fsLit "ghc")
+interactiveUnitId = UnitId (fsLit "interactive")
+thUnitId = UnitId (fsLit "template-haskell")
+
+thUnit = RealUnit (Definite thUnitId)
+primUnit = RealUnit (Definite primUnitId)
+integerUnit = RealUnit (Definite integerUnitId)
+baseUnit = RealUnit (Definite baseUnitId)
+rtsUnit = RealUnit (Definite rtsUnitId)
+thisGhcUnit = RealUnit (Definite thisGhcUnitId)
+interactiveUnit = RealUnit (Definite interactiveUnitId)
-- | 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.
-mainUnitId = fsToUnit (fsLit "main")
+mainUnitId = UnitId (fsLit "main")
+mainUnit = RealUnit (Definite mainUnitId)
isInteractiveModule :: Module -> Bool
-isInteractiveModule mod = moduleUnit mod == interactiveUnitId
+isInteractiveModule mod = moduleUnit mod == interactiveUnit
-wiredInUnitIds :: [Unit]
+wiredInUnitIds :: [UnitId]
wiredInUnitIds =
[ primUnitId
, integerUnitId