More comments on HsBang

In particular about the dcSrcBangs field of an imported DataCon

(cherry picked from commit c506f254b8e14fe422186322a580f9f7effca7f8)

5 files changed, 58 insertions, 36 deletions

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 3f27acd8fd..593e0edbf3 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -343,9 +343,14 @@ 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]
-        dcSrcBangs :: [HsSrcBang],
-                -- Strictness annotations as written by the programmer.
+        dcSrcBangs :: [HsBang],
+                -- See Note [Bangs on data constructor arguments]
+                -- For DataCons defined in this module: 
+                --    the [HsSrcBang] as written by the programmer.
+                -- For DataCons imported from an interface file:
+                --    the [HsImplBang] determined when compiling the
+                --    defining module
+                -- 
                 -- Matches 1-1 with dcOrigArgTys
                 -- Hence length = dataConSourceArity dataCon
 
@@ -466,7 +471,6 @@ data HsBang
 
 -- Two type-insecure, but useful, synonyms
 type HsSrcBang = HsBang   -- What the user wrote; hence always HsNoBang or HsSrcBang
-                          -- But see Note [HsSrcBang exceptions]
 
 type HsImplBang = HsBang   -- A HsBang implementation decision,
                            -- as determined by the compiler
@@ -477,16 +481,40 @@ type HsImplBang = HsBang   -- A HsBang implementation decision,
 -- of the DataCon *worker* fields
 data StrictnessMark = MarkedStrict | NotMarkedStrict
 
-{- Note [HsSrcBang exceptions]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Exceptions to rule that HsSrcBang is always HsSrcBang or HsNoBang:
+{- Note [Bangs on data constructor arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+  data T = MkT !Int {-# UNPACK #-} !Int Bool
+
+When compiling the module, GHC will decide how to represent
+MkT, depending on the optimisation level, and settings of
+flags like -funbox-small-strict-fields.  
+
+Terminology:
+  * HsSrcBang:  What the user wrote
+                Constructors: HsNoBang, HsUserBang
+
+  * HsImplBang: What GHC decided
+                Constructors: HsNoBang, HsStrict, HsUnpack
 
-* When we build a DataCon from an interface file we don't
-  know what the user wrote, so we use HsUnpack/HsStrict
+* If T was defined in this module, MkT's dcSrcBangs field 
+  records the [HsSrcBang] of what the user wrote; in the example
+    [ HsSrcBang Nothing True
+    , HsSrcBang (Just True) True
+    , HsNoBang]
 
-* In MkId.mkDataConRep we want to say "always unpack an equality
-  predicate for equality arguments so we use HsUnpack
-  see MkId.mk_pred_strict_mark
+* However, if T was defined in an imported module, MkT's dcSrcBangs
+  field gives the [HsImplBang] recording the decisions of the 
+  defining module.  The importing module must follow those decisions,
+  regardless of the flag settings in the importing module.
+
+* The dcr_bangs field of the dcRep field records the [HsImplBang]
+  If T was defined in this module, Without -O the dcr_bangs might be
+    [HsStrict, HsStrict, HsNoBang]
+  With -O it might be
+    [HsStrict, HsUnpack, HsNoBang]
+  With -funbox-small-strict-fields it might be
+    [HsUnpack, HsUnpack, HsNoBang]
 
 Note [Data con representation]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -506,25 +534,6 @@ 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 dcSrcBangs field records the *users* specifications, in this case
-    [ HsSrcBang Nothing True
-    , HsSrcBang (Just True) True
-    , HsNoBang]
-
-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 dcSrcBangs field is just the same as the
-dcr_bangs field; we don't know what the user originally said.
 
 
 ************************************************************************
@@ -610,7 +619,8 @@ isMarkedStrict _               = True   -- All others are strict
 -- | Build a new data constructor
 mkDataCon :: Name
           -> Bool               -- ^ Is the constructor declared infix?
-          -> [HsSrcBang]        -- ^ User-supplied strictness/unpack annotations
+          -> [HsBang]           -- ^ Strictness/unpack annotations, from user, of
+                                --   (for imported DataCons) from the interface file 
           -> [FieldLabel]       -- ^ Field labels for the constructor, if it is a record,
                                 --   otherwise empty
           -> [TyVar]            -- ^ Universally quantified type variables
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 55e812c2ad..a3ff4b824c 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -580,7 +580,14 @@ newLocal ty = do { uniq <- getUniqueM
 dataConArgRep
    :: DynFlags
    -> FamInstEnvs
-   -> Type -> HsSrcBang
+   -> Type 
+   -> HsSrcBang     -- For DataCons defined in this module, this is the
+                    --    bang/unpack annotation that the programmer wrote
+                    -- For DataCons imported from an interface file, this
+                    --    is the HsImplBang implementation decision taken
+                    --    by the compiler in the defining module; just follow
+                    --    it slavishly, so that we make the same decision as
+                    --    in the defining module
    -> ( HsImplBang                 -- Implementation decision about unpack strategy
       , [(Type, StrictnessMark)]   -- Rep types
       , (Unboxer, Boxer) )
diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs
index fa4ba1f191..33be51ff7f 100644
--- a/compiler/iface/BuildTyCl.hs
+++ b/compiler/iface/BuildTyCl.hs
@@ -128,7 +128,7 @@ mkNewTyConRhs tycon_name tycon con
 ------------------------------------------------------
 buildDataCon :: FamInstEnvs
             -> Name -> Bool
-            -> [HsSrcBang]
+            -> [HsBang]
             -> [Name]                   -- Field labels
             -> [TyVar] -> [TyVar]       -- Univ and ext
             -> [(TyVar,Type)]           -- Equality spec
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index ead3da4cac..cc40eb2e07 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -205,7 +205,8 @@ data IfaceConDecl
 
 type IfaceEqSpec = [(IfLclName,IfaceType)]
 
-data IfaceBang
+data IfaceBang  -- This corresponds to an HsImplBang; that is, the final
+                -- implementation decision about the data constructor arg
   = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion
 
 data IfaceClsInst
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 4c0440f1e1..ff0b68307e 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -532,7 +532,10 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
 
         ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr name))
                        name is_infix
-                       stricts lbl_names
+                       stricts     -- Pass the HsImplBangs (i.e. final decisions
+                                   -- to buildDataCon; it'll use these to guide 
+                                   -- the construction of a worker
+                       lbl_names
                        tc_tyvars ex_tyvars
                        eq_spec theta
                        arg_tys orig_res_ty tycon
@@ -540,6 +543,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
         ; return con }
     mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
 
+    tc_strict :: IfaceBang -> IfL HsImplBang
     tc_strict IfNoBang = return HsNoBang
     tc_strict IfStrict = return HsStrict
     tc_strict IfUnpack = return (HsUnpack Nothing)