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