diff options
| -rw-r--r-- | compiler/basicTypes/BasicTypes.lhs | 2 | ||||
| -rw-r--r-- | compiler/basicTypes/DataCon.lhs | 22 | ||||
| -rw-r--r-- | compiler/basicTypes/MkId.lhs | 5 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | compiler/main/PprTyThing.hs | 24 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 4 | ||||
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.lhs | 10 | ||||
| -rw-r--r-- | docs/users_guide/flags.xml | 4 | ||||
| -rw-r--r-- | docs/users_guide/using.xml | 10 |
9 files changed, 63 insertions, 20 deletions
diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index efef9faf57..b5fb018557 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -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 diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index d04eac588a..18e8c2a6fe 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -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. + %************************************************************************ %* * diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index ce81100607..516e25a2b0 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -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) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 746fb5b510..6735d86cb2 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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 diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index 0fa7bdff52..81d8e506c6 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -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. +-} diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 4833a1805a..1907ab320a 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -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 diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index bfb33479ea..c66174b2f4 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -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 () diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index ee92648b1e..2103260671 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -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> diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 1e81955b3c..292f4fe1c0 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -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> |