add debugDumpTcRn and use it for some debugging output
authorSimon Marlow <marlowsd@gmail.com>
Tue, 3 Jun 2008 11:20:30 +0000 (11:20 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Tue, 3 Jun 2008 11:20:30 +0000 (11:20 +0000)
compiler/typecheck/TcRnMonad.lhs
compiler/typecheck/TcSimplify.lhs

index 804098a..7f1a7fe 100644 (file)
@@ -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)
index 6d68ed8..ee62c0e 100644 (file)
@@ -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)