Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.2
http://hackage.haskell.org/trac/ghc/changeset/db1f41ac3364e1dcbda41ef59648c1c8ba1ad103 >--------------------------------------------------------------- commit db1f41ac3364e1dcbda41ef59648c1c8ba1ad103 Author: Simon Peyton Jones <[email protected]> Date: Thu Jun 30 17:46:22 2011 +0100 Remove now-unnecessary hack in CoreFVs.ruleRhsFVS >--------------------------------------------------------------- compiler/coreSyn/CoreFVs.lhs | 30 ++++++++++++++---------------- 1 files changed, 14 insertions(+), 16 deletions(-) diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs index f88cb0b..1d640a2 100644 --- a/compiler/coreSyn/CoreFVs.lhs +++ b/compiler/coreSyn/CoreFVs.lhs @@ -278,18 +278,16 @@ exprsOrphNames es = foldr (unionNameSets . exprOrphNames) emptyNameSet es -- | Those variables free in the right hand side of a rule ruleRhsFreeVars :: CoreRule -> VarSet ruleRhsFreeVars (BuiltinRule {}) = noFVs -ruleRhsFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs }) - = delFromUFM fvs fn -- Note [Rule free var hack] - where - fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet +ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs }) + = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet + -- See Note [Rule free var hack] -- | Those variables free in the both the left right hand sides of a rule ruleFreeVars :: CoreRule -> VarSet ruleFreeVars (BuiltinRule {}) = noFVs -ruleFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs, ru_args = args }) - = delFromUFM fvs fn -- Note [Rule free var hack] - where - fvs = addBndrs bndrs (exprs_fvs (rhs:args)) isLocalVar emptyVarSet +ruleFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs, ru_args = args }) + = addBndrs bndrs (exprs_fvs (rhs:args)) isLocalVar emptyVarSet + -- See Note [Rule free var hack] idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet -- Just the variables free on the *rhs* of a rule @@ -316,16 +314,16 @@ ruleLhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) = addBndrs bndrs (exprs_fvs args) isLocalId emptyVarSet \end{code} - -Note [Rule free var hack] +Note [Rule free var hack] (Not a hack any more) ~~~~~~~~~~~~~~~~~~~~~~~~~ -Don't include the Id in its own rhs free-var set. -Otherwise the occurrence analyser makes bindings recursive -that shoudn't be. E.g. +We used not to include the Id in its own rhs free-var set. +Otherwise the occurrence analyser makes bindings recursive: + f x y = x+y RULE: f (f x y) z ==> f x (f y z) - -Also since rule_fn is a Name, not a Var, we have to use the grungy delUFM. - +However, the occurrence analyser distinguishes "non-rule loop breakers" +from "rule-only loop breakers" (see BasicTypes.OccInfo). So it will +put this 'f' in a Rec block, but will mark the binding as a non-rule loop +breaker, which is perfectly inlinable. \begin{code} -- |Free variables of a vectorisation declaration _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
