From b5cad075afeeebb30e3603c23e7a1c511bff36a8 Mon Sep 17 00:00:00 2001 From: simonpj Date: Mon, 5 Mar 2001 12:19:37 +0000 Subject: [PATCH] [project @ 2001-03-05 12:19:37 by simonpj] Better dump of transformation rules --- ghc/compiler/simplCore/SimplCore.lhs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs index 6c07ba9..52a5b1b 100644 --- a/ghc/compiler/simplCore/SimplCore.lhs +++ b/ghc/compiler/simplCore/SimplCore.lhs @@ -20,7 +20,7 @@ import HscTypes ( PersistentCompilerState(..), ) import CSE ( cseProgram ) import Rules ( RuleBase, emptyRuleBase, ruleBaseFVs, ruleBaseIds, - extendRuleBaseList, addRuleBaseFVs ) + extendRuleBaseList, addRuleBaseFVs, pprRuleBase ) import Module ( moduleEnvElts ) import CoreUnfold import PprCore ( pprCoreBindings, pprIdCoreRule, pprCoreExpr ) @@ -205,12 +205,9 @@ prepareRules :: DynFlags -> PackageRuleBase -> HomeSymbolTable [IdCoreRule], -- Orphan rules IdSet) -- RHS free vars of all rules -prepareRules dflags pkg_rule_base hst us binds rules +prepareRules dflags pkg_rule_base hst us binds local_rules = do { let (better_rules,_) = initSmpl dflags sw_chkr us local_ids black_list_all - (mapSmpl simplRule rules) - - ; dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules" - (vcat (map pprIdCoreRule better_rules)) + (mapSmpl simplRule local_rules) ; let (local_rules, orphan_rules) = partition (isLocalId . fst) better_rules rule_rhs_fvs = unionVarSets (map (ruleRhsFreeVars . snd) better_rules) @@ -220,6 +217,12 @@ prepareRules dflags pkg_rule_base hst us binds rules rule_base = extendRuleBaseList imp_rule_base orphan_rules final_rule_base = addRuleBaseFVs rule_base (ruleBaseFVs local_rule_base) -- The last step black-lists the free vars of local rules too + + ; dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules" + (vcat [text "Local rules", pprRuleBase local_rule_base, + text "", + text "Imported rules", pprRuleBase final_rule_base]) + ; return (final_rule_base, local_rule_ids, orphan_rules, rule_rhs_fvs) } where -- 1.7.10.4