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 module BasicTypes(
  18         Version, bumpVersion, initialVersion,
  19
  20         Arity,
  21
  22         WarningTxt(..),
  23
  24         Fixity(..), FixityDirection(..),
  25         defaultFixity, maxPrecedence,
  26         negateFixity, funTyFixity,
  27         compareFixity,
  28
  29         IPName(..), ipNameName, mapIPName,
  30
  31         RecFlag(..), isRec, isNonRec, boolToRecFlag,
  32
  33         TopLevelFlag(..), isTopLevel, isNotTopLevel,
  34
  35         OverlapFlag(..),
  36
  37         Boxity(..), isBoxed,
  38
  39         TupCon(..), tupleParens,
  40
  41         OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
  42         isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
  43
  44         InsideLam, insideLam, notInsideLam,
  45         OneBranch, oneBranch, notOneBranch,
  46         InterestingCxt,
  47
  48         EP(..),
  49
  50         StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
  51
  52         CompilerPhase,
  53         Activation(..), isActive, isNeverActive, isAlwaysActive,
  54         InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
  55
  56         SuccessFlag(..), succeeded, failed, successIf
  57    ) where
  58
  59 import FastString
  60 import Outputable
  61 \end{code}
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsection[Arity]{Arity}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 \begin{code}
  70 type Arity = Int
  71 \end{code}
  72
  73
  74 %************************************************************************
  75 %*                                                                      *
  76 \subsection[Version]{Module and identifier version numbers}
  77 %*                                                                      *
  78 %************************************************************************
  79
  80 \begin{code}
  81 type Version = Int
  82
  83 bumpVersion :: Version -> Version
  84 bumpVersion v = v+1
  85
  86 initialVersion :: Version
  87 initialVersion = 1
  88 \end{code}
  89
  90 %************************************************************************
  91 %*                                                                      *
  92                 Deprecations
  93 %*                                                                      *
  94 %************************************************************************
  95
  96
  97 \begin{code}
  98 -- reason/explanation from a WARNING or DEPRECATED pragma
  99 data WarningTxt = WarningTxt FastString
 100                 | DeprecatedTxt FastString
 101     deriving Eq
 102
 103 instance Outputable WarningTxt where
 104     ppr (WarningTxt    w) =                        doubleQuotes (ftext w)
 105     ppr (DeprecatedTxt d) = text "Deprecated:" <+> doubleQuotes (ftext d)
 106 \end{code}
 107
 108 %************************************************************************
 109 %*                                                                      *
 110 \subsection{Implicit parameter identity}
 111 %*                                                                      *
 112 %************************************************************************
 113
 114 The @IPName@ type is here because it is used in TypeRep (i.e. very
 115 early in the hierarchy), but also in HsSyn.
 116
 117 \begin{code}
 118 newtype IPName name = IPName name       -- ?x
 119   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 120                         --      (used in HscTypes.OrigIParamCache)
 121
 122 ipNameName :: IPName name -> name
 123 ipNameName (IPName n) = n
 124
 125 mapIPName :: (a->b) -> IPName a -> IPName b
 126 mapIPName f (IPName n) = IPName (f n)
 127
 128 instance Outputable name => Outputable (IPName name) where
 129     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
 130 \end{code}
 131
 132
 133 %************************************************************************
 134 %*                                                                      *
 135 \subsection[Fixity]{Fixity info}
 136 %*                                                                      *
 137 %************************************************************************
 138
 139 \begin{code}
 140 ------------------------
 141 data Fixity = Fixity Int FixityDirection
 142
 143 instance Outputable Fixity where
 144     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 145
 146 instance Eq Fixity where                -- Used to determine if two fixities conflict
 147   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 148
 149 ------------------------
 150 data FixityDirection = InfixL | InfixR | InfixN
 151                      deriving(Eq)
 152
 153 instance Outputable FixityDirection where
 154     ppr InfixL = ptext (sLit "infixl")
 155     ppr InfixR = ptext (sLit "infixr")
 156     ppr InfixN = ptext (sLit "infix")
 157
 158 ------------------------
 159 maxPrecedence :: Int
 160 maxPrecedence = 9
 161 defaultFixity :: Fixity
 162 defaultFixity = Fixity maxPrecedence InfixL
 163
 164 negateFixity, funTyFixity :: Fixity
 165 -- Wired-in fixities
 166 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
 167 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
 168 \end{code}
 169
 170 Consider
 171
 172 \begin{verbatim}
 173         a `op1` b `op2` c
 174 \end{verbatim}
 175 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 176 whether there's an error.
 177
 178 \begin{code}
 179 compareFixity :: Fixity -> Fixity
 180               -> (Bool,         -- Error please
 181                   Bool)         -- Associate to the right: a op1 (b op2 c)
 182 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 183   = case prec1 `compare` prec2 of
 184         GT -> left
 185         LT -> right
 186         EQ -> case (dir1, dir2) of
 187                         (InfixR, InfixR) -> right
 188                         (InfixL, InfixL) -> left
 189                         _                -> error_please
 190   where
 191     right        = (False, True)
 192     left         = (False, False)
 193     error_please = (True,  False)
 194 \end{code}
 195
 196
 197 %************************************************************************
 198 %*                                                                      *
 199 \subsection[Top-level/local]{Top-level/not-top level flag}
 200 %*                                                                      *
 201 %************************************************************************
 202
 203 \begin{code}
 204 data TopLevelFlag
 205   = TopLevel
 206   | NotTopLevel
 207
 208 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 209
 210 isNotTopLevel NotTopLevel = True
 211 isNotTopLevel TopLevel    = False
 212
 213 isTopLevel TopLevel     = True
 214 isTopLevel NotTopLevel  = False
 215
 216 instance Outputable TopLevelFlag where
 217   ppr TopLevel    = ptext (sLit "<TopLevel>")
 218   ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
 219 \end{code}
 220
 221
 222 %************************************************************************
 223 %*                                                                      *
 224                 Top-level/not-top level flag
 225 %*                                                                      *
 226 %************************************************************************
 227
 228 \begin{code}
 229 data Boxity
 230   = Boxed
 231   | Unboxed
 232   deriving( Eq )
 233
 234 isBoxed :: Boxity -> Bool
 235 isBoxed Boxed   = True
 236 isBoxed Unboxed = False
 237 \end{code}
 238
 239
 240 %************************************************************************
 241 %*                                                                      *
 242                 Recursive/Non-Recursive flag
 243 %*                                                                      *
 244 %************************************************************************
 245
 246 \begin{code}
 247 data RecFlag = Recursive
 248              | NonRecursive
 249              deriving( Eq )
 250
 251 isRec :: RecFlag -> Bool
 252 isRec Recursive    = True
 253 isRec NonRecursive = False
 254
 255 isNonRec :: RecFlag -> Bool
 256 isNonRec Recursive    = False
 257 isNonRec NonRecursive = True
 258
 259 boolToRecFlag :: Bool -> RecFlag
 260 boolToRecFlag True  = Recursive
 261 boolToRecFlag False = NonRecursive
 262
 263 instance Outputable RecFlag where
 264   ppr Recursive    = ptext (sLit "Recursive")
 265   ppr NonRecursive = ptext (sLit "NonRecursive")
 266 \end{code}
 267
 268 %************************************************************************
 269 %*                                                                      *
 270                 Instance overlap flag
 271 %*                                                                      *
 272 %************************************************************************
 273
 274 \begin{code}
 275 data OverlapFlag
 276   = NoOverlap   -- This instance must not overlap another
 277
 278   | OverlapOk   -- Silently ignore this instance if you find a
 279                 -- more specific one that matches the constraint
 280                 -- you are trying to resolve
 281                 --
 282                 -- Example: constraint (Foo [Int])
 283                 --          instances  (Foo [Int])
 284                 --                     (Foo [a])        OverlapOk
 285                 -- Since the second instance has the OverlapOk flag,
 286                 -- the first instance will be chosen (otherwise
 287                 -- its ambiguous which to choose)
 288
 289   | Incoherent  -- Like OverlapOk, but also ignore this instance
 290                 -- if it doesn't match the constraint you are
 291                 -- trying to resolve, but could match if the type variables
 292                 -- in the constraint were instantiated
 293                 --
 294                 -- Example: constraint (Foo [b])
 295                 --          instances  (Foo [Int])      Incoherent
 296                 --                     (Foo [a])
 297                 -- Without the Incoherent flag, we'd complain that
 298                 -- instantiating 'b' would change which instance
 299                 -- was chosen
 300   deriving( Eq )
 301
 302 instance Outputable OverlapFlag where
 303    ppr NoOverlap  = empty
 304    ppr OverlapOk  = ptext (sLit "[overlap ok]")
 305    ppr Incoherent = ptext (sLit "[incoherent]")
 306
 307 \end{code}
 308
 309 %************************************************************************
 310 %*                                                                      *
 311                 Tuples
 312 %*                                                                      *
 313 %************************************************************************
 314
 315 \begin{code}
 316 data TupCon = TupCon Boxity Arity
 317
 318 instance Eq TupCon where
 319   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 320
 321 tupleParens :: Boxity -> SDoc -> SDoc
 322 tupleParens Boxed   p = parens p
 323 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
 324 \end{code}
 325
 326 %************************************************************************
 327 %*                                                                      *
 328 \subsection[Generic]{Generic flag}
 329 %*                                                                      *
 330 %************************************************************************
 331
 332 This is the "Embedding-Projection pair" datatype, it contains
 333 two pieces of code (normally either RenamedExpr's or Id's)
 334 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 335 represents functions of type
 336
 337         from :: T -> Tring
 338         to   :: Tring -> T
 339
 340 And we should have
 341
 342         to (from x) = x
 343
 344 T and Tring are arbitrary, but typically T is the 'main' type while
 345 Tring is the 'representation' type.  (This just helps us remember
 346 whether to use 'from' or 'to'.
 347
 348 \begin{code}
 349 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 350                  toEP   :: a }  -- :: Tring -> T
 351 \end{code}
 352
 353 Embedding-projection pairs are used in several places:
 354
 355 First of all, each type constructor has an EP associated with it, the
 356 code in EP converts (datatype T) from T to Tring and back again.
 357
 358 Secondly, when we are filling in Generic methods (in the typechecker,
 359 tcMethodBinds), we are constructing bimaps by induction on the structure
 360 of the type of the method signature.
 361
 362
 363 %************************************************************************
 364 %*                                                                      *
 365 \subsection{Occurrence information}
 366 %*                                                                      *
 367 %************************************************************************
 368
 369 This data type is used exclusively by the simplifier, but it appears in a
 370 SubstResult, which is currently defined in VarEnv, which is pretty near
 371 the base of the module hierarchy.  So it seemed simpler to put the
 372 defn of OccInfo here, safely at the bottom
 373
 374 \begin{code}
 375 data OccInfo
 376   = NoOccInfo           -- Many occurrences, or unknown
 377
 378   | IAmDead             -- Marks unused variables.  Sometimes useful for
 379                         -- lambda and case-bound variables.
 380
 381   | OneOcc              -- Occurs exactly once, not inside a rule
 382         !InsideLam
 383         !OneBranch
 384         !InterestingCxt
 385
 386   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
 387         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
 388                         --          See OccurAnal Note [Weak loop breakers]
 389
 390 type RulesOnly = Bool
 391 \end{code}
 392
 393 Note [LoopBreaker OccInfo]
 394 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 395 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
 396 analyser in two ways:
 397   (a) to mark loop-breakers in a group of recursive
 398       definitions (hence the name)
 399   (b) to mark binders that must not be inlined in this phase
 400       (perhaps it has a NOINLINE pragma)
 401 Things with (IAmLoopBreaker False) do not get an unfolding
 402 pinned on to them, so they are completely opaque.
 403
 404 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
 405
 406
 407 \begin{code}
 408 isNoOcc :: OccInfo -> Bool
 409 isNoOcc NoOccInfo = True
 410 isNoOcc _         = False
 411
 412 seqOccInfo :: OccInfo -> ()
 413 seqOccInfo occ = occ `seq` ()
 414
 415 -----------------
 416 type InterestingCxt = Bool      -- True <=> Function: is applied
 417                                 --          Data value: scrutinised by a case with
 418                                 --                      at least one non-DEFAULT branch
 419
 420 -----------------
 421 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 422                         -- Substituting a redex for this occurrence is
 423                         -- dangerous because it might duplicate work.
 424 insideLam, notInsideLam :: InsideLam
 425 insideLam    = True
 426 notInsideLam = False
 427
 428 -----------------
 429 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 430                         --      so no code-duplication issue to worry about
 431 oneBranch, notOneBranch :: OneBranch
 432 oneBranch    = True
 433 notOneBranch = False
 434
 435 isLoopBreaker :: OccInfo -> Bool
 436 isLoopBreaker (IAmALoopBreaker _) = True
 437 isLoopBreaker _                   = False
 438
 439 isNonRuleLoopBreaker :: OccInfo -> Bool
 440 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
 441 isNonRuleLoopBreaker _                       = False
 442
 443 isDeadOcc :: OccInfo -> Bool
 444 isDeadOcc IAmDead = True
 445 isDeadOcc _       = False
 446
 447 isOneOcc :: OccInfo -> Bool
 448 isOneOcc (OneOcc _ _ _) = True
 449 isOneOcc _              = False
 450
 451 isFragileOcc :: OccInfo -> Bool
 452 isFragileOcc (OneOcc _ _ _) = True
 453 isFragileOcc _              = False
 454 \end{code}
 455
 456 \begin{code}
 457 instance Outputable OccInfo where
 458   -- only used for debugging; never parsed.  KSW 1999-07
 459   ppr NoOccInfo            = empty
 460   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
 461   ppr IAmDead              = ptext (sLit "Dead")
 462   ppr (OneOcc inside_lam one_branch int_cxt)
 463         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
 464         where
 465           pp_lam | inside_lam = char 'L'
 466                  | otherwise  = empty
 467           pp_br  | one_branch = empty
 468                  | otherwise  = char '*'
 469           pp_args | int_cxt   = char '!'
 470                   | otherwise = empty
 471
 472 instance Show OccInfo where
 473   showsPrec p occ = showsPrecSDoc p (ppr occ)
 474 \end{code}
 475
 476 %************************************************************************
 477 %*                                                                      *
 478 \subsection{Strictness indication}
 479 %*                                                                      *
 480 %************************************************************************
 481
 482 The strictness annotations on types in data type declarations
 483 e.g.    data T = MkT !Int !(Bool,Bool)
 484
 485 \begin{code}
 486 data StrictnessMark     -- Used in interface decls only
 487    = MarkedStrict
 488    | MarkedUnboxed
 489    | NotMarkedStrict
 490    deriving( Eq )
 491
 492 isMarkedUnboxed :: StrictnessMark -> Bool
 493 isMarkedUnboxed MarkedUnboxed = True
 494 isMarkedUnboxed _             = False
 495
 496 isMarkedStrict :: StrictnessMark -> Bool
 497 isMarkedStrict NotMarkedStrict = False
 498 isMarkedStrict _               = True   -- All others are strict
 499
 500 instance Outputable StrictnessMark where
 501   ppr MarkedStrict     = ptext (sLit "!")
 502   ppr MarkedUnboxed    = ptext (sLit "!!")
 503   ppr NotMarkedStrict  = ptext (sLit "_")
 504 \end{code}
 505
 506
 507 %************************************************************************
 508 %*                                                                      *
 509 \subsection{Success flag}
 510 %*                                                                      *
 511 %************************************************************************
 512
 513 \begin{code}
 514 data SuccessFlag = Succeeded | Failed
 515
 516 instance Outputable SuccessFlag where
 517     ppr Succeeded = ptext (sLit "Succeeded")
 518     ppr Failed    = ptext (sLit "Failed")
 519
 520 successIf :: Bool -> SuccessFlag
 521 successIf True  = Succeeded
 522 successIf False = Failed
 523
 524 succeeded, failed :: SuccessFlag -> Bool
 525 succeeded Succeeded = True
 526 succeeded Failed    = False
 527
 528 failed Succeeded = False
 529 failed Failed    = True
 530 \end{code}
 531
 532
 533 %************************************************************************
 534 %*                                                                      *
 535 \subsection{Activation}
 536 %*                                                                      *
 537 %************************************************************************
 538
 539 When a rule or inlining is active
 540
 541 \begin{code}
 542 type CompilerPhase = Int        -- Compilation phase
 543                                 -- Phases decrease towards zero
 544                                 -- Zero is the last phase
 545
 546 data Activation = NeverActive
 547                 | AlwaysActive
 548                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 549                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 550                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 551
 552 data InlineSpec
 553   = Inline
 554         Activation      -- Says during which phases inlining is allowed
 555         Bool            -- True <=> make the RHS look small, so that when inlining
 556                         --          is enabled, it will definitely actually happen
 557   deriving( Eq )
 558
 559 defaultInlineSpec, alwaysInlineSpec, neverInlineSpec :: InlineSpec
 560
 561 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 562 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 563 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 564
 565 instance Outputable Activation where
 566    ppr NeverActive      = ptext (sLit "NEVER")
 567    ppr AlwaysActive     = ptext (sLit "ALWAYS")
 568    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 569    ppr (ActiveAfter n)  = brackets (int n)
 570
 571 instance Outputable InlineSpec where
 572    ppr (Inline act is_inline)
 573         | is_inline = ptext (sLit "INLINE")
 574                       <> case act of
 575                             AlwaysActive -> empty
 576                             _            -> ppr act
 577         | otherwise = ptext (sLit "NOINLINE")
 578                       <> case act of
 579                             NeverActive  -> empty
 580                             _            -> ppr act
 581
 582 isActive :: CompilerPhase -> Activation -> Bool
 583 isActive _ NeverActive      = False
 584 isActive _ AlwaysActive     = True
 585 isActive p (ActiveAfter n)  = p <= n
 586 isActive p (ActiveBefore n) = p >  n
 587
 588 isNeverActive, isAlwaysActive :: Activation -> Bool
 589 isNeverActive NeverActive = True
 590 isNeverActive _           = False
 591
 592 isAlwaysActive AlwaysActive = True
 593 isAlwaysActive _            = False
 594 \end{code}
 595