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

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