From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Wed, 20 Apr 2011 16:16:46 +0000 (+0100)
Subject: Add pprDefiniteTrace and use it
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=b187c221cc97679e28118ae8ac2997d6a686ba14;hp=620410fed8ee6169ccdfd5d7f914433319b29ae8

Add pprDefiniteTrace and use it

The point here is that a very few uses of pprTrace are
controlled by a flag like -ddump-inlinings or -ddump-rule-firings,
and we want to see that output even with -dno-debug-output
---

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 8249c89..db84c90 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -1237,10 +1237,10 @@ completeCall env var cont
       | not (dopt Opt_D_dump_inlinings dflags) = stuff
       | not (dopt Opt_D_verbose_core2core dflags) 
       = if isExternalName (idName var) then 
-      	  pprTrace "Inlining done:" (ppr var) stuff
+      	  pprDefiniteTrace "Inlining done:" (ppr var) stuff
         else stuff
       | otherwise
-      = pprTrace ("Inlining done: " ++ showSDoc (ppr var))
+      = pprDefiniteTrace ("Inlining done: " ++ showSDoc (ppr var))
            (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding),
                   text "Cont:  " <+> ppr cont])
            stuff
@@ -1393,10 +1393,10 @@ tryRules env rules fn args call_cont
       , not (dopt Opt_D_dump_rule_rewrites dflags) = stuff
 
       | not (dopt Opt_D_dump_rule_rewrites dflags)
-      = pprTrace "Rule fired:" (ftext (ru_name rule)) stuff
+      = pprDefiniteTrace "Rule fired:" (ftext (ru_name rule)) stuff
 
       | otherwise
-      = pprTrace "Rule fired"
+      = pprDefiniteTrace "Rule fired"
            (vcat [text "Rule:" <+> ftext (ru_name rule),
            	  text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)),
            	  text "After: " <+> pprCoreExpr rule_rhs,
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index e178e99..c4a685b 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -60,7 +60,7 @@ module Outputable (
 	
 	-- * Error handling and debugging utilities
 	pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError, 
-	pprTrace, warnPprTrace,
+	pprTrace, pprDefiniteTrace, warnPprTrace,
 	trace, pgmError, panic, sorry, panicFastInt, assertPanic
     ) where
 
@@ -800,6 +800,9 @@ pprTrace str doc x
    | opt_NoDebugOutput = x
    | otherwise         = pprAndThen trace str doc x
 
+pprDefiniteTrace :: String -> SDoc -> a -> a
+-- ^ Same as pprTrace, but show even if -dno-debug-output is on
+pprDefiniteTrace str doc x = pprAndThen trace str doc x
 
 pprPanicFastInt :: String -> SDoc -> FastInt
 -- ^ Specialization of pprPanic that can be safely used with 'FastInt'