Remove pprDefiniteTrace
authorIan Lynagh <ian@well-typed.com>
Sun, 5 Aug 2012 18:05:02 +0000 (19:05 +0100)
committerIan Lynagh <ian@well-typed.com>
Sun, 5 Aug 2012 18:05:02 +0000 (19:05 +0100)
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
compiler/utils/Outputable.lhs

index e0bc720..bc991b3 100644 (file)
@@ -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
index a6d188a..09cf6e8 100644 (file)
@@ -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