diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2018-03-19 11:57:06 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-03-19 12:05:11 -0400 |
| commit | 3d378d983a28d3650220180e1524c63fb2f4c747 (patch) | |
| tree | 10c496615ba0016c05352e95a4d9dfbb2c079465 /compiler/specialise | |
| parent | 2918abf75594001deed51ee252a05b146f844489 (diff) | |
| download | haskell-3d378d983a28d3650220180e1524c63fb2f4c747.tar.gz | |
Also check local rules with -frules-check
Reviewers: bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4255
Diffstat (limited to 'compiler/specialise')
| -rw-r--r-- | compiler/specialise/Rules.hs | 10 |
1 files changed, 5 insertions, 5 deletions
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index 319404ef15..b6025955ac 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -1148,10 +1148,10 @@ is so important. -- string for the purposes of error reporting ruleCheckProgram :: CompilerPhase -- ^ Rule activation test -> String -- ^ Rule pattern - -> RuleEnv -- ^ Database of rules + -> (Id -> [CoreRule]) -- ^ Rules for an Id -> CoreProgram -- ^ Bindings to check in -> SDoc -- ^ Resulting check message -ruleCheckProgram phase rule_pat rule_base binds +ruleCheckProgram phase rule_pat rules binds | isEmptyBag results = text "Rule check results: no rule application sites" | otherwise @@ -1164,7 +1164,7 @@ ruleCheckProgram phase rule_pat rule_base binds , rc_id_unf = idUnfolding -- Not quite right -- Should use activeUnfolding , rc_pattern = rule_pat - , rc_rule_base = rule_base } + , rc_rules = rules } results = unionManyBags (map (ruleCheckBind env) binds) line = text (replicate 20 '-') @@ -1172,7 +1172,7 @@ data RuleCheckEnv = RuleCheckEnv { rc_is_active :: Activation -> Bool, rc_id_unf :: IdUnfoldingFun, rc_pattern :: String, - rc_rule_base :: RuleEnv + rc_rules :: Id -> [CoreRule] } ruleCheckBind :: RuleCheckEnv -> CoreBind -> Bag SDoc @@ -1206,7 +1206,7 @@ ruleCheckFun env fn args | null name_match_rules = emptyBag | otherwise = unitBag (ruleAppCheck_help env fn args name_match_rules) where - name_match_rules = filter match (getRules (rc_rule_base env) fn) + name_match_rules = filter match (rc_rules env fn) match rule = (rc_pattern env) `isPrefixOf` unpackFS (ruleName rule) ruleAppCheck_help :: RuleCheckEnv -> Id -> [CoreExpr] -> [CoreRule] -> SDoc |