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     -- Used by the occurrence analyser to mark loop-breakers
 382                         -- in a group of recursive definitions
 383         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
 384                         --  See OccurAnal Note [Weak loop breakers]
 385
 386 type RulesOnly = Bool
 387 \end{code}
 388
 389
 390 \begin{code}
 391 isNoOcc :: OccInfo -> Bool
 392 isNoOcc NoOccInfo = True
 393 isNoOcc _         = False
 394
 395 seqOccInfo :: OccInfo -> ()
 396 seqOccInfo occ = occ `seq` ()
 397
 398 -----------------
 399 type InterestingCxt = Bool      -- True <=> Function: is applied
 400                                 --          Data value: scrutinised by a case with
 401                                 --                      at least one non-DEFAULT branch
 402
 403 -----------------
 404 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 405                         -- Substituting a redex for this occurrence is
 406                         -- dangerous because it might duplicate work.
 407 insideLam, notInsideLam :: InsideLam
 408 insideLam    = True
 409 notInsideLam = False
 410
 411 -----------------
 412 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 413                         --      so no code-duplication issue to worry about
 414 oneBranch, notOneBranch :: OneBranch
 415 oneBranch    = True
 416 notOneBranch = False
 417
 418 isLoopBreaker :: OccInfo -> Bool
 419 isLoopBreaker (IAmALoopBreaker _) = True
 420 isLoopBreaker _                   = False
 421
 422 isNonRuleLoopBreaker :: OccInfo -> Bool
 423 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
 424 isNonRuleLoopBreaker _                       = False
 425
 426 isDeadOcc :: OccInfo -> Bool
 427 isDeadOcc IAmDead = True
 428 isDeadOcc _       = False
 429
 430 isOneOcc :: OccInfo -> Bool
 431 isOneOcc (OneOcc _ _ _) = True
 432 isOneOcc _              = False
 433
 434 isFragileOcc :: OccInfo -> Bool
 435 isFragileOcc (OneOcc _ _ _) = True
 436 isFragileOcc _              = False
 437 \end{code}
 438
 439 \begin{code}
 440 instance Outputable OccInfo where
 441   -- only used for debugging; never parsed.  KSW 1999-07
 442   ppr NoOccInfo            = empty
 443   ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty
 444   ppr IAmDead              = ptext SLIT("Dead")
 445   ppr (OneOcc inside_lam one_branch int_cxt)
 446         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 447         where
 448           pp_lam | inside_lam = char 'L'
 449                  | otherwise  = empty
 450           pp_br  | one_branch = empty
 451                  | otherwise  = char '*'
 452           pp_args | int_cxt   = char '!'
 453                   | otherwise = empty
 454
 455 instance Show OccInfo where
 456   showsPrec p occ = showsPrecSDoc p (ppr occ)
 457 \end{code}
 458
 459 %************************************************************************
 460 %*                                                                      *
 461 \subsection{Strictness indication}
 462 %*                                                                      *
 463 %************************************************************************
 464
 465 The strictness annotations on types in data type declarations
 466 e.g.    data T = MkT !Int !(Bool,Bool)
 467
 468 \begin{code}
 469 data StrictnessMark     -- Used in interface decls only
 470    = MarkedStrict
 471    | MarkedUnboxed
 472    | NotMarkedStrict
 473    deriving( Eq )
 474
 475 isMarkedUnboxed :: StrictnessMark -> Bool
 476 isMarkedUnboxed MarkedUnboxed = True
 477 isMarkedUnboxed _             = False
 478
 479 isMarkedStrict :: StrictnessMark -> Bool
 480 isMarkedStrict NotMarkedStrict = False
 481 isMarkedStrict _               = 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, alwaysInlineSpec, neverInlineSpec :: InlineSpec
 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 NeverActive      = ptext SLIT("NEVER")
 550    ppr AlwaysActive     = ptext SLIT("ALWAYS")
 551    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 552    ppr (ActiveAfter n)  = brackets (int n)
 553
 554 instance Outputable InlineSpec where
 555    ppr (Inline act is_inline)
 556         | is_inline = ptext SLIT("INLINE")
 557                       <> case act of
 558                             AlwaysActive -> empty
 559                             _            -> ppr act
 560         | otherwise = ptext SLIT("NOINLINE")
 561                       <> case act of
 562                             NeverActive  -> empty
 563                             _            -> ppr act
 564
 565 isActive :: CompilerPhase -> Activation -> Bool
 566 isActive _ NeverActive      = False
 567 isActive _ AlwaysActive     = True
 568 isActive p (ActiveAfter n)  = p <= n
 569 isActive p (ActiveBefore n) = p >  n
 570
 571 isNeverActive, isAlwaysActive :: Activation -> Bool
 572 isNeverActive NeverActive = True
 573 isNeverActive _           = False
 574
 575 isAlwaysActive AlwaysActive = True
 576 isAlwaysActive _            = False
 577 \end{code}
 578