#include "HsVersions.h"
import CoreSyn
-import CoreFVs ( idRuleVars )
+import CoreFVs
import CoreUtils ( exprIsTrivial, isDefaultAlt )
import Id
import IdInfo
To that end, we build a Rec group for each cyclic strongly
connected component,
*treating f's rules as extra RHSs for 'f'*.
+
+ When we make the Rec groups we include variables free in *either*
+ LHS *or* RHS of the rule. The former might seems silly, but see
+ Note [Rule dependency info].
So in Example [eftInt], eftInt and eftIntFB will be put in the
same Rec, even though their 'main' RHSs are both non-recursive.
* Note [Rules are visible in their own rec group]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We want the rules for 'f' to be visible in f's right-hand side.
- And we'd like them to be visible in other function in f's Rec
+ And we'd like them to be visible in other functions in f's Rec
group. E.g. in Example [Specialisation rules] we want f' rule
to be visible in both f's RHS, and fs's RHS.
reason for computing rule_fv_env in occAnalBind. (Of course we
only consider free vars that are also binders in this Rec group.)
+ Note that when we compute this rule_fv_env, we only consider variables
+ free in the *RHS* of the rule, in contrast to the way we build the
+ Rec group in the first place (Note [Rule dependency info])
+
Note that in Example [eftInt], *neither* eftInt *nor* eftIntFB is
chosen as a loop breaker, because their RHSs don't mention each other.
And indeed both can be inlined safely.
Remmber that we simplify the RULES before any RHS (see Note
[Rules are visible in their own rec group] above).
- So we must *not* postInlineUnconditinoally 'g', even though
+ So we must *not* postInlineUnconditionally 'g', even though
its RHS turns out to be trivial. (I'm assuming that 'g' is
not choosen as a loop breaker.)
other yes yes
The **sole** reason for this kind of loop breaker is so that
- postInlineUnconditioanlly does not fire. Ugh.
+ postInlineUnconditionally does not fire. Ugh.
+
+ * Note [Rule dependency info]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ The VarSet in a SpecInfo is used for dependency analysis in the
+ occurrence analyser. We must track free vars in *both* lhs and rhs. Why both?
+ Consider
+ x = y
+ RULE f x = 4
+ Then if we substitute y for x, we'd better do so in the
+ rule's LHS too, so we'd better ensure the dependency is respected
Example [eftInt]
= body_usage +++ addRuleUsage rhs_usage bndr
(final_usage, tagged_bndrs) = tagBinders total_usage bndrs
- final_bndrs | no_rules = tagged_bndrs
+ final_bndrs | isEmptyVarSet all_rule_fvs = tagged_bndrs
| otherwise = map tag_rule_var tagged_bndrs
+
tag_rule_var bndr | bndr `elemVarSet` all_rule_fvs = makeLoopBreaker True bndr
| otherwise = bndr
+ all_rule_fvs = bndr_set `intersectVarSet` foldr (unionVarSet . idRuleVars) emptyVarSet bndrs
+ -- Mark the binder with OccInfo saying "no preInlineUnconditionally" if
+ -- it is used in any rule (lhs or rhs) of the recursive group
---- stuff for dependency analysis of binds -------------------------------
sccs :: [SCC (Node Details)]
do_final_bind (CyclicSCC cycle)
| no_rules = Rec (reOrderCycle cycle)
| otherwise = Rec (concatMap reOrderRec (stronglyConnCompR loop_breaker_edges))
- where -- See Note [Loop breaking for reason for looop_breker_edges]
+ where -- See Note [Choosing loop breakers] for looop_breker_edges
loop_breaker_edges = map mk_node cycle
mk_node (details@(bndr, rhs, rhs_fvs), k, _) = (details, k, new_ks)
where
rule_fv_env = rule_loop init_rule_fvs
no_rules = null init_rule_fvs
- all_rule_fvs = foldr (unionVarSet . snd) emptyVarSet init_rule_fvs
init_rule_fvs = [(b, rule_fvs)
| b <- bndrs
- , let rule_fvs = idRuleVars b `intersectVarSet` bndr_set
+ , let rule_fvs = idRuleRhsVars b `intersectVarSet` bndr_set
, not (isEmptyVarSet rule_fvs)]
rule_loop :: [(Id,IdSet)] -> IdEnv IdSet -- Finds fixpoint
where
new_fvs = extendFvs env emptyVarSet fvs
+idRuleRhsVars :: Id -> VarSet
+-- Just the variables free on the *rhs* of a rule
+-- See Note [Choosing loop breakers]
+idRuleRhsVars id = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet (idCoreRules id)
+
extendFvs :: IdEnv IdSet -> IdSet -> IdSet -> IdSet
-- (extendFVs env fvs s) returns (fvs `union` env(s))
extendFvs env fvs id_set