From: simonpj <unknown>
Date: Mon, 20 Oct 2003 14:02:21 +0000 (+0000)
Subject: [project @ 2003-10-20 14:02:19 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~356
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5943a1ad1ad1296251c1576722d41df83b0c8380;p=ghc-hetmet.git

[project @ 2003-10-20 14:02:19 by simonpj]
Suppress renamer warnings (such as unused variables) when
renaming stuff generated by 'deriving' code.
---

diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index 2f63cf7..012a5d0 100644
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -248,8 +248,9 @@ deriveOrdinaryStuff eqns
 	; tcg_env <- getGblEnv
 	; let gen_binds = mkGenericBinds (typeEnvTyCons (tcg_type_env tcg_env))
 
-	-- Rename these extra bindings
-	; (rn_binds, _fvs1) <- rnTopMonoBinds (extra_binds `AndMonoBinds` gen_binds) []
+	-- Rename these extra bindings, discarding warnings about unused bindings etc
+	; (rn_binds, _fvs1) <- discardWarnings $
+			       rnTopMonoBinds (extra_binds `AndMonoBinds` gen_binds) []
 
 	; let all_binds = rn_binds `ThenBinds` 
 			  foldr ThenBinds EmptyBinds aux_binds_s
diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index 4d2e8bf..c30ead5 100644
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -403,6 +403,18 @@ 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
+  = do	{ errs_var <- newMutVar emptyMessages
+	; result <- setErrsVar errs_var thing_inside
+	; (_warns, errs) <- readMutVar errs_var
+	; addMessages (emptyBag, errs)
+	; return result }
 \end{code}