- work_id wrapper_fn
- = case get_work_id wrapper_fn of
- [] -> case work_id_try2 wrapper_fn of
- [] -> pprPanic "getWorkerId: can't find worker id" (ppr wrap_id)
- [id] -> id
- _ -> pprPanic "getWorkerId: found too many worker ids" (ppr wrap_id)
- [id] -> id
- _ -> pprPanic "getWorkerId: found too many worker ids" (ppr wrap_id)
-
- get_work_id (Lam _ body) = get_work_id body
- get_work_id (Case _ _ [(_,_,rhs@(Case _ _ _))]) = get_work_id rhs
- get_work_id (Case scrut _ [(_,_,rhs)]) = (get_work_id scrut) ++ (get_work_id rhs)
- get_work_id (Note _ body) = get_work_id body
- get_work_id (Let _ body) = get_work_id body
- get_work_id (App (Var work_id) _) = [work_id]
- get_work_id (App fn _) = get_work_id fn
- get_work_id (Var work_id) = []
- get_work_id other = []
-
- work_id_try2 (Lam _ body) = work_id_try2 body
- work_id_try2 (Note _ body) = work_id_try2 body
- work_id_try2 (Let _ body) = work_id_try2 body
- work_id_try2 (App fn _) = work_id_try2 fn
- work_id_try2 (Var work_id) = [work_id]
- work_id_try2 other = []
+\begin{code}
+mkWrapper :: Type -- Wrapper type
+ -> Int -- Arity
+ -> [Demand] -- Wrapper strictness info
+ -> CprInfo -- Wrapper cpr info
+ -> UniqSM (Id -> CoreExpr) -- Wrapper body, missing worker Id
+
+mkWrapper fun_ty arity demands cpr_info
+ = mkWwBodies fun_ty arity demands cpr_info `thenUs` \ (_, wrap_fn, _) ->
+ returnUs wrap_fn