diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2011-04-20 17:16:46 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2011-04-20 17:16:46 +0100 |
| commit | b187c221cc97679e28118ae8ac2997d6a686ba14 (patch) | |
| tree | 290f3690e95a567381717df54ff5ee9608c02d6f | |
| parent | 620410fed8ee6169ccdfd5d7f914433319b29ae8 (diff) | |
| download | haskell-b187c221cc97679e28118ae8ac2997d6a686ba14.tar.gz | |
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
| -rw-r--r-- | compiler/simplCore/Simplify.lhs | 8 | ||||
| -rw-r--r-- | compiler/utils/Outputable.lhs | 5 |
2 files changed, 8 insertions, 5 deletions
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 8249c89425..db84c90fc2 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 e178e99f0d..c4a685b3b5 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' |