X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FBasicTypes.lhs;h=d4863dd8656433a31afbaf6d851925efeb95fad2;hb=9adc50f67cad200f5848ede1849b1e4b9158f915;hp=f14ab4d98ceeb84a4cf4d25cccdaad78db1860a2;hpb=011680bdbd73c93f6fd8363aaef93f995ba8f5b1;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index f14ab4d..d4863dd 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -14,6 +14,8 @@ types that
 \end{itemize}
 
 \begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
 module BasicTypes(
 	Version, bumpVersion, initialVersion,
 
@@ -52,7 +54,8 @@ module BasicTypes(
 
         EP(..),
 
-	StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
+	HsBang(..), isBanged, isMarkedUnboxed, 
+        StrictnessMark(..), isMarkedStrict,
 
 	CompilerPhase, 
 	Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
@@ -67,6 +70,8 @@ module BasicTypes(
 
 import FastString
 import Outputable
+
+import Data.Data hiding (Fixity)
 \end{code}
 
 %************************************************************************
@@ -87,7 +92,7 @@ type Arity = Int
 
 \begin{code}
 data FunctionOrData = IsFunction | IsData
-    deriving (Eq, Ord)
+    deriving (Eq, Ord, Data, Typeable)
 
 instance Outputable FunctionOrData where
     ppr IsFunction = text "(function)"
@@ -122,7 +127,7 @@ initialVersion = 1
 -- reason/explanation from a WARNING or DEPRECATED pragma
 data WarningTxt = WarningTxt [FastString]
                 | DeprecatedTxt [FastString]
-    deriving Eq
+    deriving (Eq, Data, Typeable)
 
 instance Outputable WarningTxt where
     ppr (WarningTxt    ws) = doubleQuotes (vcat (map ftext ws))
@@ -141,8 +146,9 @@ early in the hierarchy), but also in HsSyn.
 
 \begin{code}
 newtype IPName name = IPName name	-- ?x
-  deriving( Eq, Ord )	-- Ord is used in the IP name cache finite map
-			--	(used in HscTypes.OrigIParamCache)
+  deriving( Eq, Ord, Data, Typeable )
+  -- Ord is used in the IP name cache finite map
+  -- (used in HscTypes.OrigIParamCache)
 
 ipNameName :: IPName name -> name
 ipNameName (IPName n) = n
@@ -173,6 +179,7 @@ type RuleName = FastString
 \begin{code}
 ------------------------
 data Fixity = Fixity Int FixityDirection
+  deriving (Data, Typeable)
 
 instance Outputable Fixity where
     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
@@ -182,7 +189,7 @@ instance Eq Fixity where		-- Used to determine if two fixities conflict
 
 ------------------------
 data FixityDirection = InfixL | InfixR | InfixN 
-		     deriving(Eq)
+		     deriving (Eq, Data, Typeable)
 
 instance Outputable FixityDirection where
     ppr InfixL = ptext (sLit "infixl")
@@ -263,7 +270,7 @@ instance Outputable TopLevelFlag where
 data Boxity
   = Boxed
   | Unboxed
-  deriving( Eq )
+  deriving( Eq, Data, Typeable )
 
 isBoxed :: Boxity -> Bool
 isBoxed Boxed   = True
@@ -280,7 +287,7 @@ isBoxed Unboxed = False
 \begin{code}
 data RecFlag = Recursive 
 	     | NonRecursive
-	     deriving( Eq )
+	     deriving( Eq, Data, Typeable )
 
 isRec :: RecFlag -> Bool
 isRec Recursive    = True
@@ -523,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}
 
 
@@ -587,21 +616,28 @@ data Activation = NeverActive
 		| AlwaysActive
 		| ActiveBefore CompilerPhase	-- Active only *before* this phase
 		| ActiveAfter CompilerPhase	-- Active in this phase and later
-		deriving( Eq )			-- Eq used in comparing rules in HsDecls
+		deriving( Eq, Data, Typeable )			-- Eq used in comparing rules in HsDecls
 
 data RuleMatchInfo = ConLike 			-- See Note [CONLIKE pragma]
                    | FunLike
-                   deriving( Eq )
+                   deriving( Eq, Data, Typeable )
 
 data InlinePragma  	     -- Note [InlinePragma]
   = InlinePragma
       { inl_inline :: Bool           -- True <=> INLINE, 
       		      		     -- False <=> no pragma at all, or NOINLINE
+
       , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n 
       		      	    	     --            explicit (non-type, non-dictionary) args
+				     --   That is, inl_sat describes the number of *source-code*
+                                     --   arguments the thing must be applied to.  We add on the 
+                                     --   number of implicit, dictionary arguments when making
+			             --   the InlineRule, and don't look at inl_sat further
+
       , inl_act    :: Activation     -- Says during which phases inlining is allowed
+
       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
-    } deriving( Eq )
+    } deriving( Eq, Data, Typeable )
 \end{code}
 
 Note [InlinePragma]