-prepareRuleBase :: [CoreBind] -> [ProtoCoreRule] -> ([CoreBind], RuleBase)
-prepareRuleBase binds rules
- = (map zap_bind binds, (imported_rule_ids, rule_lhs_fvs))
- where
- (rule_ids, rule_lhs_fvs) = foldr add_rule (emptyVarSet, emptyVarSet) rules
- imported_rule_ids = filterVarSet (not . isLocallyDefined) rule_ids
-
- -- rule_fvs is the set of all variables mentioned in rules
- rule_fvs = foldVarSet (unionVarSet . idRuleVars) rule_lhs_fvs rule_ids
-
- -- Attach the rules for each locally-defined Id to that Id.
- -- - This makes the rules easier to look up
- -- - It means that transformation rules and specialisations for
- -- locally defined Ids are handled uniformly
- -- - It keeps alive things that are referred to only from a rule
- -- (the occurrence analyser knows about rules attached to Ids)
- -- - It makes sure that, when we apply a rule, the free vars
- -- of the RHS are more likely to be in scope
- --
- -- The LHS and RHS Ids are marked 'no-discard'.
- -- This means that the binding won't be discarded EVEN if the binding
- -- ends up being trivial (v = w) -- the simplifier would usually just
- -- substitute w for v throughout, but we don't apply the substitution to
- -- the rules (maybe we should?), so this substitution would make the rule
- -- bogus.
- zap_bind (NonRec b r) = NonRec (zap_bndr b) r
- zap_bind (Rec prs) = Rec [(zap_bndr b, r) | (b,r) <- prs]
-
- zap_bndr bndr = case lookupVarSet rule_ids bndr of
- Just bndr' -> setIdNoDiscard bndr'
- Nothing | bndr `elemVarSet` rule_fvs -> setIdNoDiscard bndr
- | otherwise -> bndr
-
-add_rule (ProtoCoreRule _ id rule)
- (rule_id_set, rule_fvs)
- = (rule_id_set `extendVarSet` new_id,
- rule_fvs `unionVarSet` extendVarSet lhs_fvs id)
+ruleBaseIds (RuleBase ids _) = ids
+ruleBaseFVs (RuleBase _ fvs) = fvs
+
+emptyRuleBase = RuleBase emptyVarSet emptyVarSet
+
+addRuleBaseFVs :: RuleBase -> IdSet -> RuleBase
+addRuleBaseFVs (RuleBase rules fvs) extra_fvs
+ = RuleBase rules (fvs `unionVarSet` extra_fvs)
+
+extendRuleBaseList :: RuleBase -> [(Id,CoreRule)] -> RuleBase
+extendRuleBaseList rule_base new_guys
+ = foldl extendRuleBase rule_base new_guys
+
+extendRuleBase :: RuleBase -> (Id,CoreRule) -> RuleBase
+extendRuleBase (RuleBase rule_ids rule_fvs) (id, rule)
+ = RuleBase (extendVarSet rule_ids new_id)
+ (rule_fvs `unionVarSet` extendVarSet lhs_fvs id)