summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Utils/Monad.hs
diff options
context:
space:
mode:
authorZubin Duggal <zubin.duggal@gmail.com>2022-02-09 17:01:38 +0530
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-02-20 13:56:15 -0500
commit4b04f7e175a01b30e098af63dfabe6ea068e9b0b (patch)
tree559e4dc5ba03f5ac8fc8917dcccef9f7c71e6507 /compiler/GHC/Tc/Utils/Monad.hs
parent67dd5724297094af93be1887ef000845722c6f2b (diff)
downloadhaskell-4b04f7e175a01b30e098af63dfabe6ea068e9b0b.tar.gz
Track object file dependencies for TH accurately (#20604)
`hscCompileCoreExprHook` is changed to return a list of `Module`s required by a splice. These modules are accumulated in the TcGblEnv (tcg_th_needed_mods). Dependencies on the object files of these modules are recording in the interface. The data structures in `LoaderState` are replaced with more efficient versions to keep track of all the information required. The MultiLayerModulesTH_Make allocations increase slightly but runtime is faster. Fixes #20604 ------------------------- Metric Increase: MultiLayerModulesTH_Make -------------------------
Diffstat (limited to 'compiler/GHC/Tc/Utils/Monad.hs')
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs22
1 files changed, 15 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index ca2915e8fa..72670e6b06 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -58,7 +58,7 @@ module GHC.Tc.Utils.Monad(
getRdrEnvs, getImports,
getFixityEnv, extendFixityEnv, getRecFieldEnv,
getDeclaredDefaultTys,
- addDependentFiles, getMnwib,
+ addDependentFiles,
-- * Error management
getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM, addLocMA, inGeneratedCode,
@@ -116,7 +116,7 @@ module GHC.Tc.Utils.Monad(
emitNamedTypeHole, IsExtraConstraint(..), emitAnonTypeHole,
-- * Template Haskell context
- recordThUse, recordThSpliceUse,
+ recordThUse, recordThSpliceUse, recordThNeededRuntimeDeps,
keepAlive, getStage, getStageAndBindLevel, setStage,
addModFinalizersWithLclEnv,
@@ -222,6 +222,8 @@ import {-# SOURCE #-} GHC.Tc.Utils.Env ( tcInitTidyEnv )
import qualified Data.Map as Map
import GHC.Driver.Env.KnotVars
+import GHC.Linker.Types
+import GHC.Types.Unique.DFM
{-
************************************************************************
@@ -263,6 +265,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
th_state_var <- newIORef Map.empty ;
th_remote_state_var <- newIORef Nothing ;
th_docs_var <- newIORef Map.empty ;
+ th_needed_deps_var <- newIORef ([], emptyUDFM) ;
next_wrapper_num <- newIORef emptyModuleEnv ;
let {
-- bangs to avoid leaking the env (#19356)
@@ -311,6 +314,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_ann_env = emptyAnnEnv,
tcg_th_used = th_var,
tcg_th_splice_used = th_splice_var,
+ tcg_th_needed_deps = th_needed_deps_var,
tcg_exports = [],
tcg_imports = emptyImportAvails,
tcg_used_gres = used_gre_var,
@@ -963,11 +967,6 @@ getSrcSpanM :: TcRn SrcSpan
-- Avoid clash with Name.getSrcLoc
getSrcSpanM = do { env <- getLclEnv; return (RealSrcSpan (tcl_loc env) Strict.Nothing) }
-getMnwib :: TcRn ModuleNameWithIsBoot
-getMnwib = do
- gbl_env <- getGblEnv
- return $ GWIB (moduleName $ tcg_mod gbl_env) (hscSourceToIsBoot (tcg_src gbl_env))
-
-- See Note [Error contexts in generated code]
inGeneratedCode :: TcRn Bool
inGeneratedCode = tcl_in_gen_code <$> getLclEnv
@@ -2010,6 +2009,15 @@ recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True }
recordThSpliceUse :: TcM ()
recordThSpliceUse = do { env <- getGblEnv; writeTcRef (tcg_th_splice_used env) True }
+recordThNeededRuntimeDeps :: [Linkable] -> PkgsLoaded -> TcM ()
+recordThNeededRuntimeDeps new_links new_pkgs
+ = do { env <- getGblEnv
+ ; updTcRef (tcg_th_needed_deps env) $ \(needed_links, needed_pkgs) ->
+ let links = new_links ++ needed_links
+ !pkgs = plusUDFM needed_pkgs new_pkgs
+ in (links, pkgs)
+ }
+
keepAlive :: Name -> TcRn () -- Record the name in the keep-alive set
keepAlive name
= do { env <- getGblEnv