diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index d65d6c34e3f8286ab8b355558cb7e2c02753356d..4a206d839ed4417fed93e282f6b6bd4ab55f769b 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -22,7 +22,7 @@ module TcRnDriver ( ) where #ifdef GHCI -import {-# SOURCE #-} TcSplice ( tcSpliceDecls ) +import {-# SOURCE #-} TcSplice ( tcSpliceDecls, runQuasi ) import RnSplice ( rnSplice ) #endif @@ -521,6 +521,15 @@ tc_rn_src_decls boot_details ds ; setEnvs (tcg_env, tcl_env) $ case group_tail of { Nothing -> do { tcg_env <- checkMain -- Check for `main' + ; traceTc "returning from tc_rn_src_decls: " $ + ppr $ nameEnvElts $ tcg_type_env tcg_env -- RAE +#ifdef GHCI + -- Run all module finalizers + ; th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv + ; modfinalizers <- readTcRef th_modfinalizers_var + ; writeTcRef th_modfinalizers_var [] + ; mapM_ runQuasi modfinalizers +#endif /* GHCI */ ; return (tcg_env, tcl_env) } diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index cb40aaa14a3116131c2e688e8f859d00a5db7be3..3ceebab733ede1d10122b321cdfabc38d7c6e4eb 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -92,8 +92,9 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this dependent_files_var <- newIORef [] ; #ifdef GHCI - th_topdecls_var <- newIORef [] ; - th_topnames_var <- newIORef emptyNameSet ; + th_topdecls_var <- newIORef [] ; + th_topnames_var <- newIORef emptyNameSet ; + th_modfinalizers_var <- newIORef [] ; #endif /* GHCI */ let { maybe_rn_syntax :: forall a. a -> Maybe a ; @@ -103,8 +104,9 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this gbl_env = TcGblEnv { #ifdef GHCI - tcg_th_topdecls = th_topdecls_var, - tcg_th_topnames = th_topnames_var, + tcg_th_topdecls = th_topdecls_var, + tcg_th_topnames = th_topnames_var, + tcg_th_modfinalizers = th_modfinalizers_var, #endif /* GHCI */ tcg_mod = mod, diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index b047e0a282e343cd977245d32400ffca1f5880f3..a4be867dc571177309ef351ce862cd513eca08f5 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -117,6 +117,9 @@ import Util import Data.Set (Set) +#ifdef GHCI +import qualified Language.Haskell.TH as TH +#endif \end{code} @@ -303,6 +306,9 @@ data TcGblEnv tcg_th_topnames :: TcRef NameSet, -- ^ Exact names bound in top-level declarations in tcg_th_topdecls + + tcg_th_modfinalizers :: TcRef [TH.Q ()], + -- ^ Template Haskell module finalizers #endif /* GHCI */ tcg_ev_binds :: Bag EvBind, -- Top-level evidence bindings diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 041df8413a60523994f2d73dd9e8cc7c9c50a678..7807f58af725c7aeb31a484462ab169a635f796a 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -13,7 +13,7 @@ module TcSplice( tcSpliceType, tcSpliceExpr, tcSpliceDecls, tcBracket, runQuasiQuoteExpr, runQuasiQuotePat, runQuasiQuoteDecl, runQuasiQuoteType, runAnnotation, - runMetaE, runMetaP, runMetaT, runMetaD ) where + runQuasi, runMetaE, runMetaP, runMetaT, runMetaD ) where #include "HsVersions.h" @@ -832,6 +832,12 @@ deprecatedDollar quoter %* * %************************************************************************ + +\begin{code} +runQuasi :: TH.Q a -> TcM a +runQuasi act = TH.runQ act +\end{code} + \begin{code} data MetaOps th_syn hs_syn = MT { mt_desc :: String -- Type of beast (expression, type etc) @@ -1079,6 +1085,10 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where addErr $ hang (ptext (sLit "The binder") <+> quotes (ppr name) <+> ptext (sLit "is not a NameU.")) 2 (text "Probable cause: you used mkName instead of newName to generate a binding.") + + qAddModFinalizer fin = do + th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv + updTcRef th_modfinalizers_var (\fins -> fin:fins) \end{code} diff --git a/compiler/typecheck/TcSplice.lhs-boot b/compiler/typecheck/TcSplice.lhs-boot index d33641ff6889445fe7ab0f857e7e421c55bfa43f..9bacd1f7076c684f52ae822f6ab66b0ceb17d78f 100644 --- a/compiler/typecheck/TcSplice.lhs-boot +++ b/compiler/typecheck/TcSplice.lhs-boot @@ -35,6 +35,7 @@ runQuasiQuoteType :: HsQuasiQuote RdrName -> TcM (LHsType RdrName) runQuasiQuotePat :: HsQuasiQuote RdrName -> TcM (LPat RdrName) runAnnotation :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation +runQuasi :: TH.Q a -> TcM a runMetaE :: LHsExpr Id -> TcM (LHsExpr RdrName) runMetaP :: LHsExpr Id -> TcM (LPat RdrName) runMetaT :: LHsExpr Id -> TcM (LHsType RdrName)