-mkWW ((arg,WwUnpack new_or_data True cs) : ds)
- = getUniques (length inst_con_arg_tys) `thenUs` \ uniqs ->
- let
- unpk_args = zipWith mk_ww_local uniqs inst_con_arg_tys
- unpk_args_w_ds = zipEqual "mkWW" unpk_args cs
- in
- mkWW (unpk_args_w_ds ++ ds) `thenUs` \ (wrap_fn, worker_args, work_fn) ->
- returnUs (\ wrapper_body -> mk_unpk_case new_or_data arg unpk_args data_con arg_tycon (wrap_fn wrapper_body),
- worker_args,
- \ worker_body -> work_fn (mk_pk_let new_or_data arg data_con tycon_arg_tys unpk_args worker_body))
- where
- inst_con_arg_tys = dataConArgTys data_con tycon_arg_tys
- (arg_tycon, tycon_arg_tys, data_con)
- = case (maybeAppDataTyConExpandingDicts (idType arg)) of
-
- Just (arg_tycon, tycon_arg_tys, [data_con]) ->
- -- The main event: a single-constructor data type
- (arg_tycon, tycon_arg_tys, data_con)
-
- Just (_, _, data_cons) -> pprPanic "mk_ww_arg_processing: not one constr (interface files not consistent/up to date ?)" ((ppr PprDebug arg) <+> (ppr PprDebug (idType arg)))
- Nothing -> panic "mk_ww_arg_processing: not datatype"
+ WwUnpack new_or_data True cs ->
+ getUniquesUs (length inst_con_arg_tys) `thenUs` \ uniqs ->
+ let
+ unpk_args = zipWith mk_ww_local uniqs inst_con_arg_tys
+ unpk_args_w_ds = zipWithEqual "mkWW" setIdDemandInfo unpk_args cs
+ in
+ mkWW (unpk_args_w_ds ++ ds) `thenUs` \ (wrap_fn, worker_args, work_fn) ->
+ returnUs (\ wrapper_body -> mk_unpk_case new_or_data arg unpk_args data_con arg_tycon
+ (wrap_fn wrapper_body),
+ worker_args,
+ \ worker_body -> work_fn (mk_pk_let new_or_data arg data_con
+ tycon_arg_tys unpk_args worker_body))
+ where
+ inst_con_arg_tys = dataConArgTys data_con tycon_arg_tys
+ (arg_tycon, tycon_arg_tys, data_con)
+ = case (splitAlgTyConApp_maybe (idType arg)) of
+
+ Just (arg_tycon, tycon_arg_tys, [data_con]) ->
+ -- The main event: a single-constructor data type
+ (arg_tycon, tycon_arg_tys, data_con)
+
+ Just (_, _, data_cons) ->
+ pprPanic "mk_ww_arg_processing:"
+ (text "not one constr (interface files not consistent/up to date?)"
+ $$ (ppr arg <+> ppr (idType arg)))
+
+ Nothing ->
+ panic "mk_ww_arg_processing: not datatype"