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