X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FBasicTypes.lhs;h=41a5fa55bd4ed8e15cef7739deb7a77e8e91d998;hp=33c65980ec657643cc52e0689a7311df82177aed;hb=215ce9f15215399ce30ae55c9521087847d78646;hpb=f278f0676579f67075033a4f9857715909c4b71e

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 33c6598..41a5fa5 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -54,7 +54,8 @@ module BasicTypes(
 
         EP(..),
 
-	StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
+	HsBang(..), isBanged, isMarkedUnboxed, 
+        StrictnessMark(..), isMarkedStrict,
 
 	CompilerPhase, 
 	Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
@@ -529,24 +530,46 @@ The strictness annotations on types in data type declarations
 e.g. 	data T = MkT !Int !(Bool,Bool)
 
 \begin{code}
-data StrictnessMark	-- Used in interface decls only
-   = MarkedStrict	
-   | MarkedUnboxed	
-   | NotMarkedStrict	
-   deriving( Eq )
+-------------------------
+-- HsBang describes what the *programmer* wrote
+-- This info is retained in the DataCon.dcStrictMarks field
+data HsBang = HsNoBang	
 
-isMarkedUnboxed :: StrictnessMark -> Bool
-isMarkedUnboxed MarkedUnboxed = True
-isMarkedUnboxed _             = False
+	    | HsStrict	
 
-isMarkedStrict :: StrictnessMark -> Bool
-isMarkedStrict NotMarkedStrict = False
-isMarkedStrict _               = True   -- All others are strict
+	    | HsUnpack	       -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
+
+	    | HsUnpackFailed   -- An UNPACK pragma that we could not make 
+	      		       -- use of, because the type isn't unboxable; 
+                               -- equivalant to HsStrict except for checkValidDataCon
+  deriving (Eq, Data, Typeable)
+
+instance Outputable HsBang where
+    ppr HsNoBang       = empty
+    ppr HsStrict       = char '!'
+    ppr HsUnpack       = ptext (sLit "{-# UNPACK #-} !")
+    ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
+
+isBanged :: HsBang -> Bool
+isBanged HsNoBang = False
+isBanged _        = True
+
+isMarkedUnboxed :: HsBang -> Bool
+isMarkedUnboxed HsUnpack = True
+isMarkedUnboxed _        = False
+
+-------------------------
+-- StrictnessMark is internal only, used to indicate strictness 
+-- of the DataCon *worker* fields
+data StrictnessMark = MarkedStrict | NotMarkedStrict	
 
 instance Outputable StrictnessMark where
   ppr MarkedStrict     = ptext (sLit "!")
-  ppr MarkedUnboxed    = ptext (sLit "!!")
-  ppr NotMarkedStrict  = ptext (sLit "_")
+  ppr NotMarkedStrict  = empty
+
+isMarkedStrict :: StrictnessMark -> Bool
+isMarkedStrict NotMarkedStrict = False
+isMarkedStrict _               = True   -- All others are strict
 \end{code}