Refactor (again) the handling of default methods

[ghc-hetmet.git] / compiler / basicTypes / BasicTypes.lhs

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 33c6598..022a8fc 100644 (file)
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -21,7 +21,7 @@ module BasicTypes(
 
        Arity, 
 
-    FunctionOrData(..),
+        FunctionOrData(..),
        
        WarningTxt(..),
 
@@ -54,7 +54,10 @@ module BasicTypes(
 
         EP(..),
 
-       StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
+       HsBang(..), isBanged, isMarkedUnboxed, 
+        StrictnessMark(..), isMarkedStrict,
+
+       DefMethSpec(..),
 
        CompilerPhase, 
        Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
@@ -521,7 +524,7 @@ instance Show OccInfo where
 
 %************************************************************************
 %*                                                                     *
-\subsection{Strictness indication}
+               Strictness indication
 %*                                                                     *
 %************************************************************************
 
@@ -529,29 +532,73 @@ 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}
 
 
 %************************************************************************
 %*                                                                     *
+               Default method specfication
+%*                                                                     *
+%************************************************************************
+
+The DefMethSpec enumeration just indicates what sort of default method
+is used for a class. It is generated from source code, and present in 
+interface files; it is converted to Class.DefMeth before begin put in a 
+Class object.
+
+\begin{code}
+data DefMethSpec = NoDM        -- No default method
+                 | VanillaDM   -- Default method given with polymorphic code
+                 | GenericDM   -- Default method given with generic code
+
+instance Outputable DefMethSpec where
+  ppr NoDM      = empty
+  ppr VanillaDM = ptext (sLit "{- Has default method -}")
+  ppr GenericDM = ptext (sLit "{- Has generic default method -}")
+\end{code}
+
+%************************************************************************
+%*                                                                     *
 \subsection{Success flag}
 %*                                                                     *
 %************************************************************************
@@ -603,9 +650,16 @@ 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, Data, Typeable )
 \end{code}