From f05b6981de4c1f76279e17a59d3c42e83ee8d244 Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 5 Apr 2001 11:28:36 +0000 Subject: [PATCH] [project @ 2001-04-05 11:28:36 by simonpj] ------------------ Better arity stuff ------------------ * CoreToStg now has a local function, predictArity, to predict the code-gen arity of a function. Better not to use CoreUtils.exprArity, because predictArity is a very local thing * CoreUtils.exprArity is freed to do a better job. Comments below. exprArity is a cheap-and-cheerful version of exprEtaExpandArity. It tells how many things the expression can be applied to before doing any work. It doesn't look inside cases, lets, etc. The idea is that exprEtaExpandArity will do the hard work, leaving something that's easy for exprArity to grapple with. In particular, Simplify uses exprArity to compute the ArityInfo for the Id. Originally I thought that it was enough just to look for top-level lambdas, but it isn't. I've seen this foo = PrelBase.timesInt We want foo to get arity 2 even though the eta-expander will leave it unchanged, in the expectation that it'll be inlined. But occasionally it isn't, because foo is blacklisted (used in a rule). Similarly, see the ok_note check in exprEtaExpandArity. So f = __inline_me (\x -> e) won't be eta-expanded. And in any case it seems more robust to have exprArity be a bit more intelligent. --- ghc/compiler/coreSyn/CoreUtils.lhs | 55 +++++++++++++++++++++++++----------- ghc/compiler/stgSyn/CoreToStg.lhs | 42 +++++++++++++++++++-------- 2 files changed, 69 insertions(+), 28 deletions(-) diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs index 032ab51..901bc4d 100644 --- a/ghc/compiler/coreSyn/CoreUtils.lhs +++ b/ghc/compiler/coreSyn/CoreUtils.lhs @@ -578,20 +578,6 @@ exprIsConApp_maybe expr analyse other = Nothing \end{code} -The arity of an expression (in the code-generator sense, i.e. the -number of lambdas at the beginning). - -\begin{code} -exprArity :: CoreExpr -> Int -exprArity (Lam x e) - | isTyVar x = exprArity e - | otherwise = 1 + exprArity e -exprArity (Note _ e) - -- Ignore coercions. Top level sccs are removed by the final - -- profiling pass, so we ignore those too. - = exprArity e -exprArity _ = 0 -\end{code} %************************************************************************ @@ -652,7 +638,8 @@ exprEtaExpandArity :: CoreExpr -> (Int, Bool) -- -- Consider let x = expensive in \y z -> E -- We want this to have arity 2 if the \y-abstraction is a 1-shot lambda --- Hence the extra Bool returned by go1 +-- +-- Hence the list of Bools returned by go1 -- NB: this is particularly important/useful for IO state -- transformers, where we often get -- let x = E in \ s -> ... @@ -680,7 +667,7 @@ exprEtaExpandArity e go1 (Note n e) | ok_note n = go1 e go1 (Var v) = replicate (idArity v) False -- When the type of the Id -- encodes one-shot-ness, use - -- th iinfo here + -- the idinfo here -- Lambdas; increase arity go1 (Lam x e) | isId x = isOneShotLambda x : go1 e @@ -774,6 +761,42 @@ etaExpand n us expr ty \end{code} +exprArity is a cheap-and-cheerful version of exprEtaExpandArity. +It tells how many things the expression can be applied to before doing +any work. It doesn't look inside cases, lets, etc. The idea is that +exprEtaExpandArity will do the hard work, leaving something that's easy +for exprArity to grapple with. In particular, Simplify uses exprArity to +compute the ArityInfo for the Id. + +Originally I thought that it was enough just to look for top-level lambdas, but +it isn't. I've seen this + + foo = PrelBase.timesInt + +We want foo to get arity 2 even though the eta-expander will leave it +unchanged, in the expectation that it'll be inlined. But occasionally it +isn't, because foo is blacklisted (used in a rule). + +Similarly, see the ok_note check in exprEtaExpandArity. So + f = __inline_me (\x -> e) +won't be eta-expanded. + +And in any case it seems more robust to have exprArity be a bit more intelligent. + +\begin{code} +exprArity :: CoreExpr -> Int +exprArity e = go e `max` 0 + where + go (Lam x e) | isId x = go e + 1 + | otherwise = go e + go (Note _ e) = go e + go (App e (Type t)) = go e + go (App f a) = go f - 1 + go (Var v) = idArity v + go _ = 0 +\end{code} + + %************************************************************************ %* * \subsection{Equality} diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs index 0bc76d9..59135df 100644 --- a/ghc/compiler/stgSyn/CoreToStg.lhs +++ b/ghc/compiler/stgSyn/CoreToStg.lhs @@ -157,9 +157,8 @@ coreTopBindToStg coreTopBindToStg env body_fvs (NonRec id rhs) = let caf_info = hasCafRefs env rhs - arity = exprArity rhs - env' = extendVarEnv env id (LetBound how_bound emptyLVS arity) + env' = extendVarEnv env id (LetBound how_bound emptyLVS (predictArity rhs)) how_bound | mayHaveCafRefs caf_info = TopLevelHasCafs | otherwise = TopLevelNoCafs @@ -174,6 +173,7 @@ coreTopBindToStg env body_fvs (NonRec id rhs) bind = StgNonRec (SRTEntries cafs) id stg_rhs in + ASSERT2(predictArity rhs == stgRhsArity stg_rhs, ppr id) ASSERT2(consistent caf_info bind, ppr id) -- WARN(not (consistent caf_info bind), ppr id <+> ppr cafs <+> ppCafInfo caf_info) (env', fvs' `unionFVInfo` body_fvs, bind) @@ -191,7 +191,7 @@ coreTopBindToStg env body_fvs (Rec pairs) caf_info = hasCafRefss env1{-NB: not env'-} rhss env' = extendVarEnvList env - [ (b, LetBound how_bound emptyLVS (exprArity rhs)) + [ (b, LetBound how_bound emptyLVS (predictArity rhs)) | (b,rhs) <- pairs ] how_bound | mayHaveCafRefs caf_info = TopLevelHasCafs @@ -208,6 +208,7 @@ coreTopBindToStg env body_fvs (Rec pairs) bind = StgRec (SRTEntries cafs) (zip binders stg_rhss) in + ASSERT2(and [predictArity rhs == stgRhsArity stg_rhs | (rhs,stg_rhs) <- rhss `zip` stg_rhss], ppr binders) ASSERT2(consistent caf_info bind, ppr binders) -- WARN(not (consistent caf_info bind), ppr binders <+> ppr cafs <+> ppCafInfo caf_info) (env', fvs' `unionFVInfo` body_fvs, bind) @@ -523,12 +524,6 @@ coreToStgApp maybe_thunk_body f args not_letrec_bound = not (isLetBound how_bound) fun_fvs = singletonFVInfo f how_bound fun_occ - -- Mostly, the arity info of a function is in the fn's IdInfo - -- But new bindings introduced by CoreSat may not have no - -- arity info; it would do us no good anyway. For example: - -- let f = \ab -> e in f - -- No point in having correct arity info for f! - -- Hence the hasArity stuff below. f_arity = case how_bound of LetBound _ _ arity -> arity _ -> 0 @@ -695,7 +690,7 @@ coreToStgLet let_no_escape bind body mk_binding bind_lvs bind_cafs binder rhs = (binder, LetBound NotTopLevelBound -- Not top level - live_vars (exprArity rhs) + live_vars (predictArity rhs) ) where live_vars = if let_no_escape then @@ -719,9 +714,9 @@ coreToStgLet let_no_escape bind body freeVarsToLiveVars bind_fvs `thenLne` \ (bind_lvs, bind_cafs) -> let - env_ext_item@(binder', _) = mk_binding bind_lvs bind_cafs binder rhs + env_ext_item = mk_binding bind_lvs bind_cafs binder rhs in - returnLne (StgNonRec (SRTEntries bind_cafs) binder' rhs2, + returnLne (StgNonRec (SRTEntries bind_cafs) binder rhs2, bind_fvs, escs, bind_lvs, bind_cafs, [env_ext_item]) @@ -756,6 +751,29 @@ is_join_var j = occNameUserString (getOccName j) == "$j" %************************************************************************ %* * +\subsection{Arity prediction} +%* * +%************************************************************************ + +To avoid yet another knot, we predict the arity of each function from +its Core form, based on the number of visible top-level lambdas. +It should be the same as the arity of the STG RHS! + +\begin{code} +predictArity :: CoreExpr -> Int +predictArity (Lam x e) + | isTyVar x = predictArity e + | otherwise = 1 + predictArity e +predictArity (Note _ e) + -- Ignore coercions. Top level sccs are removed by the final + -- profiling pass, so we ignore those too. + = predictArity e +predictArity _ = 0 +\end{code} + + +%************************************************************************ +%* * \subsection[LNE-monad]{A little monad for this let-no-escaping pass} %* * %************************************************************************ -- 1.7.10.4