compiler/basicTypes/BasicTypes.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
   4 %
   5 \section[BasicTypes]{Miscellanous types}
   6
   7 This module defines a miscellaneously collection of very simple
   8 types that
   9
  10 \begin{itemize}
  11 \item have no other obvious home
  12 \item don't depend on any other complicated types
  13 \item are used in more than one "part" of the compiler
  14 \end{itemize}
  15
  16 \begin{code}
  17 module BasicTypes(
  18         Version, bumpVersion, initialVersion,
  19
  20         Arity,
  21
  22     FunctionOrData(..),
  23
  24         WarningTxt(..),
  25
  26         Fixity(..), FixityDirection(..),
  27         defaultFixity, maxPrecedence,
  28         negateFixity, funTyFixity,
  29         compareFixity,
  30
  31         IPName(..), ipNameName, mapIPName,
  32
  33         RecFlag(..), isRec, isNonRec, boolToRecFlag,
  34
  35         RuleName,
  36
  37         TopLevelFlag(..), isTopLevel, isNotTopLevel,
  38
  39         OverlapFlag(..),
  40
  41         Boxity(..), isBoxed,
  42
  43         TupCon(..), tupleParens,
  44
  45         OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
  46         isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
  47
  48         InsideLam, insideLam, notInsideLam,
  49         OneBranch, oneBranch, notOneBranch,
  50         InterestingCxt,
  51
  52         EP(..),
  53
  54         StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
  55
  56         CompilerPhase,
  57         Activation(..), isActive, isNeverActive, isAlwaysActive,
  58         RuleMatchInfo(..), isConLike, isFunLike,
  59         InlinePragma(..), defaultInlinePragma, isDefaultInlinePragma,
  60         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
  61         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
  62         InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
  63
  64         SuccessFlag(..), succeeded, failed, successIf
  65    ) where
  66
  67 import FastString
  68 import Outputable
  69 \end{code}
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection[Arity]{Arity}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 type Arity = Int
  79 \end{code}
  80
  81 %************************************************************************
  82 %*                                                                      *
  83 \subsection[FunctionOrData]{FunctionOrData}
  84 %*                                                                      *
  85 %************************************************************************
  86
  87 \begin{code}
  88 data FunctionOrData = IsFunction | IsData
  89     deriving (Eq, Ord)
  90
  91 instance Outputable FunctionOrData where
  92     ppr IsFunction = text "(function)"
  93     ppr IsData     = text "(data)"
  94 \end{code}
  95
  96
  97 %************************************************************************
  98 %*                                                                      *
  99 \subsection[Version]{Module and identifier version numbers}
 100 %*                                                                      *
 101 %************************************************************************
 102
 103 \begin{code}
 104 type Version = Int
 105
 106 bumpVersion :: Version -> Version
 107 bumpVersion v = v+1
 108
 109 initialVersion :: Version
 110 initialVersion = 1
 111 \end{code}
 112
 113 %************************************************************************
 114 %*                                                                      *
 115                 Deprecations
 116 %*                                                                      *
 117 %************************************************************************
 118
 119
 120 \begin{code}
 121 -- reason/explanation from a WARNING or DEPRECATED pragma
 122 data WarningTxt = WarningTxt FastString
 123                 | DeprecatedTxt FastString
 124     deriving Eq
 125
 126 instance Outputable WarningTxt where
 127     ppr (WarningTxt    w) =                        doubleQuotes (ftext w)
 128     ppr (DeprecatedTxt d) = text "Deprecated:" <+> doubleQuotes (ftext d)
 129 \end{code}
 130
 131 %************************************************************************
 132 %*                                                                      *
 133 \subsection{Implicit parameter identity}
 134 %*                                                                      *
 135 %************************************************************************
 136
 137 The @IPName@ type is here because it is used in TypeRep (i.e. very
 138 early in the hierarchy), but also in HsSyn.
 139
 140 \begin{code}
 141 newtype IPName name = IPName name       -- ?x
 142   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 143                         --      (used in HscTypes.OrigIParamCache)
 144
 145 ipNameName :: IPName name -> name
 146 ipNameName (IPName n) = n
 147
 148 mapIPName :: (a->b) -> IPName a -> IPName b
 149 mapIPName f (IPName n) = IPName (f n)
 150
 151 instance Outputable name => Outputable (IPName name) where
 152     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
 153 \end{code}
 154
 155 %************************************************************************
 156 %*                                                                      *
 157                 Rules
 158 %*                                                                      *
 159 %************************************************************************
 160
 161 \begin{code}
 162 type RuleName = FastString
 163 \end{code}
 164
 165 %************************************************************************
 166 %*                                                                      *
 167 \subsection[Fixity]{Fixity info}
 168 %*                                                                      *
 169 %************************************************************************
 170
 171 \begin{code}
 172 ------------------------
 173 data Fixity = Fixity Int FixityDirection
 174
 175 instance Outputable Fixity where
 176     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 177
 178 instance Eq Fixity where                -- Used to determine if two fixities conflict
 179   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 180
 181 ------------------------
 182 data FixityDirection = InfixL | InfixR | InfixN
 183                      deriving(Eq)
 184
 185 instance Outputable FixityDirection where
 186     ppr InfixL = ptext (sLit "infixl")
 187     ppr InfixR = ptext (sLit "infixr")
 188     ppr InfixN = ptext (sLit "infix")
 189
 190 ------------------------
 191 maxPrecedence :: Int
 192 maxPrecedence = 9
 193 defaultFixity :: Fixity
 194 defaultFixity = Fixity maxPrecedence InfixL
 195
 196 negateFixity, funTyFixity :: Fixity
 197 -- Wired-in fixities
 198 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
 199 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
 200 \end{code}
 201
 202 Consider
 203
 204 \begin{verbatim}
 205         a `op1` b `op2` c
 206 \end{verbatim}
 207 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 208 whether there's an error.
 209
 210 \begin{code}
 211 compareFixity :: Fixity -> Fixity
 212               -> (Bool,         -- Error please
 213                   Bool)         -- Associate to the right: a op1 (b op2 c)
 214 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 215   = case prec1 `compare` prec2 of
 216         GT -> left
 217         LT -> right
 218         EQ -> case (dir1, dir2) of
 219                         (InfixR, InfixR) -> right
 220                         (InfixL, InfixL) -> left
 221                         _                -> error_please
 222   where
 223     right        = (False, True)
 224     left         = (False, False)
 225     error_please = (True,  False)
 226 \end{code}
 227
 228
 229 %************************************************************************
 230 %*                                                                      *
 231 \subsection[Top-level/local]{Top-level/not-top level flag}
 232 %*                                                                      *
 233 %************************************************************************
 234
 235 \begin{code}
 236 data TopLevelFlag
 237   = TopLevel
 238   | NotTopLevel
 239
 240 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 241
 242 isNotTopLevel NotTopLevel = True
 243 isNotTopLevel TopLevel    = False
 244
 245 isTopLevel TopLevel     = True
 246 isTopLevel NotTopLevel  = False
 247
 248 instance Outputable TopLevelFlag where
 249   ppr TopLevel    = ptext (sLit "<TopLevel>")
 250   ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
 251 \end{code}
 252
 253
 254 %************************************************************************
 255 %*                                                                      *
 256                 Top-level/not-top level flag
 257 %*                                                                      *
 258 %************************************************************************
 259
 260 \begin{code}
 261 data Boxity
 262   = Boxed
 263   | Unboxed
 264   deriving( Eq )
 265
 266 isBoxed :: Boxity -> Bool
 267 isBoxed Boxed   = True
 268 isBoxed Unboxed = False
 269 \end{code}
 270
 271
 272 %************************************************************************
 273 %*                                                                      *
 274                 Recursive/Non-Recursive flag
 275 %*                                                                      *
 276 %************************************************************************
 277
 278 \begin{code}
 279 data RecFlag = Recursive
 280              | NonRecursive
 281              deriving( Eq )
 282
 283 isRec :: RecFlag -> Bool
 284 isRec Recursive    = True
 285 isRec NonRecursive = False
 286
 287 isNonRec :: RecFlag -> Bool
 288 isNonRec Recursive    = False
 289 isNonRec NonRecursive = True
 290
 291 boolToRecFlag :: Bool -> RecFlag
 292 boolToRecFlag True  = Recursive
 293 boolToRecFlag False = NonRecursive
 294
 295 instance Outputable RecFlag where
 296   ppr Recursive    = ptext (sLit "Recursive")
 297   ppr NonRecursive = ptext (sLit "NonRecursive")
 298 \end{code}
 299
 300 %************************************************************************
 301 %*                                                                      *
 302                 Instance overlap flag
 303 %*                                                                      *
 304 %************************************************************************
 305
 306 \begin{code}
 307 data OverlapFlag
 308   = NoOverlap   -- This instance must not overlap another
 309
 310   | OverlapOk   -- Silently ignore this instance if you find a
 311                 -- more specific one that matches the constraint
 312                 -- you are trying to resolve
 313                 --
 314                 -- Example: constraint (Foo [Int])
 315                 --          instances  (Foo [Int])
 316                 --                     (Foo [a])        OverlapOk
 317                 -- Since the second instance has the OverlapOk flag,
 318                 -- the first instance will be chosen (otherwise
 319                 -- its ambiguous which to choose)
 320
 321   | Incoherent  -- Like OverlapOk, but also ignore this instance
 322                 -- if it doesn't match the constraint you are
 323                 -- trying to resolve, but could match if the type variables
 324                 -- in the constraint were instantiated
 325                 --
 326                 -- Example: constraint (Foo [b])
 327                 --          instances  (Foo [Int])      Incoherent
 328                 --                     (Foo [a])
 329                 -- Without the Incoherent flag, we'd complain that
 330                 -- instantiating 'b' would change which instance
 331                 -- was chosen
 332   deriving( Eq )
 333
 334 instance Outputable OverlapFlag where
 335    ppr NoOverlap  = empty
 336    ppr OverlapOk  = ptext (sLit "[overlap ok]")
 337    ppr Incoherent = ptext (sLit "[incoherent]")
 338
 339 \end{code}
 340
 341 %************************************************************************
 342 %*                                                                      *
 343                 Tuples
 344 %*                                                                      *
 345 %************************************************************************
 346
 347 \begin{code}
 348 data TupCon = TupCon Boxity Arity
 349
 350 instance Eq TupCon where
 351   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 352
 353 tupleParens :: Boxity -> SDoc -> SDoc
 354 tupleParens Boxed   p = parens p
 355 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
 356 \end{code}
 357
 358 %************************************************************************
 359 %*                                                                      *
 360 \subsection[Generic]{Generic flag}
 361 %*                                                                      *
 362 %************************************************************************
 363
 364 This is the "Embedding-Projection pair" datatype, it contains
 365 two pieces of code (normally either RenamedExpr's or Id's)
 366 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 367 represents functions of type
 368
 369         from :: T -> Tring
 370         to   :: Tring -> T
 371
 372 And we should have
 373
 374         to (from x) = x
 375
 376 T and Tring are arbitrary, but typically T is the 'main' type while
 377 Tring is the 'representation' type.  (This just helps us remember
 378 whether to use 'from' or 'to'.
 379
 380 \begin{code}
 381 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 382                  toEP   :: a }  -- :: Tring -> T
 383 \end{code}
 384
 385 Embedding-projection pairs are used in several places:
 386
 387 First of all, each type constructor has an EP associated with it, the
 388 code in EP converts (datatype T) from T to Tring and back again.
 389
 390 Secondly, when we are filling in Generic methods (in the typechecker,
 391 tcMethodBinds), we are constructing bimaps by induction on the structure
 392 of the type of the method signature.
 393
 394
 395 %************************************************************************
 396 %*                                                                      *
 397 \subsection{Occurrence information}
 398 %*                                                                      *
 399 %************************************************************************
 400
 401 This data type is used exclusively by the simplifier, but it appears in a
 402 SubstResult, which is currently defined in VarEnv, which is pretty near
 403 the base of the module hierarchy.  So it seemed simpler to put the
 404 defn of OccInfo here, safely at the bottom
 405
 406 \begin{code}
 407 -- | Identifier occurrence information
 408 data OccInfo
 409   = NoOccInfo           -- ^ There are many occurrences, or unknown occurences
 410
 411   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
 412                         -- lambda and case-bound variables.
 413
 414   | OneOcc
 415         !InsideLam
 416         !OneBranch
 417         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
 418
 419   -- | This identifier breaks a loop of mutually recursive functions. The field
 420   -- marks whether it is only a loop breaker due to a reference in a rule
 421   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
 422         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
 423                         --          See OccurAnal Note [Weak loop breakers]
 424
 425 type RulesOnly = Bool
 426 \end{code}
 427
 428 Note [LoopBreaker OccInfo]
 429 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 430 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
 431 analyser in two ways:
 432   (a) to mark loop-breakers in a group of recursive
 433       definitions (hence the name)
 434   (b) to mark binders that must not be inlined in this phase
 435       (perhaps it has a NOINLINE pragma)
 436 Things with (IAmLoopBreaker False) do not get an unfolding
 437 pinned on to them, so they are completely opaque.
 438
 439 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
 440
 441
 442 \begin{code}
 443 isNoOcc :: OccInfo -> Bool
 444 isNoOcc NoOccInfo = True
 445 isNoOcc _         = False
 446
 447 seqOccInfo :: OccInfo -> ()
 448 seqOccInfo occ = occ `seq` ()
 449
 450 -----------------
 451 type InterestingCxt = Bool      -- True <=> Function: is applied
 452                                 --          Data value: scrutinised by a case with
 453                                 --                      at least one non-DEFAULT branch
 454
 455 -----------------
 456 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 457                         -- Substituting a redex for this occurrence is
 458                         -- dangerous because it might duplicate work.
 459 insideLam, notInsideLam :: InsideLam
 460 insideLam    = True
 461 notInsideLam = False
 462
 463 -----------------
 464 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 465                         --      so no code-duplication issue to worry about
 466 oneBranch, notOneBranch :: OneBranch
 467 oneBranch    = True
 468 notOneBranch = False
 469
 470 isLoopBreaker :: OccInfo -> Bool
 471 isLoopBreaker (IAmALoopBreaker _) = True
 472 isLoopBreaker _                   = False
 473
 474 isNonRuleLoopBreaker :: OccInfo -> Bool
 475 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
 476 isNonRuleLoopBreaker _                       = False
 477
 478 isDeadOcc :: OccInfo -> Bool
 479 isDeadOcc IAmDead = True
 480 isDeadOcc _       = False
 481
 482 isOneOcc :: OccInfo -> Bool
 483 isOneOcc (OneOcc _ _ _) = True
 484 isOneOcc _              = False
 485
 486 isFragileOcc :: OccInfo -> Bool
 487 isFragileOcc (OneOcc _ _ _) = True
 488 isFragileOcc _              = False
 489 \end{code}
 490
 491 \begin{code}
 492 instance Outputable OccInfo where
 493   -- only used for debugging; never parsed.  KSW 1999-07
 494   ppr NoOccInfo            = empty
 495   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
 496   ppr IAmDead              = ptext (sLit "Dead")
 497   ppr (OneOcc inside_lam one_branch int_cxt)
 498         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
 499         where
 500           pp_lam | inside_lam = char 'L'
 501                  | otherwise  = empty
 502           pp_br  | one_branch = empty
 503                  | otherwise  = char '*'
 504           pp_args | int_cxt   = char '!'
 505                   | otherwise = empty
 506
 507 instance Show OccInfo where
 508   showsPrec p occ = showsPrecSDoc p (ppr occ)
 509 \end{code}
 510
 511 %************************************************************************
 512 %*                                                                      *
 513 \subsection{Strictness indication}
 514 %*                                                                      *
 515 %************************************************************************
 516
 517 The strictness annotations on types in data type declarations
 518 e.g.    data T = MkT !Int !(Bool,Bool)
 519
 520 \begin{code}
 521 data StrictnessMark     -- Used in interface decls only
 522    = MarkedStrict
 523    | MarkedUnboxed
 524    | NotMarkedStrict
 525    deriving( Eq )
 526
 527 isMarkedUnboxed :: StrictnessMark -> Bool
 528 isMarkedUnboxed MarkedUnboxed = True
 529 isMarkedUnboxed _             = False
 530
 531 isMarkedStrict :: StrictnessMark -> Bool
 532 isMarkedStrict NotMarkedStrict = False
 533 isMarkedStrict _               = True   -- All others are strict
 534
 535 instance Outputable StrictnessMark where
 536   ppr MarkedStrict     = ptext (sLit "!")
 537   ppr MarkedUnboxed    = ptext (sLit "!!")
 538   ppr NotMarkedStrict  = ptext (sLit "_")
 539 \end{code}
 540
 541
 542 %************************************************************************
 543 %*                                                                      *
 544 \subsection{Success flag}
 545 %*                                                                      *
 546 %************************************************************************
 547
 548 \begin{code}
 549 data SuccessFlag = Succeeded | Failed
 550
 551 instance Outputable SuccessFlag where
 552     ppr Succeeded = ptext (sLit "Succeeded")
 553     ppr Failed    = ptext (sLit "Failed")
 554
 555 successIf :: Bool -> SuccessFlag
 556 successIf True  = Succeeded
 557 successIf False = Failed
 558
 559 succeeded, failed :: SuccessFlag -> Bool
 560 succeeded Succeeded = True
 561 succeeded Failed    = False
 562
 563 failed Succeeded = False
 564 failed Failed    = True
 565 \end{code}
 566
 567
 568 %************************************************************************
 569 %*                                                                      *
 570 \subsection{Activation}
 571 %*                                                                      *
 572 %************************************************************************
 573
 574 When a rule or inlining is active
 575
 576 \begin{code}
 577 type CompilerPhase = Int        -- Compilation phase
 578                                 -- Phases decrease towards zero
 579                                 -- Zero is the last phase
 580
 581 data Activation = NeverActive
 582                 | AlwaysActive
 583                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 584                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 585                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 586
 587 data RuleMatchInfo = ConLike
 588                    | FunLike
 589                    deriving( Eq )
 590
 591 isConLike :: RuleMatchInfo -> Bool
 592 isConLike ConLike = True
 593 isConLike _            = False
 594
 595 isFunLike :: RuleMatchInfo -> Bool
 596 isFunLike FunLike = True
 597 isFunLike _            = False
 598
 599 data InlinePragma
 600   = InlinePragma
 601       Activation        -- Says during which phases inlining is allowed
 602       RuleMatchInfo     -- Should the function be treated like a constructor?
 603   deriving( Eq )
 604
 605 defaultInlinePragma :: InlinePragma
 606 defaultInlinePragma = InlinePragma AlwaysActive FunLike
 607
 608 isDefaultInlinePragma :: InlinePragma -> Bool
 609 isDefaultInlinePragma (InlinePragma activation match_info)
 610   = isAlwaysActive activation && isFunLike match_info
 611
 612 inlinePragmaActivation :: InlinePragma -> Activation
 613 inlinePragmaActivation (InlinePragma activation _) = activation
 614
 615 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
 616 inlinePragmaRuleMatchInfo (InlinePragma _ info) = info
 617
 618 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
 619 setInlinePragmaActivation (InlinePragma _ info) activation
 620   = InlinePragma activation info
 621
 622 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
 623 setInlinePragmaRuleMatchInfo (InlinePragma activation _) info
 624   = InlinePragma activation info
 625
 626 data InlineSpec
 627   = Inline
 628         InlinePragma
 629         Bool            -- True  <=> INLINE
 630                         -- False <=> NOINLINE
 631   deriving( Eq )
 632
 633 defaultInlineSpec :: InlineSpec
 634 alwaysInlineSpec, neverInlineSpec :: RuleMatchInfo -> InlineSpec
 635
 636 defaultInlineSpec = Inline defaultInlinePragma False
 637                                                 -- Inlining is OK, but not forced
 638 alwaysInlineSpec match_info
 639                 = Inline (InlinePragma AlwaysActive match_info) True
 640                                                 -- INLINE always
 641 neverInlineSpec match_info
 642                 = Inline (InlinePragma NeverActive  match_info) False
 643                                                 -- NOINLINE
 644
 645 instance Outputable Activation where
 646    ppr NeverActive      = ptext (sLit "NEVER")
 647    ppr AlwaysActive     = ptext (sLit "ALWAYS")
 648    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 649    ppr (ActiveAfter n)  = brackets (int n)
 650
 651 instance Outputable RuleMatchInfo where
 652    ppr ConLike = ptext (sLit "CONLIKE")
 653    ppr FunLike = ptext (sLit "FUNLIKE")
 654
 655 instance Outputable InlinePragma where
 656   ppr (InlinePragma activation FunLike)
 657        = ppr activation
 658   ppr (InlinePragma activation match_info)
 659        = ppr match_info <+> ppr activation
 660
 661 instance Outputable InlineSpec where
 662    ppr (Inline (InlinePragma act match_info) is_inline)
 663         | is_inline = ptext (sLit "INLINE")
 664                       <+> ppr_match_info
 665                       <+> case act of
 666                              AlwaysActive -> empty
 667                              _            -> ppr act
 668         | otherwise = ptext (sLit "NOINLINE")
 669                       <+> ppr_match_info
 670                       <+> case act of
 671                              NeverActive  -> empty
 672                              _            -> ppr act
 673      where
 674        ppr_match_info = if isFunLike match_info then empty else ppr match_info
 675
 676 isActive :: CompilerPhase -> Activation -> Bool
 677 isActive _ NeverActive      = False
 678 isActive _ AlwaysActive     = True
 679 isActive p (ActiveAfter n)  = p <= n
 680 isActive p (ActiveBefore n) = p >  n
 681
 682 isNeverActive, isAlwaysActive :: Activation -> Bool
 683 isNeverActive NeverActive = True
 684 isNeverActive _           = False
 685
 686 isAlwaysActive AlwaysActive = True
 687 isAlwaysActive _            = False
 688 \end{code}
 689