X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;h=406d02a9df17207d3fc43c4f9ac81fd0cfa20a04;hp=0558daeff2aa9cd388670b144ee3c39de01fa485;hb=215ce9f15215399ce30ae55c9521087847d78646;hpb=d3c3b434feed852a56b5da706a5310f20b3b2377

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index 0558dae..406d02a 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -51,10 +51,10 @@ import Outputable
 import Unique
 import ListSetOps
 import Util
-import Maybes
 import FastString
 import Module
 
+import qualified Data.Data as Data
 import Data.Char
 import Data.Word
 import Data.List ( partition )
@@ -327,7 +327,7 @@ data DataCon
 		-- The OrigResTy is T [a], but the dcRepTyCon might be :T123
 
 	-- Now the strictness annotations and field labels of the constructor
-	dcStrictMarks :: [StrictnessMark],
+	dcStrictMarks :: [HsBang],
 		-- Strictness annotations as decided by the compiler.  
 		-- Does *not* include the existential dictionaries
 		-- length = dataConSourceArity dataCon
@@ -342,7 +342,8 @@ data DataCon
 					-- after unboxing and flattening,
 					-- and *including* existential dictionaries
 
-	dcRepStrictness :: [StrictnessMark],	-- One for each *representation* argument	
+	dcRepStrictness :: [StrictnessMark],
+        -- One for each *representation* *value* argument
 		-- See also Note [Data-con worker strictness] in MkId.lhs
 
 	-- Result type of constructor is T t1..tn
@@ -455,6 +456,15 @@ instance Outputable DataCon where
 
 instance Show DataCon where
     showsPrec p con = showsPrecSDoc p (ppr con)
+
+instance Data.Typeable DataCon where
+    typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") []
+
+instance Data.Data DataCon where
+    -- don't traverse?
+    toConstr _   = abstractConstr "DataCon"
+    gunfold _ _  = error "gunfold"
+    dataTypeOf _ = mkNoRepType "DataCon"
 \end{code}
 
 
@@ -468,7 +478,7 @@ instance Show DataCon where
 -- | Build a new data constructor
 mkDataCon :: Name 
 	  -> Bool	        -- ^ Is the constructor declared infix?
-	  -> [StrictnessMark]   -- ^ Strictness annotations written in the source file
+	  -> [HsBang]           -- ^ Strictness annotations written in the source file
 	  -> [FieldLabel]       -- ^ Field labels for the constructor, if it is a record, 
 				--   otherwise empty
 	  -> [TyVar]            -- ^ Universally quantified type variables
@@ -548,9 +558,9 @@ mkDataCon name declared_infix
 eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
 
-mk_dict_strict_mark :: PredType -> StrictnessMark
-mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
-		         | otherwise	     = NotMarkedStrict
+mk_dict_strict_mark :: PredType -> HsBang
+mk_dict_strict_mark pred | isStrictPred pred = HsStrict
+		         | otherwise	     = HsNoBang
 \end{code}
 
 \begin{code}
@@ -653,11 +663,11 @@ dataConFieldType con label
 
 -- | The strictness markings decided on by the compiler.  Does not include those for
 -- existential dictionaries.  The list is in one-to-one correspondence with the arity of the 'DataCon'
-dataConStrictMarks :: DataCon -> [StrictnessMark]
+dataConStrictMarks :: DataCon -> [HsBang]
 dataConStrictMarks = dcStrictMarks
 
 -- | Strictness of /existential/ arguments only
-dataConExStricts :: DataCon -> [StrictnessMark]
+dataConExStricts :: DataCon -> [HsBang]
 -- Usually empty, so we don't bother to cache this
 dataConExStricts dc = map mk_dict_strict_mark $ dcDictTheta dc
 
@@ -903,7 +913,7 @@ deepSplitProductType str ty
       Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
 
 -- | Compute the representation type strictness and type suitable for a 'DataCon'
-computeRep :: [StrictnessMark]		-- ^ Original argument strictness
+computeRep :: [HsBang]			-- ^ Original argument strictness
 	   -> [Type]			-- ^ Original argument types
 	   -> ([StrictnessMark],	-- Representation arg strictness
 	       [Type])			-- And type
@@ -911,10 +921,11 @@ computeRep :: [StrictnessMark]		-- ^ Original argument strictness
 computeRep stricts tys
   = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
   where
-    unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
-    unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
-    unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
-                               where
-                                 (_tycon, _tycon_args, arg_dc, arg_tys) 
-                                     = deepSplitProductType "unbox_strict_arg_ty" ty
+    unbox HsNoBang       ty = [(NotMarkedStrict, ty)]
+    unbox HsStrict       ty = [(MarkedStrict,    ty)]
+    unbox HsUnpackFailed ty = [(MarkedStrict,    ty)]
+    unbox HsUnpack ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
+                      where
+                        (_tycon, _tycon_args, arg_dc, arg_tys) 
+                           = deepSplitProductType "unbox_strict_arg_ty" ty
 \end{code}