Major refactoring of the way that UNPACK pragmas are handled

The situation was pretty dire.  The way in which data constructors
were handled, notably the mapping between their *source* argument types
and their *representation* argument types (after seq'ing and unpacking)
was scattered in three different places, and hard to keep in sync.

Now it is all in one place:

 * The dcRep field of a DataCon gives its representation,
   specified by a DataConRep

 * As well as having the wrapper, the DataConRep has a "boxer"
   of type DataConBoxer (defined in MkId for loopy reasons).
   The boxer used at a pattern match to reconstruct the source-level
   arguments from the rep-level bindings in the pattern match.

 * The unboxing in the wrapper and the boxing in the boxer are dual,
   and are now constructed together, by MkId.mkDataConRep. This is
   the key function of this change.

 * All the computeBoxingStrategy code in TcTyClsDcls disappears.

Much nicer.

There is a little bit of refactoring left to do; the strange
deepSplitProductType functions are now called only in WwLib, so
I moved them there, and I think they could be tidied up further.

3 files changed, 17 insertions, 12 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 5d667ced4f..8226b426c3 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -749,19 +749,20 @@ instance Binary InlineSpec where
                   _ -> return NoInline
 
 instance Binary HsBang where
-    put_ bh HsNoBang        = putByte bh 0
-    put_ bh HsStrict        = putByte bh 1
-    put_ bh HsUnpack        = putByte bh 2
-    put_ bh HsUnpackFailed  = putByte bh 3
-    put_ bh HsNoUnpack      = putByte bh 4
+    put_ bh HsNoBang       = putByte bh 0
+    put_ bh (HsBang False) = putByte bh 1
+    put_ bh (HsBang True)  = putByte bh 2
+    put_ bh HsUnpack       = putByte bh 3
+    put_ bh HsStrict       = putByte bh 4
+
     get bh = do
             h <- getByte bh
             case h of
               0 -> do return HsNoBang
-              1 -> do return HsStrict
-              2 -> do return HsUnpack
-              3 -> do return HsUnpackFailed
-              _ -> do return HsNoUnpack
+              1 -> do return (HsBang False)
+              2 -> do return (HsBang True)
+              3 -> do return HsUnpack
+              _ -> do return HsStrict
 
 instance Binary TupleSort where
     put_ bh BoxedTuple      = putByte bh 0
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index be757c62ad..f1361fa7e7 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -39,6 +39,7 @@ import Coercion
 
 import DynFlags
 import TcRnMonad
+import UniqSupply
 import Util
 import Outputable
 \end{code}
@@ -155,14 +156,17 @@ buildDataCon src_name declared_infix arg_stricts field_lbls
 	-- code, which (for Haskell source anyway) will be in the DataName name
 	-- space, and puts it into the VarName name space
 
+        ; us <- newUniqueSupply
+        ; dflags <- getDynFlags
 	; let
 		stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs
 		data_con = mkDataCon src_name declared_infix
 				     arg_stricts field_lbls
 				     univ_tvs ex_tvs eq_spec ctxt
 				     arg_tys res_ty rep_tycon
-				     stupid_ctxt dc_ids
-		dc_ids = mkDataConIds wrap_name work_name data_con
+				     stupid_ctxt dc_wrk dc_rep
+                dc_wrk = mkDataConWorkId work_name data_con
+                dc_rep = initUs_ us (mkDataConRep dflags wrap_name data_con)
 
 	; return data_con }
 
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index c410cd770f..09d3210c14 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1506,7 +1506,7 @@ tyConToIfaceDecl env tycon
                     ifConArgTys  = map (tidyToIfaceType env2) arg_tys,
                     ifConFields  = map getOccName 
                                        (dataConFieldLabels data_con),
-                    ifConStricts = dataConStrictMarks data_con }
+                    ifConStricts = dataConRepBangs data_con }
         where
           (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) = dataConFullSig data_con