- (IdSet,IdSet), -- Local rule Ids, and RHS fvs
- [IdCoreRule]) -- Orphan rules
-
-prepareRules dflags pkg_rule_base hst us binds 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))
-
- ; let (local_rules, orphan_rules) = partition (isLocalId . fst) better_rules
- local_rule_rhs_fvs = unionVarSets (map (ruleRhsFreeVars . snd) local_rules)
+ IdSet, -- Local rule Ids
+ [IdCoreRule], -- Orphan rules
+ IdSet) -- RHS free vars of all rules
+
+prepareRules dflags pkg_rule_base hpt us binds local_rules
+ = do { let env = emptySimplEnv SimplGently [] local_ids
+ (better_rules,_) = initSmpl dflags us (mapSmpl (simplRule env) local_rules)
+
+ ; let (local_rules, orphan_rules) = partition ((`elemVarSet` local_ids) . fst) better_rules
+ -- We use (`elemVarSet` local_ids) rather than isLocalId because
+ -- isLocalId isn't true of class methods.
+ -- If we miss any rules for Ids defined here, then we end up
+ -- giving the local decl a new Unique (because the in-scope-set is the
+ -- same as the rule-id set), and now the binding for the class method
+ -- doesn't have the same Unique as the one in the Class and the tc-env
+ -- Example: class Foo a where
+ -- op :: a -> a
+ -- {-# RULES "op" op x = x #-}
+
+ rule_rhs_fvs = unionVarSets (map (ruleRhsFreeVars . snd) better_rules)