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