-mkWWstr res_ty wrap_args
- = mk_ww_str wrap_args `thenUs` \ (work_args, take_apart, put_together) ->
- let
- work_dmds = [idNewDemandInfo v | v <- work_args, isId v]
- apply_to args fn = mkVarApps fn args
- in
- if not (null work_dmds && isUnLiftedType res_ty) then
- returnUs ( work_dmds,
- take_apart . applyToVars work_args,
- mkLams work_args . put_together)
- else
- -- Horrid special case. If the worker would have no arguments, and the
- -- function returns a primitive type value, that would make the worker into
- -- an unboxed value. We box it by passing a dummy void argument, thus:
- --
- -- f = /\abc. \xyz. fw abc void
- -- fw = /\abc. \v. body
- --
- -- We use the state-token type which generates no code
- getUniqueUs `thenUs` \ void_arg_uniq ->
- let
- void_arg = mk_ww_local void_arg_uniq realWorldStatePrimTy
- in
- returnUs ([Lazy],
- take_apart . applyToVars [realWorldPrimId] . apply_to work_args,
- mkLams work_args . Lam void_arg . put_together)
+----------------------
+nop_fn body = body
+
+----------------------
+mkWWstr []
+ = returnUs ([], nop_fn, nop_fn)
+
+mkWWstr (arg : args)
+ = mkWWstr_one arg `thenUs` \ (args1, wrap_fn1, work_fn1) ->
+ mkWWstr args `thenUs` \ (args2, wrap_fn2, work_fn2) ->
+ returnUs (args1 ++ args2, wrap_fn1 . wrap_fn2, work_fn1 . work_fn2)