[project @ 2003-10-29 18:14:27 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnMonad.lhs

diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index 4d2e8bf..47cd402 100644 (file)
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -92,7 +92,8 @@ initTc hsc_env mod do_this
                tcg_deprecs  = NoDeprecs,
                tcg_insts    = [],
                tcg_rules    = [],
-               tcg_fords    = []
+               tcg_fords    = [],
+               tcg_keep     = emptyNameSet
             } ;
             lcl_env = TcLclEnv {
                tcl_errs       = errs_var,
@@ -403,6 +404,20 @@ addMessages (m_warns, m_errs)
         (warns, errs) <- readMutVar errs_var ;
         writeMutVar errs_var (warns `unionBags` m_warns,
                               errs  `unionBags` m_errs) }
+
+discardWarnings :: TcRn a -> TcRn a
+-- Ignore warnings inside the thing inside;
+-- used to ignore-unused-variable warnings inside derived code
+-- With -dppr-debug, the effects is switched off, so you can still see
+-- what warnings derived code would give
+discardWarnings thing_inside
+  | opt_PprStyle_Debug = thing_inside
+  | otherwise
+  = do { errs_var <- newMutVar emptyMessages
+       ; result <- setErrsVar errs_var thing_inside
+       ; (_warns, errs) <- readMutVar errs_var
+       ; addMessages (emptyBag, errs)
+       ; return result }
 \end{code}