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                 --                     (Foo [a])        OverlapOk
 328                 -- Since the second instance has the OverlapOk flag,
 329                 -- the first instance will be chosen (otherwise
 330                 -- its ambiguous which to choose)
 331
 332   | Incoherent  -- Like OverlapOk, but also ignore this instance
 333                 -- if it doesn't match the constraint you are
 334                 -- trying to resolve, but could match if the type variables
 335                 -- in the constraint were instantiated
 336                 --
 337                 -- Example: constraint (Foo [b])
 338                 --          instances  (Foo [Int])      Incoherent
 339                 --                     (Foo [a])
 340                 -- Without the Incoherent flag, we'd complain that
 341                 -- instantiating 'b' would change which instance
 342                 -- was chosen
 343   deriving( Eq )
 344
 345 instance Outputable OverlapFlag where
 346    ppr NoOverlap  = empty
 347    ppr OverlapOk  = ptext (sLit "[overlap ok]")
 348    ppr Incoherent = ptext (sLit "[incoherent]")
 349
 350 \end{code}
 351
 352 %************************************************************************
 353 %*                                                                      *
 354                 Tuples
 355 %*                                                                      *
 356 %************************************************************************
 357
 358 \begin{code}
 359 data TupCon = TupCon Boxity Arity
 360
 361 instance Eq TupCon where
 362   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 363
 364 tupleParens :: Boxity -> SDoc -> SDoc
 365 tupleParens Boxed   p = parens p
 366 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
 367 \end{code}
 368
 369 %************************************************************************
 370 %*                                                                      *
 371 \subsection[Generic]{Generic flag}
 372 %*                                                                      *
 373 %************************************************************************
 374
 375 This is the "Embedding-Projection pair" datatype, it contains
 376 two pieces of code (normally either RenamedExpr's or Id's)
 377 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 378 represents functions of type
 379
 380         from :: T -> Tring
 381         to   :: Tring -> T
 382
 383 And we should have
 384
 385         to (from x) = x
 386
 387 T and Tring are arbitrary, but typically T is the 'main' type while
 388 Tring is the 'representation' type.  (This just helps us remember
 389 whether to use 'from' or 'to'.
 390
 391 \begin{code}
 392 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 393                  toEP   :: a }  -- :: Tring -> T
 394 \end{code}
 395
 396 Embedding-projection pairs are used in several places:
 397
 398 First of all, each type constructor has an EP associated with it, the
 399 code in EP converts (datatype T) from T to Tring and back again.
 400
 401 Secondly, when we are filling in Generic methods (in the typechecker,
 402 tcMethodBinds), we are constructing bimaps by induction on the structure
 403 of the type of the method signature.
 404
 405
 406 %************************************************************************
 407 %*                                                                      *
 408 \subsection{Occurrence information}
 409 %*                                                                      *
 410 %************************************************************************
 411
 412 This data type is used exclusively by the simplifier, but it appears in a
 413 SubstResult, which is currently defined in VarEnv, which is pretty near
 414 the base of the module hierarchy.  So it seemed simpler to put the
 415 defn of OccInfo here, safely at the bottom
 416
 417 \begin{code}
 418 -- | Identifier occurrence information
 419 data OccInfo
 420   = NoOccInfo           -- ^ There are many occurrences, or unknown occurences
 421
 422   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
 423                         -- lambda and case-bound variables.
 424
 425   | OneOcc
 426         !InsideLam
 427         !OneBranch
 428         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
 429
 430   -- | This identifier breaks a loop of mutually recursive functions. The field
 431   -- marks whether it is only a loop breaker due to a reference in a rule
 432   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
 433         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
 434                         --          See OccurAnal Note [Weak loop breakers]
 435
 436 type RulesOnly = Bool
 437 \end{code}
 438
 439 Note [LoopBreaker OccInfo]
 440 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 441 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
 442 analyser in two ways:
 443   (a) to mark loop-breakers in a group of recursive
 444       definitions (hence the name)
 445   (b) to mark binders that must not be inlined in this phase
 446       (perhaps it has a NOINLINE pragma)
 447 Things with (IAmLoopBreaker False) do not get an unfolding
 448 pinned on to them, so they are completely opaque.
 449
 450 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
 451
 452
 453 \begin{code}
 454 isNoOcc :: OccInfo -> Bool
 455 isNoOcc NoOccInfo = True
 456 isNoOcc _         = False
 457
 458 seqOccInfo :: OccInfo -> ()
 459 seqOccInfo occ = occ `seq` ()
 460
 461 -----------------
 462 type InterestingCxt = Bool      -- True <=> Function: is applied
 463                                 --          Data value: scrutinised by a case with
 464                                 --                      at least one non-DEFAULT branch
 465
 466 -----------------
 467 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 468                         -- Substituting a redex for this occurrence is
 469                         -- dangerous because it might duplicate work.
 470 insideLam, notInsideLam :: InsideLam
 471 insideLam    = True
 472 notInsideLam = False
 473
 474 -----------------
 475 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 476                         --      so no code-duplication issue to worry about
 477 oneBranch, notOneBranch :: OneBranch
 478 oneBranch    = True
 479 notOneBranch = False
 480
 481 isLoopBreaker :: OccInfo -> Bool
 482 isLoopBreaker (IAmALoopBreaker _) = True
 483 isLoopBreaker _                   = False
 484
 485 isNonRuleLoopBreaker :: OccInfo -> Bool
 486 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
 487 isNonRuleLoopBreaker _                       = False
 488
 489 nonRuleLoopBreaker :: OccInfo
 490 nonRuleLoopBreaker = IAmALoopBreaker False
 491
 492 isDeadOcc :: OccInfo -> Bool
 493 isDeadOcc IAmDead = True
 494 isDeadOcc _       = False
 495
 496 isOneOcc :: OccInfo -> Bool
 497 isOneOcc (OneOcc {}) = True
 498 isOneOcc _           = False
 499
 500 zapFragileOcc :: OccInfo -> OccInfo
 501 zapFragileOcc (OneOcc {}) = NoOccInfo
 502 zapFragileOcc occ         = occ
 503 \end{code}
 504
 505 \begin{code}
 506 instance Outputable OccInfo where
 507   -- only used for debugging; never parsed.  KSW 1999-07
 508   ppr NoOccInfo            = empty
 509   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
 510   ppr IAmDead              = ptext (sLit "Dead")
 511   ppr (OneOcc inside_lam one_branch int_cxt)
 512         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
 513         where
 514           pp_lam | inside_lam = char 'L'
 515                  | otherwise  = empty
 516           pp_br  | one_branch = empty
 517                  | otherwise  = char '*'
 518           pp_args | int_cxt   = char '!'
 519                   | otherwise = empty
 520
 521 instance Show OccInfo where
 522   showsPrec p occ = showsPrecSDoc p (ppr occ)
 523 \end{code}
 524
 525 %************************************************************************
 526 %*                                                                      *
 527                 Strictness indication
 528 %*                                                                      *
 529 %************************************************************************
 530
 531 The strictness annotations on types in data type declarations
 532 e.g.    data T = MkT !Int !(Bool,Bool)
 533
 534 \begin{code}
 535 -------------------------
 536 -- HsBang describes what the *programmer* wrote
 537 -- This info is retained in the DataCon.dcStrictMarks field
 538 data HsBang = HsNoBang
 539
 540             | HsStrict
 541
 542             | HsUnpack         -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
 543
 544             | HsUnpackFailed   -- An UNPACK pragma that we could not make
 545                                -- use of, because the type isn't unboxable;
 546                                -- equivalant to HsStrict except for checkValidDataCon
 547   deriving (Eq, Data, Typeable)
 548
 549 instance Outputable HsBang where
 550     ppr HsNoBang       = empty
 551     ppr HsStrict       = char '!'
 552     ppr HsUnpack       = ptext (sLit "{-# UNPACK #-} !")
 553     ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
 554
 555 isBanged :: HsBang -> Bool
 556 isBanged HsNoBang = False
 557 isBanged _        = True
 558
 559 isMarkedUnboxed :: HsBang -> Bool
 560 isMarkedUnboxed HsUnpack = True
 561 isMarkedUnboxed _        = False
 562
 563 -------------------------
 564 -- StrictnessMark is internal only, used to indicate strictness
 565 -- of the DataCon *worker* fields
 566 data StrictnessMark = MarkedStrict | NotMarkedStrict
 567
 568 instance Outputable StrictnessMark where
 569   ppr MarkedStrict     = ptext (sLit "!")
 570   ppr NotMarkedStrict  = empty
 571
 572 isMarkedStrict :: StrictnessMark -> Bool
 573 isMarkedStrict NotMarkedStrict = False
 574 isMarkedStrict _               = True   -- All others are strict
 575 \end{code}
 576
 577
 578 %************************************************************************
 579 %*                                                                      *
 580                 Default method specfication
 581 %*                                                                      *
 582 %************************************************************************
 583
 584 The DefMethSpec enumeration just indicates what sort of default method
 585 is used for a class. It is generated from source code, and present in
 586 interface files; it is converted to Class.DefMeth before begin put in a
 587 Class object.
 588
 589 \begin{code}
 590 data DefMethSpec = NoDM        -- No default method
 591                  | VanillaDM   -- Default method given with polymorphic code
 592                  | GenericDM   -- Default method given with generic code
 593
 594 instance Outputable DefMethSpec where
 595   ppr NoDM      = empty
 596   ppr VanillaDM = ptext (sLit "{- Has default method -}")
 597   ppr GenericDM = ptext (sLit "{- Has generic default method -}")
 598 \end{code}
 599
 600 %************************************************************************
 601 %*                                                                      *
 602 \subsection{Success flag}
 603 %*                                                                      *
 604 %************************************************************************
 605
 606 \begin{code}
 607 data SuccessFlag = Succeeded | Failed
 608
 609 instance Outputable SuccessFlag where
 610     ppr Succeeded = ptext (sLit "Succeeded")
 611     ppr Failed    = ptext (sLit "Failed")
 612
 613 successIf :: Bool -> SuccessFlag
 614 successIf True  = Succeeded
 615 successIf False = Failed
 616
 617 succeeded, failed :: SuccessFlag -> Bool
 618 succeeded Succeeded = True
 619 succeeded Failed    = False
 620
 621 failed Succeeded = False
 622 failed Failed    = True
 623 \end{code}
 624
 625
 626 %************************************************************************
 627 %*                                                                      *
 628 \subsection{Activation}
 629 %*                                                                      *
 630 %************************************************************************
 631
 632 When a rule or inlining is active
 633
 634 \begin{code}
 635 type CompilerPhase = Int        -- Compilation phase
 636                                 -- Phases decrease towards zero
 637                                 -- Zero is the last phase
 638
 639 data Activation = NeverActive
 640                 | AlwaysActive
 641                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 642                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 643                 deriving( Eq, Data, Typeable )                  -- Eq used in comparing rules in HsDecls
 644
 645 data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
 646                    | FunLike
 647                    deriving( Eq, Data, Typeable )
 648
 649 data InlinePragma            -- Note [InlinePragma]
 650   = InlinePragma
 651       { inl_inline :: Bool           -- True <=> INLINE,
 652                                      -- False <=> no pragma at all, or NOINLINE
 653
 654       , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
 655                                      --            explicit (non-type, non-dictionary) args
 656                                      --   That is, inl_sat describes the number of *source-code*
 657                                      --   arguments the thing must be applied to.  We add on the
 658                                      --   number of implicit, dictionary arguments when making
 659                                      --   the InlineRule, and don't look at inl_sat further
 660
 661       , inl_act    :: Activation     -- Says during which phases inlining is allowed
 662
 663       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
 664     } deriving( Eq, Data, Typeable )
 665 \end{code}
 666
 667 Note [InlinePragma]
 668 ~~~~~~~~~~~~~~~~~~~
 669 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
 670 the source program.
 671
 672 If you write nothing at all, you get defaultInlinePragma:
 673    inl_inline = False
 674    inl_act    = AlwaysActive
 675    inl_rule   = FunLike
 676
 677 It's not possible to get that combination by *writing* something, so
 678 if an Id has defaultInlinePragma it means the user didn't specify anything.
 679
 680 If inl_inline = True, then the Id should have an InlineRule unfolding.
 681
 682 Note [CONLIKE pragma]
 683 ~~~~~~~~~~~~~~~~~~~~~
 684 The ConLike constructor of a RuleMatchInfo is aimed at the following.
 685 Consider first
 686     {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
 687     g b bs = let x = b:bs in ..x...x...(r x)...
 688 Now, the rule applies to the (r x) term, because GHC "looks through"
 689 the definition of 'x' to see that it is (b:bs).
 690
 691 Now consider
 692     {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
 693     g v = let x = f v in ..x...x...(r x)...
 694 Normally the (r x) would *not* match the rule, because GHC would be
 695 scared about duplicating the redex (f v), so it does not "look
 696 through" the bindings.
 697
 698 However the CONLIKE modifier says to treat 'f' like a constructor in
 699 this situation, and "look through" the unfolding for x.  So (r x)
 700 fires, yielding (f (v+1)).
 701
 702 This is all controlled with a user-visible pragma:
 703      {-# NOINLINE CONLIKE [1] f #-}
 704
 705 The main effects of CONLIKE are:
 706
 707     - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
 708       CONLIKE thing like constructors, by ANF-ing them
 709
 710     - New function coreUtils.exprIsExpandable is like exprIsCheap, but
 711       additionally spots applications of CONLIKE functions
 712
 713     - A CoreUnfolding has a field that caches exprIsExpandable
 714
 715     - The rule matcher consults this field.  See
 716       Note [Expanding variables] in Rules.lhs.
 717
 718 \begin{code}
 719 isConLike :: RuleMatchInfo -> Bool
 720 isConLike ConLike = True
 721 isConLike _            = False
 722
 723 isFunLike :: RuleMatchInfo -> Bool
 724 isFunLike FunLike = True
 725 isFunLike _            = False
 726
 727 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
 728   :: InlinePragma
 729 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
 730                                    , inl_rule = FunLike
 731                                    , inl_inline = False
 732                                    , inl_sat = Nothing }
 733
 734 alwaysInlinePragma = defaultInlinePragma { inl_inline = True }
 735 neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
 736
 737 -- A DFun has an always-active inline activation so that
 738 -- exprIsConApp_maybe can "see" its unfolding
 739 -- (However, its actual Unfolding is a DFunUnfolding, which is
 740 --  never inlined other than via exprIsConApp_maybe.)
 741 dfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive
 742                                          , inl_rule = ConLike }
 743
 744 isDefaultInlinePragma :: InlinePragma -> Bool
 745 isDefaultInlinePragma (InlinePragma { inl_act = activation
 746                                     , inl_rule = match_info
 747                                     , inl_inline = inline })
 748   = not inline && isAlwaysActive activation && isFunLike match_info
 749
 750 isInlinePragma :: InlinePragma -> Bool
 751 isInlinePragma prag = inl_inline prag
 752
 753 inlinePragmaSat :: InlinePragma -> Maybe Arity
 754 inlinePragmaSat = inl_sat
 755
 756 inlinePragmaActivation :: InlinePragma -> Activation
 757 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
 758
 759 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
 760 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
 761
 762 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
 763 setInlinePragmaActivation prag activation = prag { inl_act = activation }
 764
 765 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
 766 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
 767
 768 instance Outputable Activation where
 769    ppr AlwaysActive     = brackets (ptext (sLit "ALWAYS"))
 770    ppr NeverActive      = brackets (ptext (sLit "NEVER"))
 771    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 772    ppr (ActiveAfter n)  = brackets (int n)
 773
 774 instance Outputable RuleMatchInfo where
 775    ppr ConLike = ptext (sLit "CONLIKE")
 776    ppr FunLike = ptext (sLit "FUNLIKE")
 777
 778 instance Outputable InlinePragma where
 779   ppr (InlinePragma { inl_inline = inline, inl_act = activation
 780                     , inl_rule = info, inl_sat = mb_arity })
 781     = pp_inl_act (inline, activation) <+> pp_sat <+> pp_info
 782     where
 783       pp_inl_act (False, AlwaysActive)  = empty -- defaultInlinePragma
 784       pp_inl_act (False, NeverActive)   = ptext (sLit "NOINLINE")
 785       pp_inl_act (False, act)           = ptext (sLit "NOINLINE") <> ppr act
 786       pp_inl_act (True,  AlwaysActive)  = ptext (sLit "INLINE")
 787       pp_inl_act (True,  act)           = ptext (sLit "INLINE") <> ppr act
 788
 789       pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
 790              | otherwise           = empty
 791       pp_info | isFunLike info = empty
 792               | otherwise      = ppr info
 793
 794 isActive :: CompilerPhase -> Activation -> Bool
 795 isActive _ NeverActive      = False
 796 isActive _ AlwaysActive     = True
 797 isActive p (ActiveAfter n)  = p <= n
 798 isActive p (ActiveBefore n) = p >  n
 799
 800 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
 801 isNeverActive NeverActive = True
 802 isNeverActive _           = False
 803
 804 isAlwaysActive AlwaysActive = True
 805 isAlwaysActive _            = False
 806
 807 isEarlyActive AlwaysActive      = True
 808 isEarlyActive (ActiveBefore {}) = True
 809 isEarlyActive _                 = False
 810 \end{code}
 811