+-- prepareLocalRuleBase takes the CoreBinds and rules defined in this module.
+-- It attaches those rules that are for local Ids to their binders, and
+-- returns the remainder attached to Ids in an IdSet. It also returns
+-- Ids mentioned on LHS of some rule; these should be blacklisted.
+
+-- The rule Ids and LHS Ids are black-listed; that is, they aren't inlined
+-- so that the opportunity to apply the rule isn't lost too soon
+
+\begin{code}
+prepareRules :: DynFlags -> PackageRuleBase -> HomePackageTable
+ -> UniqSupply
+ -> [CoreBind]
+ -> [IdCoreRule] -- Local rules
+ -> IO (RuleBase, -- Full rule base
+ 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)
+ local_rule_base = extendRuleBaseList emptyRuleBase local_rules
+ local_rule_ids = ruleBaseIds local_rule_base -- Local Ids with rules attached
+ imp_rule_base = foldl add_rules pkg_rule_base (moduleEnvElts hpt)
+ 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
+ add_rules rule_base mod_info = extendRuleBaseList rule_base (md_rules (hm_details mod_info))
+
+ -- Boringly, we need to gather the in-scope set.
+ local_ids = foldr (unionVarSet . mkVarSet . bindersOf) emptyVarSet binds
+
+
+updateBinders :: GhciMode
+ -> IdSet -- Locally defined ids with their Rules attached
+ -> IdSet -- Ids free in the RHS of local rules
+ -> Avails -- What is exported
+ -> [CoreBind] -> [CoreBind]
+ -- A horrible function
+
+-- Update the binders of top-level bindings as follows
+-- a) Attach the rules for each locally-defined Id to that Id.
+-- b) Set the no-discard flag if either the Id is exported,
+-- or it's mentioned in the RHS of a rule
+--
+-- You might wonder why exported Ids aren't already marked as such;
+-- it's just because the type checker is rather busy already and
+-- I didn't want to pass in yet another mapping.
+--
+-- Reason for (a)
+-- - It 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
+--
+-- Reason for (b)
+-- It 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.
+
+updateBinders ghci_mode rule_ids rule_rhs_fvs exports binds
+ = map update_bndrs binds
+ where
+ update_bndrs (NonRec b r) = NonRec (update_bndr b) r
+ update_bndrs (Rec prs) = Rec [(update_bndr b, r) | (b,r) <- prs]
+
+ update_bndr bndr
+ | dont_discard bndr = setIdLocalExported bndr_with_rules
+ | otherwise = bndr_with_rules
+ where
+ bndr_with_rules = lookupVarSet rule_ids bndr `orElse` bndr
+
+ dont_discard bndr = is_exported (idName bndr)
+ || bndr `elemVarSet` rule_rhs_fvs
+
+ -- In interactive mode, we don't want to discard any top-level
+ -- entities at all (eg. do not inline them away during
+ -- simplification), and retain them all in the TypeEnv so they are
+ -- available from the command line.
+ --
+ -- isExternalName separates the user-defined top-level names from those
+ -- introduced by the type checker.
+ is_exported :: Name -> Bool
+ is_exported | ghci_mode == Interactive = isExternalName
+ | otherwise = (`elemNameSet` export_fvs)
+
+ export_fvs = availsToNameSet exports
+\end{code}
+
+
+We must do some gentle simplification on the template (but not the RHS)