import MkId ( realWorldPrimId, voidArgId, mkRuntimeErrorApp, rUNTIME_ERROR_ID )
import TysWiredIn ( tupleCon )
import Type ( Type, isUnLiftedType, mkFunTys,
- splitForAllTys, splitFunTys, splitNewType_maybe, isAlgType
+ splitForAllTys, splitFunTys, splitRecNewType_maybe, isAlgType
)
-import Literal ( Literal(MachStr) )
import BasicTypes ( Boxity(..) )
import Var ( Var, isId )
import UniqSupply ( returnUs, thenUs, getUniquesUs, UniqSM )
Type) -- Type of wrapper body
mkWWargs fun_ty demands one_shots
- | Just rep_ty <- splitNewType_maybe fun_ty
+ | Just rep_ty <- splitRecNewType_maybe fun_ty
-- The newtype case is for when the function has
-- a recursive newtype after the arrow (rare)
-- We check for arity >= 0 to avoid looping in the case
| n_con_args == 1 && isUnLiftedType con_arg_ty1
-- Special case when there is a single result of unlifted type
+ --
+ -- Wrapper: case (..call worker..) of x -> C x
+ -- Worker: case ( ..body.. ) of C x -> x
= getUniquesUs `thenUs` \ (work_uniq : arg_uniq : _) ->
let
work_wild = mk_ww_local work_uniq body_ty
con_arg_ty1)
| otherwise -- The general case
+ -- Wrapper: case (..call worker..) of (# a, b #) -> C a b
+ -- Worker: case ( ...body... ) of C a b -> (# a, b #)
= getUniquesUs `thenUs` \ uniqs ->
let
(wrap_wild : work_wild : args) = zipWith mk_ww_local uniqs (ubx_tup_ty : body_ty : con_arg_tys)
ubx_tup_app = mkConApp ubx_tup_con (map Type con_arg_tys ++ arg_vars)
con_app = mkConApp data_con (map Type tycon_arg_tys ++ arg_vars)
in
- returnUs (\ wkr_call -> Case wkr_call wrap_wild [(DataAlt ubx_tup_con, args, con_app)],
+ returnUs (\ wkr_call -> Case wkr_call wrap_wild [(DataAlt ubx_tup_con, args, con_app)],
\ body -> workerCase body work_wild [(DataAlt data_con, args, ubx_tup_app)],
ubx_tup_ty)
where