From: simonpj <unknown>
Date: Mon, 16 May 2005 12:40:14 +0000 (+0000)
Subject: [project @ 2005-05-16 12:40:14 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~546
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=94cc5f40a24dc5ada1e9b358868ce7f43f440a47;p=ghc-hetmet.git

[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
--- 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
--- 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
 
 	;