Encapsulate the EPS IORef in a newtype

7 files changed, 56 insertions, 42 deletions

diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index d18fedfdfa..16a7d58448 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -508,13 +508,13 @@ innerBkpM do_this =
 updateEpsGhc_ :: GhcMonad m => (ExternalPackageState -> ExternalPackageState) -> m ()
 updateEpsGhc_ f = do
     hsc_env <- getSession
-    liftIO $ atomicModifyIORef' (hsc_EPS hsc_env) (\x -> (f x, ()))
+    liftIO $ atomicModifyIORef' (euc_eps (hsc_EPS hsc_env)) (\x -> (f x, ()))
 
 -- | Get the EPS from a 'GhcMonad'.
 getEpsGhc :: GhcMonad m => m ExternalPackageState
 getEpsGhc = do
     hsc_env <- getSession
-    liftIO $ readIORef (hsc_EPS hsc_env)
+    liftIO $ hscEPS hsc_env
 
 -- | Run 'BkpM' in 'Ghc'.
 initBkpM :: FilePath -> [LHsUnit HsComponentId] -> BkpM a -> Ghc a
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index 8d9aa961fb..4bf2d9b72e 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -162,7 +162,7 @@ configured via command-line flags (in `GHC.setSessionDynFlags`).
 
 -- | Retrieve the ExternalPackageState cache.
 hscEPS :: HscEnv -> IO ExternalPackageState
-hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
+hscEPS hsc_env = readIORef (euc_eps (hsc_EPS hsc_env))
 
 hptCompleteSigs :: HscEnv -> [CompleteMatch]
 hptCompleteSigs = hptAllThings  (md_complete_matches . hm_details)
@@ -248,7 +248,7 @@ prepareAnnotations hsc_env mb_guts = do
 -- have to do that yourself, if desired
 lookupType :: HscEnv -> Name -> IO (Maybe TyThing)
 lookupType hsc_env name = do
-   eps <- liftIO $ readIORef (hsc_EPS hsc_env)
+   eps <- liftIO $ hscEPS hsc_env
    let pte = eps_PTE eps
        hpt = hsc_HPT hsc_env
 
diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs
index abf19a0afa..402366894d 100644
--- a/compiler/GHC/Driver/Env/Types.hs
+++ b/compiler/GHC/Driver/Env/Types.hs
@@ -97,7 +97,7 @@ data HscEnv
                 --
                 -- (This changes a previous invariant: changed Jan 05.)
 
-        hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),
+        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.
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index aca035e026..e25dfa7053 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -117,7 +117,7 @@ import GHC.StgToByteCode    ( byteCodeGen, stgExprToBCOs )
 
 import GHC.IfaceToCore  ( typecheckIface )
 
-import GHC.Iface.Load   ( ifaceStats, initExternalPackageState, writeIface )
+import GHC.Iface.Load   ( ifaceStats, writeIface )
 import GHC.Iface.Make
 import GHC.Iface.Recomp
 import GHC.Iface.Tidy
@@ -242,7 +242,7 @@ 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 <- newIORef initExternalPackageState
+    eps_var <- initExternalUnitCache
     nc_var  <- initNameCache 'r' knownKeyNames
     fc_var  <- initFinderCache
     logger  <- initLogger
@@ -2141,7 +2141,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
 
 dumpIfaceStats :: HscEnv -> IO ()
 dumpIfaceStats hsc_env = do
-    eps <- readIORef (hsc_EPS hsc_env)
+    eps <- hscEPS hsc_env
     dumpIfSet logger dflags (dump_if_trace || dump_rn_stats)
               "Interface statistics"
               (ifaceStats eps)
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 10033ad2ce..8cd93e058f 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -26,7 +26,6 @@ module GHC.Iface.Load (
         loadInterface,
         loadSysInterface, loadUserInterface, loadPluginInterface,
         findAndReadIface, readIface, writeIface,
-        initExternalPackageState,
         moduleFreeHolesPrecise,
         needWiredInHomeIface, loadWiredInHomeIface,
 
@@ -997,33 +996,6 @@ readIface dflags name_cache wanted_mod file_path = do
 *********************************************************
 -}
 
-initExternalPackageState :: ExternalPackageState
-initExternalPackageState
-  = EPS {
-      eps_is_boot          = emptyUFM,
-      eps_PIT              = emptyPackageIfaceTable,
-      eps_free_holes       = emptyInstalledModuleEnv,
-      eps_PTE              = emptyTypeEnv,
-      eps_inst_env         = emptyInstEnv,
-      eps_fam_inst_env     = emptyFamInstEnv,
-      eps_rule_base        = mkRuleBase builtinRules,
-        -- Initialise the EPS rule pool with the built-in rules
-      eps_mod_fam_inst_env = emptyModuleEnv,
-      eps_complete_matches = [],
-      eps_ann_env          = emptyAnnEnv,
-      eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
-                           , n_insts_in = 0, n_insts_out = 0
-                           , n_rules_in = length builtinRules, n_rules_out = 0 }
-    }
-
-{-
-*********************************************************
-*                                                       *
-        Wired-in interface for GHC.Prim
-*                                                       *
-*********************************************************
--}
-
 -- See Note [GHC.Prim] in primops.txt.pp.
 ghcPrimIface :: ModIface
 ghcPrimIface
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 0bdfa00d5d..912ad4fbd0 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -557,10 +557,10 @@ withoutDynamicNow =
               top { hsc_dflags = dflags { dynamicNow = False} })
 
 getEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState)
-getEpsVar = do { env <- getTopEnv; return (hsc_EPS env) }
+getEpsVar = do { env <- getTopEnv; return (euc_eps (hsc_EPS env)) }
 
 getEps :: TcRnIf gbl lcl ExternalPackageState
-getEps = do { env <- getTopEnv; readMutVar (hsc_EPS env) }
+getEps = do { env <- getTopEnv; liftIO $ hscEPS env }
 
 -- | Update the external package state.  Returns the second result of the
 -- modifier function.
@@ -586,7 +586,7 @@ getHpt :: TcRnIf gbl lcl HomePackageTable
 getHpt = do { env <- getTopEnv; return (hsc_HPT env) }
 
 getEpsAndHpt :: TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
-getEpsAndHpt = do { env <- getTopEnv; eps <- readMutVar (hsc_EPS env)
+getEpsAndHpt = do { env <- getTopEnv; eps <- liftIO $ hscEPS env
                   ; return (eps, hsc_HPT env) }
 
 -- | A convenient wrapper for taking a @MaybeErr SDoc a@ and throwing
diff --git a/compiler/GHC/Unit/External.hs b/compiler/GHC/Unit/External.hs
index 2ee6191ec9..177a9db2ba 100644
--- a/compiler/GHC/Unit/External.hs
+++ b/compiler/GHC/Unit/External.hs
@@ -1,5 +1,8 @@
 module GHC.Unit.External
-   ( ExternalPackageState (..)
+   ( ExternalUnitCache (..)
+   , initExternalUnitCache
+   , ExternalPackageState (..)
+   , initExternalPackageState
    , EpsStats(..)
    , addEpsInStats
    , PackageTypeEnv
@@ -19,12 +22,17 @@ import GHC.Unit.Module.ModIface
 
 import GHC.Core         ( RuleBase )
 import GHC.Core.FamInstEnv
-import GHC.Core.InstEnv ( InstEnv )
+import GHC.Core.InstEnv ( InstEnv, emptyInstEnv )
+import GHC.Core.Opt.ConstantFold
+import GHC.Core.Rules (mkRuleBase)
 
-import GHC.Types.Annotations ( AnnEnv )
+import GHC.Types.Annotations ( AnnEnv, emptyAnnEnv )
 import GHC.Types.CompleteMatch
 import GHC.Types.TypeEnv
 import GHC.Types.Unique.DSet
+import GHC.Types.Unique.FM
+
+import Data.IORef
 
 
 type PackageTypeEnv          = TypeEnv
@@ -42,6 +50,40 @@ type PackageIfaceTable = ModuleEnv ModIface
 emptyPackageIfaceTable :: PackageIfaceTable
 emptyPackageIfaceTable = emptyModuleEnv
 
+-- | Information about the currently loaded external packages.
+-- This is mutable because packages will be demand-loaded during
+-- a compilation run as required.
+newtype ExternalUnitCache = ExternalUnitCache
+  { euc_eps :: IORef ExternalPackageState
+  }
+
+initExternalUnitCache :: IO ExternalUnitCache
+initExternalUnitCache = ExternalUnitCache <$> newIORef initExternalPackageState
+
+initExternalPackageState :: ExternalPackageState
+initExternalPackageState = EPS
+  { eps_is_boot          = emptyUFM
+  , eps_PIT              = emptyPackageIfaceTable
+  , eps_free_holes       = emptyInstalledModuleEnv
+  , eps_PTE              = emptyTypeEnv
+  , eps_inst_env         = emptyInstEnv
+  , eps_fam_inst_env     = emptyFamInstEnv
+  , eps_rule_base        = mkRuleBase builtinRules
+  , -- Initialise the EPS rule pool with the built-in rules
+    eps_mod_fam_inst_env = emptyModuleEnv
+  , eps_complete_matches = []
+  , eps_ann_env          = emptyAnnEnv
+  , eps_stats            = EpsStats
+                            { n_ifaces_in = 0
+                            , n_decls_in = 0
+                            , n_decls_out = 0
+                            , n_insts_in = 0
+                            , n_insts_out = 0
+                            , n_rules_in = length builtinRules
+                            , n_rules_out = 0
+                            }
+  }
+
 
 -- | Information about other packages that we have slurped in by reading
 -- their interface files