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