- (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs rep_ty demands one_shots
- return (wrap_args,
- \ e -> Cast (wrap_fn_args e) (mkSymCoercion co),
- \ e -> work_fn_args (Cast e co),
- res_ty)
- | notNull demands = do
- wrap_uniqs <- getUniquesM
- let
- (tyvars, tau) = splitForAllTys fun_ty
- (arg_tys, body_ty) = splitFunTys tau
-
- n_demands = length demands
- n_arg_tys = length arg_tys
- n_args = n_demands `min` n_arg_tys
-
- new_fun_ty = mkFunTys (drop n_demands arg_tys) body_ty
- new_demands = drop n_arg_tys demands
- new_one_shots = drop n_args one_shots
-
- val_args = zipWith4 mk_wrap_arg wrap_uniqs arg_tys demands one_shots
- wrap_args = tyvars ++ val_args
-{- ASSERT( notNull tyvars || notNull arg_tys ) -}
- if (null tyvars) && (null arg_tys) then
- pprTrace "mkWWargs" (ppr fun_ty $$ ppr demands)
- return ([], id, id, fun_ty)
- else do
-
- (more_wrap_args, wrap_fn_args, work_fn_args, res_ty) <-
- mkWWargs new_fun_ty new_demands new_one_shots
-
- return (wrap_args ++ more_wrap_args,
- mkLams wrap_args . wrap_fn_args,
- work_fn_args . applyToVars wrap_args,
- res_ty)
+ --
+ -- Note (Sept 08): This case applies even if demands is empty.
+ -- I'm not quite sure why; perhaps it makes it
+ -- easier for CPR
+ = do { (wrap_args, wrap_fn_args, work_fn_args, res_ty)
+ <- mkWWargs subst rep_ty arg_info
+ ; return (wrap_args,
+ \e -> Cast (wrap_fn_args e) (mkSymCo co),
+ \e -> work_fn_args (Cast e co),
+ res_ty) }
+
+ | null arg_info
+ = return ([], id, id, substTy subst fun_ty)
+
+ | Just (tv, fun_ty') <- splitForAllTy_maybe fun_ty
+ = do { let (subst', tv') = substTyVarBndr subst tv
+ -- This substTyVarBndr clones the type variable when necy
+ -- See Note [Freshen type variables]
+ ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)
+ <- mkWWargs subst' fun_ty' arg_info
+ ; return (tv' : wrap_args,
+ Lam tv' . wrap_fn_args,
+ work_fn_args . (`App` Type (mkTyVarTy tv')),
+ res_ty) }
+
+ | ((dmd,one_shot):arg_info') <- arg_info
+ , Just (arg_ty, fun_ty') <- splitFunTy_maybe fun_ty
+ = do { uniq <- getUniqueM
+ ; let arg_ty' = substTy subst arg_ty
+ id = mk_wrap_arg uniq arg_ty' dmd one_shot
+ ; (wrap_args, wrap_fn_args, work_fn_args, res_ty)
+ <- mkWWargs subst fun_ty' arg_info'
+ ; return (id : wrap_args,
+ Lam id . wrap_fn_args,
+ work_fn_args . (`App` varToCoreExpr id),
+ res_ty) }