+
+-----------
+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