[commit: ghc] master: Remove pprDefiniteTrace (13f3a31)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/13f3a3196ac6c3e2f6416ff0f000ed097d67a5be

>---------------------------------------------------------------

commit 13f3a3196ac6c3e2f6416ff0f000ed097d67a5be
Author: Ian Lynagh <ian at well-typed.com>
Date:   Sun Aug 5 19:05:02 2012 +0100

    Remove pprDefiniteTrace
    
    All uses of it are now in an IO Monad, so we don't need to use
    a trace-like function.

>---------------------------------------------------------------

 compiler/simplCore/Simplify.lhs |   23 ++++++++++++-----------
 compiler/utils/Outputable.lhs   |    6 +-----
 2 files changed, 13 insertions(+), 16 deletions(-)

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index e0bc720..bc991b3 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -38,6 +38,7 @@ import TysPrim          ( realWorldStatePrimTy )
 import BasicTypes       ( TopLevelFlag(..), isTopLevel, RecFlag(..) )
 import MonadUtils       ( foldlM, mapAccumLM, liftIO )
 import Maybes           ( orElse, isNothing )
+import Control.Monad
 import Data.List        ( mapAccumL )
 import Outputable
 import FastString
@@ -1402,8 +1403,8 @@ completeCall env var cont
         ; case maybe_inline of {
             Just expr      -- There is an inlining!
               ->  do { checkedTick (UnfoldingDone var)
-                     ; trace_inline dflags expr cont $
-                       simplExprF (zapSubstEnv env) expr cont }
+                     ; dump_inline dflags expr cont
+                     ; simplExprF (zapSubstEnv env) expr cont }
 
             ; Nothing -> do               -- No inlining!
 
@@ -1412,17 +1413,17 @@ completeCall env var cont
         ; rebuildCall env info cont
     }}}
   where
-    trace_inline dflags unfolding cont stuff
-      | not (dopt Opt_D_dump_inlinings dflags) = stuff
+    dump_inline dflags unfolding cont
+      | not (dopt Opt_D_dump_inlinings dflags) = return ()
       | not (dopt Opt_D_verbose_core2core dflags)
-      = if isExternalName (idName var) then
-          pprDefiniteTrace dflags "Inlining done:" (ppr var) stuff
-        else stuff
+      = when (isExternalName (idName var)) $
+            liftIO $ printInfoForUser dflags alwaysQualify $
+                sep [text "Inlining done:", nest 4 (ppr var)]
       | otherwise
-      = pprDefiniteTrace dflags ("Inlining done: " ++ showSDocDump dflags (ppr var))
-           (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding),
-                  text "Cont:  " <+> ppr cont])
-           stuff
+      = liftIO $ printInfoForUser dflags alwaysQualify $
+           sep [text "Inlining done: " <> ppr var,
+                nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding),
+                              text "Cont:  " <+> ppr cont])]
 
 rebuildCall :: SimplEnv
             -> ArgInfo
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index a6d188a..09cf6e8 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -65,7 +65,7 @@ module Outputable (
 
         -- * Error handling and debugging utilities
         pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError,
-        pprTrace, pprDefiniteTrace, warnPprTrace,
+        pprTrace, warnPprTrace,
         trace, pgmError, panic, sorry, panicFastInt, assertPanic,
         pprDebugAndThen,
     ) where
@@ -916,10 +916,6 @@ pprTrace str doc x
    | opt_NoDebugOutput = x
    | otherwise         = pprDebugAndThen tracingDynFlags trace str doc x
 
-pprDefiniteTrace :: DynFlags -> String -> SDoc -> a -> a
--- ^ Same as pprTrace, but show even if -dno-debug-output is on
-pprDefiniteTrace dflags str doc x = pprDebugAndThen dflags trace str doc x
-
 pprPanicFastInt :: String -> SDoc -> FastInt
 -- ^ Specialization of pprPanic that can be safely used with 'FastInt'
 pprPanicFastInt heading pretty_msg = panicDocFastInt heading pretty_msg