From 9c84f11b774960077d33d94a23ebc42af79d2ec4 Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Sat, 27 Nov 2010 12:20:22 +0000 Subject: [PATCH] New flag -dddump-rule-rewrites Now, -ddump-rule-firings only shows the names of the rules that fired (it would show "before" and "after" with -dverbose-core2core previously) and -ddump-rule-rewrites always shows the "before" and "after" bits, even without -dverbose-core2core. --- compiler/main/DynFlags.hs | 2 ++ compiler/simplCore/Simplify.lhs | 7 ++++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4c52d2a..7a4607a 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -133,6 +133,7 @@ data DynFlag | Opt_D_dump_foreign | Opt_D_dump_inlinings | Opt_D_dump_rule_firings + | Opt_D_dump_rule_rewrites | Opt_D_dump_occur_anal | Opt_D_dump_parsed | Opt_D_dump_rn @@ -1232,6 +1233,7 @@ dynamic_flags = [ , Flag "ddump-foreign" (setDumpFlag Opt_D_dump_foreign) , Flag "ddump-inlinings" (setDumpFlag Opt_D_dump_inlinings) , Flag "ddump-rule-firings" (setDumpFlag Opt_D_dump_rule_firings) + , Flag "ddump-rule-rewrites" (setDumpFlag Opt_D_dump_rule_rewrites) , Flag "ddump-occur-anal" (setDumpFlag Opt_D_dump_occur_anal) , Flag "ddump-parsed" (setDumpFlag Opt_D_dump_parsed) , Flag "ddump-rn" (setDumpFlag Opt_D_dump_rn) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index df80c4a..7894d7e 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -1363,14 +1363,15 @@ tryRules env rules fn args call_cont return (Just (ruleArity rule, rule_rhs)) }}}} where trace_dump dflags rule rule_rhs stuff - | not (dopt Opt_D_dump_rule_firings dflags) = stuff - | not (dopt Opt_D_verbose_core2core dflags) + | not (dopt Opt_D_dump_rule_firings dflags) + , not (dopt Opt_D_dump_rule_rewrites dflags) = stuff + | not (dopt Opt_D_dump_rule_rewrites dflags) = pprTrace "Rule fired:" (ftext (ru_name rule)) stuff | otherwise = pprTrace "Rule fired" (vcat [text "Rule:" <+> ftext (ru_name rule), - text "Before:" <+> ppr fn <+> sep (map pprParendExpr args), + text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)), text "After: " <+> pprCoreExpr rule_rhs, text "Cont: " <+> ppr call_cont]) stuff -- 1.7.10.4