Commit a77bbb8b authored by Facundo Domínguez's avatar Facundo Domínguez Committed by Ben Gamari

Don't ignore addTopDecls in module finalizers.

Summary:
Module finalizer could call addTopDecls, however, the declarations
added in this fashion were ignored. This patch makes sure to rename,
type check and incorporate this declarations.

Because a declaration may include a splice which calls addModFinalizer,
the list of finalizers is repeteadly checked after adding declarations
until no more finalizers remain.

Test Plan: ./validate

Reviewers: bgamari, goldfire, simonpj, austin

Reviewed By: bgamari, simonpj

Subscribers: simonmar, mboes, thomie

Differential Revision: https://phabricator.haskell.org/D2505

GHC Trac Issues: #12559

(cherry picked from commit 71dd6e44)
parent bdfb9012
......@@ -612,6 +612,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 ->
......
......@@ -477,7 +477,9 @@ 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
; tcg_env <- setEnvs (tcg_env, tcl_env) $
checkMain explicit_mod_hdr
; return (tcg_env, tcl_env) }
......@@ -548,6 +550,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
......
......@@ -961,16 +961,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
......
import TH_finalizer2M
main = print (f 0)
{-# LANGUAGE TemplateHaskell #-}
module TH_finalizer2M where
import Language.Haskell.TH.Syntax
g :: IO ()
g = $(do addModFinalizer (do d <- [d| f x = (2 :: Int) |]; addTopDecls d)
[| return ()|]
)
......@@ -401,6 +401,9 @@ test('T11341', normal, compile, ['-v0 -dsuppress-uniques'])
test('T11345', normal, compile_and_run, ['-v0 -dsuppress-uniques'])
test('TH_finalizer', normal, compile, ['-v0'])
test('TH_finalizer2',
normal, multimod_compile_and_run,
['TH_finalizer2', '-v0 ' + config.ghc_th_way_flags])
test('T10603', normal, compile, ['-ddump-splices -dsuppress-uniques'])
test('T11452', normal, compile_fail, ['-v0'])
test('T11145', normal, compile_fail, ['-v0 -dsuppress-uniques'])
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment