- Eta reduction
-%* *
-%************************************************************************
-
-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 value, 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
- = 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!
-
- -- 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
-
- ok_arg b arg = varToCoreExpr b `cheapEqExpr` arg
-\end{code}
-
-
-%************************************************************************
-%* *