[project @ 2005-05-16 12:40:14 by simonpj]

Better debug-printing for -ddump-inlinings

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 931a1a8..e7e7da3 100644 (file)
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -609,10 +609,7 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con
                                   text "is value:" <+> ppr is_value,
                                   text "is cheap:" <+> ppr is_cheap,
                                   text "guidance" <+> ppr guidance,
-                                  text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO",
-                                  if yes_or_no then
-                                       text "Unfolding =" <+> pprCoreExpr unf_template
-                                  else empty])
+                                  text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
                  result
     else
     result

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 1f88c60..aa008a6 100644 (file)
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -1001,6 +1001,13 @@ completeCall env var occ_info cont
     case maybe_inline of {
        Just unfolding          -- There is an inlining!
          ->  tick (UnfoldingDone var)          `thenSmpl_`
+               (if dopt Opt_D_dump_inlinings dflags then
+                  pprTrace "Inlining done" (vcat [
+                       text "Before:" <+> ppr var <+> sep (map pprParendExpr args),
+                       text "Inlined fn: " <+> ppr unfolding,
+                       text "Cont:  " <+> ppr call_cont])
+                else
+                       id)             $
              makeThatCall env var unfolding args call_cont
 
        ;