Commit 72d08610 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Refactor homeUnit

* rename thisPackage into homeUnit
* document and refactor several Backpack things
parent 7a02599a
......@@ -1489,7 +1489,7 @@ findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
let
dflags = hsc_dflags hsc_env
this_pkg = thisPackage dflags
this_pkg = homeUnit dflags
--
case maybe_pkg of
Just pkg | fsToUnit pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
......
......@@ -377,7 +377,7 @@ cmmtop :: { CmmParse () }
| cmmdata { $1 }
| decl { $1 }
| 'CLOSURE' '(' NAME ',' NAME lits ')' ';'
{% liftP . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \pkg ->
do lits <- sequence $6;
staticClosure pkg $3 $5 (map getLit lits) }
......@@ -398,7 +398,7 @@ cmmdata :: { CmmParse () }
data_label :: { CmmParse CLabel }
: NAME ':'
{% liftP . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \pkg ->
return (mkCmmDataLabel pkg $1) }
statics :: { [CmmParse [CmmStatic]] }
......@@ -455,14 +455,14 @@ maybe_body :: { CmmParse () }
info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
: NAME
{% liftP . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \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 . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \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 . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \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 . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \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 . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \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 . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \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 . withThisPackage $ \pkg ->
{% liftP . withHomeUnit $ \pkg ->
do dflags <- getDynFlags
let platform = targetPlatform dflags
live <- sequence $7
......
......@@ -149,7 +149,7 @@ mkNatM_State us delta dflags this_mod
initConfig :: DynFlags -> NCGConfig
initConfig dflags = NCGConfig
{ ncgPlatform = targetPlatform dflags
, ncgUnitId = thisPackage dflags
, ncgUnitId = homeUnit dflags
, ncgProcAlignment = cmmProcAlignment dflags
, ncgDebugLevel = debugLevel dflags
, ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
......
......@@ -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
| thisPackage dflags == primUnitId
| homeUnit dflags == primUnitId
= return $ panic "Can't use Integer in ghc-prim"
| thisPackage dflags == integerUnitId
| homeUnit 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
| thisPackage dflags == primUnitId
| homeUnit dflags == primUnitId
= return $ panic "Can't use Natural in ghc-prim"
| thisPackage dflags == integerUnitId
| homeUnit dflags == integerUnitId
= return $ panic "Can't use Natural in integer-*"
| thisPackage dflags == baseUnitId
| homeUnit dflags == baseUnitId
= return $ panic "Can't use Natural in base"
| otherwise = act
......
......@@ -171,9 +171,12 @@ withBkpSession cid insts deps session_type do_this = do
hscTarget = case session_type of
TcSession -> HscNothing
_ -> hscTarget dflags,
thisUnitIdInsts_ = Just insts,
thisComponentId_ = Just cid,
thisUnitId =
homeUnitInstantiations = insts,
-- if we don't have any instantiation, don't
-- fill `homeUnitInstanceOfId` as it makes no
-- sense (we're not instantiating anything)
homeUnitInstanceOfId = if null insts then Nothing else Just cid,
homeUnitId =
case session_type of
TcSession -> newUnitId cid Nothing
-- No hash passed if no instances
......@@ -312,7 +315,7 @@ buildUnit session cid insts lunit = do
unitPackageId = PackageId compat_fs,
unitPackageName = compat_pn,
unitPackageVersion = makeVersion [],
unitId = toUnitId (thisPackage dflags),
unitId = toUnitId (homeUnit dflags),
unitComponentName = Nothing,
unitInstanceOf = cid,
unitInstantiations = insts,
......@@ -652,7 +655,7 @@ hsunitModuleGraph dflags unit = do
-- requirement.
let node_map = Map.fromList [ ((ms_mod_name n, ms_hsc_src n == HsigFile), n)
| n <- nodes ]
req_nodes <- fmap catMaybes . forM (thisUnitIdInsts dflags) $ \(mod_name, _) ->
req_nodes <- fmap catMaybes . forM (homeUnitInstantiations dflags) $ \(mod_name, _) ->
let has_local = Map.member (mod_name, True) node_map
in if has_local
then return Nothing
......
......@@ -74,7 +74,7 @@ flushFinderCaches :: HscEnv -> IO ()
flushFinderCaches hsc_env =
atomicModifyIORef' fc_ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
where
this_pkg = thisPackage (hsc_dflags hsc_env)
this_pkg = homeUnit (hsc_dflags hsc_env)
fc_ref = hsc_FC hsc_env
is_ext mod _ | not (moduleUnit mod `unitIdEq` this_pkg) = True
| otherwise = False
......@@ -135,7 +135,7 @@ findPluginModule hsc_env mod_name =
findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
findExactModule hsc_env mod =
let dflags = hsc_dflags hsc_env
in if moduleUnit mod `unitIdEq` thisPackage dflags
in if moduleUnit mod `unitIdEq` homeUnit dflags
then findInstalledHomeModule hsc_env (moduleName mod)
else findPackageModule hsc_env mod
......@@ -245,7 +245,7 @@ modLocationCache hsc_env mod do_this = do
mkHomeInstalledModule :: DynFlags -> ModuleName -> InstalledModule
mkHomeInstalledModule dflags mod_name =
let iuid = thisUnitId dflags
let iuid = homeUnitId dflags
in Module iuid mod_name
-- This returns a module because it's more convenient for users
......@@ -253,7 +253,7 @@ addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder hsc_env mod_name loc = do
let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
addToFinderCache (hsc_FC hsc_env) mod (InstalledFound loc mod)
return (mkModule (thisPackage (hsc_dflags hsc_env)) mod_name)
return (mkHomeModule (hsc_dflags hsc_env) mod_name)
uncacheModule :: HscEnv -> ModuleName -> IO ()
uncacheModule hsc_env mod_name = do
......@@ -279,7 +279,7 @@ findHomeModule hsc_env mod_name = do
}
where
dflags = hsc_dflags hsc_env
uid = thisPackage dflags
uid = homeUnit dflags
-- | Implements the search for a module name in the home package only. Calling
-- this function directly is usually *not* what you want; currently, it's used
......@@ -678,7 +678,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
NotFound { fr_paths = files, fr_pkg = mb_pkg
, fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
, fr_unusables = unusables, fr_suggestions = suggest }
| Just pkg <- mb_pkg, pkg /= thisPackage dflags
| Just pkg <- mb_pkg, pkg /= homeUnit dflags
-> not_found_in_package pkg files
| not (null suggest)
......@@ -794,7 +794,7 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
text "was found" $$ looks_like_srcpkgid pkg
InstalledNotFound files mb_pkg
| Just pkg <- mb_pkg, not (pkg `unitIdEq` thisPackage dflags)
| Just pkg <- mb_pkg, not (pkg `unitIdEq` homeUnit dflags)
-> not_found_in_package pkg files
| null files
......
......@@ -470,12 +470,12 @@ hsc_typecheck keep_rn mod_summary mb_rdr_module = do
dflags = hsc_dflags hsc_env
outer_mod = ms_mod mod_summary
mod_name = moduleName outer_mod
outer_mod' = mkModule (thisPackage dflags) mod_name
outer_mod' = mkHomeModule dflags mod_name
inner_mod = canonicalizeHomeModule dflags mod_name
src_filename = ms_hspp_file mod_summary
real_loc = realSrcLocSpan $ mkRealSrcLoc (mkFastString src_filename) 1 1
keep_rn' = gopt Opt_WriteHie dflags || keep_rn
MASSERT( moduleUnit outer_mod == thisPackage dflags )
MASSERT( isHomeModule dflags outer_mod )
tc_result <- if hsc_src == HsigFile && not (isHoleModule inner_mod)
then ioMsgMaybe $ tcRnInstantiateSignature hsc_env outer_mod' real_loc
else
......@@ -1116,8 +1116,8 @@ hscCheckSafe' m l = do
dflags <- getDynFlags
(tw, pkgs) <- isModSafe m l
case tw of
False -> return (Nothing, pkgs)
True | isHomePkg dflags m -> return (Nothing, pkgs)
False -> return (Nothing, pkgs)
True | isHomeModule dflags m -> return (Nothing, pkgs)
-- TODO: do we also have to check the trust of the instantiation?
-- Not necessary if that is reflected in dependencies
| otherwise -> return (Just $ toUnitId (moduleUnit m), pkgs)
......@@ -1191,7 +1191,7 @@ hscCheckSafe' m l = do
packageTrusted _ Sf_Safe False _ = True
packageTrusted _ Sf_SafeInferred False _ = True
packageTrusted dflags _ _ m
| isHomePkg dflags m = True
| isHomeModule dflags m = True
| otherwise = unitIsTrusted $ unsafeGetUnitInfo dflags (moduleUnit m)
lookup' :: Module -> Hsc (Maybe ModIface)
......@@ -1210,11 +1210,6 @@ hscCheckSafe' m l = do
return iface'
isHomePkg :: DynFlags -> Module -> Bool
isHomePkg dflags m
| thisPackage dflags == moduleUnit m = True
| otherwise = False
-- | Check the list of packages are trusted.
checkPkgTrust :: Set UnitId -> Hsc ()
checkPkgTrust pkgs = do
......@@ -1493,7 +1488,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
let -- Make up a module name to give the NCG. We can't pass bottom here
-- lest we reproduce #11784.
mod_name = mkModuleName $ "Cmm$" ++ FilePath.takeFileName filename
cmm_mod = mkModule (thisPackage dflags) mod_name
cmm_mod = mkHomeModule dflags mod_name
-- Compile decls in Cmm files one decl at a time, to avoid re-ordering
-- them in SRT analysis.
......
......@@ -656,7 +656,7 @@ discardIC hsc_env
| nameIsFromExternalPackage this_pkg old_name = old_name
| otherwise = ic_name empty_ic
where
this_pkg = thisPackage dflags
this_pkg = homeUnit dflags
old_name = ic_name old_ic
-- | If there is no -o option, guess the name of target executable
......@@ -1200,7 +1200,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup
zipWith f home_imps (repeat NotBoot) ++
zipWith f home_src_imps (repeat IsBoot)
where f mn isBoot = GWIB
{ gwib_mod = mkModule (thisPackage lcl_dflags) mn
{ gwib_mod = mkHomeModule lcl_dflags mn
, gwib_isBoot = isBoot
}
......@@ -2213,7 +2213,7 @@ enableCodeGenForTH =
hscTarget dflags == HscNothing &&
-- Don't enable codegen for TH on indefinite packages; we
-- can't compile anything anyway! See #16219.
not (isIndefinite dflags)
homeUnitIsDefinite dflags
-- | Update the every ModSummary that is depended on
-- by a module that needs unboxed tuples. We enable codegen to
......@@ -2560,12 +2560,12 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
$$ text "Saw:" <+> quotes (ppr pi_mod_name)
$$ text "Expected:" <+> quotes (ppr wanted_mod)
when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (thisUnitIdInsts dflags))) $
when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (homeUnitInstantiations dflags))) $
let suggested_instantiated_with =
hcat (punctuate comma $
[ ppr k <> text "=" <> ppr v
| (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name)
: thisUnitIdInsts dflags)
: homeUnitInstantiations dflags)
])
in throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $
text "Unexpected signature:" <+> quotes (ppr pi_mod_name)
......
......@@ -379,7 +379,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do
-- https://gitlab.haskell.org/ghc/ghc/issues/12673
-- and https://github.com/haskell/cabal/issues/2257
empty_stub <- newTempName dflags TFL_CurrentModule "c"
let src = text "int" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text "= 0;"
let src = text "int" <+> ppr (mkHomeModule dflags mod_name) <+> text "= 0;"
writeFile empty_stub (showSDoc dflags (pprCode CStyle src))
_ <- runPipeline StopLn hsc_env
(empty_stub, Nothing, Nothing)
......@@ -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 &&
thisPackage dflags == baseUnitId
homeUnit dflags == baseUnitId
then [ "-DCOMPILING_BASE_PACKAGE" ]
else [])
......
......@@ -66,7 +66,7 @@ module GHC.Driver.Session (
addWay', updateWays,
thisPackage, thisComponentId, thisUnitIdInsts,
homeUnit, mkHomeModule, isHomeModule,
-- ** Log output
putLogMsg,
......@@ -254,7 +254,7 @@ import GHC.Unit.Module
import {-# SOURCE #-} GHC.Driver.Plugins
import {-# SOURCE #-} GHC.Driver.Hooks
import GHC.Builtin.Names ( mAIN )
import {-# SOURCE #-} GHC.Unit.State (PackageState, emptyPackageState, PackageDatabase, mkIndefUnitId, updateIndefUnitId)
import {-# SOURCE #-} GHC.Unit.State (PackageState, emptyPackageState, PackageDatabase, updateIndefUnitId)
import GHC.Driver.Phases ( Phase(..), phaseInputExt )
import GHC.Driver.Flags
import GHC.Driver.Ways
......@@ -528,9 +528,9 @@ data DynFlags = DynFlags {
solverIterations :: IntWithInf, -- ^ Number of iterations in the constraints solver
-- Typically only 1 is needed
thisUnitId :: UnitId, -- ^ Target unit-id
thisComponentId_ :: Maybe IndefUnitId, -- ^ Unit-id to instantiate
thisUnitIdInsts_ :: Maybe [(ModuleName, Module)], -- ^ How to instantiate the unit-id above
homeUnitId :: UnitId, -- ^ Target home unit-id
homeUnitInstanceOfId :: Maybe IndefUnitId, -- ^ Unit-id to instantiate
homeUnitInstantiations:: [(ModuleName, Module)], -- ^ How to instantiate `homeUnitInstanceOfId` unit
-- ways
ways :: Set Way, -- ^ Way flags from the command line
......@@ -1329,9 +1329,9 @@ defaultDynFlags mySettings llvmConfig =
reductionDepth = treatZeroAsInf mAX_REDUCTION_DEPTH,
solverIterations = treatZeroAsInf mAX_SOLVER_ITERATIONS,
thisUnitId = toUnitId mainUnitId,
thisUnitIdInsts_ = Nothing,
thisComponentId_ = Nothing,
homeUnitId = toUnitId mainUnitId,
homeUnitInstanceOfId = Nothing,
homeUnitInstantiations = [],
objectDir = Nothing,
dylibInstallName = Nothing,
......@@ -1961,34 +1961,31 @@ setOutputHi f d = d { outputHi = f}
setJsonLogAction :: DynFlags -> DynFlags
setJsonLogAction d = d { log_action = jsonLogAction }
thisComponentId :: DynFlags -> IndefUnitId
thisComponentId dflags =
let pkgstate = pkgState dflags
in case thisComponentId_ dflags of
Just uid -> updateIndefUnitId pkgstate uid
Nothing ->
case thisUnitIdInsts_ dflags of
Just _ ->
throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")
Nothing -> mkIndefUnitId pkgstate (unitFS (thisPackage dflags))
thisUnitIdInsts :: DynFlags -> [(ModuleName, Module)]
thisUnitIdInsts dflags =
case thisUnitIdInsts_ dflags of
Just insts -> insts
Nothing -> []
thisPackage :: DynFlags -> Unit
thisPackage dflags =
case thisUnitIdInsts_ dflags of
Nothing -> default_uid
Just insts
| all (\(x,y) -> mkHoleModule x == y) insts
-> mkVirtUnit (thisComponentId dflags) insts
| otherwise
-> default_uid
where
default_uid = RealUnit (Definite (thisUnitId dflags))
-- | Make a module in home unit
mkHomeModule :: DynFlags -> ModuleName -> Module
mkHomeModule dflags = mkModule (homeUnit dflags)
-- | Test if the module comes from the home unit
isHomeModule :: DynFlags -> Module -> Bool
isHomeModule dflags m = moduleUnit m == homeUnit dflags
-- | Get home unit
homeUnit :: DynFlags -> Unit
homeUnit dflags =
case (homeUnitInstanceOfId dflags, homeUnitInstantiations dflags) of
(Nothing,[]) -> RealUnit (Definite (homeUnitId dflags))
(Nothing, _) -> throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")
(Just _, []) -> throwGhcException $ CmdLineError ("Use of -this-component-id requires -instantiated-with")
(Just u, is)
-- 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
-> 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??
| otherwise
-> RealUnit (Definite (homeUnitId dflags))
parseUnitInsts :: String -> Instantiations
parseUnitInsts str = case filter ((=="").snd) (readP_to_S parse str) of
......@@ -2001,13 +1998,13 @@ parseUnitInsts str = case filter ((=="").snd) (readP_to_S parse str) of
m <- parseHoleyModule
return (n, m)
setUnitIdInsts :: String -> DynFlags -> DynFlags
setUnitIdInsts s d =
d { thisUnitIdInsts_ = Just (parseUnitInsts s) }
setUnitInstantiations :: String -> DynFlags -> DynFlags
setUnitInstantiations s d =
d { homeUnitInstantiations = parseUnitInsts s }
setComponentId :: String -> DynFlags -> DynFlags
setComponentId s d =
d { thisComponentId_ = Just (Indefinite (UnitId (fsLit s)) Nothing) }
setUnitInstanceOf :: String -> DynFlags -> DynFlags
setUnitInstanceOf s d =
d { homeUnitInstanceOfId = Just (Indefinite (UnitId (fsLit s)) Nothing) }
addPluginModuleName :: String -> DynFlags -> DynFlags
addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }
......@@ -2330,8 +2327,8 @@ dynamic_flags_deps = [
-- as specifying that the number of
-- parallel builds is equal to the
-- result of getNumProcessors
, make_ord_flag defFlag "instantiated-with" (sepArg setUnitIdInsts)
, make_ord_flag defFlag "this-component-id" (sepArg setComponentId)
, make_ord_flag defFlag "instantiated-with" (sepArg setUnitInstantiations)
, make_ord_flag defFlag "this-component-id" (sepArg setUnitInstanceOf)
-- RTS options -------------------------------------------------------------
, make_ord_flag defFlag "H" (HasArg (\s -> upd (\d ->
......@@ -4588,20 +4585,20 @@ parseUnitArg =
fmap UnitIdArg parseUnit
setUnitId :: String -> DynFlags -> DynFlags
setUnitId p d = d { thisUnitId = stringToUnitId p }
setUnitId p d = d { homeUnitId = stringToUnitId p }
-- | Given a 'ModuleName' of a signature in the home library, find
-- out how it is instantiated. E.g., the canonical form of
-- A in @p[A=q[]:A]@ is @q[]:A@.
canonicalizeHomeModule :: DynFlags -> ModuleName -> Module
canonicalizeHomeModule dflags mod_name =
case lookup mod_name (thisUnitIdInsts dflags) of
Nothing -> mkModule (thisPackage dflags) mod_name
case lookup mod_name (homeUnitInstantiations dflags) of
Nothing -> mkHomeModule dflags mod_name
Just mod -> mod
canonicalizeModuleIfHome :: DynFlags -> Module -> Module
canonicalizeModuleIfHome dflags mod
= if thisPackage dflags == moduleUnit mod
= if homeUnit dflags == moduleUnit mod
then canonicalizeHomeModule dflags (moduleName mod)
else mod
......
......@@ -1593,7 +1593,7 @@ The details are a bit tricky though:
in the Home Package Table (HPT). When you say :load, that's when we
extend the HPT.
* The 'thisPackage' field of DynFlags is *not* set to 'interactive'.
* The 'homeUnitId' field of DynFlags is *not* set to 'interactive'.
It stays as 'main' (or whatever -this-unit-id says), and is the
package to which :load'ed modules are added to.
......@@ -1603,7 +1603,7 @@ The details are a bit tricky though:
call to initTc in initTcInteractive, which in turn get the module
from it 'icInteractiveModule' field of the interactive context.
The 'thisPackage' field stays as 'main' (or whatever -this-unit-id says.
The 'homeUnitId' field stays as 'main' (or whatever -this-unit-id says.
* The main trickiness is that the type environment (tcg_type_env) and
fixity envt (tcg_fix_env), now contain entities from all the
......@@ -1848,11 +1848,11 @@ shadowed_by ids = shadowed
shadowed id = getOccName id `elemOccSet` new_occs
new_occs = mkOccSet (map getOccName ids)
-- | Set the 'DynFlags.homeUnitId' to 'interactive'
setInteractivePackage :: HscEnv -> HscEnv
-- Set the 'thisPackage' DynFlag to 'interactive'
setInteractivePackage hsc_env
= hsc_env { hsc_dflags = (hsc_dflags hsc_env)
{ thisUnitId = toUnitId interactiveUnitId } }
{ homeUnitId = toUnitId interactiveUnitId } }
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName ic n = ic{ic_int_print = n}
......@@ -2013,7 +2013,7 @@ mkPrintUnqualified dflags env = QueryQualify qual_name
-- is only one exposed package which exports this module, don't qualify.
mkQualModule :: DynFlags -> QueryQualifyModule
mkQualModule dflags mod
| moduleUnit mod == thisPackage dflags = False
| isHomeModule dflags mod = False
| [(_, pkgconfig)] <- lookup,
mkUnit pkgconfig == moduleUnit mod
......@@ -2305,7 +2305,7 @@ lookupType dflags hpt pte name
where
mod = ASSERT2( isExternalName name, ppr name )
if isHoleName name
then mkModule (thisPackage dflags) (moduleName (nameModule name))
then mkHomeModule dflags (moduleName (nameModule name))
else nameModule name
-- | As 'lookupType', but with a marginally easier-to-use interface
......
......@@ -174,7 +174,7 @@ deSugar hsc_env
; let used_names = mkUsedNames tcg_env
pluginModules =
map lpModule (cachedPlugins (hsc_dflags hsc_env))
; deps <- mkDependencies (thisUnitId (hsc_dflags hsc_env))
; deps <- mkDependencies (homeUnitId (hsc_dflags hsc_env))
(map mi_module pluginModules) tcg_env
; used_th <- readIORef tc_splice_used
......
......@@ -250,7 +250,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
where
hpt = hsc_HPT hsc_env
dflags = hsc_dflags hsc_env
this_pkg = thisPackage dflags
this_pkg = homeUnit dflags
used_mods = moduleEnvKeys ent_map
dir_imp_mods = moduleEnvKeys direct_imports
......
......@@ -64,6 +64,7 @@ import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Avail
import GHC.Unit.Module
import GHC.Unit.State
import GHC.Data.Maybe
import GHC.Utils.Error
import GHC.Driver.Finder
......@@ -401,7 +402,7 @@ loadInterface doc_str mod from
-- Hole modules get special treatment
= do dflags <- getDynFlags
-- Redo search for our local hole module
loadInterface doc_str (mkModule (thisPackage dflags) (moduleName mod)) from
loadInterface doc_str (mkHomeModule dflags (moduleName mod)) from
| otherwise
= withTimingSilentD (text "loading interface") (pure ()) $
do { -- Read the state
......@@ -619,7 +620,7 @@ is_external_sig dflags iface =
-- It's a signature iface...
mi_semantic_module iface /= mi_module iface &&
-- and it's not from the local package
moduleUnit (mi_module iface) /= thisPackage dflags
moduleUnit (mi_module iface) /= homeUnit dflags
-- | This is an improved version of 'findAndReadIface' which can also
-- handle the case when a user requests @p[A=<B>]:M@ but we only
......@@ -642,7 +643,7 @@ computeInterface doc_str hi_boot_file mod0 = do
MASSERT( not (isHoleModule mod0) )
dflags <- getDynFlags
case getModuleInstantiation mod0 of
(imod, Just indef) | not (unitIsDefinite (thisPackage dflags)) -> do
(imod, Just indef) | homeUnitIsIndefinite dflags -> do
r <- findAndReadIface doc_str imod mod0 hi_boot_file
case r of
Succeeded (iface0, path) -> do
......@@ -728,7 +729,7 @@ 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 == moduleUnit mod
this_package = homeUnit dflags == moduleUnit mod
badSourceImport :: Module -> SDoc
badSourceImport mod
......@@ -927,7 +928,7 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
(ml_hi_file loc)
-- See Note [Home module load error]
if moduleUnit mod `unitIdEq` thisPackage dflags &&
if moduleUnit mod `unitIdEq` homeUnit dflags &&
not (isOneShot (ghcMode dflags))
then return (Failed (homeModError mod loc))
else do r <- read_file file_path
......
......@@ -166,7 +166,7 @@ mkIfaceTc hsc_env safe_mode mod_details
let pluginModules =
map lpModule (cachedPlugins (hsc_dflags hsc_env))
deps <- mkDependencies
(thisUnitId (hsc_dflags hsc_env))
(homeUnitId (hsc_dflags hsc_env))
(map mi_module pluginModules) tc_result
let hpc_info = emptyHpcInfo other_hpc_info
used_th <- readIORef tc_splice_used
......
......@@ -212,7 +212,7 @@ checkVersions hsc_env mod_summary iface
-- readIface will have verified that the UnitId matches,
-- but we ALSO must make sure the instantiation matches up. See
-- test case bkpcabal04!
; if moduleUnit (mi_module iface) /= thisPackage (hsc_dflags hsc_env)
; if moduleUnit (mi_module iface) /= homeUnit (hsc_dflags hsc_env)
then return (RecompBecause "-this-unit-id changed", Nothing) else do {
; recomp <- checkFlagHash hsc_env iface
; if recompileRequired recomp then return (recomp, Nothing) else do {
......@@ -250,7 +250,7 @@ checkVersions hsc_env mod_summary iface
; return (recomp, Just iface)
}}}}}}}}}}
where
this_pkg = thisPackage (hsc_dflags hsc_env)
this_pkg = homeUnit (hsc_dflags hsc_env)
-- This is a bit of a hack really
mod_deps :: ModuleNameEnv ModuleNameWithIsBoot
mod_deps = mkModDeps (dep_mods (mi_deps iface))
......@@ -332,7 +332,7 @@ checkHsig mod_summary iface = do
dflags <- getDynFlags
let outer_mod = ms_mod mod_summary
inner_mod = canonicalizeHomeModule dflags (moduleName outer_mod)
MASSERT( moduleUnit outer_mod == thisPackage dflags )
MASSERT( moduleUnit outer_mod == homeUnit dflags )
case inner_mod == mi_semantic_module iface of
True -> up_to_date (text "implementing module unchanged")
False -> return (RecompBecause "implementing module changed")
......@@ -447,7 +447,7 @@ checkDependencies hsc_env summary iface
prev_dep_plgn = dep_plgins (mi_deps iface)
prev_dep_pkgs = dep_pkgs (mi_deps iface)
this_pkg = thisPackage (hsc_dflags hsc_env)
this_pkg = homeUnit (hsc_dflags hsc_env)
dep_missing (mb_pkg, L _ mod) = do
find_res <- liftIO $ findImportedModule hsc_env mod (mb_pkg)
......@@ -1348,7 +1348,7 @@ mkHashFun
-> (Name -> IO Fingerprint)
mkHashFun hsc_env eps name
| isHoleModule orig_mod
= lookup (mkModule (thisPackage dflags) (moduleName orig_mod))
= lookup (mkHomeModule dflags (moduleName orig_mod))
| otherwise
= lookup orig_mod
where
......
......@@ -36,7 +36,7 @@ fingerprintDynFlags :: DynFlags -> Module
fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
let mainis = if mainModIs == this_mod then Just mainFunIs else Nothing
-- see #5878
-- pkgopts = (thisPackage dflags, sort $ packageFlags dflags)
-- pkgopts = (homeUnit dflags, sort $ packageFlags dflags)
safeHs = setSafeMode safeHaskell
-- oflags = sort $ filter filterOFlags $ flags dflags
......
......@@ -341,7 +341,7 @@ rnIfaceGlobal n = do
-- went from <A> to <B>.
let m'' = if isHoleModule m'
-- Pull out the local guy!!
then mkModule (thisPackage dflags) (moduleName m')
then mkHomeModule dflags (moduleName m')
else m'
iface <- liftIO . initIfaceCheck (text "rnIfaceGlobal") hsc_env
$ loadSysInterface (text "rnIfaceGlobal") m''
......
......@@ -55,7 +55,7 @@ module GHC.Parser.Lexer (
appendError,
allocateComments,
MonadP(..),
getRealSrcLoc, getPState, withThisPackage,
getRealSrcLoc, getPState, withHomeUnit,
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
, pThisPackage :: Unit -- ^ key of package currently being compiled
, pHomeUnit :: Unit -- ^ unit currently being compiled
, pExtsBitmap :: !ExtsBitmap -- ^ bitmap of permitted extensions
}
......@@ -2183,8 +2183,8 @@ failLocMsgP loc1 loc2 str =
getPState :: P PState