X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fstranal%2FWwLib.lhs;h=f3af6f0395797e0c7caaed4997f462e94876d025;hp=e44e521c83b6dd09dd8e5782331743372a076862;hb=f3c4792fad3bf46e5ee500a909287718324c45d1;hpb=dceb1790d14292280b5d13c2f08cf936ddaaedc7 diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index e44e521..f3af6f0 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -22,6 +22,7 @@ import TysWiredIn ( tupleCon ) import Type ( Type, isUnLiftedType, mkFunTys, splitForAllTys, splitFunTys, splitRecNewType_maybe, isAlgType ) +import Coercion ( Coercion, mkSymCoercion, splitRecNewTypeCo_maybe ) import BasicTypes ( Boxity(..) ) import Var ( Var, isId ) import UniqSupply ( returnUs, thenUs, getUniquesUs, UniqSM ) @@ -223,7 +224,7 @@ mkWWargs :: Type Type) -- Type of wrapper body mkWWargs fun_ty demands one_shots - | Just rep_ty <- splitRecNewType_maybe fun_ty + | Just (rep_ty, co) <- splitRecNewTypeCo_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 @@ -236,8 +237,8 @@ mkWWargs fun_ty demands one_shots -- simply coerces. = mkWWargs rep_ty demands one_shots `thenUs` \ (wrap_args, wrap_fn_args, work_fn_args, res_ty) -> returnUs (wrap_args, - Note (Coerce fun_ty rep_ty) . wrap_fn_args, - work_fn_args . Note (Coerce rep_ty fun_ty), + \ e -> Cast (wrap_fn_args e) co, + \ e -> work_fn_args (Cast e (mkSymCoercion co)), res_ty) | notNull demands