[project @ 2001-07-23 10:54:46 by simonpj]

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

diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
index 820a3b9..0f7a462 100644 (file)
--- a/ghc/compiler/basicTypes/BasicTypes.lhs
+++ b/ghc/compiler/basicTypes/BasicTypes.lhs
@@ -36,7 +36,9 @@ module BasicTypes(
        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
 
-        EP(..)
+        EP(..),
+
+       StrictnessMark(..), isMarkedUnboxed, isMarkedStrict
    ) where
 
 #include "HsVersions.h"
@@ -304,3 +306,32 @@ instance Show OccInfo where
   showsPrec p occ = showsPrecSDoc p (ppr occ)
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+\subsection{Strictness indication}
+%*                                                                     *
+%************************************************************************
+
+The strictness annotations on types in data type declarations
+e.g.   data T = MkT !Int !(Bool,Bool)
+
+\begin{code}
+data StrictnessMark
+   = MarkedUserStrict  -- "!"  in a source decl
+   | MarkedStrict      -- "!"  in an interface decl: strict but not unboxed
+   | MarkedUnboxed     -- "!!" in an interface decl: unboxed 
+   | NotMarkedStrict   -- No annotation at all
+   deriving( Eq )
+
+isMarkedUnboxed MarkedUnboxed = True
+isMarkedUnboxed other        = False
+
+isMarkedStrict NotMarkedStrict = False
+isMarkedStrict other          = True   -- All others are strict
+
+instance Outputable StrictnessMark where
+  ppr MarkedUserStrict = ptext SLIT("!u")
+  ppr MarkedStrict     = ptext SLIT("!")
+  ppr MarkedUnboxed    = ptext SLIT("! !")
+  ppr NotMarkedStrict  = empty
+\end{code}