Move the EPS into UnitEnv

8 files changed, 20 insertions, 18 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 23e74fb35a..f77ab69532 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -686,6 +686,7 @@ setSessionDynFlags dflags0 = do
         , ue_namever   = ghcNameVersion dflags
         , ue_home_unit = Just home_unit
         , ue_hpt       = ue_hpt old_unit_env
+        , ue_eps       = ue_eps old_unit_env
         , ue_units     = unit_state
         , ue_unit_dbs  = Just dbs
         }
@@ -723,6 +724,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
               , ue_namever   = ghcNameVersion dflags'
               , ue_home_unit = Just home_unit
               , ue_hpt       = ue_hpt old_unit_env
+              , ue_eps       = ue_eps old_unit_env
               , ue_units     = unit_state
               , ue_unit_dbs  = Just dbs
               }
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index fce04654c0..4789af6fe7 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -432,6 +432,7 @@ addUnit u = do
           , ue_namever   = ghcNameVersion (hsc_dflags hsc_env)
           , ue_home_unit = Just home_unit
           , ue_hpt       = ue_hpt old_unit_env
+          , ue_eps       = ue_eps old_unit_env
           , ue_units     = unit_state
           , ue_unit_dbs  = Just dbs
           }
@@ -510,7 +511,7 @@ innerBkpM do_this =
 updateEpsGhc_ :: GhcMonad m => (ExternalPackageState -> ExternalPackageState) -> m ()
 updateEpsGhc_ f = do
     hsc_env <- getSession
-    liftIO $ atomicModifyIORef' (euc_eps (hsc_EPS hsc_env)) (\x -> (f x, ()))
+    liftIO $ atomicModifyIORef' (euc_eps (ue_eps (hsc_unit_env hsc_env))) (\x -> (f x, ()))
 
 -- | Get the EPS from a 'GhcMonad'.
 getEpsGhc :: GhcMonad m => m ExternalPackageState
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index fb077829c9..6e843d2ea4 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -170,7 +170,7 @@ configured via command-line flags (in `GHC.setSessionDynFlags`).
 
 -- | Retrieve the ExternalPackageState cache.
 hscEPS :: HscEnv -> IO ExternalPackageState
-hscEPS hsc_env = readIORef (euc_eps (hsc_EPS hsc_env))
+hscEPS hsc_env = readIORef (euc_eps (ue_eps (hsc_unit_env hsc_env)))
 
 hptCompleteSigs :: HscEnv -> [CompleteMatch]
 hptCompleteSigs = hptAllThings  (md_complete_matches . hm_details)
diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs
index d926b27ac8..d1fc22314a 100644
--- a/compiler/GHC/Driver/Env/Types.hs
+++ b/compiler/GHC/Driver/Env/Types.hs
@@ -13,7 +13,6 @@ import GHC.Types.Error ( WarningMessages )
 import GHC.Types.Name.Cache
 import GHC.Types.Target
 import GHC.Types.TypeEnv
-import GHC.Unit.External
 import GHC.Unit.Finder.Types
 import GHC.Unit.Module.Graph
 import GHC.Unit.Env
@@ -75,11 +74,6 @@ data HscEnv
         hsc_IC :: InteractiveContext,
                 -- ^ The context for evaluating interactive statements
 
-        hsc_EPS :: {-# UNPACK #-} !ExternalUnitCache,
-                -- ^ Information about the currently loaded external packages.
-                -- This is mutable because packages will be demand-loaded during
-                -- a compilation run as required.
-
         hsc_NC  :: {-# UNPACK #-} !NameCache,
                 -- ^ Global Name cache so that each Name gets a single Unique.
                 -- Also track the origin of the Names.
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index ae4fd216a8..0c67d05d3a 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -241,9 +241,6 @@ import Data.Bifunctor (first, bimap)
 
 newHscEnv :: DynFlags -> IO HscEnv
 newHscEnv dflags = do
-    -- we don't store the unit databases and the unit state to still
-    -- allow `setSessionDynFlags` to be used to set unit db flags.
-    eps_var <- initExternalUnitCache
     nc_var  <- initNameCache 'r' knownKeyNames
     fc_var  <- initFinderCache
     logger  <- initLogger
@@ -254,7 +251,6 @@ newHscEnv dflags = do
                   ,  hsc_targets        = []
                   ,  hsc_mod_graph      = emptyMG
                   ,  hsc_IC             = emptyInteractiveContext dflags
-                  ,  hsc_EPS            = eps_var
                   ,  hsc_NC             = nc_var
                   ,  hsc_FC             = fc_var
                   ,  hsc_type_env_var   = Nothing
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 16d43017c6..514c3c9701 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -819,13 +819,11 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase)
                                       $ dflags
                        hsc_env' <- newHscEnv dflags'
                        (dbs,unit_state,home_unit) <- initUnits logger dflags' Nothing
-                       let unit_env = UnitEnv
-                             { ue_platform  = targetPlatform dflags'
-                             , ue_namever   = ghcNameVersion dflags'
-                             , ue_home_unit = Just home_unit
+                       unit_env0 <- initUnitEnv (ghcNameVersion dflags') (targetPlatform dflags')
+                       let unit_env = unit_env0
+                             { ue_home_unit = Just home_unit
                              , ue_units     = unit_state
                              , ue_unit_dbs  = Just dbs
-                             , ue_hpt       = emptyHomePackageTable
                              }
                        let hsc_env'' = hsc_env'
                             { hsc_unit_env = unit_env
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 912ad4fbd0..6fb31e2d7d 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -164,6 +164,7 @@ import GHC.Tc.Utils.TcType
 import GHC.Hs hiding (LIE)
 
 import GHC.Unit
+import GHC.Unit.Env
 import GHC.Unit.External
 import GHC.Unit.Module.Warnings
 import GHC.Unit.Home.ModInfo
@@ -557,7 +558,9 @@ withoutDynamicNow =
               top { hsc_dflags = dflags { dynamicNow = False} })
 
 getEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState)
-getEpsVar = do { env <- getTopEnv; return (euc_eps (hsc_EPS env)) }
+getEpsVar = do
+  env <- getTopEnv
+  return (euc_eps (ue_eps (hsc_unit_env env)))
 
 getEps :: TcRnIf gbl lcl ExternalPackageState
 getEps = do { env <- getTopEnv; liftIO $ hscEPS env }
diff --git a/compiler/GHC/Unit/Env.hs b/compiler/GHC/Unit/Env.hs
index 8ba341cb6f..2655bb166c 100644
--- a/compiler/GHC/Unit/Env.hs
+++ b/compiler/GHC/Unit/Env.hs
@@ -10,6 +10,7 @@ where
 
 import GHC.Prelude
 
+import GHC.Unit.External
 import GHC.Unit.State
 import GHC.Unit.Home
 import GHC.Unit.Types
@@ -34,6 +35,11 @@ data UnitEnv = UnitEnv
         -- Usually we don't reload the databases from disk if they are
         -- cached, even if the database flags changed!
 
+    , ue_eps :: {-# UNPACK #-} !ExternalUnitCache
+        -- ^ Information about the currently loaded external packages.
+        -- This is mutable because packages will be demand-loaded during
+        -- a compilation run as required.
+
     , ue_home_unit :: !(Maybe HomeUnit)
         -- ^ Home unit
 
@@ -66,9 +72,11 @@ data UnitEnv = UnitEnv
 
 initUnitEnv :: GhcNameVersion -> Platform -> IO UnitEnv
 initUnitEnv namever platform = do
+  eps <- initExternalUnitCache
   return $ UnitEnv
     { ue_units     = emptyUnitState
     , ue_unit_dbs  = Nothing
+    , ue_eps       = eps
     , ue_home_unit = Nothing
     , ue_hpt       = emptyHomePackageTable
     , ue_platform  = platform