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 {-# OPTIONS -w #-}
  18 -- The above warning supression flag is a temporary kludge.
  19 -- While working on this module you are encouraged to remove it and fix
  20 -- any warnings in the module. See
  21 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  22 -- for details
  23
  24 module BasicTypes(
  25         Version, bumpVersion, initialVersion,
  26
  27         Arity,
  28
  29         DeprecTxt,
  30
  31         Fixity(..), FixityDirection(..),
  32         defaultFixity, maxPrecedence,
  33         negateFixity, funTyFixity,
  34         compareFixity,
  35
  36         IPName(..), ipNameName, mapIPName,
  37
  38         RecFlag(..), isRec, isNonRec, boolToRecFlag,
  39
  40         TopLevelFlag(..), isTopLevel, isNotTopLevel,
  41
  42         OverlapFlag(..),
  43
  44         Boxity(..), isBoxed,
  45
  46         TupCon(..), tupleParens,
  47
  48         OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
  49         isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
  50
  51         InsideLam, insideLam, notInsideLam,
  52         OneBranch, oneBranch, notOneBranch,
  53         InterestingCxt,
  54
  55         EP(..),
  56
  57         StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
  58
  59         CompilerPhase,
  60         Activation(..), isActive, isNeverActive, isAlwaysActive,
  61         InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
  62
  63         SuccessFlag(..), succeeded, failed, successIf
  64    ) where
  65
  66 #include "HsVersions.h"
  67
  68 import FastString( FastString )
  69 import Outputable
  70 \end{code}
  71
  72 %************************************************************************
  73 %*                                                                      *
  74 \subsection[Arity]{Arity}
  75 %*                                                                      *
  76 %************************************************************************
  77
  78 \begin{code}
  79 type Arity = Int
  80 \end{code}
  81
  82
  83 %************************************************************************
  84 %*                                                                      *
  85 \subsection[Version]{Module and identifier version numbers}
  86 %*                                                                      *
  87 %************************************************************************
  88
  89 \begin{code}
  90 type Version = Int
  91
  92 bumpVersion :: Version -> Version
  93 bumpVersion v = v+1
  94
  95 initialVersion :: Version
  96 initialVersion = 1
  97 \end{code}
  98
  99 %************************************************************************
 100 %*                                                                      *
 101                 Deprecations
 102 %*                                                                      *
 103 %************************************************************************
 104
 105
 106 \begin{code}
 107 type DeprecTxt = FastString     -- reason/explanation for deprecation
 108 \end{code}
 109
 110 %************************************************************************
 111 %*                                                                      *
 112 \subsection{Implicit parameter identity}
 113 %*                                                                      *
 114 %************************************************************************
 115
 116 The @IPName@ type is here because it is used in TypeRep (i.e. very
 117 early in the hierarchy), but also in HsSyn.
 118
 119 \begin{code}
 120 newtype IPName name = IPName name       -- ?x
 121   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 122                         --      (used in HscTypes.OrigIParamCache)
 123
 124 ipNameName :: IPName name -> name
 125 ipNameName (IPName n) = n
 126
 127 mapIPName :: (a->b) -> IPName a -> IPName b
 128 mapIPName f (IPName n) = IPName (f n)
 129
 130 instance Outputable name => Outputable (IPName name) where
 131     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
 132 \end{code}
 133
 134
 135 %************************************************************************
 136 %*                                                                      *
 137 \subsection[Fixity]{Fixity info}
 138 %*                                                                      *
 139 %************************************************************************
 140
 141 \begin{code}
 142 ------------------------
 143 data Fixity = Fixity Int FixityDirection
 144
 145 instance Outputable Fixity where
 146     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 147
 148 instance Eq Fixity where                -- Used to determine if two fixities conflict
 149   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 150
 151 ------------------------
 152 data FixityDirection = InfixL | InfixR | InfixN
 153                      deriving(Eq)
 154
 155 instance Outputable FixityDirection where
 156     ppr InfixL = ptext SLIT("infixl")
 157     ppr InfixR = ptext SLIT("infixr")
 158     ppr InfixN = ptext SLIT("infix")
 159
 160 ------------------------
 161 maxPrecedence = (9::Int)
 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     -- Used by the occurrence analyser to mark loop-breakers
 387                         -- in a group of recursive definitions
 388         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
 389                         --  See OccurAnal Note [Weak loop breakers]
 390
 391 type RulesOnly = Bool
 392 \end{code}
 393
 394
 395 \begin{code}
 396 isNoOcc :: OccInfo -> Bool
 397 isNoOcc NoOccInfo = True
 398 isNoOcc other     = False
 399
 400 seqOccInfo :: OccInfo -> ()
 401 seqOccInfo occ = occ `seq` ()
 402
 403 -----------------
 404 type InterestingCxt = Bool      -- True <=> Function: is applied
 405                                 --          Data value: scrutinised by a case with
 406                                 --                      at least one non-DEFAULT branch
 407
 408 -----------------
 409 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 410                         -- Substituting a redex for this occurrence is
 411                         -- dangerous because it might duplicate work.
 412 insideLam    = True
 413 notInsideLam = False
 414
 415 -----------------
 416 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 417                         --      so no code-duplication issue to worry about
 418 oneBranch    = True
 419 notOneBranch = False
 420
 421 isLoopBreaker :: OccInfo -> Bool
 422 isLoopBreaker (IAmALoopBreaker _) = True
 423 isLoopBreaker other               = False
 424
 425 isNonRuleLoopBreaker :: OccInfo -> Bool
 426 isNonRuleLoopBreaker (IAmALoopBreaker False) = True     -- Loop-breaker that breaks a non-rule cycle
 427 isNonRuleLoopBreaker other                   = False
 428
 429 isDeadOcc :: OccInfo -> Bool
 430 isDeadOcc IAmDead = True
 431 isDeadOcc other   = False
 432
 433 isOneOcc (OneOcc _ _ _) = True
 434 isOneOcc other          = False
 435
 436 isFragileOcc :: OccInfo -> Bool
 437 isFragileOcc (OneOcc _ _ _) = True
 438 isFragileOcc other          = False
 439 \end{code}
 440
 441 \begin{code}
 442 instance Outputable OccInfo where
 443   -- only used for debugging; never parsed.  KSW 1999-07
 444   ppr NoOccInfo            = empty
 445   ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty
 446   ppr IAmDead              = ptext SLIT("Dead")
 447   ppr (OneOcc inside_lam one_branch int_cxt)
 448         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 449         where
 450           pp_lam | inside_lam = char 'L'
 451                  | otherwise  = empty
 452           pp_br  | one_branch = empty
 453                  | otherwise  = char '*'
 454           pp_args | int_cxt   = char '!'
 455                   | otherwise = empty
 456
 457 instance Show OccInfo where
 458   showsPrec p occ = showsPrecSDoc p (ppr occ)
 459 \end{code}
 460
 461 %************************************************************************
 462 %*                                                                      *
 463 \subsection{Strictness indication}
 464 %*                                                                      *
 465 %************************************************************************
 466
 467 The strictness annotations on types in data type declarations
 468 e.g.    data T = MkT !Int !(Bool,Bool)
 469
 470 \begin{code}
 471 data StrictnessMark     -- Used in interface decls only
 472    = MarkedStrict
 473    | MarkedUnboxed
 474    | NotMarkedStrict
 475    deriving( Eq )
 476
 477 isMarkedUnboxed MarkedUnboxed = True
 478 isMarkedUnboxed other         = False
 479
 480 isMarkedStrict NotMarkedStrict = False
 481 isMarkedStrict other           = True   -- All others are strict
 482
 483 instance Outputable StrictnessMark where
 484   ppr MarkedStrict     = ptext SLIT("!")
 485   ppr MarkedUnboxed    = ptext SLIT("!!")
 486   ppr NotMarkedStrict  = ptext SLIT("_")
 487 \end{code}
 488
 489
 490 %************************************************************************
 491 %*                                                                      *
 492 \subsection{Success flag}
 493 %*                                                                      *
 494 %************************************************************************
 495
 496 \begin{code}
 497 data SuccessFlag = Succeeded | Failed
 498
 499 instance Outputable SuccessFlag where
 500     ppr Succeeded = ptext SLIT("Succeeded")
 501     ppr Failed    = ptext SLIT("Failed")
 502
 503 successIf :: Bool -> SuccessFlag
 504 successIf True  = Succeeded
 505 successIf False = Failed
 506
 507 succeeded, failed :: SuccessFlag -> Bool
 508 succeeded Succeeded = True
 509 succeeded Failed    = False
 510
 511 failed Succeeded = False
 512 failed Failed    = True
 513 \end{code}
 514
 515
 516 %************************************************************************
 517 %*                                                                      *
 518 \subsection{Activation}
 519 %*                                                                      *
 520 %************************************************************************
 521
 522 When a rule or inlining is active
 523
 524 \begin{code}
 525 type CompilerPhase = Int        -- Compilation phase
 526                                 -- Phases decrease towards zero
 527                                 -- Zero is the last phase
 528
 529 data Activation = NeverActive
 530                 | AlwaysActive
 531                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 532                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 533                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 534
 535 data InlineSpec
 536   = Inline
 537         Activation      -- Says during which phases inlining is allowed
 538         Bool            -- True <=> make the RHS look small, so that when inlining
 539                         --          is enabled, it will definitely actually happen
 540   deriving( Eq )
 541
 542 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 543 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 544 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 545
 546 instance Outputable Activation where
 547    ppr NeverActive      = ptext SLIT("NEVER")
 548    ppr AlwaysActive     = ptext SLIT("ALWAYS")
 549    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 550    ppr (ActiveAfter n)  = brackets (int n)
 551
 552 instance Outputable InlineSpec where
 553    ppr (Inline act is_inline)
 554         | is_inline = ptext SLIT("INLINE")
 555                       <> case act of
 556                            AlwaysActive -> empty
 557                            other        -> ppr act
 558         | otherwise = ptext SLIT("NOINLINE")
 559                       <> case act of
 560                             NeverActive -> empty
 561                             other       -> ppr act
 562
 563 isActive :: CompilerPhase -> Activation -> Bool
 564 isActive p NeverActive      = False
 565 isActive p AlwaysActive     = True
 566 isActive p (ActiveAfter n)  = p <= n
 567 isActive p (ActiveBefore n) = p >  n
 568
 569 isNeverActive, isAlwaysActive :: Activation -> Bool
 570 isNeverActive NeverActive = True
 571 isNeverActive act         = False
 572
 573 isAlwaysActive AlwaysActive = True
 574 isAlwaysActive other        = False
 575 \end{code}
 576