From 42088528ceea9bd88a0caa15e59587d0f593440d Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 11 Jan 2007 13:08:04 +0000 Subject: [PATCH] Add -ddump-rule-firings --- compiler/main/DynFlags.hs | 2 ++ compiler/simplCore/Simplify.lhs | 8 ++++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index d0fce4a..d05b8b2 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -102,6 +102,7 @@ data DynFlag | Opt_D_dump_flatC | Opt_D_dump_foreign | Opt_D_dump_inlinings + | Opt_D_dump_rule_firings | Opt_D_dump_occur_anal | Opt_D_dump_parsed | Opt_D_dump_rn @@ -932,6 +933,7 @@ dynamic_flags = [ , ( "ddump-flatC", setDumpFlag Opt_D_dump_flatC) , ( "ddump-foreign", setDumpFlag Opt_D_dump_foreign) , ( "ddump-inlinings", setDumpFlag Opt_D_dump_inlinings) + , ( "ddump-rule-firings", setDumpFlag Opt_D_dump_rule_firings) , ( "ddump-occur-anal", setDumpFlag Opt_D_dump_occur_anal) , ( "ddump-parsed", setDumpFlag Opt_D_dump_parsed) , ( "ddump-rn", setDumpFlag Opt_D_dump_rn) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index d2e912b..13c20e7 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -208,7 +208,8 @@ simplTopBinds env binds -- It's rather as if the top-level binders were imported. ; env <- simplRecBndrs env (bindersOfBinds binds) ; dflags <- getDOptsSmpl - ; let dump_flag = dopt Opt_D_dump_inlinings dflags + ; let dump_flag = dopt Opt_D_dump_inlinings dflags || + dopt Opt_D_dump_rule_firings dflags ; env' <- simpl_binds dump_flag env binds ; freeTick SimplifierDone ; return (getFloats env') } @@ -216,6 +217,9 @@ simplTopBinds env binds -- We need to track the zapped top-level binders, because -- they should have their fragile IdInfo zapped (notably occurrence info) -- That's why we run down binds and bndrs' simultaneously. + -- + -- The dump-flag emits a trace for each top-level binding, which + -- helps to locate the tracing for inlining and rule firing simpl_binds :: Bool -> SimplEnv -> [InBind] -> SimplM SimplEnv simpl_binds dump env [] = return env simpl_binds dump env (bind:binds) = do { env' <- trace dump bind $ @@ -946,7 +950,7 @@ completeCall env var cont ; case maybe_rule of { Just (rule, rule_rhs) -> tick (RuleFired (ru_name rule)) `thenSmpl_` - (if dopt Opt_D_dump_inlinings dflags then + (if dopt Opt_D_dump_rule_firings dflags then pprTrace "Rule fired" (vcat [ text "Rule:" <+> ftext (ru_name rule), text "Before:" <+> ppr var <+> sep (map pprParendExpr args), -- 1.7.10.4