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

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index d86b864..df6acfb 100644 (file)
--- 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 (file)
--- 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