Wibbles to faa8ff40 (UNPACK pragmas)

Nothing big here, just tidying up deetails

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

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.
+
 
 %************************************************************************
 %*									*

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)

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

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.
+-}

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

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 ()

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>

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>