[project @ 2001-11-26 09:20:25 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 6a8c583..35522d3 100644 (file)
--- a/ghc/compiler/basicTypes/BasicTypes.lhs
+++ b/ghc/compiler/basicTypes/BasicTypes.lhs
@@ -36,7 +36,12 @@ module BasicTypes(
        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
 
-        EP(..)
+        EP(..),
+
+       StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
+
+       CompilerPhase, pprPhase, 
+       Activation(..), isActive, isNeverActive, isAlwaysActive
    ) where
 
 #include "HsVersions.h"
@@ -83,8 +88,10 @@ type Version = Int
 bogusVersion :: Version        -- Shouldn't look at these
 bogusVersion = error "bogusVersion"
 
-bumpVersion :: Version -> Version 
-bumpVersion v = v+1
+bumpVersion :: Bool -> Version -> Version 
+-- Bump if the predicate (typically equality between old and new) is false
+bumpVersion False v = v+1
+bumpVersion True  v = v
 
 initialVersion :: Version
 initialVersion = 1
@@ -137,6 +144,7 @@ data NewOrData
   deriving( Eq )       -- Needed because Demand derives Eq
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 \subsection[Top-level/local]{Top-level/not-top level flag}
@@ -285,7 +293,7 @@ isDeadOcc other       = False
 
 isFragileOcc :: OccInfo -> Bool
 isFragileOcc (OneOcc _ _) = True
-isFragileOcc other           = False
+isFragileOcc other       = False
 \end{code}
 
 \begin{code}
@@ -302,3 +310,72 @@ 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}
+
+
+%************************************************************************
+%*                                                                     *
+\subsection{Activation}
+%*                                                                     *
+%************************************************************************
+
+When a rule or inlining is active
+
+\begin{code}
+type CompilerPhase = Int       -- Compilation phase
+                               -- Phases decrease towards zero
+                               -- Zero is the last phase
+
+pprPhase :: CompilerPhase -> SDoc
+pprPhase n = brackets (int n)
+
+data Activation = NeverActive
+               | AlwaysActive
+               | ActiveAfter CompilerPhase     -- Active in this phase and later
+               deriving( Eq )                  -- Eq used in comparing rules in HsDecls
+
+instance Outputable Activation where
+   ppr AlwaysActive    = empty         -- The default
+   ppr (ActiveAfter n) = pprPhase n
+   ppr NeverActive     = ptext SLIT("NEVER")
+    
+isActive :: CompilerPhase -> Activation -> Bool
+isActive p NeverActive     = False
+isActive p AlwaysActive    = True
+isActive p (ActiveAfter n) = p <= n
+
+isNeverActive, isAlwaysActive :: Activation -> Bool
+isNeverActive NeverActive = True
+isNeverActive act        = False
+
+isAlwaysActive AlwaysActive = True
+isAlwaysActive other       = False
+\end{code}