-
-%************************************************************************
-%* *
-\subsection{Building lets}
-%* *
-%************************************************************************
-
-Use case, not let for unlifted types. The simplifier will turn some
-back again.
-
-\begin{code}
-mkDsLet :: CoreBind -> CoreExpr -> CoreExpr
-mkDsLet (NonRec bndr rhs) body -- See Note [CoreSyn let/app invariant]
- | isUnLiftedType (idType bndr) && not (exprOkForSpeculation rhs)
- = Case rhs bndr (exprType body) [(DEFAULT,[],body)]
-mkDsLet bind body
- = Let bind body
-
-mkDsLets :: [CoreBind] -> CoreExpr -> CoreExpr
-mkDsLets binds body = foldr mkDsLet body binds
-
------------
-mkDsApp :: CoreExpr -> CoreExpr -> CoreExpr
--- Check the invariant that the arg of an App is ok-for-speculation if unlifted
--- See CoreSyn Note [CoreSyn let/app invariant]
-mkDsApp fun (Type ty) = App fun (Type ty)
-mkDsApp fun arg = mk_val_app fun arg arg_ty res_ty
- where
- (arg_ty, res_ty) = splitFunTy (exprType fun)
-
------------
-mkDsApps :: CoreExpr -> [CoreExpr] -> CoreExpr
--- Slightly more efficient version of (foldl mkDsApp)
-mkDsApps fun args
- = go fun (exprType fun) args
- where
- go fun fun_ty [] = fun
- go fun fun_ty (Type ty : args) = go (App fun (Type ty)) (applyTy fun_ty ty) args
- go fun fun_ty (arg : args) = go (mk_val_app fun arg arg_ty res_ty) res_ty args
- where
- (arg_ty, res_ty) = splitFunTy fun_ty
------------
-mk_val_app fun arg arg_ty res_ty -- See Note [CoreSyn let/app invariant]
- | not (isUnLiftedType arg_ty) || exprOkForSpeculation arg
- = App fun arg -- The vastly common case
-
-mk_val_app (Var f `App` Type ty1 `App` Type ty2 `App` arg1) arg2 _ res_ty
- | f == seqId -- Note [Desugaring seq]
- = Case arg1 (mkWildId ty1) res_ty [(DEFAULT,[],arg2)]
-
-mk_val_app fun arg arg_ty res_ty
- = Case arg (mkWildId arg_ty) res_ty [(DEFAULT,[],App fun (Var arg_id))]
- where
- arg_id = mkWildId arg_ty -- Lots of shadowing, but it doesn't matter,
- -- because 'fun ' should not have a free wild-id
-\end{code}
-
-Note [Desugaring seq] cf Trac #1031
-~~~~~~~~~~~~~~~~~~~~~
- f x y = x `seq` (y `seq` (# x,y #))
-
-The [CoreSyn let/app invariant] means that, other things being equal, because
-the argument to the outer 'seq' has an unlifted type, we'll use call-by-value thus:
-
- f x y = case (y `seq` (# x,y #)) of v -> x `seq` v
-
-But that is bad for two reasons:
- (a) we now evaluate y before x, and
- (b) we can't bind v to an unboxed pair
-
-Seq is very, very special! So we recognise it right here, and desugar to
- case x of _ -> case y of _ -> (# x,y #)
-
-The special case would be valid for all calls to 'seq', but it's only *necessary*
-for ones whose second argument has an unlifted type. So we only catch the latter
-case here, to avoid unnecessary tests.
-
-