compiler/basicTypes/BasicTypes.lhs

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