compiler/basicTypes/BasicTypes.lhs

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