From 71dd6e4429833238bcdaf96da8e2e41a62dacbf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Facundo=20Dom=C3=ADnguez?= Date: Thu, 1 Sep 2016 11:00:08 -0300 Subject: 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 --- compiler/rename/RnSplice.hs | 1 + compiler/typecheck/TcRnDriver.hs | 24 +++++++++++++++++++++++- compiler/typecheck/TcSplice.hs | 10 +++------- 3 files changed, 27 insertions(+), 8 deletions(-) (limited to 'compiler') 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 -- cgit v1.2.1