diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/rename/RnSplice.hs | 1 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 24 | ||||
| -rw-r--r-- | compiler/typecheck/TcSplice.hs | 10 |
3 files changed, 27 insertions, 8 deletions
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 1b99376a51..4b2e561d29 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -654,6 +654,7 @@ rnTopSpliceDecls splice -- -- See Note [Delaying modFinalizers in untyped splices]. add_mod_finalizers_now :: [ForeignRef (TH.Q ())] -> TcRn () + add_mod_finalizers_now [] = return () add_mod_finalizers_now mod_finalizers = do th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv updTcRef th_modfinalizers_var $ \fins -> diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index bd32d80ae1..da8c2a67a6 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -471,7 +471,8 @@ tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all tcRnSrcDecls explicit_mod_hdr decls = do { -- Do all the declarations ; ((tcg_env, tcl_env), lie) <- captureConstraints $ - do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ; + do { envs <- tc_rn_src_decls decls + ; (tcg_env, tcl_env) <- setEnvs envs run_th_modfinalizers -- Check for the 'main' declaration -- Must do this inside the captureConstraints @@ -539,6 +540,27 @@ tcRnSrcDecls explicit_mod_hdr decls } } +#ifdef GHCI +-- | Runs TH finalizers and renames and typechecks the top-level declarations +-- that they could introduce. +run_th_modfinalizers :: TcM (TcGblEnv, TcLclEnv) +run_th_modfinalizers = do + th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv + th_modfinalizers <- readTcRef th_modfinalizers_var + if null th_modfinalizers + then getEnvs + else do + writeTcRef th_modfinalizers_var [] + sequence_ th_modfinalizers + -- Finalizers can add top-level declarations with addTopDecls. + envs <- tc_rn_src_decls [] + -- addTopDecls can add declarations which add new finalizers. + setEnvs envs run_th_modfinalizers +#else +run_th_modfinalizers :: TcM (TcGblEnv, TcLclEnv) +run_th_modfinalizers = getEnvs +#endif /* GHCI */ + tc_rn_src_decls :: [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv) -- Loops around dealing with each top level inter-splice group diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index d879e56be1..861c3707fd 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -962,16 +962,12 @@ addModFinalizerRef finRef = do pprPanic "addModFinalizer was called when no finalizers were collected" (ppr th_stage) --- | Run all module finalizers +-- | Releases the external interpreter state. finishTH :: TcM () finishTH = do - tcg <- getGblEnv - let th_modfinalizers_var = tcg_th_modfinalizers tcg - modfinalizers <- readTcRef th_modfinalizers_var - writeTcRef th_modfinalizers_var [] - sequence_ modfinalizers dflags <- getDynFlags - when (gopt Opt_ExternalInterpreter dflags) $ + when (gopt Opt_ExternalInterpreter dflags) $ do + tcg <- getGblEnv writeTcRef (tcg_th_remote_state tcg) Nothing runTHExp :: ForeignHValue -> TcM TH.Exp |