diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/simplCore/Simplify.lhs | 23 | ||||
| -rw-r--r-- | 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 e0bc720419..bc991b3bf1 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 a6d188ab54..09cf6e84ec 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 |