Commit b5853125 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Wibbles to faa8ff40 (UNPACK pragmas)

Nothing big here, just tidying up deetails
parent ea8490e7
......@@ -591,7 +591,7 @@ data HsBang = HsNoBang -- Lazy field
-- True <=> also an {-# UNPACK #-} pragma
| HsUnpack -- Definite commitment: this field is strict and unboxed
| HsStrict -- Definite commitment: this field is strict but not unboxec
| HsStrict -- Definite commitment: this field is strict but not unboxed
deriving (Eq, Data, Typeable)
instance Outputable HsBang where
......
......@@ -341,6 +341,7 @@ data DataCon
-- The OrigResTy is T [a], but the dcRepTyCon might be :T123
-- Now the strictness annotations and field labels of the constructor
-- See Note [Bangs on data constructor arguments]
dcArgBangs :: [HsBang],
-- Strictness annotations as decided by the compiler.
-- Matches 1-1 with dcOrigArgTys
......@@ -407,6 +408,8 @@ data DataConRep
, dcr_bangs :: [HsBang] -- The actual decisions made (including failures)
-- 1-1 with orig_arg_tys
-- See Note [Bangs on data constructor arguments]
}
-- Algebraic data types always have a worker, and
-- may or may not have a wrapper, depending on whether
......@@ -460,6 +463,25 @@ but the rep type is
Trep :: Int# -> a -> T a
Actually, the unboxed part isn't implemented yet!
Note [Bangs on data constructor arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
data T = MkT !Int {-# UNPACK #-} !Int Bool
Its dcArgBangs field records the *users* specifications, in this case
[HsBang False, HsBang True, HsNoBang]
See the declaration of HsBang in BasicTypes
The dcr_bangs field of the dcRep field records the *actual, decided*
representation of the data constructor. Without -O this might be
[HsStrict, HsStrict, HsNoBang]
With -O it might be
[HsStrict, HsUnpack, HsNoBang]
With -funbox-small-strict-fields it might be
[HsUnpack, HsUnpack, HsNoBang]
For imported data types, the dcArgBangs field is just the same as the
dcr_bangs field; we don't know what the user originally said.
%************************************************************************
%* *
......
......@@ -583,7 +583,9 @@ dataConArgRep _ arg_ty HsNoBang
dataConArgRep dflags arg_ty (HsBang False) -- No {-# UNPACK #-} pragma
| gopt Opt_OmitInterfacePragmas dflags
= strict_but_not_unpacked arg_ty -- Don't unpack if -fomit-iface-pragmas
= strict_but_not_unpacked arg_ty -- Don't unpack if we aren't optimising;
-- rather arbitrarily, we use -fomit-iface-pragmas
-- as the indication
| (True, rep_tys, unbox, box) <- dataConArgUnpack arg_ty
, gopt Opt_UnboxStrictFields dflags
......@@ -610,7 +612,6 @@ dataConArgRep _ arg_ty HsUnpack
= (HsUnpack, rep_tys, unbox, box)
| otherwise -- An interface file specified Unpacked, but we couldn't unpack it
= pprPanic "dataConArgRep" (ppr arg_ty)
strict_but_not_unpacked :: Type -> (HsBang, [(Type,StrictnessMark)], Unboxer, Boxer)
strict_but_not_unpacked arg_ty
= (HsStrict, [(arg_ty, MarkedStrict)], seqUnboxer, unitBoxer)
......
......@@ -270,7 +270,7 @@ data GeneralFlag
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
| Opt_UnboxStrictPrimitiveFields
| Opt_UnboxSmallStrictFields
| Opt_DictsCheap
| Opt_EnableRewriteRules -- Apply rewrite rules during simplification
| Opt_Vectorise
......
......@@ -29,10 +29,12 @@ import GHC ( TyThing(..) )
import DataCon
import Id
import TyCon
import BasicTypes
import Coercion( pprCoAxiom )
import HscTypes( tyThingParent_maybe )
import TcType
import Name
import StaticFlags( opt_PprStyle_Debug )
import Outputable
import FastString
......@@ -203,7 +205,7 @@ pprDataConDecl pefas ss gadt_style dataCon
(arg_tys, res_ty) = tcSplitFunTys tau
labels = GHC.dataConFieldLabels dataCon
stricts = GHC.dataConStrictMarks dataCon
tys_w_strs = zip stricts arg_tys
tys_w_strs = zip (map user_ify stricts) arg_tys
pp_foralls | pefas = GHC.pprForAll forall_tvs
| otherwise = empty
......@@ -211,11 +213,17 @@ pprDataConDecl pefas ss gadt_style dataCon
add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty
pprParendBangTy (bang,ty) = ppr bang <> GHC.pprParendType ty
pprBangTy (bang,ty) = ppr bang <> ppr ty
pprBangTy bang ty = ppr bang <> ppr ty
-- See Note [Printing bangs on data constructors]
user_ify :: HsBang -> HsBang
user_ify bang | opt_PprStyle_Debug = bang
user_ify HsStrict = HsBang False
user_ify HsUnpack = HsBang True
user_ify bang = bang
maybe_show_label (lbl,(strict,tp))
| showSub ss lbl = Just (ppr lbl <+> dcolon <+> pprBangTy strict tp)
maybe_show_label (lbl,bty)
| showSub ss lbl = Just (ppr lbl <+> dcolon <+> pprBangTy bty)
| otherwise = Nothing
ppr_fields [ty1, ty2]
......@@ -290,3 +298,11 @@ showWithLoc loc doc
where
comment = ptext (sLit "--")
{-
Note [Printing bangs on data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For imported data constructors the dataConStrictMarks are the
representation choices (see Note [Bangs on data constructor arguments]
in DataCon.lhs). So we have to fiddle a little bit here to turn them
back into user-printable form.
-}
......@@ -1005,8 +1005,8 @@ infixtype :: { LHsType RdrName }
| btype tyvarop type { LL $ mkHsOpTy $1 $2 $3 }
strict_mark :: { Located HsBang }
: '!' { L1 HsStrict }
| '{-# UNPACK' '#-}' '!' { LL HsUnpack }
: '!' { L1 (HsBang False) }
| '{-# UNPACK' '#-}' '!' { LL (HsBang True) }
| '{-# NOUNPACK' '#-}' '!' { LL HsStrict }
-- A ctype is a for-all type
......
......@@ -1224,10 +1224,11 @@ checkValidTyCon tc
-- Check arg types of data constructors
; traceTc "cvtc2" (ppr tc)
; dflags <- getDynFlags
; existential_ok <- xoptM Opt_ExistentialQuantification
; gadt_ok <- xoptM Opt_GADTs
; let ex_ok = existential_ok || gadt_ok -- Data cons can have existential context
; mapM_ (checkValidDataCon ex_ok tc) data_cons
; mapM_ (checkValidDataCon dflags ex_ok tc) data_cons
-- Check that fields with the same name share a type
; mapM_ check_fields groups }
......@@ -1287,8 +1288,8 @@ checkFieldCompat fld con1 con2 tvs1 res1 res2 fty1 fty2
mb_subst2 = tcMatchTyX tvs1 (expectJust "checkFieldCompat" mb_subst1) fty1 fty2
-------------------------------
checkValidDataCon :: Bool -> TyCon -> DataCon -> TcM ()
checkValidDataCon existential_ok tc con
checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM ()
checkValidDataCon dflags existential_ok tc con
= setSrcSpan (srcLocSpan (getSrcLoc con)) $
addErrCtxt (dataConCtxt con) $
do { traceTc "Validity of data con" (ppr con)
......@@ -1323,6 +1324,9 @@ checkValidDataCon existential_ok tc con
check_bang (HsBang want_unpack, rep_bang, n)
| want_unpack
, case rep_bang of { HsUnpack -> False; _ -> True }
, not (gopt Opt_OmitInterfacePragmas dflags)
-- If not optimising, se don't unpack, so don't complain!
-- See MkId.dataConArgRep, the (HsBang True) case
= addWarnTc (cant_unbox_msg n)
check_bang _
= return ()
......
......@@ -1735,11 +1735,11 @@
</row>
<row>
<entry><option>-funbox-strict-primitive-fields</option></entry>
<entry><option>-funbox-small-strict-fields</option></entry>
<entry>Flatten strict constructor fields with a
pointer-sized representation</entry>
<entry>dynamic</entry>
<entry><option>-fno-unbox-strict-primitive-fields</option></entry>
<entry><option>-fno-unbox-small-strict-fields</option></entry>
</row>
<row>
......
......@@ -1862,8 +1862,8 @@ f "2" = 2
<varlistentry>
<term>
<option>-funbox-strict-primitive-fields</option>:
<indexterm><primary><option>-funbox-strict-primitive-fields</option></primary></indexterm>
<option>-funbox-small-strict-fields</option>:
<indexterm><primary><option>-funbox-small-strict-fields</option></primary></indexterm>
<indexterm><primary>strict constructor fields</primary></indexterm>
<indexterm><primary>constructor fields, strict</primary></indexterm>
</term>
......@@ -1874,7 +1874,7 @@ f "2" = 2
pointer to be unpacked, if possible. It is equivalent to
adding an <literal>UNPACK</literal> pragma (see <xref
linkend="unpack-pragma"/>) to every strict constructor
field that fullfills the size restriction.
field that fulfils the size restriction.
</para>
<para>For example, the constructor fields in the following
......@@ -1888,12 +1888,12 @@ data D = D !C
would all be represented by a single
<literal>Int#</literal> (see <xref linkend="primitives"/>)
value with
<option>-funbox-strict-primitive-fields</option> enabled.
<option>-funbox-small-strict-fields</option> enabled.
</para>
<para>This option is less of a sledgehammer than
<option>-funbox-strict-fields</option>: it should rarely make things
worse. If you use <option>-funbox-strict-primitive-fields</option>
worse. If you use <option>-funbox-small-strict-fields</option>
to turn on unboxing by default you can disable it for certain
constructor fields using the <literal>NOUNPACK</literal> pragma (see
<xref linkend="nounpack-pragma"/>).</para>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment