summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Driver/Backpack.hs4
-rw-r--r--compiler/GHC/Driver/Env.hs4
-rw-r--r--compiler/GHC/Driver/Env/Types.hs2
-rw-r--r--compiler/GHC/Driver/Main.hs6
-rw-r--r--compiler/GHC/Iface/Load.hs28
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs6
-rw-r--r--compiler/GHC/Unit/External.hs48
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
View Lorry Controller Status