From e18bb2e86eb13bdb98cc0afc7c2aa8e56d98bcc7 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 11 Jan 2001 14:09:50 +0000
Subject: [PATCH] [project @ 2001-01-11 14:09:50 by simonpj] Add debug print
 for rule firings; controlled by -ddump-inlinings.

Also, make -ddump-inlinings work without -DDEBUG is off.
It's jolly useful, and it's tiresome to have to tell
people to rebuild their compiler.
---
 ghc/compiler/coreSyn/CoreUnfold.lhs |    2 --
 ghc/compiler/simplCore/Simplify.lhs |   11 +++++++++++
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index d86b864..df6acfb 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -614,7 +614,6 @@ callSiteInline dflags black_listed inline_call occ id arg_infos interesting_cont
 						 arg_infos really_interesting_cont
 		
     in    
-#ifdef DEBUG
     if dopt Opt_D_dump_inlinings dflags then
 	pprTrace "Considering inlining"
 		 (ppr id <+> vcat [text "black listed:" <+> ppr black_listed,
@@ -630,7 +629,6 @@ callSiteInline dflags black_listed inline_call occ id arg_infos interesting_cont
 				   else empty])
 		  result
     else
-#endif
     result
     }
 
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 76da6e5..34f4dee 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -10,6 +10,7 @@ module Simplify ( simplTopBinds, simplExpr ) where
 
 import CmdLineOpts	( switchIsOn, opt_SimplDoEtaReduction,
 			  opt_SimplNoPreInlining, 
+			  dopt, DynFlag(Opt_D_dump_inlinings),
 			  SimplifierSwitch(..)
 			)
 import SimplMonad
@@ -38,6 +39,7 @@ import DataCon		( dataConNumInstArgs, dataConRepStrictness,
 			  dataConSig, dataConArgTys
 			)
 import CoreSyn
+import PprCore		( pprParendExpr, pprCoreExpr )
 import CoreFVs		( mustHaveLocalBinding, exprFreeVars )
 import CoreUnfold	( mkOtherCon, mkUnfolding, otherCons,
 			  callSiteInline
@@ -830,6 +832,15 @@ completeCall var occ_info cont
     case maybe_rule of {
 	Just (rule_name, rule_rhs) -> 
 		tick (RuleFired rule_name)			`thenSmpl_`
+#ifdef DEBUG
+		(if dopt Opt_D_dump_inlinings dflags then
+		   pprTrace "Rule fired" (vcat [
+			text "Rule:" <+> ptext rule_name,
+			text "Before:" <+> ppr var <+> sep (map pprParendExpr args'),
+			text "After: " <+> pprCoreExpr rule_rhs])
+		 else
+			id)		$
+#endif
 		simplExprF rule_rhs call_cont ;
 	
 	Nothing -> 		-- No rules
-- 
1.7.10.4