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 loop breaker mentions the other binders
 389                         --          in its recursive group only in its RULES, not
 390                         --          in its rhs
 391                         --  See OccurAnal Note [RulesOnly]
 392
 393 type RulesOnly = Bool
 394 \end{code}
 395
 396
 397 \begin{code}
 398 isNoOcc :: OccInfo -> Bool
 399 isNoOcc NoOccInfo = True
 400 isNoOcc other     = False
 401
 402 seqOccInfo :: OccInfo -> ()
 403 seqOccInfo occ = occ `seq` ()
 404
 405 -----------------
 406 type InterestingCxt = Bool      -- True <=> Function: is applied
 407                                 --          Data value: scrutinised by a case with
 408                                 --                      at least one non-DEFAULT branch
 409
 410 -----------------
 411 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 412                         -- Substituting a redex for this occurrence is
 413                         -- dangerous because it might duplicate work.
 414 insideLam    = True
 415 notInsideLam = False
 416
 417 -----------------
 418 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 419                         --      so no code-duplication issue to worry about
 420 oneBranch    = True
 421 notOneBranch = False
 422
 423 isLoopBreaker :: OccInfo -> Bool
 424 isLoopBreaker (IAmALoopBreaker _) = True
 425 isLoopBreaker other               = False
 426
 427 isNonRuleLoopBreaker :: OccInfo -> Bool
 428 isNonRuleLoopBreaker (IAmALoopBreaker False) = True     -- Loop-breaker that breaks a non-rule cycle
 429 isNonRuleLoopBreaker other                   = False
 430
 431 isDeadOcc :: OccInfo -> Bool
 432 isDeadOcc IAmDead = True
 433 isDeadOcc other   = False
 434
 435 isOneOcc (OneOcc _ _ _) = True
 436 isOneOcc other          = False
 437
 438 isFragileOcc :: OccInfo -> Bool
 439 isFragileOcc (OneOcc _ _ _) = True
 440 isFragileOcc other          = False
 441 \end{code}
 442
 443 \begin{code}
 444 instance Outputable OccInfo where
 445   -- only used for debugging; never parsed.  KSW 1999-07
 446   ppr NoOccInfo            = empty
 447   ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty
 448   ppr IAmDead              = ptext SLIT("Dead")
 449   ppr (OneOcc inside_lam one_branch int_cxt)
 450         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 451         where
 452           pp_lam | inside_lam = char 'L'
 453                  | otherwise  = empty
 454           pp_br  | one_branch = empty
 455                  | otherwise  = char '*'
 456           pp_args | int_cxt   = char '!'
 457                   | otherwise = empty
 458
 459 instance Show OccInfo where
 460   showsPrec p occ = showsPrecSDoc p (ppr occ)
 461 \end{code}
 462
 463 %************************************************************************
 464 %*                                                                      *
 465 \subsection{Strictness indication}
 466 %*                                                                      *
 467 %************************************************************************
 468
 469 The strictness annotations on types in data type declarations
 470 e.g.    data T = MkT !Int !(Bool,Bool)
 471
 472 \begin{code}
 473 data StrictnessMark     -- Used in interface decls only
 474    = MarkedStrict
 475    | MarkedUnboxed
 476    | NotMarkedStrict
 477    deriving( Eq )
 478
 479 isMarkedUnboxed MarkedUnboxed = True
 480 isMarkedUnboxed other         = False
 481
 482 isMarkedStrict NotMarkedStrict = False
 483 isMarkedStrict other           = True   -- All others are strict
 484
 485 instance Outputable StrictnessMark where
 486   ppr MarkedStrict     = ptext SLIT("!")
 487   ppr MarkedUnboxed    = ptext SLIT("!!")
 488   ppr NotMarkedStrict  = ptext SLIT("_")
 489 \end{code}
 490
 491
 492 %************************************************************************
 493 %*                                                                      *
 494 \subsection{Success flag}
 495 %*                                                                      *
 496 %************************************************************************
 497
 498 \begin{code}
 499 data SuccessFlag = Succeeded | Failed
 500
 501 instance Outputable SuccessFlag where
 502     ppr Succeeded = ptext SLIT("Succeeded")
 503     ppr Failed    = ptext SLIT("Failed")
 504
 505 successIf :: Bool -> SuccessFlag
 506 successIf True  = Succeeded
 507 successIf False = Failed
 508
 509 succeeded, failed :: SuccessFlag -> Bool
 510 succeeded Succeeded = True
 511 succeeded Failed    = False
 512
 513 failed Succeeded = False
 514 failed Failed    = True
 515 \end{code}
 516
 517
 518 %************************************************************************
 519 %*                                                                      *
 520 \subsection{Activation}
 521 %*                                                                      *
 522 %************************************************************************
 523
 524 When a rule or inlining is active
 525
 526 \begin{code}
 527 type CompilerPhase = Int        -- Compilation phase
 528                                 -- Phases decrease towards zero
 529                                 -- Zero is the last phase
 530
 531 data Activation = NeverActive
 532                 | AlwaysActive
 533                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 534                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 535                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 536
 537 data InlineSpec
 538   = Inline
 539         Activation      -- Says during which phases inlining is allowed
 540         Bool            -- True <=> make the RHS look small, so that when inlining
 541                         --          is enabled, it will definitely actually happen
 542   deriving( Eq )
 543
 544 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 545 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 546 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 547
 548 instance Outputable Activation where
 549    ppr AlwaysActive     = empty         -- The default
 550    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 551    ppr (ActiveAfter n)  = brackets (int n)
 552    ppr NeverActive      = ptext SLIT("NEVER")
 553
 554 instance Outputable InlineSpec where
 555    ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
 556    ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
 557
 558 isActive :: CompilerPhase -> Activation -> Bool
 559 isActive p NeverActive      = False
 560 isActive p AlwaysActive     = True
 561 isActive p (ActiveAfter n)  = p <= n
 562 isActive p (ActiveBefore n) = p >  n
 563
 564 isNeverActive, isAlwaysActive :: Activation -> Bool
 565 isNeverActive NeverActive = True
 566 isNeverActive act         = False
 567
 568 isAlwaysActive AlwaysActive = True
 569 isAlwaysActive other        = False
 570 \end{code}
 571