-unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
-
-unbox_strict_arg_ty tycon strict_mark ty
- | case strict_mark of
- NotMarkedStrict -> False
- MarkedUnboxed _ _ -> True -- !! From interface file
- MarkedStrict -> opt_UnboxStrictFields && -- ! From source
- maybeToBool maybe_product &&
- not (isRecursiveTyCon tycon) &&
- isDataTyCon arg_tycon
- -- We can't look through newtypes in arguments (yet)
- = (MarkedUnboxed con arg_tys, arg_tys)
-
- | otherwise
- = (strict_mark, [ty])
-
+chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
+ -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
+chooseBoxingStrategy tycon arg_ty strict
+ = case strict of
+ MarkedUserStrict
+ | opt_UnboxStrictFields
+ && unbox arg_ty -> MarkedUnboxed
+ | otherwise -> MarkedStrict
+ other -> strict
+ where
+ -- beware: repType will go into a loop if we try this on a recursive
+ -- type (for reasons unknown...), hence the check for recursion below.
+ unbox ty =
+ case splitTyConApp_maybe ty of
+ Nothing -> False
+ Just (arg_tycon, _)
+ | isRecursiveTyCon arg_tycon -> False
+ | otherwise ->
+ case splitTyConApp_maybe (repType ty) of
+ Nothing -> False
+ Just (arg_tycon, _) -> isProductTyCon arg_tycon
+
+unbox_strict_arg_ty
+ :: StrictnessMark -- After strategy choice; can't be MkaredUserStrict
+ -> Type -- Source argument type
+ -> [(Demand,Type)] -- Representation argument types and demamds
+
+unbox_strict_arg_ty NotMarkedStrict ty = [(wwLazy, ty)]
+unbox_strict_arg_ty MarkedStrict ty = [(wwStrict, ty)]
+unbox_strict_arg_ty MarkedUnboxed ty
+ = zipEqual "unbox_strict_arg_ty" (dataConRepStrictness arg_data_con) arg_tys