X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplUtils.lhs;h=cff659d55696d563f73b9c8a6f2c6daefe1ba78e;hb=c412fa2e1a11ae4666bea97cd8d790ecf7fcb253;hp=fbbdf45792985756b89c2b8a8d8a6d4c4969e4e3;hpb=a5f2ab64f2f1306c803c0c20e21238973070f74b;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index fbbdf45..cff659d 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -302,62 +302,25 @@ applies when x is bound to a lambda expression. Hence contIsInteresting looks for case expressions with just a single default case. + \begin{code} -interestingCallContext :: Bool -- False <=> no args at all - -> Bool -- False <=> no value args - -> SimplCont -> Bool - -- The "lone-variable" case is important. I spent ages - -- messing about with unsatisfactory varaints, but this is nice. - -- The idea is that if a variable appear all alone - -- as an arg of lazy fn, or rhs Stop - -- as scrutinee of a case Select - -- as arg of a strict fn ArgOf - -- then we should not inline it (unless there is some other reason, - -- e.g. is is the sole occurrence). We achieve this by making - -- interestingCallContext return False for a lone variable. - -- - -- Why? At least in the case-scrutinee situation, turning - -- let x = (a,b) in case x of y -> ... - -- into - -- let x = (a,b) in case (a,b) of y -> ... - -- and thence to - -- let x = (a,b) in let y = (a,b) in ... - -- is bad if the binding for x will remain. - -- - -- Another example: I discovered that strings - -- were getting inlined straight back into applications of 'error' - -- because the latter is strict. - -- s = "foo" - -- f = \x -> ...(error s)... - - -- Fundamentally such contexts should not ecourage inlining because - -- the context can ``see'' the unfolding of the variable (e.g. case or a RULE) - -- so there's no gain. - -- - -- However, even a type application or coercion isn't a lone variable. - -- Consider - -- case $fMonadST @ RealWorld of { :DMonad a b c -> c } - -- We had better inline that sucker! The case won't see through it. - -- - -- For now, I'm treating treating a variable applied to types - -- in a *lazy* context "lone". The motivating example was - -- f = /\a. \x. BIG - -- g = /\a. \y. h (f a) - -- There's no advantage in inlining f here, and perhaps - -- a significant disadvantage. Hence some_val_args in the Stop case - -interestingCallContext some_args some_val_args cont +interestingCallContext :: SimplCont -> CallContInfo +interestingCallContext cont = interesting cont where - interesting (Select {}) = some_args - interesting (ApplyTo {}) = True -- Can happen if we have (coerce t (f x)) y + interesting (Select _ bndr _ _ _) + | isDeadBinder bndr = CaseCont + | otherwise = InterestingCont + + interesting (ApplyTo {}) = InterestingCont + -- Can happen if we have (coerce t (f x)) y -- Perhaps True is a bit over-keen, but I've -- seen (coerce f) x, where f has an INLINE prag, - -- So we have to give some motivaiton for inlining it - interesting (StrictArg {}) = some_val_args - interesting (StrictBind {}) = some_val_args -- ?? - interesting (Stop ty _ interesting) = some_val_args && interesting - interesting (CoerceIt _ cont) = interesting cont + -- So we have to give some motivation for inlining it + interesting (StrictArg {}) = InterestingCont + interesting (StrictBind {}) = InterestingCont + interesting (Stop ty _ yes) = if yes then InterestingCont else BoringCont + interesting (CoerceIt _ cont) = interesting cont -- If this call is the arg of a strict function, the context -- is a bit interesting. If we inline here, we may get useful -- evaluation information to avoid repeated evals: e.g. @@ -418,7 +381,9 @@ interestingArgContext :: Id -> SimplCont -> Bool -- where g has rules, then we *do* want to inline f, in case it -- exposes a rule that might fire. Similarly, if the context is -- h (g (f x x)) --- where h has rules, then we do want to inline f. +-- where h has rules, then we do want to inline f; hence the +-- call_cont argument to interestingArgContext +-- -- The interesting_arg_ctxt flag makes this happen; if it's -- set, the inliner gets just enough keener to inline f -- regardless of how boring f's arguments are, if it's marked INLINE @@ -426,8 +391,8 @@ interestingArgContext :: Id -> SimplCont -> Bool -- The alternative would be to *always* inline an INLINE function, -- regardless of how boring its context is; but that seems overkill -- For example, it'd mean that wrapper functions were always inlined -interestingArgContext fn cont - = idHasRules fn || go cont +interestingArgContext fn call_cont + = idHasRules fn || go call_cont where go (Select {}) = False go (ApplyTo {}) = False @@ -917,48 +882,90 @@ because the latter is not well-kinded. %************************************************************************ %* * -\subsection{Eta expansion and reduction} + Eta reduction %* * %************************************************************************ -We try for eta reduction here, but *only* if we get all the -way to an exprIsTrivial expression. -We don't want to remove extra lambdas unless we are going -to avoid allocating this thing altogether +Note [Eta reduction conditions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We try for eta reduction here, but *only* if we get all the way to an +trivial expression. We don't want to remove extra lambdas unless we +are going to avoid allocating this thing altogether. + +There are some particularly delicate points here: + +* Eta reduction is not valid in general: + \x. bot /= bot + This matters, partly for old-fashioned correctness reasons but, + worse, getting it wrong can yield a seg fault. Consider + f = \x.f x + h y = case (case y of { True -> f `seq` True; False -> False }) of + True -> ...; False -> ... + + If we (unsoundly) eta-reduce f to get f=f, the strictness analyser + says f=bottom, and replaces the (f `seq` True) with just + (f `cast` unsafe-co). BUT, as thing stand, 'f' got arity 1, and it + *keeps* arity 1 (perhaps also wrongly). So CorePrep eta-expands + the definition again, so that it does not termninate after all. + Result: seg-fault because the boolean case actually gets a function value. + See Trac #1947. + + So it's important to to the right thing. + +* We need to be careful if we just look at f's arity. Currently (Dec07), + f's arity is visible in its own RHS (see Note [Arity robustness] in + SimplEnv) so we must *not* trust the arity when checking that 'f' is + a value. Instead, look at the unfolding. + + However for GlobalIds we can look at the arity; and for primops we + must, since they have no unfolding. + +* Regardless of whether 'f' is a vlaue, we always want to + reduce (/\a -> f a) to f + This came up in a RULE: foldr (build (/\a -> g a)) + did not match foldr (build (/\b -> ...something complex...)) + The type checker can insert these eta-expanded versions, + with both type and dictionary lambdas; hence the slightly + ad-hoc isDictId + +These delicacies are why we don't use exprIsTrivial and exprIsHNF here. +Alas. \begin{code} tryEtaReduce :: [OutBndr] -> OutExpr -> Maybe OutExpr tryEtaReduce bndrs body - -- We don't use CoreUtils.etaReduce, because we can be more - -- efficient here: - -- (a) we already have the binders - -- (b) we can do the triviality test before computing the free vars = go (reverse bndrs) body where go (b : bs) (App fun arg) | ok_arg b arg = go bs fun -- Loop round go [] fun | ok_fun fun = Just fun -- Success! go _ _ = Nothing -- Failure! - ok_fun fun = exprIsTrivial fun - && not (any (`elemVarSet` (exprFreeVars fun)) bndrs) - && (exprIsHNF fun || all ok_lam bndrs) + -- Note [Eta reduction conditions] + ok_fun (App fun (Type ty)) + | not (any (`elemVarSet` tyVarsOfType ty) bndrs) + = ok_fun fun + ok_fun (Var fun_id) + = not (fun_id `elem` bndrs) + && (ok_fun_id fun_id || all ok_lam bndrs) + ok_fun _fun = False + + ok_fun_id fun + | isLocalId fun = isEvaldUnfolding (idUnfolding fun) + | isDataConWorkId fun = True + | isGlobalId fun = idArity fun > 0 + ok_lam v = isTyVar v || isDictId v - -- The exprIsHNF is because eta reduction is not - -- valid in general: \x. bot /= bot - -- So we need to be sure that the "fun" is a value. - -- - -- However, we always want to reduce (/\a -> f a) to f - -- This came up in a RULE: foldr (build (/\a -> g a)) - -- did not match foldr (build (/\b -> ...something complex...)) - -- The type checker can insert these eta-expanded versions, - -- with both type and dictionary lambdas; hence the slightly - -- ad-hoc isDictTy ok_arg b arg = varToCoreExpr b `cheapEqExpr` arg \end{code} - Try eta expansion for RHSs +%************************************************************************ +%* * + Eta expansion +%* * +%************************************************************************ + We go for: f = \x1..xn -> N ==> f = \x1..xn y1..ym -> N y1..ym @@ -973,6 +980,16 @@ where (in both cases) * N is a NORMAL FORM (i.e. no redexes anywhere) wanting a suitable number of extra args. +The biggest reason for doing this is for cases like + + f = \x -> case x of + True -> \y -> e1 + False -> \y -> e2 + +Here we want to get the lambdas together. A good exmaple is the nofib +program fibheaps, which gets 25% more allocation if you don't do this +eta-expansion. + We may have to sandwich some coerces between the lambdas to make the types work. exprEtaExpandArity looks through coerces when computing arity; and etaExpand adds the coerces as necessary when