[project @ 2002-03-05 14:18:53 by simonmar]
[ghc-hetmet.git] / ghc / compiler / basicTypes / BasicTypes.lhs
index 696a4c1..42e5e9f 100644 (file)
@@ -33,7 +33,8 @@ module BasicTypes(
 
        Boxity(..), isBoxed, tupleParens,
 
-       OccInfo(..), seqOccInfo, isFragileOcc, isDeadOcc, isLoopBreaker,
+       OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc, 
+       isDeadOcc, isLoopBreaker,
 
        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
@@ -42,7 +43,7 @@ module BasicTypes(
 
        StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
 
-       CompilerPhase, pprPhase, 
+       CompilerPhase, 
        Activation(..), isActive, isNeverActive, isAlwaysActive
    ) where
 
@@ -320,6 +321,9 @@ isDeadOcc :: OccInfo -> Bool
 isDeadOcc IAmDead = True
 isDeadOcc other          = False
 
+isOneOcc (OneOcc _ _) = True
+isOneOcc other       = False
+
 isFragileOcc :: OccInfo -> Bool
 isFragileOcc (OneOcc _ _) = True
 isFragileOcc other       = False
@@ -383,23 +387,23 @@ 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
+               | ActiveBefore CompilerPhase    -- Active only *before* this phase
                | 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")
+   ppr AlwaysActive     = empty                -- The default
+   ppr (ActiveBefore n) = brackets (char '~' <> int n)
+   ppr (ActiveAfter n)  = brackets (int n)
+   ppr NeverActive      = ptext SLIT("NEVER")
     
 isActive :: CompilerPhase -> Activation -> Bool
-isActive p NeverActive     = False
-isActive p AlwaysActive    = True
-isActive p (ActiveAfter n) = p <= n
+isActive p NeverActive      = False
+isActive p AlwaysActive     = True
+isActive p (ActiveAfter n)  = p <= n
+isActive p (ActiveBefore n) = p >  n
 
 isNeverActive, isAlwaysActive :: Activation -> Bool
 isNeverActive NeverActive = True