-
--- We attempt to unbox/unpack a strict field when either:
--- (i) The tycon is imported, and the field is marked '! !', or
--- (ii) The tycon is defined in this module, the field is marked '!',
--- and the -funbox-strict-fields flag is on.
---
--- This ensures that if we compile some modules with -funbox-strict-fields and
--- some without, the compiler doesn't get confused about the constructor
--- representations.
-
-unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
-unbox_strict_arg_ty tycon NotMarkedStrict ty
- = (NotMarkedStrict, [ty])
-unbox_strict_arg_ty tycon MarkedStrict ty
- | not opt_UnboxStrictFields
- || not (isLocallyDefinedName (getName tycon)) = (MarkedStrict, [ty])
-unbox_strict_arg_ty tycon marked_unboxed ty
- -- MarkedUnboxed || (MarkedStrict && opt_UnboxStrictFields && not imported)
- = case splitAlgTyConApp_maybe ty of
- Just (tycon,_,[])
- -> panic (showSDoc (hcat [
- text "unbox_strict_arg_ty: constructors for ",
- ppr tycon,
- text " not available."
- ]))
- Just (tycon,ty_args,[con])
- -> case maybe_unpack_fields emptyUniqSet
- (zip (dataConOrigArgTys con ty_args)
- (dcUserStricts con))
- of
- Nothing -> (MarkedStrict, [ty])
- Just tys -> (MarkedUnboxed con tys, tys)
- _ -> (MarkedStrict, [ty])
-
--- bail out if we encounter the same tycon twice. This avoids problems like
---
--- data A = !B
--- data B = !A
---
--- where no useful unpacking can be done.
-
-maybe_unpack_field :: UniqSet TyCon -> Type -> StrictnessMark -> Maybe [Type]
-maybe_unpack_field set ty NotMarkedStrict
- = Just [ty]
-maybe_unpack_field set ty MarkedStrict | not opt_UnboxStrictFields
- = Just [ty]
-maybe_unpack_field set ty strict
- = case splitAlgTyConApp_maybe ty of
- Just (tycon,ty_args,[con])
- -- loop breaker
- | tycon `elementOfUniqSet` set -> Nothing
- -- don't unpack constructors with existential tyvars
- | not (null ex_tyvars) -> Nothing
- -- ok, let's do it
- | otherwise ->
- let set' = addOneToUniqSet set tycon in
- maybe_unpack_fields set'
- (zip (dataConOrigArgTys con ty_args)
- (dcUserStricts con))
- where (_, _, ex_tyvars, _, _, _) = dataConSig con
- _ -> Just [ty]
-
-maybe_unpack_fields :: UniqSet TyCon -> [(Type,StrictnessMark)] -> Maybe [Type]
-maybe_unpack_fields set tys
- | all isJust unpacked_fields = Just (concat (catMaybes unpacked_fields))
- | otherwise = Nothing
- where unpacked_fields = map (\(ty,str) -> maybe_unpack_field set ty str) tys