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, isEarlyActive,
  58         RuleMatchInfo(..), isConLike, isFunLike,
  59         InlinePragma(..), defaultInlinePragma, neverInlinePragma, dfunInlinePragma,
  60         isDefaultInlinePragma, isInlinePragma,
  61         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
  62         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
  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    ws) = doubleQuotes (vcat (map ftext ws))
 128     ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
 129                              doubleQuotes (vcat (map ftext ds))
 130 \end{code}
 131
 132 %************************************************************************
 133 %*                                                                      *
 134 \subsection{Implicit parameter identity}
 135 %*                                                                      *
 136 %************************************************************************
 137
 138 The @IPName@ type is here because it is used in TypeRep (i.e. very
 139 early in the hierarchy), but also in HsSyn.
 140
 141 \begin{code}
 142 newtype IPName name = IPName name       -- ?x
 143   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 144                         --      (used in HscTypes.OrigIParamCache)
 145
 146 ipNameName :: IPName name -> name
 147 ipNameName (IPName n) = n
 148
 149 mapIPName :: (a->b) -> IPName a -> IPName b
 150 mapIPName f (IPName n) = IPName (f n)
 151
 152 instance Outputable name => Outputable (IPName name) where
 153     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
 154 \end{code}
 155
 156 %************************************************************************
 157 %*                                                                      *
 158                 Rules
 159 %*                                                                      *
 160 %************************************************************************
 161
 162 \begin{code}
 163 type RuleName = FastString
 164 \end{code}
 165
 166 %************************************************************************
 167 %*                                                                      *
 168 \subsection[Fixity]{Fixity info}
 169 %*                                                                      *
 170 %************************************************************************
 171
 172 \begin{code}
 173 ------------------------
 174 data Fixity = Fixity Int FixityDirection
 175
 176 instance Outputable Fixity where
 177     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 178
 179 instance Eq Fixity where                -- Used to determine if two fixities conflict
 180   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 181
 182 ------------------------
 183 data FixityDirection = InfixL | InfixR | InfixN
 184                      deriving(Eq)
 185
 186 instance Outputable FixityDirection where
 187     ppr InfixL = ptext (sLit "infixl")
 188     ppr InfixR = ptext (sLit "infixr")
 189     ppr InfixN = ptext (sLit "infix")
 190
 191 ------------------------
 192 maxPrecedence :: Int
 193 maxPrecedence = 9
 194 defaultFixity :: Fixity
 195 defaultFixity = Fixity maxPrecedence InfixL
 196
 197 negateFixity, funTyFixity :: Fixity
 198 -- Wired-in fixities
 199 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
 200 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
 201 \end{code}
 202
 203 Consider
 204
 205 \begin{verbatim}
 206         a `op1` b `op2` c
 207 \end{verbatim}
 208 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 209 whether there's an error.
 210
 211 \begin{code}
 212 compareFixity :: Fixity -> Fixity
 213               -> (Bool,         -- Error please
 214                   Bool)         -- Associate to the right: a op1 (b op2 c)
 215 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 216   = case prec1 `compare` prec2 of
 217         GT -> left
 218         LT -> right
 219         EQ -> case (dir1, dir2) of
 220                         (InfixR, InfixR) -> right
 221                         (InfixL, InfixL) -> left
 222                         _                -> error_please
 223   where
 224     right        = (False, True)
 225     left         = (False, False)
 226     error_please = (True,  False)
 227 \end{code}
 228
 229
 230 %************************************************************************
 231 %*                                                                      *
 232 \subsection[Top-level/local]{Top-level/not-top level flag}
 233 %*                                                                      *
 234 %************************************************************************
 235
 236 \begin{code}
 237 data TopLevelFlag
 238   = TopLevel
 239   | NotTopLevel
 240
 241 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 242
 243 isNotTopLevel NotTopLevel = True
 244 isNotTopLevel TopLevel    = False
 245
 246 isTopLevel TopLevel     = True
 247 isTopLevel NotTopLevel  = False
 248
 249 instance Outputable TopLevelFlag where
 250   ppr TopLevel    = ptext (sLit "<TopLevel>")
 251   ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
 252 \end{code}
 253
 254
 255 %************************************************************************
 256 %*                                                                      *
 257                 Top-level/not-top level flag
 258 %*                                                                      *
 259 %************************************************************************
 260
 261 \begin{code}
 262 data Boxity
 263   = Boxed
 264   | Unboxed
 265   deriving( Eq )
 266
 267 isBoxed :: Boxity -> Bool
 268 isBoxed Boxed   = True
 269 isBoxed Unboxed = False
 270 \end{code}
 271
 272
 273 %************************************************************************
 274 %*                                                                      *
 275                 Recursive/Non-Recursive flag
 276 %*                                                                      *
 277 %************************************************************************
 278
 279 \begin{code}
 280 data RecFlag = Recursive
 281              | NonRecursive
 282              deriving( Eq )
 283
 284 isRec :: RecFlag -> Bool
 285 isRec Recursive    = True
 286 isRec NonRecursive = False
 287
 288 isNonRec :: RecFlag -> Bool
 289 isNonRec Recursive    = False
 290 isNonRec NonRecursive = True
 291
 292 boolToRecFlag :: Bool -> RecFlag
 293 boolToRecFlag True  = Recursive
 294 boolToRecFlag False = NonRecursive
 295
 296 instance Outputable RecFlag where
 297   ppr Recursive    = ptext (sLit "Recursive")
 298   ppr NonRecursive = ptext (sLit "NonRecursive")
 299 \end{code}
 300
 301 %************************************************************************
 302 %*                                                                      *
 303                 Instance overlap flag
 304 %*                                                                      *
 305 %************************************************************************
 306
 307 \begin{code}
 308 data OverlapFlag
 309   = NoOverlap   -- This instance must not overlap another
 310
 311   | OverlapOk   -- Silently ignore this instance if you find a
 312                 -- more specific one that matches the constraint
 313                 -- you are trying to resolve
 314                 --
 315                 -- Example: constraint (Foo [Int])
 316                 --          instances  (Foo [Int])
 317                 --                     (Foo [a])        OverlapOk
 318                 -- Since the second instance has the OverlapOk flag,
 319                 -- the first instance will be chosen (otherwise
 320                 -- its ambiguous which to choose)
 321
 322   | Incoherent  -- Like OverlapOk, but also ignore this instance
 323                 -- if it doesn't match the constraint you are
 324                 -- trying to resolve, but could match if the type variables
 325                 -- in the constraint were instantiated
 326                 --
 327                 -- Example: constraint (Foo [b])
 328                 --          instances  (Foo [Int])      Incoherent
 329                 --                     (Foo [a])
 330                 -- Without the Incoherent flag, we'd complain that
 331                 -- instantiating 'b' would change which instance
 332                 -- was chosen
 333   deriving( Eq )
 334
 335 instance Outputable OverlapFlag where
 336    ppr NoOverlap  = empty
 337    ppr OverlapOk  = ptext (sLit "[overlap ok]")
 338    ppr Incoherent = ptext (sLit "[incoherent]")
 339
 340 \end{code}
 341
 342 %************************************************************************
 343 %*                                                                      *
 344                 Tuples
 345 %*                                                                      *
 346 %************************************************************************
 347
 348 \begin{code}
 349 data TupCon = TupCon Boxity Arity
 350
 351 instance Eq TupCon where
 352   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 353
 354 tupleParens :: Boxity -> SDoc -> SDoc
 355 tupleParens Boxed   p = parens p
 356 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
 357 \end{code}
 358
 359 %************************************************************************
 360 %*                                                                      *
 361 \subsection[Generic]{Generic flag}
 362 %*                                                                      *
 363 %************************************************************************
 364
 365 This is the "Embedding-Projection pair" datatype, it contains
 366 two pieces of code (normally either RenamedExpr's or Id's)
 367 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 368 represents functions of type
 369
 370         from :: T -> Tring
 371         to   :: Tring -> T
 372
 373 And we should have
 374
 375         to (from x) = x
 376
 377 T and Tring are arbitrary, but typically T is the 'main' type while
 378 Tring is the 'representation' type.  (This just helps us remember
 379 whether to use 'from' or 'to'.
 380
 381 \begin{code}
 382 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 383                  toEP   :: a }  -- :: Tring -> T
 384 \end{code}
 385
 386 Embedding-projection pairs are used in several places:
 387
 388 First of all, each type constructor has an EP associated with it, the
 389 code in EP converts (datatype T) from T to Tring and back again.
 390
 391 Secondly, when we are filling in Generic methods (in the typechecker,
 392 tcMethodBinds), we are constructing bimaps by induction on the structure
 393 of the type of the method signature.
 394
 395
 396 %************************************************************************
 397 %*                                                                      *
 398 \subsection{Occurrence information}
 399 %*                                                                      *
 400 %************************************************************************
 401
 402 This data type is used exclusively by the simplifier, but it appears in a
 403 SubstResult, which is currently defined in VarEnv, which is pretty near
 404 the base of the module hierarchy.  So it seemed simpler to put the
 405 defn of OccInfo here, safely at the bottom
 406
 407 \begin{code}
 408 -- | Identifier occurrence information
 409 data OccInfo
 410   = NoOccInfo           -- ^ There are many occurrences, or unknown occurences
 411
 412   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
 413                         -- lambda and case-bound variables.
 414
 415   | OneOcc
 416         !InsideLam
 417         !OneBranch
 418         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
 419
 420   -- | This identifier breaks a loop of mutually recursive functions. The field
 421   -- marks whether it is only a loop breaker due to a reference in a rule
 422   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
 423         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
 424                         --          See OccurAnal Note [Weak loop breakers]
 425
 426 type RulesOnly = Bool
 427 \end{code}
 428
 429 Note [LoopBreaker OccInfo]
 430 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 431 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
 432 analyser in two ways:
 433   (a) to mark loop-breakers in a group of recursive
 434       definitions (hence the name)
 435   (b) to mark binders that must not be inlined in this phase
 436       (perhaps it has a NOINLINE pragma)
 437 Things with (IAmLoopBreaker False) do not get an unfolding
 438 pinned on to them, so they are completely opaque.
 439
 440 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
 441
 442
 443 \begin{code}
 444 isNoOcc :: OccInfo -> Bool
 445 isNoOcc NoOccInfo = True
 446 isNoOcc _         = False
 447
 448 seqOccInfo :: OccInfo -> ()
 449 seqOccInfo occ = occ `seq` ()
 450
 451 -----------------
 452 type InterestingCxt = Bool      -- True <=> Function: is applied
 453                                 --          Data value: scrutinised by a case with
 454                                 --                      at least one non-DEFAULT branch
 455
 456 -----------------
 457 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 458                         -- Substituting a redex for this occurrence is
 459                         -- dangerous because it might duplicate work.
 460 insideLam, notInsideLam :: InsideLam
 461 insideLam    = True
 462 notInsideLam = False
 463
 464 -----------------
 465 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 466                         --      so no code-duplication issue to worry about
 467 oneBranch, notOneBranch :: OneBranch
 468 oneBranch    = True
 469 notOneBranch = False
 470
 471 isLoopBreaker :: OccInfo -> Bool
 472 isLoopBreaker (IAmALoopBreaker _) = True
 473 isLoopBreaker _                   = False
 474
 475 isNonRuleLoopBreaker :: OccInfo -> Bool
 476 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
 477 isNonRuleLoopBreaker _                       = False
 478
 479 isDeadOcc :: OccInfo -> Bool
 480 isDeadOcc IAmDead = True
 481 isDeadOcc _       = False
 482
 483 isOneOcc :: OccInfo -> Bool
 484 isOneOcc (OneOcc _ _ _) = True
 485 isOneOcc _              = False
 486
 487 isFragileOcc :: OccInfo -> Bool
 488 isFragileOcc (OneOcc _ _ _) = True
 489 isFragileOcc _              = False
 490 \end{code}
 491
 492 \begin{code}
 493 instance Outputable OccInfo where
 494   -- only used for debugging; never parsed.  KSW 1999-07
 495   ppr NoOccInfo            = empty
 496   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
 497   ppr IAmDead              = ptext (sLit "Dead")
 498   ppr (OneOcc inside_lam one_branch int_cxt)
 499         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
 500         where
 501           pp_lam | inside_lam = char 'L'
 502                  | otherwise  = empty
 503           pp_br  | one_branch = empty
 504                  | otherwise  = char '*'
 505           pp_args | int_cxt   = char '!'
 506                   | otherwise = empty
 507
 508 instance Show OccInfo where
 509   showsPrec p occ = showsPrecSDoc p (ppr occ)
 510 \end{code}
 511
 512 %************************************************************************
 513 %*                                                                      *
 514 \subsection{Strictness indication}
 515 %*                                                                      *
 516 %************************************************************************
 517
 518 The strictness annotations on types in data type declarations
 519 e.g.    data T = MkT !Int !(Bool,Bool)
 520
 521 \begin{code}
 522 data StrictnessMark     -- Used in interface decls only
 523    = MarkedStrict
 524    | MarkedUnboxed
 525    | NotMarkedStrict
 526    deriving( Eq )
 527
 528 isMarkedUnboxed :: StrictnessMark -> Bool
 529 isMarkedUnboxed MarkedUnboxed = True
 530 isMarkedUnboxed _             = False
 531
 532 isMarkedStrict :: StrictnessMark -> Bool
 533 isMarkedStrict NotMarkedStrict = False
 534 isMarkedStrict _               = True   -- All others are strict
 535
 536 instance Outputable StrictnessMark where
 537   ppr MarkedStrict     = ptext (sLit "!")
 538   ppr MarkedUnboxed    = ptext (sLit "!!")
 539   ppr NotMarkedStrict  = ptext (sLit "_")
 540 \end{code}
 541
 542
 543 %************************************************************************
 544 %*                                                                      *
 545 \subsection{Success flag}
 546 %*                                                                      *
 547 %************************************************************************
 548
 549 \begin{code}
 550 data SuccessFlag = Succeeded | Failed
 551
 552 instance Outputable SuccessFlag where
 553     ppr Succeeded = ptext (sLit "Succeeded")
 554     ppr Failed    = ptext (sLit "Failed")
 555
 556 successIf :: Bool -> SuccessFlag
 557 successIf True  = Succeeded
 558 successIf False = Failed
 559
 560 succeeded, failed :: SuccessFlag -> Bool
 561 succeeded Succeeded = True
 562 succeeded Failed    = False
 563
 564 failed Succeeded = False
 565 failed Failed    = True
 566 \end{code}
 567
 568
 569 %************************************************************************
 570 %*                                                                      *
 571 \subsection{Activation}
 572 %*                                                                      *
 573 %************************************************************************
 574
 575 When a rule or inlining is active
 576
 577 \begin{code}
 578 type CompilerPhase = Int        -- Compilation phase
 579                                 -- Phases decrease towards zero
 580                                 -- Zero is the last phase
 581
 582 data Activation = NeverActive
 583                 | AlwaysActive
 584                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 585                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 586                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 587
 588 data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
 589                    | FunLike
 590                    deriving( Eq )
 591
 592 data InlinePragma            -- Note [InlinePragma]
 593   = InlinePragma
 594       { inl_inline :: Bool           -- True <=> INLINE,
 595                                      -- False <=> no pragma at all, or NOINLINE
 596       , inl_act    :: Activation     -- Says during which phases inlining is allowed
 597       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
 598     } deriving( Eq )
 599 \end{code}
 600
 601 Note [InlinePragma]
 602 ~~~~~~~~~~~~~~~~~~~
 603 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
 604 the source program.
 605
 606 If you write nothing at all, you get defaultInlinePragma:
 607    inl_inline = False
 608    inl_act    = AlwaysActive
 609    inl_rule   = FunLike
 610
 611 It's not possible to get that combination by *writing* something, so
 612 if an Id has defaultInlinePragma it means the user didn't specify anything.
 613
 614 Note [CONLIKE pragma]
 615 ~~~~~~~~~~~~~~~~~~~~~
 616 The ConLike constructor of a RuleMatchInfo is aimed at the following.
 617 Consider first
 618     {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
 619     g b bs = let x = b:bs in ..x...x...(r x)...
 620 Now, the rule applies to the (r x) term, because GHC "looks through"
 621 the definition of 'x' to see that it is (b:bs).
 622
 623 Now consider
 624     {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
 625     g v = let x = f v in ..x...x...(r x)...
 626 Normally the (r x) would *not* match the rule, because GHC would be
 627 scared about duplicating the redex (f v), so it does not "look
 628 through" the bindings.
 629
 630 However the CONLIKE modifier says to treat 'f' like a constructor in
 631 this situation, and "look through" the unfolding for x.  So (r x)
 632 fires, yielding (f (v+1)).
 633
 634 This is all controlled with a user-visible pragma:
 635      {-# NOINLINE CONLIKE [1] f #-}
 636
 637 The main effects of CONLIKE are:
 638
 639     - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
 640       CONLIKE thing like constructors, by ANF-ing them
 641
 642     - New function coreUtils.exprIsExpandable is like exprIsCheap, but
 643       additionally spots applications of CONLIKE functions
 644
 645     - A CoreUnfolding has a field that caches exprIsExpandable
 646
 647     - The rule matcher consults this field.  See
 648       Note [Expanding variables] in Rules.lhs.
 649
 650 \begin{code}
 651 isConLike :: RuleMatchInfo -> Bool
 652 isConLike ConLike = True
 653 isConLike _            = False
 654
 655 isFunLike :: RuleMatchInfo -> Bool
 656 isFunLike FunLike = True
 657 isFunLike _            = False
 658
 659 defaultInlinePragma, neverInlinePragma, dfunInlinePragma :: InlinePragma
 660 defaultInlinePragma
 661   = InlinePragma { inl_act = AlwaysActive, inl_rule = FunLike, inl_inline = False }
 662 neverInlinePragma
 663    = InlinePragma { inl_act = NeverActive, inl_rule = FunLike, inl_inline = False }
 664 dfunInlinePragma
 665    = InlinePragma { inl_act = AlwaysActive, inl_rule = ConLike, inl_inline = False }
 666
 667
 668 isDefaultInlinePragma :: InlinePragma -> Bool
 669 isDefaultInlinePragma (InlinePragma { inl_act = activation
 670                                     , inl_rule = match_info
 671                                     , inl_inline = inline })
 672   = not inline && isAlwaysActive activation && isFunLike match_info
 673
 674 isInlinePragma :: InlinePragma -> Bool
 675 isInlinePragma prag = inl_inline prag
 676
 677 inlinePragmaActivation :: InlinePragma -> Activation
 678 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
 679
 680 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
 681 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
 682
 683 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
 684 setInlinePragmaActivation prag activation = prag { inl_act = activation }
 685
 686 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
 687 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
 688
 689 instance Outputable Activation where
 690    ppr AlwaysActive     = ptext (sLit "ALWAYS")
 691    ppr NeverActive      = ptext (sLit "NEVER")
 692    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 693    ppr (ActiveAfter n)  = brackets (int n)
 694
 695 instance Outputable RuleMatchInfo where
 696    ppr ConLike = ptext (sLit "CONLIKE")
 697    ppr FunLike = ptext (sLit "FUNLIKE")
 698
 699 instance Outputable InlinePragma where
 700   ppr (InlinePragma { inl_inline = inline, inl_act = activation, inl_rule = info })
 701     = pp_inline <+> pp_info <+> pp_activation
 702     where
 703       pp_inline | inline    = ptext (sLit "INLINE")
 704                 | otherwise = ptext (sLit "NOINLINE")
 705       pp_info | isFunLike info = empty
 706               | otherwise      = ppr info
 707       pp_activation
 708         | inline     && isAlwaysActive activation = empty
 709         | not inline && isNeverActive  activation = empty
 710         | otherwise                               = ppr activation
 711
 712 isActive :: CompilerPhase -> Activation -> Bool
 713 isActive _ NeverActive      = False
 714 isActive _ AlwaysActive     = True
 715 isActive p (ActiveAfter n)  = p <= n
 716 isActive p (ActiveBefore n) = p >  n
 717
 718 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
 719 isNeverActive NeverActive = True
 720 isNeverActive _           = False
 721
 722 isAlwaysActive AlwaysActive = True
 723 isAlwaysActive _            = False
 724
 725 isEarlyActive AlwaysActive      = True
 726 isEarlyActive (ActiveBefore {}) = True
 727 isEarlyActive _                 = False
 728 \end{code}
 729