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 {-# LANGUAGE DeriveDataTypeable #-}
  18
  19 module BasicTypes(
  20         Version, bumpVersion, initialVersion,
  21
  22         Arity,
  23
  24         FunctionOrData(..),
  25
  26         WarningTxt(..),
  27
  28         Fixity(..), FixityDirection(..),
  29         defaultFixity, maxPrecedence,
  30         negateFixity, funTyFixity,
  31         compareFixity,
  32
  33         IPName(..), ipNameName, mapIPName,
  34
  35         RecFlag(..), isRec, isNonRec, boolToRecFlag,
  36
  37         RuleName,
  38
  39         TopLevelFlag(..), isTopLevel, isNotTopLevel,
  40
  41         OverlapFlag(..),
  42
  43         Boxity(..), isBoxed,
  44
  45         TupCon(..), tupleParens,
  46
  47         OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc,
  48         isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
  49         nonRuleLoopBreaker,
  50
  51         InsideLam, insideLam, notInsideLam,
  52         OneBranch, oneBranch, notOneBranch,
  53         InterestingCxt,
  54
  55         EP(..),
  56
  57         HsBang(..), isBanged, isMarkedUnboxed,
  58         StrictnessMark(..), isMarkedStrict,
  59
  60         DefMethSpec(..),
  61
  62         CompilerPhase,
  63         Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
  64         RuleMatchInfo(..), isConLike, isFunLike,
  65         InlineSpec(..),
  66         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
  67         neverInlinePragma, dfunInlinePragma,
  68         isDefaultInlinePragma,
  69         isInlinePragma, isInlinablePragma, isAnyInlinePragma,
  70         inlinePragmaSpec, inlinePragmaSat,
  71         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
  72         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
  73
  74         SuccessFlag(..), succeeded, failed, successIf
  75    ) where
  76
  77 import FastString
  78 import Outputable
  79
  80 import Data.Data hiding (Fixity)
  81 \end{code}
  82
  83 %************************************************************************
  84 %*                                                                      *
  85 \subsection[Arity]{Arity}
  86 %*                                                                      *
  87 %************************************************************************
  88
  89 \begin{code}
  90 type Arity = Int
  91 \end{code}
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection[FunctionOrData]{FunctionOrData}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 \begin{code}
 100 data FunctionOrData = IsFunction | IsData
 101     deriving (Eq, Ord, Data, Typeable)
 102
 103 instance Outputable FunctionOrData where
 104     ppr IsFunction = text "(function)"
 105     ppr IsData     = text "(data)"
 106 \end{code}
 107
 108
 109 %************************************************************************
 110 %*                                                                      *
 111 \subsection[Version]{Module and identifier version numbers}
 112 %*                                                                      *
 113 %************************************************************************
 114
 115 \begin{code}
 116 type Version = Int
 117
 118 bumpVersion :: Version -> Version
 119 bumpVersion v = v+1
 120
 121 initialVersion :: Version
 122 initialVersion = 1
 123 \end{code}
 124
 125 %************************************************************************
 126 %*                                                                      *
 127                 Deprecations
 128 %*                                                                      *
 129 %************************************************************************
 130
 131
 132 \begin{code}
 133 -- reason/explanation from a WARNING or DEPRECATED pragma
 134 data WarningTxt = WarningTxt [FastString]
 135                 | DeprecatedTxt [FastString]
 136     deriving (Eq, Data, Typeable)
 137
 138 instance Outputable WarningTxt where
 139     ppr (WarningTxt    ws) = doubleQuotes (vcat (map ftext ws))
 140     ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
 141                              doubleQuotes (vcat (map ftext ds))
 142 \end{code}
 143
 144 %************************************************************************
 145 %*                                                                      *
 146 \subsection{Implicit parameter identity}
 147 %*                                                                      *
 148 %************************************************************************
 149
 150 The @IPName@ type is here because it is used in TypeRep (i.e. very
 151 early in the hierarchy), but also in HsSyn.
 152
 153 \begin{code}
 154 newtype IPName name = IPName name       -- ?x
 155   deriving( Eq, Ord, Data, Typeable )
 156   -- Ord is used in the IP name cache finite map
 157   -- (used in HscTypes.OrigIParamCache)
 158
 159 ipNameName :: IPName name -> name
 160 ipNameName (IPName n) = n
 161
 162 mapIPName :: (a->b) -> IPName a -> IPName b
 163 mapIPName f (IPName n) = IPName (f n)
 164
 165 instance Outputable name => Outputable (IPName name) where
 166     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
 167 \end{code}
 168
 169 %************************************************************************
 170 %*                                                                      *
 171                 Rules
 172 %*                                                                      *
 173 %************************************************************************
 174
 175 \begin{code}
 176 type RuleName = FastString
 177 \end{code}
 178
 179 %************************************************************************
 180 %*                                                                      *
 181 \subsection[Fixity]{Fixity info}
 182 %*                                                                      *
 183 %************************************************************************
 184
 185 \begin{code}
 186 ------------------------
 187 data Fixity = Fixity Int FixityDirection
 188   deriving (Data, Typeable)
 189
 190 instance Outputable Fixity where
 191     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 192
 193 instance Eq Fixity where                -- Used to determine if two fixities conflict
 194   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 195
 196 ------------------------
 197 data FixityDirection = InfixL | InfixR | InfixN
 198                      deriving (Eq, Data, Typeable)
 199
 200 instance Outputable FixityDirection where
 201     ppr InfixL = ptext (sLit "infixl")
 202     ppr InfixR = ptext (sLit "infixr")
 203     ppr InfixN = ptext (sLit "infix")
 204
 205 ------------------------
 206 maxPrecedence :: Int
 207 maxPrecedence = 9
 208 defaultFixity :: Fixity
 209 defaultFixity = Fixity maxPrecedence InfixL
 210
 211 negateFixity, funTyFixity :: Fixity
 212 -- Wired-in fixities
 213 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
 214 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
 215 \end{code}
 216
 217 Consider
 218
 219 \begin{verbatim}
 220         a `op1` b `op2` c
 221 \end{verbatim}
 222 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 223 whether there's an error.
 224
 225 \begin{code}
 226 compareFixity :: Fixity -> Fixity
 227               -> (Bool,         -- Error please
 228                   Bool)         -- Associate to the right: a op1 (b op2 c)
 229 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 230   = case prec1 `compare` prec2 of
 231         GT -> left
 232         LT -> right
 233         EQ -> case (dir1, dir2) of
 234                         (InfixR, InfixR) -> right
 235                         (InfixL, InfixL) -> left
 236                         _                -> error_please
 237   where
 238     right        = (False, True)
 239     left         = (False, False)
 240     error_please = (True,  False)
 241 \end{code}
 242
 243
 244 %************************************************************************
 245 %*                                                                      *
 246 \subsection[Top-level/local]{Top-level/not-top level flag}
 247 %*                                                                      *
 248 %************************************************************************
 249
 250 \begin{code}
 251 data TopLevelFlag
 252   = TopLevel
 253   | NotTopLevel
 254
 255 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 256
 257 isNotTopLevel NotTopLevel = True
 258 isNotTopLevel TopLevel    = False
 259
 260 isTopLevel TopLevel     = True
 261 isTopLevel NotTopLevel  = False
 262
 263 instance Outputable TopLevelFlag where
 264   ppr TopLevel    = ptext (sLit "<TopLevel>")
 265   ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
 266 \end{code}
 267
 268
 269 %************************************************************************
 270 %*                                                                      *
 271                 Top-level/not-top level flag
 272 %*                                                                      *
 273 %************************************************************************
 274
 275 \begin{code}
 276 data Boxity
 277   = Boxed
 278   | Unboxed
 279   deriving( Eq, Data, Typeable )
 280
 281 isBoxed :: Boxity -> Bool
 282 isBoxed Boxed   = True
 283 isBoxed Unboxed = False
 284 \end{code}
 285
 286
 287 %************************************************************************
 288 %*                                                                      *
 289                 Recursive/Non-Recursive flag
 290 %*                                                                      *
 291 %************************************************************************
 292
 293 \begin{code}
 294 data RecFlag = Recursive
 295              | NonRecursive
 296              deriving( Eq, Data, Typeable )
 297
 298 isRec :: RecFlag -> Bool
 299 isRec Recursive    = True
 300 isRec NonRecursive = False
 301
 302 isNonRec :: RecFlag -> Bool
 303 isNonRec Recursive    = False
 304 isNonRec NonRecursive = True
 305
 306 boolToRecFlag :: Bool -> RecFlag
 307 boolToRecFlag True  = Recursive
 308 boolToRecFlag False = NonRecursive
 309
 310 instance Outputable RecFlag where
 311   ppr Recursive    = ptext (sLit "Recursive")
 312   ppr NonRecursive = ptext (sLit "NonRecursive")
 313 \end{code}
 314
 315 %************************************************************************
 316 %*                                                                      *
 317                 Instance overlap flag
 318 %*                                                                      *
 319 %************************************************************************
 320
 321 \begin{code}
 322 data OverlapFlag
 323   = NoOverlap   -- This instance must not overlap another
 324
 325   | OverlapOk   -- Silently ignore this instance if you find a
 326                 -- more specific one that matches the constraint
 327                 -- you are trying to resolve
 328                 --
 329                 -- Example: constraint (Foo [Int])
 330                 --          instances  (Foo [Int])
 331
 332                 --                     (Foo [a])        OverlapOk
 333                 -- Since the second instance has the OverlapOk flag,
 334                 -- the first instance will be chosen (otherwise
 335                 -- its ambiguous which to choose)
 336
 337   | Incoherent  -- Like OverlapOk, but also ignore this instance
 338                 -- if it doesn't match the constraint you are
 339                 -- trying to resolve, but could match if the type variables
 340                 -- in the constraint were instantiated
 341                 --
 342                 -- Example: constraint (Foo [b])
 343                 --          instances  (Foo [Int])      Incoherent
 344                 --                     (Foo [a])
 345                 -- Without the Incoherent flag, we'd complain that
 346                 -- instantiating 'b' would change which instance
 347                 -- was chosen
 348   deriving( Eq )
 349
 350 instance Outputable OverlapFlag where
 351    ppr NoOverlap  = empty
 352    ppr OverlapOk  = ptext (sLit "[overlap ok]")
 353    ppr Incoherent = ptext (sLit "[incoherent]")
 354
 355 \end{code}
 356
 357 %************************************************************************
 358 %*                                                                      *
 359                 Tuples
 360 %*                                                                      *
 361 %************************************************************************
 362
 363 \begin{code}
 364 data TupCon = TupCon Boxity Arity
 365
 366 instance Eq TupCon where
 367   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 368
 369 tupleParens :: Boxity -> SDoc -> SDoc
 370 tupleParens Boxed   p = parens p
 371 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
 372 \end{code}
 373
 374 %************************************************************************
 375 %*                                                                      *
 376 \subsection[Generic]{Generic flag}
 377 %*                                                                      *
 378 %************************************************************************
 379
 380 This is the "Embedding-Projection pair" datatype, it contains
 381 two pieces of code (normally either RenamedExpr's or Id's)
 382 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 383 represents functions of type
 384
 385         from :: T -> Tring
 386         to   :: Tring -> T
 387
 388 And we should have
 389
 390         to (from x) = x
 391
 392 T and Tring are arbitrary, but typically T is the 'main' type while
 393 Tring is the 'representation' type.  (This just helps us remember
 394 whether to use 'from' or 'to'.
 395
 396 \begin{code}
 397 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 398                  toEP   :: a }  -- :: Tring -> T
 399 \end{code}
 400
 401 Embedding-projection pairs are used in several places:
 402
 403 First of all, each type constructor has an EP associated with it, the
 404 code in EP converts (datatype T) from T to Tring and back again.
 405
 406 Secondly, when we are filling in Generic methods (in the typechecker,
 407 tcMethodBinds), we are constructing bimaps by induction on the structure
 408 of the type of the method signature.
 409
 410
 411 %************************************************************************
 412 %*                                                                      *
 413 \subsection{Occurrence information}
 414 %*                                                                      *
 415 %************************************************************************
 416
 417 This data type is used exclusively by the simplifier, but it appears in a
 418 SubstResult, which is currently defined in VarEnv, which is pretty near
 419 the base of the module hierarchy.  So it seemed simpler to put the
 420 defn of OccInfo here, safely at the bottom
 421
 422 \begin{code}
 423 -- | Identifier occurrence information
 424 data OccInfo
 425   = NoOccInfo           -- ^ There are many occurrences, or unknown occurences
 426
 427   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
 428                         -- lambda and case-bound variables.
 429
 430   | OneOcc
 431         !InsideLam
 432         !OneBranch
 433         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
 434
 435   -- | This identifier breaks a loop of mutually recursive functions. The field
 436   -- marks whether it is only a loop breaker due to a reference in a rule
 437   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
 438         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
 439                         --          See OccurAnal Note [Weak loop breakers]
 440
 441 type RulesOnly = Bool
 442 \end{code}
 443
 444 Note [LoopBreaker OccInfo]
 445 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 446 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
 447 analyser in two ways:
 448   (a) to mark loop-breakers in a group of recursive
 449       definitions (hence the name)
 450   (b) to mark binders that must not be inlined in this phase
 451       (perhaps it has a NOINLINE pragma)
 452 Things with (IAmLoopBreaker False) do not get an unfolding
 453 pinned on to them, so they are completely opaque.
 454
 455 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
 456
 457
 458 \begin{code}
 459 isNoOcc :: OccInfo -> Bool
 460 isNoOcc NoOccInfo = True
 461 isNoOcc _         = False
 462
 463 seqOccInfo :: OccInfo -> ()
 464 seqOccInfo occ = occ `seq` ()
 465
 466 -----------------
 467 type InterestingCxt = Bool      -- True <=> Function: is applied
 468                                 --          Data value: scrutinised by a case with
 469                                 --                      at least one non-DEFAULT branch
 470
 471 -----------------
 472 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 473                         -- Substituting a redex for this occurrence is
 474                         -- dangerous because it might duplicate work.
 475 insideLam, notInsideLam :: InsideLam
 476 insideLam    = True
 477 notInsideLam = False
 478
 479 -----------------
 480 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 481                         --      so no code-duplication issue to worry about
 482 oneBranch, notOneBranch :: OneBranch
 483 oneBranch    = True
 484 notOneBranch = False
 485
 486 isLoopBreaker :: OccInfo -> Bool
 487 isLoopBreaker (IAmALoopBreaker _) = True
 488 isLoopBreaker _                   = False
 489
 490 isNonRuleLoopBreaker :: OccInfo -> Bool
 491 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
 492 isNonRuleLoopBreaker _                       = False
 493
 494 nonRuleLoopBreaker :: OccInfo
 495 nonRuleLoopBreaker = IAmALoopBreaker False
 496
 497 isDeadOcc :: OccInfo -> Bool
 498 isDeadOcc IAmDead = True
 499 isDeadOcc _       = False
 500
 501 isOneOcc :: OccInfo -> Bool
 502 isOneOcc (OneOcc {}) = True
 503 isOneOcc _           = False
 504
 505 zapFragileOcc :: OccInfo -> OccInfo
 506 zapFragileOcc (OneOcc {}) = NoOccInfo
 507 zapFragileOcc occ         = occ
 508 \end{code}
 509
 510 \begin{code}
 511 instance Outputable OccInfo where
 512   -- only used for debugging; never parsed.  KSW 1999-07
 513   ppr NoOccInfo            = empty
 514   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
 515   ppr IAmDead              = ptext (sLit "Dead")
 516   ppr (OneOcc inside_lam one_branch int_cxt)
 517         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
 518         where
 519           pp_lam | inside_lam = char 'L'
 520                  | otherwise  = empty
 521           pp_br  | one_branch = empty
 522                  | otherwise  = char '*'
 523           pp_args | int_cxt   = char '!'
 524                   | otherwise = empty
 525
 526 instance Show OccInfo where
 527   showsPrec p occ = showsPrecSDoc p (ppr occ)
 528 \end{code}
 529
 530 %************************************************************************
 531 %*                                                                      *
 532                 Strictness indication
 533 %*                                                                      *
 534 %************************************************************************
 535
 536 The strictness annotations on types in data type declarations
 537 e.g.    data T = MkT !Int !(Bool,Bool)
 538
 539 \begin{code}
 540 -------------------------
 541 -- HsBang describes what the *programmer* wrote
 542 -- This info is retained in the DataCon.dcStrictMarks field
 543 data HsBang = HsNoBang
 544
 545             | HsStrict
 546
 547             | HsUnpack         -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
 548
 549             | HsUnpackFailed   -- An UNPACK pragma that we could not make
 550                                -- use of, because the type isn't unboxable;
 551                                -- equivalant to HsStrict except for checkValidDataCon
 552   deriving (Eq, Data, Typeable)
 553
 554 instance Outputable HsBang where
 555     ppr HsNoBang       = empty
 556     ppr HsStrict       = char '!'
 557     ppr HsUnpack       = ptext (sLit "{-# UNPACK #-} !")
 558     ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
 559
 560 isBanged :: HsBang -> Bool
 561 isBanged HsNoBang = False
 562 isBanged _        = True
 563
 564 isMarkedUnboxed :: HsBang -> Bool
 565 isMarkedUnboxed HsUnpack = True
 566 isMarkedUnboxed _        = False
 567
 568 -------------------------
 569 -- StrictnessMark is internal only, used to indicate strictness
 570 -- of the DataCon *worker* fields
 571 data StrictnessMark = MarkedStrict | NotMarkedStrict
 572
 573 instance Outputable StrictnessMark where
 574   ppr MarkedStrict     = ptext (sLit "!")
 575   ppr NotMarkedStrict  = empty
 576
 577 isMarkedStrict :: StrictnessMark -> Bool
 578 isMarkedStrict NotMarkedStrict = False
 579 isMarkedStrict _               = True   -- All others are strict
 580 \end{code}
 581
 582
 583 %************************************************************************
 584 %*                                                                      *
 585                 Default method specfication
 586 %*                                                                      *
 587 %************************************************************************
 588
 589 The DefMethSpec enumeration just indicates what sort of default method
 590 is used for a class. It is generated from source code, and present in
 591 interface files; it is converted to Class.DefMeth before begin put in a
 592 Class object.
 593
 594 \begin{code}
 595 data DefMethSpec = NoDM        -- No default method
 596                  | VanillaDM   -- Default method given with polymorphic code
 597                  | GenericDM   -- Default method given with generic code
 598
 599 instance Outputable DefMethSpec where
 600   ppr NoDM      = empty
 601   ppr VanillaDM = ptext (sLit "{- Has default method -}")
 602   ppr GenericDM = ptext (sLit "{- Has generic default method -}")
 603 \end{code}
 604
 605 %************************************************************************
 606 %*                                                                      *
 607 \subsection{Success flag}
 608 %*                                                                      *
 609 %************************************************************************
 610
 611 \begin{code}
 612 data SuccessFlag = Succeeded | Failed
 613
 614 instance Outputable SuccessFlag where
 615     ppr Succeeded = ptext (sLit "Succeeded")
 616     ppr Failed    = ptext (sLit "Failed")
 617
 618 successIf :: Bool -> SuccessFlag
 619 successIf True  = Succeeded
 620 successIf False = Failed
 621
 622 succeeded, failed :: SuccessFlag -> Bool
 623 succeeded Succeeded = True
 624 succeeded Failed    = False
 625
 626 failed Succeeded = False
 627 failed Failed    = True
 628 \end{code}
 629
 630
 631 %************************************************************************
 632 %*                                                                      *
 633 \subsection{Activation}
 634 %*                                                                      *
 635 %************************************************************************
 636
 637 When a rule or inlining is active
 638
 639 \begin{code}
 640 type CompilerPhase = Int        -- Compilation phase
 641                                 -- Phases decrease towards zero
 642                                 -- Zero is the last phase
 643
 644 data Activation = NeverActive
 645                 | AlwaysActive
 646                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 647                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 648                 deriving( Eq, Data, Typeable )  -- Eq used in comparing rules in HsDecls
 649
 650 data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
 651                    | FunLike
 652                    deriving( Eq, Data, Typeable, Show )
 653         -- Show needed for Lexer.x
 654
 655 data InlinePragma            -- Note [InlinePragma]
 656   = InlinePragma
 657       { inl_inline :: InlineSpec
 658
 659       , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
 660                                      --            explicit (non-type, non-dictionary) args
 661                                      --   That is, inl_sat describes the number of *source-code*
 662                                      --   arguments the thing must be applied to.  We add on the
 663                                      --   number of implicit, dictionary arguments when making
 664                                      --   the InlineRule, and don't look at inl_sat further
 665
 666       , inl_act    :: Activation     -- Says during which phases inlining is allowed
 667
 668       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
 669     } deriving( Eq, Data, Typeable )
 670
 671 data InlineSpec   -- What the user's INLINE pragama looked like
 672   = Inline
 673   | Inlinable
 674   | NoInline
 675   | EmptyInlineSpec
 676   deriving( Eq, Data, Typeable, Show )
 677         -- Show needed for Lexer.x
 678 \end{code}
 679
 680 Note [InlinePragma]
 681 ~~~~~~~~~~~~~~~~~~~
 682 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
 683 the source program.
 684
 685 If you write nothing at all, you get defaultInlinePragma:
 686    inl_inline = False
 687    inl_act    = AlwaysActive
 688    inl_rule   = FunLike
 689
 690 It's not possible to get that combination by *writing* something, so
 691 if an Id has defaultInlinePragma it means the user didn't specify anything.
 692
 693 If inl_inline = True, then the Id should have an InlineRule unfolding.
 694
 695 Note [CONLIKE pragma]
 696 ~~~~~~~~~~~~~~~~~~~~~
 697 The ConLike constructor of a RuleMatchInfo is aimed at the following.
 698 Consider first
 699     {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
 700     g b bs = let x = b:bs in ..x...x...(r x)...
 701 Now, the rule applies to the (r x) term, because GHC "looks through"
 702 the definition of 'x' to see that it is (b:bs).
 703
 704 Now consider
 705     {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
 706     g v = let x = f v in ..x...x...(r x)...
 707 Normally the (r x) would *not* match the rule, because GHC would be
 708 scared about duplicating the redex (f v), so it does not "look
 709 through" the bindings.
 710
 711 However the CONLIKE modifier says to treat 'f' like a constructor in
 712 this situation, and "look through" the unfolding for x.  So (r x)
 713 fires, yielding (f (v+1)).
 714
 715 This is all controlled with a user-visible pragma:
 716      {-# NOINLINE CONLIKE [1] f #-}
 717
 718 The main effects of CONLIKE are:
 719
 720     - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
 721       CONLIKE thing like constructors, by ANF-ing them
 722
 723     - New function coreUtils.exprIsExpandable is like exprIsCheap, but
 724       additionally spots applications of CONLIKE functions
 725
 726     - A CoreUnfolding has a field that caches exprIsExpandable
 727
 728     - The rule matcher consults this field.  See
 729       Note [Expanding variables] in Rules.lhs.
 730
 731 \begin{code}
 732 isConLike :: RuleMatchInfo -> Bool
 733 isConLike ConLike = True
 734 isConLike _            = False
 735
 736 isFunLike :: RuleMatchInfo -> Bool
 737 isFunLike FunLike = True
 738 isFunLike _            = False
 739
 740 isEmptyInlineSpec :: InlineSpec -> Bool
 741 isEmptyInlineSpec EmptyInlineSpec = True
 742 isEmptyInlineSpec _               = False
 743
 744 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
 745   :: InlinePragma
 746 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
 747                                    , inl_rule = FunLike
 748                                    , inl_inline = EmptyInlineSpec
 749                                    , inl_sat = Nothing }
 750
 751 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
 752 neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
 753
 754 inlinePragmaSpec :: InlinePragma -> InlineSpec
 755 inlinePragmaSpec = inl_inline
 756
 757 -- A DFun has an always-active inline activation so that
 758 -- exprIsConApp_maybe can "see" its unfolding
 759 -- (However, its actual Unfolding is a DFunUnfolding, which is
 760 --  never inlined other than via exprIsConApp_maybe.)
 761 dfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive
 762                                          , inl_rule = ConLike }
 763
 764 isDefaultInlinePragma :: InlinePragma -> Bool
 765 isDefaultInlinePragma (InlinePragma { inl_act = activation
 766                                     , inl_rule = match_info
 767                                     , inl_inline = inline })
 768   = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
 769
 770 isInlinePragma :: InlinePragma -> Bool
 771 isInlinePragma prag = case inl_inline prag of
 772                         Inline -> True
 773                         _      -> False
 774
 775 isInlinablePragma :: InlinePragma -> Bool
 776 isInlinablePragma prag = case inl_inline prag of
 777                            Inlinable -> True
 778                            _         -> False
 779
 780 isAnyInlinePragma :: InlinePragma -> Bool
 781 -- INLINE or INLINABLE
 782 isAnyInlinePragma prag = case inl_inline prag of
 783                         Inline    -> True
 784                         Inlinable -> True
 785                         _         -> False
 786
 787 inlinePragmaSat :: InlinePragma -> Maybe Arity
 788 inlinePragmaSat = inl_sat
 789
 790 inlinePragmaActivation :: InlinePragma -> Activation
 791 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
 792
 793 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
 794 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
 795
 796 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
 797 setInlinePragmaActivation prag activation = prag { inl_act = activation }
 798
 799 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
 800 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
 801
 802 instance Outputable Activation where
 803    ppr AlwaysActive     = brackets (ptext (sLit "ALWAYS"))
 804    ppr NeverActive      = brackets (ptext (sLit "NEVER"))
 805    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 806    ppr (ActiveAfter n)  = brackets (int n)
 807
 808 instance Outputable RuleMatchInfo where
 809    ppr ConLike = ptext (sLit "CONLIKE")
 810    ppr FunLike = ptext (sLit "FUNLIKE")
 811
 812 instance Outputable InlineSpec where
 813    ppr Inline          = ptext (sLit "INLINE")
 814    ppr NoInline        = ptext (sLit "NOINLINE")
 815    ppr Inlinable       = ptext (sLit "INLINABLE")
 816    ppr EmptyInlineSpec = empty
 817
 818 instance Outputable InlinePragma where
 819   ppr (InlinePragma { inl_inline = inline, inl_act = activation
 820                     , inl_rule = info, inl_sat = mb_arity })
 821     = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
 822     where
 823       pp_act Inline   AlwaysActive = empty
 824       pp_act NoInline NeverActive  = empty
 825       pp_act _        act          = ppr act
 826
 827       pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
 828              | otherwise           = empty
 829       pp_info | isFunLike info = empty
 830               | otherwise      = ppr info
 831
 832 isActive :: CompilerPhase -> Activation -> Bool
 833 isActive _ NeverActive      = False
 834 isActive _ AlwaysActive     = True
 835 isActive p (ActiveAfter n)  = p <= n
 836 isActive p (ActiveBefore n) = p >  n
 837
 838 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
 839 isNeverActive NeverActive = True
 840 isNeverActive _           = False
 841
 842 isAlwaysActive AlwaysActive = True
 843 isAlwaysActive _            = False
 844
 845 isEarlyActive AlwaysActive      = True
 846 isEarlyActive (ActiveBefore {}) = True
 847 isEarlyActive _                 = False
 848 \end{code}
 849