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