diff options
Diffstat (limited to 'compiler/stranal/WwLib.hs')
| -rw-r--r-- | compiler/stranal/WwLib.hs | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs index f346324f4d..5e4d22857a 100644 --- a/compiler/stranal/WwLib.hs +++ b/compiler/stranal/WwLib.hs @@ -16,7 +16,7 @@ module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs import GhcPrelude import CoreSyn -import CoreUtils ( exprType, mkCast ) +import CoreUtils ( exprType, mkCast, mkDefaultCase, mkSingleAltCase ) import Id import IdInfo ( JoinArity ) import DataCon @@ -1027,7 +1027,7 @@ mkWWcpr_help (data_con, inst_tys, arg_tys, co) con_app = mkConApp2 data_con inst_tys [arg] `mkCast` mkSymCo co ; return ( True - , \ wkr_call -> Case wkr_call arg (exprType con_app) [(DEFAULT, [], con_app)] + , \ wkr_call -> mkDefaultCase wkr_call arg con_app , \ body -> mkUnpackCase body co work_uniq data_con [arg] (varToCoreExpr arg) -- varToCoreExpr important here: arg can be a coercion -- Lacking this caused #10658 @@ -1042,9 +1042,11 @@ mkWWcpr_help (data_con, inst_tys, arg_tys, co) ubx_tup_ty = exprType ubx_tup_app ubx_tup_app = mkCoreUbxTup (map fst arg_tys) (map varToCoreExpr args) con_app = mkConApp2 data_con inst_tys args `mkCast` mkSymCo co + tup_con = tupleDataCon Unboxed (length arg_tys) ; return (True - , \ wkr_call -> Case wkr_call wrap_wild (exprType con_app) [(DataAlt (tupleDataCon Unboxed (length arg_tys)), args, con_app)] + , \ wkr_call -> mkSingleAltCase wkr_call wrap_wild + (DataAlt tup_con) args con_app , \ body -> mkUnpackCase body co work_uniq data_con args ubx_tup_app , ubx_tup_ty ) } @@ -1056,8 +1058,8 @@ mkUnpackCase :: CoreExpr -> Coercion -> Unique -> DataCon -> [Id] -> CoreExpr - mkUnpackCase (Tick tickish e) co uniq con args body -- See Note [Profiling and unpacking] = Tick tickish (mkUnpackCase e co uniq con args body) mkUnpackCase scrut co uniq boxing_con unpk_args body - = Case casted_scrut bndr (exprType body) - [(DataAlt boxing_con, unpk_args, body)] + = mkSingleAltCase casted_scrut bndr + (DataAlt boxing_con) unpk_args body where casted_scrut = scrut `mkCast` co bndr = mk_ww_local uniq (exprType casted_scrut, MarkedStrict) |