- (rule_ids, rule_lhs_fvs) = foldr add_rule emptyRuleBase local_rules
- imported_id_rule_ids = filterVarSet (not . isLocallyDefined) rule_ids
-
- -- rule_fvs is the set of all variables mentioned in this module's 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
-
-addRuleToId id rule = setIdSpecialisation id (addRule id (idSpecialisation id) rule)
-
--- prepareOrphanRuleBase does exactly the same as prepareLocalRuleBase, except that
--- it assumes that none of the rules can be attached to local Ids.
-
-prepareOrphanRuleBase :: [ProtoCoreRule] -> RuleBase
-prepareOrphanRuleBase imported_rules
- = foldr add_rule (emptyVarSet, emptyVarSet) imported_rules
+ new_id = setIdSpecialisation id (addRule id old_rules rule)
+ old_rules = idSpecialisation (fromMaybe id (lookupVarSet rule_ids id))
+ -- Get the old rules from rule_ids if the Id is already there, but
+ -- if not, use the Id from the incoming rule. If may be a PrimOpId,
+ -- in which case it may have rules in its belly already. Seems
+ -- dreadfully hackoid.
+
+pprRuleBase :: RuleBase -> SDoc
+pprRuleBase (RuleBase rules) = vcat [ pprTidyIdRules id | id <- varSetElems rules ]