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