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