+\begin{code}
+newId :: EncodedFS -> Type -> SimplM Id
+newId fs ty = getUniqueSmpl `thenSmpl` \ uniq ->
+ returnSmpl (mkSysLocal fs uniq ty)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Rebuilding a lambda}
+%* *
+%************************************************************************
+
+\begin{code}
+mkLam :: SimplEnv -> [OutBinder] -> OutExpr -> SimplCont -> SimplM FloatsWithExpr
+\end{code}
+
+Try three things
+ a) eta reduction, if that gives a trivial expression
+ b) eta expansion [only if there are some value lambdas]
+ c) floating lets out through big lambdas
+ [only if all tyvar lambdas, and only if this lambda
+ is the RHS of a let]
+
+\begin{code}
+mkLam env bndrs body cont
+ | opt_SimplDoEtaReduction,
+ Just etad_lam <- tryEtaReduce bndrs body
+ = tick (EtaReduction (head bndrs)) `thenSmpl_`
+ returnSmpl (emptyFloats env, etad_lam)
+
+ | opt_SimplDoLambdaEtaExpansion,
+ any isRuntimeVar bndrs
+ = tryEtaExpansion body `thenSmpl` \ body' ->
+ returnSmpl (emptyFloats env, mkLams bndrs body')
+
+{- Sept 01: I'm experimenting with getting the
+ full laziness pass to float out past big lambdsa
+ | all isTyVar bndrs, -- Only for big lambdas
+ contIsRhs cont -- Only try the rhs type-lambda floating
+ -- if this is indeed a right-hand side; otherwise
+ -- we end up floating the thing out, only for float-in
+ -- to float it right back in again!
+ = tryRhsTyLam env bndrs body `thenSmpl` \ (floats, body') ->
+ returnSmpl (floats, mkLams bndrs body')
+-}
+
+ | otherwise
+ = returnSmpl (emptyFloats env, mkLams bndrs body)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Eta expansion and 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
+
+\begin{code}
+tryEtaReduce :: [OutBinder] -> 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
+ -- [in fact I take the simple path and look for just a variable]
+ = go (reverse bndrs) body
+ where
+ go (b : bs) (App fun arg) | ok_arg b arg = go bs fun -- Loop round
+ go [] (Var fun) | ok_fun fun = Just (Var fun) -- Success!
+ go _ _ = Nothing -- Failure!
+
+ ok_fun fun = not (fun `elem` bndrs) &&
+ (isEvaldUnfolding (idUnfolding fun) || all ok_lam bndrs)
+ ok_lam v = isTyVar v || isDictTy (idType v)
+ -- The isEvaldUnfolding 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
+
+We go for:
+ f = \x1..xn -> N ==> f = \x1..xn y1..ym -> N y1..ym
+ (n >= 0)
+
+where (in both cases)
+
+ * The xi can include type variables
+
+ * The yi are all value variables
+
+ * N is a NORMAL FORM (i.e. no redexes anywhere)
+ wanting a suitable number of extra args.
+
+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
+actually computing the expansion.
+
+\begin{code}
+tryEtaExpansion :: OutExpr -> SimplM OutExpr
+-- There is at least one runtime binder in the binders
+tryEtaExpansion body
+ = getUniquesSmpl `thenSmpl` \ us ->
+ returnSmpl (etaExpand fun_arity us body (exprType body))
+ where
+ fun_arity = exprEtaExpandArity body
+\end{code}
+
+