X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FFloatIn.lhs;h=cf53e91220143cef4eb331eca9d67ac00ab7104b;hb=0a5613f40b0e32cf59966e6b56b807cdbe80aa7b;hp=668879715abe217fe639ece624a816677b322275;hpb=d95ce839533391e7118257537044f01cbb1d6694;p=ghc-hetmet.git diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs index 6688797..cf53e91 100644 --- a/compiler/simplCore/FloatIn.lhs +++ b/compiler/simplCore/FloatIn.lhs @@ -18,7 +18,7 @@ module FloatIn ( floatInwards ) where import CoreSyn import CoreUtils ( exprIsHNF, exprIsDupable ) -import CoreFVs ( CoreExprWithFVs, freeVars, freeVarsOf, idRuleVars ) +import CoreFVs ( CoreExprWithFVs, freeVars, freeVarsOf, idRuleAndUnfoldingVars ) import Id ( isOneShotBndr, idType ) import Var import Type ( isUnLiftedType ) @@ -259,10 +259,12 @@ arrange to dump bindings that bind extra_fvs before the entire let. Note [extra_fvs (s): free variables of rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider let x{rule mentioning y} = rhs in body +Consider + let x{rule mentioning y} = rhs in body Here y is not free in rhs or body; but we still want to dump bindings that bind y outside the let. So we augment extra_fvs with the -idRuleVars of x. +idRuleAndUnfoldingVars of x. No need for type variables, hence not using +idFreeVars. \begin{code} @@ -271,7 +273,7 @@ fiExpr to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body) where body_fvs = freeVarsOf body - rule_fvs = idRuleVars id -- See Note [extra_fvs (2): free variables of rules] + rule_fvs = idRuleAndUnfoldingVars id -- See Note [extra_fvs (2): free variables of rules] extra_fvs | noFloatIntoRhs ann_rhs || isUnLiftedType (idType id) = rule_fvs `unionVarSet` rhs_fvs | otherwise = rule_fvs @@ -300,7 +302,7 @@ fiExpr to_drop (_,AnnLet (AnnRec bindings) body) body_fvs = freeVarsOf body -- See Note [extra_fvs (1,2)] - rule_fvs = foldr (unionVarSet . idRuleVars) emptyVarSet ids + rule_fvs = foldr (unionVarSet . idRuleAndUnfoldingVars) emptyVarSet ids extra_fvs = rule_fvs `unionVarSet` unionVarSets [ fvs | (fvs, rhs) <- rhss , noFloatIntoRhs rhs ] @@ -368,7 +370,7 @@ noFloatIntoRhs (AnnLam b _) = not (is_one_shot b) noFloatIntoRhs rhs = exprIsHNF (deAnnotate' rhs) -- We'd just float right back out again... is_one_shot :: Var -> Bool -is_one_shot b = isIdVar b && isOneShotBndr b +is_one_shot b = isId b && isOneShotBndr b \end{code}