Commit e5013a56 authored by Krzysztof Gogolewski's avatar Krzysztof Gogolewski Committed by Ben Gamari

Make TcRnMonad independent of TcSplice (#14391)

Test Plan: validate

Reviewers: simonpj, bgamari

Reviewed By: simonpj

Subscribers: rwbarton, carter

GHC Trac Issues: #14391

Differential Revision: https://phabricator.haskell.org/D5135
parent 98daa34c
......@@ -51,7 +51,6 @@ import {-# SOURCE #-} TcSplice
, runMetaE
, runMetaP
, runMetaT
, runRemoteModFinalizers
, tcTopSpliceExpr
)
......@@ -638,9 +637,16 @@ rnTopSpliceDecls splice
rnSplice splice
-- As always, be sure to checkNoErrs above lest we end up with
-- holes making it to typechecking, hence #12584.
--
-- Note that we cannot call checkNoErrs for the whole duration
-- of rnTopSpliceDecls. The reason is that checkNoErrs changes
-- the local environment to temporarily contain a new
-- reference to store errors, and add_mod_finalizers would
-- cause this reference to be stored after checkNoErrs finishes.
-- This is checked by test TH_finalizer.
; traceRn "rnTopSpliceDecls: untyped declaration splice" empty
; (decls, mod_finalizers) <-
runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
; (decls, mod_finalizers) <- checkNoErrs $
runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
; add_mod_finalizers_now mod_finalizers
; return (decls,fvs) }
where
......@@ -658,8 +664,9 @@ rnTopSpliceDecls splice
add_mod_finalizers_now [] = return ()
add_mod_finalizers_now mod_finalizers = do
th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
env <- getLclEnv
updTcRef th_modfinalizers_var $ \fins ->
runRemoteModFinalizers (ThModFinalizers mod_finalizers) : fins
(env, ThModFinalizers mod_finalizers) : fins
{-
......
......@@ -47,7 +47,7 @@ module TcRnDriver (
import GhcPrelude
import {-# SOURCE #-} TcSplice ( finishTH )
import {-# SOURCE #-} TcSplice ( finishTH, runRemoteModFinalizers )
import RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )
import IfaceEnv( externaliseName )
import TcHsType
......@@ -470,8 +470,10 @@ run_th_modfinalizers = do
then getEnvs
else do
writeTcRef th_modfinalizers_var []
(_, lie_th) <- captureTopConstraints $
sequence_ th_modfinalizers
let run_finalizer (lcl_env, f) =
setLclEnv lcl_env (runRemoteModFinalizers f)
(_, lie_th) <- captureTopConstraints $ mapM_ run_finalizer th_modfinalizers
-- Finalizers can add top-level declarations with addTopDecls, so
-- we have to run tc_rn_src_decls to get them
(tcg_env, tcl_env, lie_top_decls) <- tc_rn_src_decls []
......@@ -550,8 +552,7 @@ tc_rn_src_decls ds
do { recordTopLevelSpliceLoc loc
-- Rename the splice expression, and get its supporting decls
; (spliced_decls, splice_fvs) <- checkNoErrs (rnTopSpliceDecls
splice)
; (spliced_decls, splice_fvs) <- rnTopSpliceDecls splice
-- Glue them on the front of the remaining decls and loop
; (tcg_env, tcl_env, lie2) <-
......
......@@ -183,7 +183,6 @@ import Control.Monad
import Data.Set ( Set )
import qualified Data.Set as Set
import {-# SOURCE #-} TcSplice ( runRemoteModFinalizers )
import {-# SOURCE #-} TcEnv ( tcInitTidyEnv )
import qualified Data.Map as Map
......@@ -1715,8 +1714,7 @@ addModFinalizersWithLclEnv mod_finalizers
= do lcl_env <- getLclEnv
th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
updTcRef th_modfinalizers_var $ \fins ->
setLclEnv lcl_env (runRemoteModFinalizers mod_finalizers)
: fins
(lcl_env, mod_finalizers) : fins
{-
************************************************************************
......
......@@ -633,11 +633,10 @@ data TcGblEnv
tcg_th_topnames :: TcRef NameSet,
-- ^ Exact names bound in top-level declarations in tcg_th_topdecls
tcg_th_modfinalizers :: TcRef [TcM ()],
tcg_th_modfinalizers :: TcRef [(TcLclEnv, ThModFinalizers)],
-- ^ Template Haskell module finalizers.
--
-- They are computations in the @TcM@ monad rather than @Q@ because we
-- set them to use particular local environments.
-- They can use particular local environments.
tcg_th_coreplugins :: TcRef [String],
-- ^ Core plugins added by Template Haskell code.
......
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