diff options
-rw-r--r-- | compiler/typecheck/TcRnDriver.lhs | 9 | ||||
-rw-r--r-- | compiler/typecheck/TcRnMonad.lhs | 10 | ||||
-rw-r--r-- | compiler/typecheck/TcRnTypes.lhs | 7 | ||||
-rw-r--r-- | compiler/typecheck/TcSplice.lhs | 12 | ||||
-rw-r--r-- | compiler/typecheck/TcSplice.lhs-boot | 1 |
5 files changed, 33 insertions, 6 deletions
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 482885d36b..314d50f917 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 @@ -532,6 +532,13 @@ tc_rn_src_decls boot_details ds { 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 97c6fb1bb9..a628510353 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -91,8 +91,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 ; @@ -102,8 +103,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 5889f74359..357bb11551 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -114,6 +114,10 @@ import ListSetOps import FastString import Data.Set (Set) + +#ifdef GHCI +import qualified Language.Haskell.TH as TH +#endif \end{code} @@ -296,6 +300,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 d64b456710..b91cbf6aab 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -14,7 +14,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" @@ -836,6 +836,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) @@ -1084,6 +1090,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 d33641ff68..9bacd1f707 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) |