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         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 import FastString
  60 import Outputable
  61 \end{code}
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsection[Arity]{Arity}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 \begin{code}
  70 type Arity = Int
  71 \end{code}
  72
  73
  74 %************************************************************************
  75 %*                                                                      *
  76 \subsection[Version]{Module and identifier version numbers}
  77 %*                                                                      *
  78 %************************************************************************
  79
  80 \begin{code}
  81 type Version = Int
  82
  83 bumpVersion :: Version -> Version
  84 bumpVersion v = v+1
  85
  86 initialVersion :: Version
  87 initialVersion = 1
  88 \end{code}
  89
  90 %************************************************************************
  91 %*                                                                      *
  92                 Deprecations
  93 %*                                                                      *
  94 %************************************************************************
  95
  96
  97 \begin{code}
  98 -- reason/explanation from a WARNING or DEPRECATED pragma
  99 data WarningTxt = WarningTxt FastString
 100                 | DeprecatedTxt FastString
 101     deriving Eq
 102
 103 instance Outputable WarningTxt where
 104     ppr (WarningTxt    w) =                        doubleQuotes (ftext w)
 105     ppr (DeprecatedTxt d) = text "Deprecated:" <+> doubleQuotes (ftext d)
 106 \end{code}
 107
 108 %************************************************************************
 109 %*                                                                      *
 110 \subsection{Implicit parameter identity}
 111 %*                                                                      *
 112 %************************************************************************
 113
 114 The @IPName@ type is here because it is used in TypeRep (i.e. very
 115 early in the hierarchy), but also in HsSyn.
 116
 117 \begin{code}
 118 newtype IPName name = IPName name       -- ?x
 119   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 120                         --      (used in HscTypes.OrigIParamCache)
 121
 122 ipNameName :: IPName name -> name
 123 ipNameName (IPName n) = n
 124
 125 mapIPName :: (a->b) -> IPName a -> IPName b
 126 mapIPName f (IPName n) = IPName (f n)
 127
 128 instance Outputable name => Outputable (IPName name) where
 129     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
 130 \end{code}
 131
 132
 133 %************************************************************************
 134 %*                                                                      *
 135 \subsection[Fixity]{Fixity info}
 136 %*                                                                      *
 137 %************************************************************************
 138
 139 \begin{code}
 140 ------------------------
 141 data Fixity = Fixity Int FixityDirection
 142
 143 instance Outputable Fixity where
 144     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 145
 146 instance Eq Fixity where                -- Used to determine if two fixities conflict
 147   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 148
 149 ------------------------
 150 data FixityDirection = InfixL | InfixR | InfixN
 151                      deriving(Eq)
 152
 153 instance Outputable FixityDirection where
 154     ppr InfixL = ptext (sLit "infixl")
 155     ppr InfixR = ptext (sLit "infixr")
 156     ppr InfixN = ptext (sLit "infix")
 157
 158 ------------------------
 159 maxPrecedence :: Int
 160 maxPrecedence = 9
 161 defaultFixity :: Fixity
 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 -- | Identifier occurrence information
 376 data OccInfo
 377   = NoOccInfo           -- ^ There are many occurrences, or unknown occurences
 378
 379   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
 380                         -- lambda and case-bound variables.
 381
 382   | OneOcc
 383         !InsideLam
 384         !OneBranch
 385         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
 386
 387   -- | This identifier breaks a loop of mutually recursive functions. The field
 388   -- marks whether it is only a loop breaker due to a reference in a rule
 389   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
 390         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
 391                         --          See OccurAnal Note [Weak loop breakers]
 392
 393 type RulesOnly = Bool
 394 \end{code}
 395
 396 Note [LoopBreaker OccInfo]
 397 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 398 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
 399 analyser in two ways:
 400   (a) to mark loop-breakers in a group of recursive
 401       definitions (hence the name)
 402   (b) to mark binders that must not be inlined in this phase
 403       (perhaps it has a NOINLINE pragma)
 404 Things with (IAmLoopBreaker False) do not get an unfolding
 405 pinned on to them, so they are completely opaque.
 406
 407 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
 408
 409
 410 \begin{code}
 411 isNoOcc :: OccInfo -> Bool
 412 isNoOcc NoOccInfo = True
 413 isNoOcc _         = False
 414
 415 seqOccInfo :: OccInfo -> ()
 416 seqOccInfo occ = occ `seq` ()
 417
 418 -----------------
 419 type InterestingCxt = Bool      -- True <=> Function: is applied
 420                                 --          Data value: scrutinised by a case with
 421                                 --                      at least one non-DEFAULT branch
 422
 423 -----------------
 424 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 425                         -- Substituting a redex for this occurrence is
 426                         -- dangerous because it might duplicate work.
 427 insideLam, notInsideLam :: InsideLam
 428 insideLam    = True
 429 notInsideLam = False
 430
 431 -----------------
 432 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 433                         --      so no code-duplication issue to worry about
 434 oneBranch, notOneBranch :: OneBranch
 435 oneBranch    = True
 436 notOneBranch = False
 437
 438 isLoopBreaker :: OccInfo -> Bool
 439 isLoopBreaker (IAmALoopBreaker _) = True
 440 isLoopBreaker _                   = False
 441
 442 isNonRuleLoopBreaker :: OccInfo -> Bool
 443 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
 444 isNonRuleLoopBreaker _                       = False
 445
 446 isDeadOcc :: OccInfo -> Bool
 447 isDeadOcc IAmDead = True
 448 isDeadOcc _       = False
 449
 450 isOneOcc :: OccInfo -> Bool
 451 isOneOcc (OneOcc _ _ _) = True
 452 isOneOcc _              = False
 453
 454 isFragileOcc :: OccInfo -> Bool
 455 isFragileOcc (OneOcc _ _ _) = True
 456 isFragileOcc _              = False
 457 \end{code}
 458
 459 \begin{code}
 460 instance Outputable OccInfo where
 461   -- only used for debugging; never parsed.  KSW 1999-07
 462   ppr NoOccInfo            = empty
 463   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
 464   ppr IAmDead              = ptext (sLit "Dead")
 465   ppr (OneOcc inside_lam one_branch int_cxt)
 466         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
 467         where
 468           pp_lam | inside_lam = char 'L'
 469                  | otherwise  = empty
 470           pp_br  | one_branch = empty
 471                  | otherwise  = char '*'
 472           pp_args | int_cxt   = char '!'
 473                   | otherwise = empty
 474
 475 instance Show OccInfo where
 476   showsPrec p occ = showsPrecSDoc p (ppr occ)
 477 \end{code}
 478
 479 %************************************************************************
 480 %*                                                                      *
 481 \subsection{Strictness indication}
 482 %*                                                                      *
 483 %************************************************************************
 484
 485 The strictness annotations on types in data type declarations
 486 e.g.    data T = MkT !Int !(Bool,Bool)
 487
 488 \begin{code}
 489 data StrictnessMark     -- Used in interface decls only
 490    = MarkedStrict
 491    | MarkedUnboxed
 492    | NotMarkedStrict
 493    deriving( Eq )
 494
 495 isMarkedUnboxed :: StrictnessMark -> Bool
 496 isMarkedUnboxed MarkedUnboxed = True
 497 isMarkedUnboxed _             = False
 498
 499 isMarkedStrict :: StrictnessMark -> Bool
 500 isMarkedStrict NotMarkedStrict = False
 501 isMarkedStrict _               = True   -- All others are strict
 502
 503 instance Outputable StrictnessMark where
 504   ppr MarkedStrict     = ptext (sLit "!")
 505   ppr MarkedUnboxed    = ptext (sLit "!!")
 506   ppr NotMarkedStrict  = ptext (sLit "_")
 507 \end{code}
 508
 509
 510 %************************************************************************
 511 %*                                                                      *
 512 \subsection{Success flag}
 513 %*                                                                      *
 514 %************************************************************************
 515
 516 \begin{code}
 517 data SuccessFlag = Succeeded | Failed
 518
 519 instance Outputable SuccessFlag where
 520     ppr Succeeded = ptext (sLit "Succeeded")
 521     ppr Failed    = ptext (sLit "Failed")
 522
 523 successIf :: Bool -> SuccessFlag
 524 successIf True  = Succeeded
 525 successIf False = Failed
 526
 527 succeeded, failed :: SuccessFlag -> Bool
 528 succeeded Succeeded = True
 529 succeeded Failed    = False
 530
 531 failed Succeeded = False
 532 failed Failed    = True
 533 \end{code}
 534
 535
 536 %************************************************************************
 537 %*                                                                      *
 538 \subsection{Activation}
 539 %*                                                                      *
 540 %************************************************************************
 541
 542 When a rule or inlining is active
 543
 544 \begin{code}
 545 type CompilerPhase = Int        -- Compilation phase
 546                                 -- Phases decrease towards zero
 547                                 -- Zero is the last phase
 548
 549 data Activation = NeverActive
 550                 | AlwaysActive
 551                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 552                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 553                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 554
 555 data InlineSpec
 556   = Inline
 557         Activation      -- Says during which phases inlining is allowed
 558         Bool            -- True <=> make the RHS look small, so that when inlining
 559                         --          is enabled, it will definitely actually happen
 560   deriving( Eq )
 561
 562 defaultInlineSpec, alwaysInlineSpec, neverInlineSpec :: InlineSpec
 563
 564 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 565 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 566 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 567
 568 instance Outputable Activation where
 569    ppr NeverActive      = ptext (sLit "NEVER")
 570    ppr AlwaysActive     = ptext (sLit "ALWAYS")
 571    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 572    ppr (ActiveAfter n)  = brackets (int n)
 573
 574 instance Outputable InlineSpec where
 575    ppr (Inline act is_inline)
 576         | is_inline = ptext (sLit "INLINE")
 577                       <> case act of
 578                             AlwaysActive -> empty
 579                             _            -> ppr act
 580         | otherwise = ptext (sLit "NOINLINE")
 581                       <> case act of
 582                             NeverActive  -> empty
 583                             _            -> ppr act
 584
 585 isActive :: CompilerPhase -> Activation -> Bool
 586 isActive _ NeverActive      = False
 587 isActive _ AlwaysActive     = True
 588 isActive p (ActiveAfter n)  = p <= n
 589 isActive p (ActiveBefore n) = p >  n
 590
 591 isNeverActive, isAlwaysActive :: Activation -> Bool
 592 isNeverActive NeverActive = True
 593 isNeverActive _           = False
 594
 595 isAlwaysActive AlwaysActive = True
 596 isAlwaysActive _            = False
 597 \end{code}
 598