diff options
| -rw-r--r-- | compiler/rename/RnSplice.hs | 15 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 11 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnMonad.hs | 4 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnTypes.hs | 5 |
4 files changed, 20 insertions, 15 deletions
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 19bf763f63..c26d03a645 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -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 {- diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 74319c0229..e53314dedc 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -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) <- diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 12b88dd30b..b93652fb3c 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -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 {- ************************************************************************ diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 322e4e0bba..695d2aea8a 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -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. |