Cache HomeUnit in HscEnv (#17957)

Instead of recreating the HomeUnit from the DynFlags every time we need
it, we store it in the HscEnv.

28 files changed, 180 insertions, 173 deletions

diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 6d0712e634..64cb5e9486 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -103,7 +103,7 @@ core2core hsc_env guts@(ModGuts { mg_module  = mod
     hpt_rule_base  = mkRuleBase home_pkg_rules
     print_unqual   = mkPrintUnqualified
                         (unitState dflags)
-                        (mkHomeUnitFromFlags dflags)
+                        (hsc_home_unit hsc_env)
                         rdr_env
     -- mod: get the module out of the current HscEnv so we can retrieve it from the monad.
     -- This is very convienent for the users of the monad (e.g. plugins do not have to
@@ -696,7 +696,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
     }
   where
     dflags       = hsc_dflags hsc_env
-    print_unqual = mkPrintUnqualified (unitState dflags) (mkHomeUnitFromFlags dflags) rdr_env
+    print_unqual = mkPrintUnqualified (unitState dflags) (hsc_home_unit hsc_env) rdr_env
     simpl_env    = mkSimplEnv mode
     active_rule  = activeRule mode
     active_unf   = activeUnfolding mode
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index e5fc09522d..0b689732a2 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -1556,7 +1556,7 @@ mkConvertNumLiteral hsc_env = do
    let
       dflags   = hsc_dflags hsc_env
       platform = targetPlatform dflags
-      home_unit = mkHomeUnitFromFlags dflags
+      home_unit = hsc_home_unit hsc_env
       guardBignum act
          | isHomeUnitInstanceOf home_unit primUnitId
          = return $ panic "Bignum literals are not supported in ghc-prim"
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 242ecd9aa4..6822c85b65 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -288,7 +288,7 @@ buildUnit session cid insts lunit = do
     conf <- withBkpSession cid insts deps_w_rns session $ do
 
         dflags <- getDynFlags
-        mod_graph <- hsunitModuleGraph dflags (unLoc lunit)
+        mod_graph <- hsunitModuleGraph (unLoc lunit)
 
         msg <- mkBackpackMsg
         ok <- load' LoadAllTargets (Just msg) mod_graph
@@ -312,7 +312,7 @@ buildUnit session cid insts lunit = do
 
         let compat_fs = unitIdFS (indefUnit cid)
             compat_pn = PackageName compat_fs
-            unit_id   = homeUnitId (mkHomeUnitFromFlags (hsc_dflags hsc_env))
+            unit_id   = homeUnitId (hsc_home_unit hsc_env)
 
         return GenericUnitInfo {
             -- Stub data
@@ -378,8 +378,7 @@ compileExe lunit = do
     forM_ (zip [1..] deps) $ \(i, dep) ->
         compileInclude (length deps) (i, dep)
     withBkpExeSession deps_w_rns $ do
-        dflags <- getDynFlags
-        mod_graph <- hsunitModuleGraph dflags (unLoc lunit)
+        mod_graph <- hsunitModuleGraph (unLoc lunit)
         msg <- mkBackpackMsg
         ok <- load' LoadAllTargets (Just msg) mod_graph
         when (failed ok) (liftIO $ exitWith (ExitFailure 1))
@@ -645,11 +644,12 @@ convertHsModuleId (HsModuleId (L _ hsuid) (L _ modname)) = mkModule (convertHsCo
 --
 -- We don't bother trying to support GHC.Driver.Make for now, it's more trouble
 -- than it's worth for inline modules.
-hsunitModuleGraph :: DynFlags -> HsUnit HsComponentId -> BkpM ModuleGraph
-hsunitModuleGraph dflags unit = do
+hsunitModuleGraph :: HsUnit HsComponentId -> BkpM ModuleGraph
+hsunitModuleGraph unit = do
+    hsc_env <- getSession
     let decls = hsunitBody unit
         pn = hsPackageName (unLoc (hsunitName unit))
-        home_unit = mkHomeUnitFromFlags dflags
+        home_unit = hsc_home_unit hsc_env
 
     --  1. Create a HsSrcFile/HsigFile summary for every
     --  explicitly mentioned module/signature.
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index b6cdcdfa76..ffcd8d9359 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -81,7 +81,7 @@ flushFinderCaches hsc_env =
   atomicModifyIORef' fc_ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
  where
         fc_ref       = hsc_FC hsc_env
-        home_unit    = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+        home_unit    = hsc_home_unit hsc_env
         is_ext mod _ = not (isHomeInstalledModule home_unit mod)
 
 addToFinderCache :: IORef FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
@@ -139,7 +139,7 @@ findPluginModule hsc_env mod_name =
 
 findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
 findExactModule hsc_env mod =
-    let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+    let home_unit = hsc_home_unit hsc_env
     in if isHomeInstalledModule home_unit mod
        then findInstalledHomeModule hsc_env (moduleName mod)
        else findPackageModule hsc_env mod
@@ -179,7 +179,7 @@ orIfNotFound this or_this = do
 -- was successful.)
 homeSearchCache :: HscEnv -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
 homeSearchCache hsc_env mod_name do_this = do
-  let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+  let home_unit = hsc_home_unit hsc_env
       mod = mkHomeInstalledModule home_unit mod_name
   modLocationCache hsc_env mod do_this
 
@@ -255,14 +255,14 @@ modLocationCache hsc_env mod do_this = do
 -- This returns a module because it's more convenient for users
 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
 addHomeModuleToFinder hsc_env mod_name loc = do
-  let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+  let home_unit = hsc_home_unit hsc_env
       mod = mkHomeInstalledModule home_unit mod_name
   addToFinderCache (hsc_FC hsc_env) mod (InstalledFound loc mod)
   return (mkHomeModule home_unit mod_name)
 
 uncacheModule :: HscEnv -> ModuleName -> IO ()
 uncacheModule hsc_env mod_name = do
-  let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+  let home_unit = hsc_home_unit hsc_env
       mod = mkHomeInstalledModule home_unit mod_name
   removeFromFinderCache (hsc_FC hsc_env) mod
 
@@ -284,9 +284,8 @@ findHomeModule hsc_env mod_name = do
         fr_suggestions = []
       }
  where
-  dflags    = hsc_dflags hsc_env
-  home_unit = mkHomeUnitFromFlags dflags
-  uid       = homeUnitAsUnit (mkHomeUnitFromFlags dflags)
+  home_unit = hsc_home_unit hsc_env
+  uid       = homeUnitAsUnit home_unit
 
 -- | 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
@@ -309,7 +308,7 @@ findInstalledHomeModule hsc_env mod_name =
    homeSearchCache hsc_env mod_name $
    let
      dflags = hsc_dflags hsc_env
-     home_unit = mkHomeUnitFromFlags dflags
+     home_unit = hsc_home_unit hsc_env
      home_path = importPaths dflags
      hisuf = hiSuf dflags
      mod = mkHomeInstalledModule home_unit mod_name
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index a2fa2e2aea..2299337596 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -214,6 +214,7 @@ newHscEnv dflags = do
                   ,  hsc_type_env_var = Nothing
                   ,  hsc_interp       = Nothing
                   ,  hsc_dynLinker    = emptyDynLinker
+                  ,  hsc_home_unit    = home_unit
                   }
 
 -- -----------------------------------------------------------------------------
@@ -477,7 +478,7 @@ hsc_typecheck keep_rn mod_summary mb_rdr_module = do
     hsc_env <- getHscEnv
     let hsc_src = ms_hsc_src mod_summary
         dflags = hsc_dflags hsc_env
-        home_unit = mkHomeUnitFromFlags dflags
+        home_unit = hsc_home_unit hsc_env
         outer_mod = ms_mod mod_summary
         mod_name = moduleName outer_mod
         outer_mod' = mkHomeModule home_unit mod_name
@@ -1123,9 +1124,9 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
 hscCheckSafe' :: Module -> SrcSpan
   -> Hsc (Maybe UnitId, Set UnitId)
 hscCheckSafe' m l = do
-    dflags <- getDynFlags
-    let home_unit = mkHomeUnitFromFlags dflags
-    (tw, pkgs) <- isModSafe m l
+    hsc_env <- getHscEnv
+    let home_unit = hsc_home_unit hsc_env
+    (tw, pkgs) <- isModSafe home_unit m l
     case tw of
         False                           -> return (Nothing, pkgs)
         True | isHomeModule home_unit m -> return (Nothing, pkgs)
@@ -1133,8 +1134,8 @@ hscCheckSafe' m l = do
              -- Not necessary if that is reflected in dependencies
              | otherwise   -> return (Just $ toUnitId (moduleUnit m), pkgs)
   where
-    isModSafe :: Module -> SrcSpan -> Hsc (Bool, Set UnitId)
-    isModSafe m l = do
+    isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId)
+    isModSafe home_unit m l = do
         dflags <- getDynFlags
         iface <- lookup' m
         case iface of
@@ -1150,7 +1151,7 @@ hscCheckSafe' m l = do
                     -- check module is trusted
                     safeM = trust `elem` [Sf_Safe, Sf_SafeInferred, Sf_Trustworthy]
                     -- check package is trusted
-                    safeP = packageTrusted dflags trust trust_own_pkg m
+                    safeP = packageTrusted dflags home_unit trust trust_own_pkg m
                     -- pkg trust reqs
                     pkgRs = S.fromList . map fst $ filter snd $ dep_pkgs $ mi_deps iface'
                     -- warn if Safe module imports Safe-Inferred module.
@@ -1195,16 +1196,16 @@ hscCheckSafe' m l = do
     -- modules are trusted without requiring that their package is trusted. For
     -- trustworthy modules, modules in the home package are trusted but
     -- otherwise we check the package trust flag.
-    packageTrusted :: DynFlags -> SafeHaskellMode -> Bool -> Module -> Bool
-    packageTrusted _ Sf_None      _ _ = False -- shouldn't hit these cases
-    packageTrusted _ Sf_Ignore    _ _ = False -- shouldn't hit these cases
-    packageTrusted _ Sf_Unsafe    _ _ = False -- prefer for completeness.
-    packageTrusted dflags _ _ _
+    packageTrusted :: DynFlags -> HomeUnit -> SafeHaskellMode -> Bool -> Module -> Bool
+    packageTrusted _ _ Sf_None      _ _ = False -- shouldn't hit these cases
+    packageTrusted _ _ Sf_Ignore    _ _ = False -- shouldn't hit these cases
+    packageTrusted _ _ Sf_Unsafe    _ _ = False -- prefer for completeness.
+    packageTrusted dflags _ _ _ _
         | not (packageTrustOn dflags) = True
-    packageTrusted _ Sf_Safe  False _ = True
-    packageTrusted _ Sf_SafeInferred False _ = True
-    packageTrusted dflags _ _ m
-        | isHomeModule (mkHomeUnitFromFlags dflags) m = True
+    packageTrusted _ _ Sf_Safe  False _ = True
+    packageTrusted _ _ Sf_SafeInferred False _ = True
+    packageTrusted dflags home_unit _ _ m
+        | isHomeModule home_unit m = True
         | otherwise = unitIsTrusted $ unsafeLookupUnit (unitState dflags) (moduleUnit m)
 
     lookup' :: Module -> Hsc (Maybe ModIface)
@@ -1500,7 +1501,7 @@ hscInteractive hsc_env cgguts location = do
 hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> IO ()
 hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
     let dflags   = hsc_dflags hsc_env
-        home_unit = mkHomeUnitFromFlags dflags
+        home_unit = hsc_home_unit hsc_env
         platform  = targetPlatform dflags
     cmm <- ioMsgMaybe
                $ do
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index e71eba95f3..5c955749a3 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -661,7 +661,7 @@ discardIC hsc_env
     | nameIsFromExternalPackage home_unit old_name = old_name
     | otherwise = ic_name empty_ic
     where
-    home_unit = mkHomeUnitFromFlags dflags
+    home_unit = hsc_home_unit hsc_env
     old_name = ic_name old_ic
 
 -- | If there is no -o option, guess the name of target executable
@@ -1078,7 +1078,8 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
                 -- work to compile the module (see parUpsweep_one).
                 m_res <- MC.try $ unmask $ prettyPrintGhcErrors lcl_dflags $
                         parUpsweep_one mod home_mod_map comp_graph_loops
-                                       lcl_dflags mHscMessage cleanup
+                                       lcl_dflags (hsc_home_unit hsc_env)
+                                       mHscMessage cleanup
                                        par_sem hsc_env_var old_hpt_var
                                        stable_mods mod_idx (length sccs)
 
@@ -1180,6 +1181,8 @@ parUpsweep_one
     -- ^ The list of all module loops within the compilation graph.
     -> DynFlags
     -- ^ The thread-local DynFlags
+    -> HomeUnit
+    -- ^ The home-unit
     -> Maybe Messager
     -- ^ The messager
     -> (HscEnv -> IO ())
@@ -1198,14 +1201,13 @@ parUpsweep_one
     -- ^ The total number of modules
     -> IO SuccessFlag
     -- ^ The result of this compile
-parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup par_sem
+parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags home_unit mHscMessage cleanup par_sem
                hsc_env_var old_hpt_var stable_mods mod_index num_mods = do
 
     let this_build_mod = mkBuildModule mod
 
     let home_imps     = map unLoc $ ms_home_imps mod
     let home_src_imps = map unLoc $ ms_home_srcimps mod
-    let home_unit     = mkHomeUnitFromFlags lcl_dflags
 
     -- All the textual imports of this module.
     let textual_deps = Set.fromList $
@@ -2117,8 +2119,9 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
        -- otherwise those modules will fail to compile.
        -- See Note [-fno-code mode] #8025
        let default_backend = platformDefaultBackend (targetPlatform dflags)
+           home_unit       = hsc_home_unit hsc_env
        map1 <- case backend dflags of
-         NoBackend   -> enableCodeGenForTH default_backend map0
+         NoBackend   -> enableCodeGenForTH home_unit default_backend map0
          Interpreter -> enableCodeGenForUnboxedTuplesOrSums default_backend map0
          _           -> return map0
        if null errs
@@ -2203,10 +2206,10 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
 -- the specified target, disable optimization and change the .hi
 -- and .o file locations to be temporary files.
 -- See Note [-fno-code mode]
-enableCodeGenForTH :: Backend
+enableCodeGenForTH :: HomeUnit -> Backend
   -> NodeMap [Either ErrorMessages ModSummary]
   -> IO (NodeMap [Either ErrorMessages ModSummary])
-enableCodeGenForTH =
+enableCodeGenForTH home_unit =
   enableCodeGenWhen condition should_modify TFL_CurrentModule TFL_GhcSession
   where
     condition = isTemplateHaskellOrQQNonBoot
@@ -2214,7 +2217,7 @@ enableCodeGenForTH =
       backend dflags == NoBackend &&
       -- Don't enable codegen for TH on indefinite packages; we
       -- can't compile anything anyway! See #16219.
-      isHomeUnitDefinite (mkHomeUnitFromFlags dflags)
+      isHomeUnitDefinite home_unit
 
 -- | Update the every ModSummary that is depended on
 -- by a module that needs unboxed tuples. We enable codegen to
@@ -2503,7 +2506,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
   | otherwise  = find_it
   where
     dflags = hsc_dflags hsc_env
-    home_unit = mkHomeUnitFromFlags dflags
+    home_unit = hsc_home_unit hsc_env
 
     check_timestamp old_summary location src_fn =
         checkSummaryTimestamp
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 91f8044dcd..8d0159b800 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -384,7 +384,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 home_unit = mkHomeUnitFromFlags dflags
+  let home_unit = hsc_home_unit hsc_env
       src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;"
   writeFile empty_stub (showSDoc dflags (pprCode CStyle src))
   _ <- runPipeline StopLn hsc_env
@@ -1297,7 +1297,7 @@ runPhase (RealPhase cc_phase) input_fn dflags
         pkg_include_dirs <- liftIO $ getUnitIncludePath
                                        (initSDocContext dflags defaultUserStyle)
                                        (unitState dflags)
-                                       (mkHomeUnitFromFlags dflags)
+                                       home_unit
                                        pkgs
         let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
               (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)
@@ -1329,7 +1329,7 @@ runPhase (RealPhase cc_phase) input_fn dflags
              else getUnitExtraCcOpts
                      (initSDocContext dflags defaultUserStyle)
                      (unitState dflags)
-                     (mkHomeUnitFromFlags dflags)
+                     home_unit
                      pkgs
 
         framework_paths <-
@@ -1337,7 +1337,7 @@ runPhase (RealPhase cc_phase) input_fn dflags
             then do pkgFrameworkPaths <- liftIO $ getUnitFrameworkPath
                                                    (initSDocContext dflags defaultUserStyle)
                                                    (unitState dflags)
-                                                   (mkHomeUnitFromFlags dflags)
+                                                   home_unit
                                                    pkgs
                     let cmdlineFrameworkPaths = frameworkPaths dflags
                     return $ map ("-F"++)
@@ -1732,6 +1732,7 @@ linkBinary' staticLink dflags o_files dep_units = do
         toolSettings' = toolSettings dflags
         verbFlags = getVerbFlags dflags
         output_fn = exeFileName staticLink dflags
+        home_unit = mkHomeUnitFromFlags dflags
 
     -- get the full list of packages to link with, by combining the
     -- explicit packages with the auto packages and all of their
@@ -1744,7 +1745,7 @@ linkBinary' staticLink dflags o_files dep_units = do
     pkg_lib_paths <- getUnitLibraryPath
                         (initSDocContext dflags defaultUserStyle)
                         (unitState dflags)
-                        (mkHomeUnitFromFlags dflags)
+                        home_unit
                         (ways dflags)
                         dep_units
     let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
@@ -2016,6 +2017,7 @@ linkStaticLib dflags o_files dep_units = do
   let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
       modules = o_files ++ extra_ld_inputs
       output_fn = exeFileName True dflags
+      home_unit = mkHomeUnitFromFlags dflags
 
   full_output_fn <- if isAbsolute output_fn
                     then return output_fn
@@ -2027,7 +2029,7 @@ linkStaticLib dflags o_files dep_units = do
   pkg_cfgs_init <- getPreloadUnitsAnd
                      (initSDocContext dflags defaultUserStyle)
                      (unitState dflags)
-                     (mkHomeUnitFromFlags dflags)
+                     home_unit
                      dep_units
 
   let pkg_cfgs
@@ -2056,11 +2058,12 @@ doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
 doCpp dflags raw input_fn output_fn = do
     let hscpp_opts = picPOpts dflags
     let cmdline_include_paths = includePaths dflags
+    let home_unit = mkHomeUnitFromFlags dflags
 
     pkg_include_dirs <- getUnitIncludePath
                            (initSDocContext dflags defaultUserStyle)
                            (unitState dflags)
-                           (mkHomeUnitFromFlags dflags)
+                           home_unit
                            []
     let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) []
           (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs)
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index 672dd1b451..41da5da110 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -102,7 +102,7 @@ module GHC.Driver.Types (
         implicitTyThings, implicitTyConThings, implicitClassThings,
         isImplicitTyThing,
 
-        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
+        TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
         typeEnvFromEntities, mkTypeEnvWithImplicits,
         extendTypeEnv, extendTypeEnvList,
         extendTypeEnvWithIds, plusTypeEnv,
@@ -490,6 +490,9 @@ data HscEnv
         , hsc_dynLinker :: DynLinker
                 -- ^ dynamic linker.
 
+        , hsc_home_unit :: !HomeUnit
+                -- ^ Home-unit
+
  }
 
 {-
@@ -2286,34 +2289,24 @@ plusTypeEnv env1 env2 = plusNameEnv env1 env2
 -- compiled modules in other packages that live in 'PackageTypeEnv'. Note
 -- that this does NOT look up the 'TyThing' in the module being compiled: you
 -- have to do that yourself, if desired
-lookupType :: DynFlags
-           -> HomePackageTable
-           -> PackageTypeEnv
-           -> Name
-           -> Maybe TyThing
-
-lookupType dflags hpt pte name
-  | isOneShot (ghcMode dflags)  -- in one-shot, we don't use the HPT
-  = lookupNameEnv pte name
-  | otherwise
-  = case lookupHptByModule hpt mod of
-       Just hm -> lookupNameEnv (md_types (hm_details hm)) name
-       Nothing -> lookupNameEnv pte name
-  where
-    mod = ASSERT2( isExternalName name, ppr name )
-          if isHoleName name
-            then mkHomeModule (mkHomeUnitFromFlags dflags) (moduleName (nameModule name))
-            else nameModule name
-
--- | As 'lookupType', but with a marginally easier-to-use interface
--- if you have a 'HscEnv'
-lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)
-lookupTypeHscEnv hsc_env name = do
-    eps <- readIORef (hsc_EPS hsc_env)
-    return $! lookupType dflags hpt (eps_PTE eps) name
-  where
-    dflags = hsc_dflags hsc_env
-    hpt = hsc_HPT hsc_env
+lookupType :: HscEnv -> Name -> IO (Maybe TyThing)
+lookupType hsc_env name = do
+   eps <- liftIO $ readIORef (hsc_EPS hsc_env)
+   let pte = eps_PTE eps
+       hpt = hsc_HPT hsc_env
+
+       mod = ASSERT2( isExternalName name, ppr name )
+             if isHoleName name
+               then mkHomeModule (hsc_home_unit hsc_env) (moduleName (nameModule name))
+               else nameModule name
+
+       !ty = if isOneShot (ghcMode (hsc_dflags hsc_env))
+               -- in one-shot, we don't use the HPT
+               then lookupNameEnv pte name
+               else case lookupHptByModule hpt mod of
+                Just hm -> lookupNameEnv (md_types (hm_details hm)) name
+                Nothing -> lookupNameEnv pte name
+   pure ty
 
 -- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise
 tyThingTyCon :: HasDebugCallStack => TyThing -> TyCon
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 3b013850b2..2fd0a9302b 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -120,7 +120,7 @@ deSugar hsc_env
                             })
 
   = do { let dflags = hsc_dflags hsc_env
-             home_unit = mkHomeUnitFromFlags dflags
+             home_unit = hsc_home_unit hsc_env
              print_unqual = mkPrintUnqualified
                               (unitState dflags)
                               home_unit
@@ -183,7 +183,7 @@ deSugar hsc_env
 
         ; let used_names = mkUsedNames tcg_env
               pluginModules = map lpModule (cachedPlugins (hsc_dflags hsc_env))
-              home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+              home_unit = hsc_home_unit hsc_env
         ; deps <- mkDependencies (homeUnitId home_unit)
                                  (map mi_module pluginModules) tcg_env
 
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index fce4e2d580..653d88420f 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -78,6 +78,8 @@ import GHC.HsToCore.Types
 import GHC.HsToCore.Pmc.Solver.Types (Nablas, initNablas)
 import GHC.Types.Id
 import GHC.Unit.Module
+import GHC.Unit.Home
+import GHC.Unit.State
 import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.Core.Type
@@ -213,6 +215,8 @@ mkDsEnvsFromTcGbl hsc_env msg_var tcg_env
   = do { cc_st_var   <- liftIO $ newIORef newCostCentreState
        ; eps <- liftIO $ hscEPS hsc_env
        ; let dflags   = hsc_dflags hsc_env
+             home_unit = hsc_home_unit hsc_env
+             unit_state = unitState dflags
              this_mod = tcg_mod tcg_env
              type_env = tcg_type_env tcg_env
              rdr_env  = tcg_rdr_env tcg_env
@@ -220,7 +224,7 @@ mkDsEnvsFromTcGbl hsc_env msg_var tcg_env
              complete_matches = hptCompleteSigs hsc_env         -- from the home package
                                 ++ tcg_complete_matches tcg_env -- from the current module
                                 ++ eps_complete_matches eps     -- from imports
-       ; return $ mkDsEnvs dflags this_mod rdr_env type_env fam_inst_env
+       ; return $ mkDsEnvs unit_state home_unit this_mod rdr_env type_env fam_inst_env
                            msg_var cc_st_var complete_matches
        }
 
@@ -244,6 +248,8 @@ initDsWithModGuts hsc_env guts thing_inside
        ; msg_var <- newIORef emptyMessages
        ; eps <- liftIO $ hscEPS hsc_env
        ; let dflags   = hsc_dflags hsc_env
+             home_unit = hsc_home_unit hsc_env
+             unit_state = unitState dflags
              type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts)
              rdr_env  = mg_rdr_env guts
              fam_inst_env = mg_fam_inst_env guts
@@ -256,7 +262,7 @@ initDsWithModGuts hsc_env guts thing_inside
              bindsToIds (Rec    binds) = map fst binds
              ids = concatMap bindsToIds (mg_binds guts)
 
-             envs  = mkDsEnvs dflags this_mod rdr_env type_env
+             envs  = mkDsEnvs unit_state home_unit this_mod rdr_env type_env
                               fam_inst_env msg_var cc_st_var
                               complete_matches
        ; runDs hsc_env envs thing_inside
@@ -285,10 +291,10 @@ initTcDsForSolver thing_inside
          updGblEnv (\tc_gbl -> tc_gbl { tcg_fam_inst_env = fam_inst_env }) $
          thing_inside }
 
-mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv
+mkDsEnvs :: UnitState -> HomeUnit -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv
          -> IORef Messages -> IORef CostCentreState -> CompleteMatches
          -> (DsGblEnv, DsLclEnv)
-mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var
+mkDsEnvs unit_state home_unit mod rdr_env type_env fam_inst_env msg_var cc_st_var
          complete_matches
   = let if_genv = IfGblEnv { if_doc       = text "mkDsEnvs",
                              if_rec_types = Just (mod, return type_env) }
@@ -298,10 +304,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var
         gbl_env = DsGblEnv { ds_mod     = mod
                            , ds_fam_inst_env = fam_inst_env
                            , ds_if_env  = (if_genv, if_lenv)
-                           , ds_unqual  = mkPrintUnqualified
-                                             (unitState dflags)
-                                             (mkHomeUnitFromFlags dflags)
-                                             rdr_env
+                           , ds_unqual  = mkPrintUnqualified unit_state home_unit rdr_env
                            , ds_msgs    = msg_var
                            , ds_complete_matches = complete_matches
                            , ds_cc_st   = cc_st_var
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index b3de3cc4ce..c7fc988fe0 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -253,7 +253,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
-    home_unit = mkHomeUnitFromFlags dflags
+    home_unit = hsc_home_unit hsc_env
 
     used_mods    = moduleEnvKeys ent_map
     dir_imp_mods = moduleEnvKeys direct_imports
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 85b8b524f6..212bcb78ac 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -121,7 +121,7 @@ tcLookupImported_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing)
 -- Returns (Failed err) if we can't find the interface file for the thing
 tcLookupImported_maybe name
   = do  { hsc_env <- getTopEnv
-        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
+        ; mb_thing <- liftIO (lookupType hsc_env name)
         ; case mb_thing of
             Just thing -> return (Succeeded thing)
             Nothing    -> tcImportDecl_maybe name }
@@ -402,8 +402,8 @@ loadInterface :: SDoc -> Module -> WhereFrom
 loadInterface doc_str mod from
   | isHoleModule mod
   -- Hole modules get special treatment
-  = do dflags <- getDynFlags
-       let home_unit = mkHomeUnitFromFlags dflags
+  = do hsc_env <- getTopEnv
+       let home_unit = hsc_home_unit hsc_env
        -- Redo search for our local hole module
        loadInterface doc_str (mkHomeModule home_unit (moduleName mod)) from
   | otherwise
@@ -416,7 +416,8 @@ loadInterface doc_str mod from
 
                 -- Check whether we have the interface already
         ; dflags <- getDynFlags
-        ; let home_unit = mkHomeUnitFromFlags dflags
+        ; hsc_env <- getTopEnv
+        ; let home_unit = hsc_home_unit hsc_env
         ; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
             Just iface
                 -> return (Succeeded iface) ;   -- Already loaded
@@ -643,8 +644,8 @@ computeInterface ::
     -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
 computeInterface doc_str hi_boot_file mod0 = do
     MASSERT( not (isHoleModule mod0) )
-    dflags <- getDynFlags
-    let home_unit = mkHomeUnitFromFlags dflags
+    hsc_env <- getTopEnv
+    let home_unit = hsc_home_unit hsc_env
     case getModuleInstantiation mod0 of
         (imod, Just indef) | isHomeUnitIndefinite home_unit -> do
             r <- findAndReadIface doc_str imod mod0 hi_boot_file
@@ -925,7 +926,7 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
                -- Look for the file
                hsc_env <- getTopEnv
                mb_found <- liftIO (findExactModule hsc_env mod)
-               let home_unit = mkHomeUnitFromFlags dflags
+               let home_unit = hsc_home_unit hsc_env
                case mb_found of
                    InstalledFound loc mod -> do
                        -- Found file, so read it
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 941aa4083c..cdcf80bb1f 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -172,7 +172,7 @@ mkIfaceTc hsc_env safe_mode mod_details
   = do
           let used_names = mkUsedNames tc_result
           let pluginModules = map lpModule (cachedPlugins (hsc_dflags hsc_env))
-          let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+          let home_unit = hsc_home_unit hsc_env
           deps <- mkDependencies (homeUnitId home_unit)
                     (map mi_module pluginModules) tc_result
           let hpc_info = emptyHpcInfo other_hpc_info
@@ -228,7 +228,7 @@ mkIface_ hsc_env
 --      to expose in the interface
 
   = do
-    let home_unit    = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+    let home_unit    = hsc_home_unit hsc_env
         semantic_mod = homeModuleNameInstantiation home_unit (moduleName this_mod)
         entities = typeEnvElts type_env
         show_linear_types = xopt LangExt.LinearTypes (hsc_dflags hsc_env)
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index eca2d2c875..68df3e2fbd 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -256,7 +256,7 @@ checkVersions hsc_env mod_summary iface
        ; return (recomp, Just iface)
     }}}}}}}}}}
   where
-    home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+    home_unit = hsc_home_unit hsc_env
     -- This is a bit of a hack really
     mod_deps :: ModuleNameEnv ModuleNameWithIsBoot
     mod_deps = mkModDeps (dep_mods (mi_deps iface))
@@ -335,8 +335,8 @@ pluginRecompileToRecompileRequired old_fp new_fp pr
 -- implementing module has changed.
 checkHsig :: ModSummary -> ModIface -> IfG RecompileRequired
 checkHsig mod_summary iface = do
-    dflags <- getDynFlags
-    let home_unit = mkHomeUnitFromFlags dflags
+    hsc_env <- getTopEnv
+    let home_unit = hsc_home_unit hsc_env
         outer_mod = ms_mod mod_summary
         inner_mod = homeModuleNameInstantiation home_unit (moduleName outer_mod)
     MASSERT( isHomeModule home_unit outer_mod )
@@ -453,7 +453,7 @@ checkDependencies hsc_env summary iface
    prev_dep_mods = dep_mods (mi_deps iface)
    prev_dep_plgn = dep_plgins (mi_deps iface)
    prev_dep_pkgs = dep_pkgs (mi_deps iface)
-   home_unit     = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+   home_unit     = hsc_home_unit hsc_env
 
    dep_missing (mb_pkg, L _ mod) = do
      find_res <- liftIO $ findImportedModule hsc_env mod (mb_pkg)
@@ -486,7 +486,6 @@ checkDependencies hsc_env summary iface
    isOldHomeDeps = flip Set.member old_deps
    checkForNewHomeDependency (L _ mname) = do
      let
-       home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
        mod = mkHomeModule home_unit mname
        str_mname = moduleNameString mname
        reason = str_mname ++ " changed"
@@ -1359,8 +1358,7 @@ mkHashFun hsc_env eps name
   | otherwise
   = lookup orig_mod
   where
-      dflags = hsc_dflags hsc_env
-      home_unit = mkHomeUnitFromFlags dflags
+      home_unit = hsc_home_unit hsc_env
       hpt = hsc_HPT hsc_env
       pit = eps_PIT eps
       occ = nameOccName name
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 7a511fdc49..cac4f6e438 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -300,7 +300,7 @@ rnIfaceGlobal :: Name -> ShIfM Name
 rnIfaceGlobal n = do
     hsc_env <- getTopEnv
     let dflags = hsc_dflags hsc_env
-        home_unit = mkHomeUnitFromFlags dflags
+        home_unit = hsc_home_unit hsc_env
     iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
     mb_nsubst <- fmap sh_if_shape getGblEnv
     hmap <- getHoleSubst
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 68386a69ae..df1db23b33 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -371,7 +371,7 @@ tidyProgram hsc_env  (ModGuts { mg_module           = mod
               ; expose_all = gopt Opt_ExposeAllUnfoldings  dflags
               ; print_unqual = mkPrintUnqualified
                                  (unitState dflags)
-                                 (mkHomeUnitFromFlags dflags)
+                                 (hsc_home_unit hsc_env)
                                  rdr_env
               ; implicit_binds = concatMap getImplicitBinds tcs
               }
diff --git a/compiler/GHC/Iface/Tidy/StaticPtrTable.hs b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
index 965140e6f2..5e40bed45e 100644
--- a/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
+++ b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
@@ -241,11 +241,11 @@ sptCreateStaticBinds hsc_env this_mod binds
         PW8 -> mkWordLit platform . toInteger
 
     lookupIdHscEnv :: Name -> IO Id
-    lookupIdHscEnv n = lookupTypeHscEnv hsc_env n >>=
+    lookupIdHscEnv n = lookupType hsc_env n >>=
                          maybe (getError n) (return . tyThingId)
 
     lookupDataConHscEnv :: Name -> IO DataCon
-    lookupDataConHscEnv n = lookupTypeHscEnv hsc_env n >>=
+    lookupDataConHscEnv n = lookupType hsc_env n >>=
                               maybe (getError n) (return . tyThingDataCon)
 
     getError n = pprPanic "sptCreateStaticBinds.get: not found" $
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index ed8c3efb65..381d0b08d2 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1669,7 +1669,7 @@ tcIfaceGlobal name
   where
     via_external =  do
         { hsc_env <- getTopEnv
-        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
+        ; mb_thing <- liftIO (lookupType hsc_env name)
         ; case mb_thing of {
             Just thing -> return thing ;
             Nothing    -> do
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 2eedd939a5..7945263dc6 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -43,7 +43,6 @@ import GHC.Tc.Utils.Monad
 
 import GHC.Types.ForeignCall ( CCallTarget(..) )
 import GHC.Unit
-import GHC.Driver.Types ( Warnings(..), plusWarns )
 import GHC.Builtin.Names( applicativeClassName, pureAName, thenAName
                         , monadClassName, returnMName, thenMName
                         , semigroupClassName, sappendName
@@ -61,7 +60,7 @@ import GHC.Types.SrcLoc as SrcLoc
 import GHC.Driver.Session
 import GHC.Utils.Misc   ( debugIsOn, lengthExceeds, partitionWith )
 import GHC.Utils.Panic
-import GHC.Driver.Types ( HscEnv, hsc_dflags )
+import GHC.Driver.Types ( Warnings(..), plusWarns, HscEnv(..))
 import GHC.Data.List.SetOps ( findDupsEq, removeDups, equivClasses )
 import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..)
                                , stronglyConnCompFromEdgedVerticesUniq )
@@ -350,7 +349,7 @@ rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec })
        ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty
 
         -- Mark any PackageTarget style imports as coming from the current package
-       ; let home_unit = mkHomeUnitFromFlags (hsc_dflags topEnv)
+       ; let home_unit = hsc_home_unit topEnv
              spec'  = patchForeignImport (homeUnitAsUnit home_unit) spec
 
        ; return (ForeignImport { fd_i_ext = noExtField
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index e587720a3e..6778e6f868 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -365,7 +365,9 @@ rnImportDecl this_mod
                     || (not implicit && safeDirectImpsReq dflags)
                     || (implicit && safeImplicitImpsReq dflags)
 
-    let imv = ImportedModsVal
+    hsc_env <- getTopEnv
+    let home_unit = hsc_home_unit hsc_env
+        imv = ImportedModsVal
             { imv_name        = qual_mod_name
             , imv_span        = loc
             , imv_is_safe     = mod_safe'
@@ -373,7 +375,7 @@ rnImportDecl this_mod
             , imv_all_exports = potential_gres
             , imv_qualified   = qual_only
             }
-        imports = calculateAvails dflags iface mod_safe' want_boot (ImportedByUser imv)
+        imports = calculateAvails home_unit iface mod_safe' want_boot (ImportedByUser imv)
 
     -- Complain if we import a deprecated module
     whenWOptM Opt_WarnWarningsDeprecations (
@@ -395,13 +397,13 @@ rnImportDecl this_mod
 
 -- | Calculate the 'ImportAvails' induced by an import of a particular
 -- interface, but without 'imp_mods'.
-calculateAvails :: DynFlags
+calculateAvails :: HomeUnit
                 -> ModIface
                 -> IsSafeImport
                 -> IsBootInterface
                 -> ImportedBy
                 -> ImportAvails
-calculateAvails dflags iface mod_safe' want_boot imported_by =
+calculateAvails home_unit iface mod_safe' want_boot imported_by =
   let imp_mod    = mi_module iface
       imp_sem_mod= mi_semantic_module iface
       orph_iface = mi_orphan (mi_final_exts iface)
@@ -451,8 +453,6 @@ calculateAvails dflags iface mod_safe' want_boot imported_by =
       -- to be trusted? See Note [Trust Own Package]
       ptrust = trust == Sf_Trustworthy || trust_pkg
 
-      home_unit = mkHomeUnitFromFlags dflags
-
       (dependent_mods, dependent_pkgs, pkg_trust_req)
          | isHomeUnit home_unit pkg =
             -- Imported module is from the home package
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index be416a3997..fa9e80ecfd 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -811,7 +811,7 @@ getContext = withSession $ \HscEnv{ hsc_IC=ic } ->
 -- its full top-level scope available.
 moduleIsInterpreted :: GhcMonad m => Module -> m Bool
 moduleIsInterpreted modl = withSession $ \h ->
- if notHomeModule (mkHomeUnitFromFlags (hsc_dflags h)) modl
+ if notHomeModule (hsc_home_unit h) modl
         then return False
         else case lookupHpt (hsc_HPT h) (moduleName modl) of
                 Just details       -> return (isJust (mi_globals (hm_iface details)))
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 5d0eb3c467..aaa74b3625 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -682,7 +682,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
           let
             pkg = moduleUnit mod
             deps  = mi_deps iface
-            home_unit = mkHomeUnitFromFlags dflags
+            home_unit = hsc_home_unit hsc_env
 
             pkg_deps = dep_pkgs deps
             (boot_deps, mod_deps) = flip partitionWith (dep_mods deps) $
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 728b5ca84d..b0a0c97c7b 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -161,7 +161,7 @@ forceLoadTyCon :: HscEnv -> Name -> IO TyCon
 forceLoadTyCon hsc_env con_name = do
     forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of loadTyConTy") con_name
 
-    mb_con_thing <- lookupTypeHscEnv hsc_env con_name
+    mb_con_thing <- lookupType hsc_env con_name
     case mb_con_thing of
         Nothing -> throwCmdLineErrorS dflags $ missingTyThingError con_name
         Just (ATyCon tycon) -> return tycon
@@ -193,7 +193,7 @@ getHValueSafely :: HscEnv -> Name -> Type -> IO (Maybe HValue)
 getHValueSafely hsc_env val_name expected_type = do
     forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of getHValueSafely") val_name
     -- Now look up the names for the value and type constructor in the type environment
-    mb_val_thing <- lookupTypeHscEnv hsc_env val_name
+    mb_val_thing <- lookupType hsc_env val_name
     case mb_val_thing of
         Nothing -> throwCmdLineErrorS dflags $ missingTyThingError val_name
         Just (AnId id) -> do
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 0df9de0480..b83a4bee8e 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -184,7 +184,7 @@ tcRnModule hsc_env mod_sum save_rn_syntax
   where
     hsc_src = ms_hsc_src mod_sum
     dflags = hsc_dflags hsc_env
-    home_unit = mkHomeUnitFromFlags dflags
+    home_unit = hsc_home_unit hsc_env
     err_msg = mkPlainErrMsg dflags loc $
               text "Module does not have a RealSrcSpan:" <+> ppr this_mod
 
@@ -2832,7 +2832,7 @@ loadUnqualIfaces hsc_env ictxt
   = initIfaceTcRn $ do
     mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))
   where
-    home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+    home_unit = hsc_home_unit hsc_env
 
     unqual_mods = [ nameModule name
                   | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 52872deeab..28d3651876 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE CPP, TupleSections, ScopedTypeVariables, MultiWayIf #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -173,7 +174,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
 
            -- Step 1.5: Make sure we don't have any type synonym cycles
        ; traceTc "Starting synonym cycle check" (ppr tyclss)
-       ; home_unit <- mkHomeUnitFromFlags <$> getDynFlags
+       ; home_unit <- hsc_home_unit <$> getTopEnv
        ; checkSynCycles (homeUnitAsUnit home_unit) tyclss tyclds
        ; traceTc "Done synonym cycle check" (ppr tyclss)
 
@@ -4094,6 +4095,36 @@ checkValidDataCon dflags existential_ok tc con
           -- Check that UNPACK pragmas and bangs work out
           -- E.g.  reject   data T = MkT {-# UNPACK #-} Int     -- No "!"
           --                data T = MkT {-# UNPACK #-} !a      -- Can't unpack
+        ; hsc_env <- getTopEnv
+        ; let check_bang :: HsSrcBang -> HsImplBang -> Int -> TcM ()
+              check_bang bang rep_bang n
+               | HsSrcBang _ _ SrcLazy <- bang
+               , not (xopt LangExt.StrictData dflags)
+               = addErrTc (bad_bang n (text "Lazy annotation (~) without StrictData"))
+
+               | HsSrcBang _ want_unpack strict_mark <- bang
+               , isSrcUnpacked want_unpack, not (is_strict strict_mark)
+               = addWarnTc NoReason (bad_bang n (text "UNPACK pragma lacks '!'"))
+
+               | HsSrcBang _ want_unpack _ <- bang
+               , isSrcUnpacked want_unpack
+               , case rep_bang of { HsUnpack {} -> False; _ -> True }
+               -- If not optimising, we don't unpack (rep_bang is never
+               -- HsUnpack), so don't complain!  This happens, e.g., in Haddock.
+               -- See dataConSrcToImplBang.
+               , not (gopt Opt_OmitInterfacePragmas dflags)
+               -- When typechecking an indefinite package in Backpack, we
+               -- may attempt to UNPACK an abstract type.  The test here will
+               -- conclude that this is unusable, but it might become usable
+               -- when we actually fill in the abstract type.  As such, don't
+               -- warn in this case (it gives users the wrong idea about whether
+               -- or not UNPACK on abstract types is supported; it is!)
+               , isHomeUnitDefinite (hsc_home_unit hsc_env)
+               = addWarnTc NoReason (bad_bang n (text "Ignoring unusable UNPACK pragma"))
+
+               | otherwise
+               = return ()
+
         ; zipWith3M_ check_bang (dataConSrcBangs con) (dataConImplBangs con) [1..]
 
           -- Check the dcUserTyVarBinders invariant
@@ -4125,36 +4156,9 @@ checkValidDataCon dflags existential_ok tc con
     }
   where
     ctxt = ConArgCtxt (dataConName con)
-
-    check_bang :: HsSrcBang -> HsImplBang -> Int -> TcM ()
-    check_bang (HsSrcBang _ _ SrcLazy) _ n
-      | not (xopt LangExt.StrictData dflags)
-      = addErrTc
-          (bad_bang n (text "Lazy annotation (~) without StrictData"))
-    check_bang (HsSrcBang _ want_unpack strict_mark) rep_bang n
-      | isSrcUnpacked want_unpack, not is_strict
-      = addWarnTc NoReason (bad_bang n (text "UNPACK pragma lacks '!'"))
-      | isSrcUnpacked want_unpack
-      , case rep_bang of { HsUnpack {} -> False; _ -> True }
-      -- If not optimising, we don't unpack (rep_bang is never
-      -- HsUnpack), so don't complain!  This happens, e.g., in Haddock.
-      -- See dataConSrcToImplBang.
-      , not (gopt Opt_OmitInterfacePragmas dflags)
-      -- When typechecking an indefinite package in Backpack, we
-      -- may attempt to UNPACK an abstract type.  The test here will
-      -- conclude that this is unusable, but it might become usable
-      -- when we actually fill in the abstract type.  As such, don't
-      -- warn in this case (it gives users the wrong idea about whether
-      -- or not UNPACK on abstract types is supported; it is!)
-      , isHomeUnitDefinite (mkHomeUnitFromFlags dflags)
-      = addWarnTc NoReason (bad_bang n (text "Ignoring unusable UNPACK pragma"))
-      where
-        is_strict = case strict_mark of
-                      NoSrcStrict -> xopt LangExt.StrictData dflags
-                      bang        -> isSrcStrict bang
-
-    check_bang _ _ _
-      = return ()
+    is_strict = \case
+      NoSrcStrict -> xopt LangExt.StrictData dflags
+      bang        -> isSrcStrict bang
 
     bad_bang n herald
       = hang herald 2 (text "on the" <+> speakNth n
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 9d901b21c3..dcdf51c237 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -313,8 +313,7 @@ implicitRequirements' hsc_env normal_imports
             Found _ mod | not (isHomeModule home_unit mod) ->
                 return (uniqDSetToList (moduleFreeHoles mod))
             _ -> return []
-  where dflags = hsc_dflags hsc_env
-        home_unit = mkHomeUnitFromFlags dflags
+  where home_unit = hsc_home_unit hsc_env
 
 -- | Given a 'Unit', make sure it is well typed.  This is because
 -- unit IDs come from Cabal, which does not know if things are well-typed or
@@ -538,7 +537,7 @@ mergeSignatures
         inner_mod  = tcg_semantic_mod tcg_env
         mod_name   = moduleName (tcg_mod tcg_env)
         unit_state = unitState dflags
-        home_unit  = mkHomeUnitFromFlags dflags
+        home_unit  = hsc_home_unit hsc_env
 
     -- STEP 1: Figure out all of the external signature interfaces
     -- we are going to merge in.
@@ -830,6 +829,7 @@ mergeSignatures
         -- we hope that we get lucky / the overlapping instances never
         -- get used, but it is not a very good situation to be in.
         --
+        hsc_env <- getTopEnv
         let merge_inst (insts, inst_env) inst
                 | memberInstEnv inst_env inst -- test DFun Type equality
                 = (insts, inst_env)
@@ -844,8 +844,9 @@ mergeSignatures
             -- in the listing.  We don't want it because a module is NOT
             -- supposed to include itself in its dep_orphs/dep_finsts.  See #13214
             iface' = iface { mi_final_exts = (mi_final_exts iface){ mi_orphan = False, mi_finsts = False } }
+            home_unit = hsc_home_unit hsc_env
             avails = plusImportAvails (tcg_imports tcg_env) $
-                        calculateAvails dflags iface' False NotBoot ImportedBySystem
+                        calculateAvails home_unit iface' False NotBoot ImportedBySystem
         return tcg_env {
             tcg_inst_env = inst_env,
             tcg_insts    = insts,
@@ -912,7 +913,9 @@ impl_msg unit_state impl_mod (Module req_uid req_mod_name)
 checkImplements :: Module -> InstantiatedModule -> TcRn TcGblEnv
 checkImplements impl_mod req_mod@(Module uid mod_name) = do
   dflags <- getDynFlags
+  hsc_env <- getTopEnv
   let unit_state = unitState dflags
+      home_unit  = hsc_home_unit hsc_env
   addErrCtxt (impl_msg unit_state impl_mod req_mod) $ do
     let insts = instUnitInsts uid
 
@@ -933,7 +936,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
     loadModuleInterfaces (text "Loading orphan modules (from implementor of hsig)")
                          (dep_orphs (mi_deps impl_iface))
 
-    let avails = calculateAvails dflags
+    let avails = calculateAvails home_unit
                     impl_iface False{- safe -} NotBoot ImportedBySystem
         fix_env = mkNameEnv [ (gre_name rdr_elt, FixItem occ f)
                             | (occ, f) <- mi_fixities impl_iface
@@ -997,11 +1000,11 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
 -- checking that the implementation matches the signature.
 instantiateSignature :: TcRn TcGblEnv
 instantiateSignature = do
+    hsc_env <- getTopEnv
     tcg_env <- getGblEnv
-    dflags <- getDynFlags
     let outer_mod = tcg_mod tcg_env
         inner_mod = tcg_semantic_mod tcg_env
-        home_unit = mkHomeUnitFromFlags dflags
+        home_unit = hsc_home_unit hsc_env
     -- TODO: setup the local RdrEnv so the error messages look a little better.
     -- But this information isn't stored anywhere. Should we RETYPECHECK
     -- the local one just to get the information?  Hmm...
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 04db590f4d..2bcc8af641 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -146,8 +146,7 @@ lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc TyThing)
 lookupGlobal_maybe hsc_env name
   = do  {    -- Try local envt
           let mod = icInteractiveModule (hsc_IC hsc_env)
-              dflags = hsc_dflags hsc_env
-              home_unit = mkHomeUnitFromFlags dflags
+              home_unit = hsc_home_unit hsc_env
               tcg_semantic_mod = homeModuleInstantiation home_unit mod
 
         ; if nameIsLocalOrFrom tcg_semantic_mod name
@@ -162,7 +161,7 @@ lookupGlobal_maybe hsc_env name
 lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc TyThing)
 -- Returns (Failed err) if we can't find the interface file for the thing
 lookupImported_maybe hsc_env name
-  = do  { mb_thing <- lookupTypeHscEnv hsc_env name
+  = do  { mb_thing <- lookupType hsc_env name
         ; case mb_thing of
             Just thing -> return (Succeeded thing)
             Nothing    -> importDecl_maybe hsc_env name
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index f50cab2bb7..7932d140b3 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -242,7 +242,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
         th_remote_state_var  <- newIORef Nothing ;
         let {
              dflags = hsc_dflags hsc_env ;
-             home_unit = mkHomeUnitFromFlags dflags ;
+             home_unit = hsc_home_unit hsc_env ;
 
              maybe_rn_syntax :: forall a. a -> Maybe a ;
              maybe_rn_syntax empty_val
@@ -774,8 +774,9 @@ wrapDocLoc doc = do
 getPrintUnqualified :: DynFlags -> TcRn PrintUnqualified
 getPrintUnqualified dflags
   = do { rdr_env <- getGlobalRdrEnv
+       ; hsc_env <- getTopEnv
        ; let unit_state = unitState dflags
-       ; let home_unit  = mkHomeUnitFromFlags dflags
+       ; let home_unit  = hsc_home_unit hsc_env
        ; return $ mkPrintUnqualified unit_state home_unit rdr_env }
 
 -- | Like logInfoTcRn, but for user consumption
@@ -1967,9 +1968,9 @@ mkIfLclEnv mod loc boot
 initIfaceTcRn :: IfG a -> TcRn a
 initIfaceTcRn thing_inside
   = do  { tcg_env <- getGblEnv
-        ; dflags <- getDynFlags
+        ; hsc_env <- getTopEnv
         ; let !mod = tcg_semantic_mod tcg_env
-              home_unit = mkHomeUnitFromFlags dflags
+              home_unit = hsc_home_unit hsc_env
               -- When we are instantiating a signature, we DEFINITELY
               -- do not want to knot tie.
               is_instantiate = isHomeUnitInstantiating home_unit