import IdInfo ( vanillaIdInfo )
import DataCon ( splitProductType_maybe, splitProductType )
import NewDemand ( Demand(..), DmdResult(..), Demands(..) )
-import MkId ( realWorldPrimId, voidArgId, eRROR_CSTRING_ID )
+import MkId ( realWorldPrimId, voidArgId, mkRuntimeErrorApp, rUNTIME_ERROR_ID )
import TysWiredIn ( tupleCon )
import Type ( Type, isUnLiftedType, mkFunTys,
splitForAllTys, splitFunTys, splitNewType_maybe, isAlgType
)
-import Literal ( Literal(MachStr) )
import BasicTypes ( Boxity(..) )
import Var ( Var, isId )
import UniqSupply ( returnUs, thenUs, getUniquesUs, UniqSM )
| 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
= panic "WwLib: haven't done mk_absent_let for primitives yet"
where
arg_ty = idType arg
--- abs_rhs = mkTyApps (Var aBSENT_ERROR_ID) [arg_ty]
- abs_rhs = mkApps (Var eRROR_CSTRING_ID) [Type arg_ty, Lit (MachStr (_PK_ msg))]
+ abs_rhs = mkRuntimeErrorApp rUNTIME_ERROR_ID arg_ty msg
msg = "Oops! Entered absent arg " ++ showSDocDebug (ppr arg <+> ppr (idType arg))
mk_unpk_case arg unpk_args boxing_con boxing_tycon body