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