compiler/basicTypes/BasicTypes.lhs

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