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