tcConArg unbox_strict bty
= do { arg_ty <- tcHsBangType bty
; let bang = getBangStrictness bty
- ; return (arg_ty, chooseBoxingStrategy unbox_strict arg_ty bang) }
+ ; strict_mark <- chooseBoxingStrategy unbox_strict arg_ty bang
+ ; return (arg_ty, strict_mark) }
-- We attempt to unbox/unpack a strict field when either:
-- (i) The field is marked '!!', or
--
-- We have turned off unboxing of newtypes because coercions make unboxing
-- and reboxing more complicated
-chooseBoxingStrategy :: Bool -> TcType -> HsBang -> StrictnessMark
+chooseBoxingStrategy :: Bool -> TcType -> HsBang -> TcM StrictnessMark
chooseBoxingStrategy unbox_strict_fields arg_ty bang
= case bang of
- HsNoBang -> NotMarkedStrict
+ HsNoBang -> return NotMarkedStrict
+ HsUnbox | can_unbox arg_ty -> return MarkedUnboxed
+ | otherwise -> do { addWarnTc cant_unbox_msg
+ ; return MarkedStrict }
HsStrict | unbox_strict_fields
- && can_unbox arg_ty -> MarkedUnboxed
- HsUnbox | can_unbox arg_ty -> MarkedUnboxed
- _ -> MarkedStrict
+ , can_unbox arg_ty -> return MarkedUnboxed
+ _ -> return MarkedStrict
where
-- we can unbox if the type is a chain of newtypes with a product tycon
-- at the end
(if isNewTyCon arg_tycon then
can_unbox (newTyConInstRhs arg_tycon tycon_args)
else True)
+
+ cant_unbox_msg = ptext (sLit "Ignoring unusable UNPACK pragma")
\end{code}
Note [Recursive unboxing]