diff options
| author | Roman Leshchinskiy <rl@cse.unsw.edu.au> | 2010-11-27 12:20:22 +0000 |
|---|---|---|
| committer | Roman Leshchinskiy <rl@cse.unsw.edu.au> | 2010-11-27 12:20:22 +0000 |
| commit | 9c84f11b774960077d33d94a23ebc42af79d2ec4 (patch) | |
| tree | 77b50d98589b41a6e4c9cde19ea22d9bc987e9cd /compiler | |
| parent | e24638cf715a67d087cac3d6a8d979f76f957c62 (diff) | |
| download | haskell-9c84f11b774960077d33d94a23ebc42af79d2ec4.tar.gz | |
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.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | 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 4c52d2a9e8..7a4607a4b6 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 df80c4a66e..7894d7e8fd 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 |