From e1dbfe8a13490e6ea1a442adc1f76bd8fed4399f Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 4 Aug 2005 11:18:41 +0000 Subject: [PATCH] [project @ 2005-08-04 11:18:41 by simonmar] preInlineUnconditionally: replace exprIsValue call with home-grown version to fix loss-of-sharing that arises because exprIsValue doesn't necessarily mean "ok to inline inside a lambda". Fixes last night's 10queens test failures. --- ghc/compiler/simplCore/SimplUtils.lhs | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs index f1de359..499cfbd 100644 --- a/ghc/compiler/simplCore/SimplUtils.lhs +++ b/ghc/compiler/simplCore/SimplUtils.lhs @@ -594,12 +594,7 @@ preInlineUnconditionally env top_lvl bndr rhs try_once in_lam int_cxt -- There's one textual occurrence = not in_lam && (isNotTopLevel top_lvl || early_phase) - || (exprIsValue rhs && int_cxt) - -- exprIsValue => free vars of rhs are (Once in_lam) or Many, - -- so substituting rhs inside a lambda doesn't change the occ info - -- Caveat: except the fn of a PAP, but since it has arity > 0, it - -- must be a HNF, so it doesn't matter if we push it inside - -- a lambda + || (canInlineInLam rhs && int_cxt) -- -- int_cxt The context isn't totally boring -- E.g. let f = \ab.BIG in \y. map f xs @@ -610,6 +605,21 @@ preInlineUnconditionally env top_lvl bndr rhs -- saturated, because we're going to allocate a closure for -- (f y) every time round the loop anyhow. + -- canInlineInLam => free vars of rhs are (Once in_lam) or Many, + -- so substituting rhs inside a lambda doesn't change the occ info. + -- Sadly, not quite the same as exprIsValue. + canInlineInLam (Var x) = occ_info_ok (idOccInfo x) + canInlineInLam (Lit l) = True + canInlineInLam (Type ty) = True + canInlineInLam (Lam b e) = isRuntimeVar b || canInlineInLam e + canInlineInLam (App e (Type _)) = canInlineInLam e + canInlineInLam (Note _ e) = canInlineInLam e + canInlineInLam _ = False + + occ_info_ok (OneOcc in_lam _ _) = in_lam + occ_info_ok NoOccInfo = True + occ_info_ok _ = False + early_phase = case phase of SimplPhase 0 -> False other -> True -- 1.7.10.4