From: Simon Marlow <marlowsd@gmail.com>
Date: Tue, 3 Jun 2008 11:20:30 +0000 (+0000)
Subject: add debugDumpTcRn and use it for some debugging output
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=fce61e356063836debcc579e336e99a65d61284e

add debugDumpTcRn and use it for some debugging output
---

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 804098a..7f1a7fe 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -361,7 +361,11 @@ traceOptTcRn flag doc = ifOptM flag $ do
 dumpTcRn :: SDoc -> TcRn ()
 dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
                     dflags <- getDOpts ;
-		    liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
+                        liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
+
+debugDumpTcRn :: SDoc -> TcRn ()
+debugDumpTcRn doc | opt_NoDebugOutput = return ()
+                  | otherwise         = dumpTcRn doc
 
 dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
 dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 6d68ed8..ee62c0e 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -1908,7 +1908,7 @@ reduceList env@(RedEnv {red_stack = (n,stk)}) wanteds state
   = do	{ traceTc (text "reduceList " <+> (ppr wanteds $$ ppr state))
 	; dopts <- getDOpts
 	; when (debugIsOn && (n > 8)) $ do
-		dumpTcRn (hang (ptext (sLit "Interesting! Context reduction stack depth") <+> int n) 
+		debugDumpTcRn (hang (ptext (sLit "Interesting! Context reduction stack depth") <+> int n) 
 			     2 (ifPprDebug (nest 2 (pprStack stk))))
 	; if n >= ctxtStkDepth dopts then
 	    failWithTc (reduceDepthErr n stk)