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, 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 data IPName name
 113   = Dupable   name      -- ?x: you can freely duplicate this implicit parameter
 114   | Linear name         -- %x: you must use the splitting function to duplicate it
 115   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 116                         --      (used in HscTypes.OrigIParamCache)
 117
 118
 119 ipNameName :: IPName name -> name
 120 ipNameName (Dupable n) = n
 121 ipNameName (Linear  n) = n
 122
 123 mapIPName :: (a->b) -> IPName a -> IPName b
 124 mapIPName f (Dupable n) = Dupable (f n)
 125 mapIPName f (Linear  n) = Linear  (f n)
 126
 127 instance Outputable name => Outputable (IPName name) where
 128     ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters
 129     ppr (Linear  n) = char '%' <> ppr n -- Splittable 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 = (9::Int)
 160 defaultFixity = Fixity maxPrecedence InfixL
 161
 162 negateFixity, funTyFixity :: Fixity
 163 -- Wired-in fixities
 164 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
 165 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
 166 \end{code}
 167
 168 Consider
 169
 170 \begin{verbatim}
 171         a `op1` b `op2` c
 172 \end{verbatim}
 173 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 174 whether there's an error.
 175
 176 \begin{code}
 177 compareFixity :: Fixity -> Fixity
 178               -> (Bool,         -- Error please
 179                   Bool)         -- Associate to the right: a op1 (b op2 c)
 180 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 181   = case prec1 `compare` prec2 of
 182         GT -> left
 183         LT -> right
 184         EQ -> case (dir1, dir2) of
 185                         (InfixR, InfixR) -> right
 186                         (InfixL, InfixL) -> left
 187                         _                -> error_please
 188   where
 189     right        = (False, True)
 190     left         = (False, False)
 191     error_please = (True,  False)
 192 \end{code}
 193
 194
 195 %************************************************************************
 196 %*                                                                      *
 197 \subsection[Top-level/local]{Top-level/not-top level flag}
 198 %*                                                                      *
 199 %************************************************************************
 200
 201 \begin{code}
 202 data TopLevelFlag
 203   = TopLevel
 204   | NotTopLevel
 205
 206 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 207
 208 isNotTopLevel NotTopLevel = True
 209 isNotTopLevel TopLevel    = False
 210
 211 isTopLevel TopLevel     = True
 212 isTopLevel NotTopLevel  = False
 213
 214 instance Outputable TopLevelFlag where
 215   ppr TopLevel    = ptext SLIT("<TopLevel>")
 216   ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
 217 \end{code}
 218
 219
 220 %************************************************************************
 221 %*                                                                      *
 222                 Top-level/not-top level flag
 223 %*                                                                      *
 224 %************************************************************************
 225
 226 \begin{code}
 227 data Boxity
 228   = Boxed
 229   | Unboxed
 230   deriving( Eq )
 231
 232 isBoxed :: Boxity -> Bool
 233 isBoxed Boxed   = True
 234 isBoxed Unboxed = False
 235 \end{code}
 236
 237
 238 %************************************************************************
 239 %*                                                                      *
 240                 Recursive/Non-Recursive flag
 241 %*                                                                      *
 242 %************************************************************************
 243
 244 \begin{code}
 245 data RecFlag = Recursive
 246              | NonRecursive
 247              deriving( Eq )
 248
 249 isRec :: RecFlag -> Bool
 250 isRec Recursive    = True
 251 isRec NonRecursive = False
 252
 253 isNonRec :: RecFlag -> Bool
 254 isNonRec Recursive    = False
 255 isNonRec NonRecursive = True
 256
 257 boolToRecFlag :: Bool -> RecFlag
 258 boolToRecFlag True  = Recursive
 259 boolToRecFlag False = NonRecursive
 260
 261 instance Outputable RecFlag where
 262   ppr Recursive    = ptext SLIT("Recursive")
 263   ppr NonRecursive = ptext SLIT("NonRecursive")
 264 \end{code}
 265
 266 %************************************************************************
 267 %*                                                                      *
 268                 Instance overlap flag
 269 %*                                                                      *
 270 %************************************************************************
 271
 272 \begin{code}
 273 data OverlapFlag
 274   = NoOverlap   -- This instance must not overlap another
 275
 276   | OverlapOk   -- Silently ignore this instance if you find a
 277                 -- more specific one that matches the constraint
 278                 -- you are trying to resolve
 279                 --
 280                 -- Example: constraint (Foo [Int])
 281                 --          instances  (Foo [Int])
 282                 --                     (Foo [a])        OverlapOk
 283                 -- Since the second instance has the OverlapOk flag,
 284                 -- the first instance will be chosen (otherwise
 285                 -- its ambiguous which to choose)
 286
 287   | Incoherent  -- Like OverlapOk, but also ignore this instance
 288                 -- if it doesn't match the constraint you are
 289                 -- trying to resolve, but could match if the type variables
 290                 -- in the constraint were instantiated
 291                 --
 292                 -- Example: constraint (Foo [b])
 293                 --          instances  (Foo [Int])      Incoherent
 294                 --                     (Foo [a])
 295                 -- Without the Incoherent flag, we'd complain that
 296                 -- instantiating 'b' would change which instance
 297                 -- was chosen
 298
 299 instance Outputable OverlapFlag where
 300    ppr NoOverlap  = empty
 301    ppr OverlapOk  = ptext SLIT("[overlap ok]")
 302    ppr Incoherent = ptext SLIT("[incoherent]")
 303
 304 \end{code}
 305
 306 %************************************************************************
 307 %*                                                                      *
 308                 Tuples
 309 %*                                                                      *
 310 %************************************************************************
 311
 312 \begin{code}
 313 data TupCon = TupCon Boxity Arity
 314
 315 instance Eq TupCon where
 316   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 317
 318 tupleParens :: Boxity -> SDoc -> SDoc
 319 tupleParens Boxed   p = parens p
 320 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
 321 \end{code}
 322
 323 %************************************************************************
 324 %*                                                                      *
 325 \subsection[Generic]{Generic flag}
 326 %*                                                                      *
 327 %************************************************************************
 328
 329 This is the "Embedding-Projection pair" datatype, it contains
 330 two pieces of code (normally either RenamedExpr's or Id's)
 331 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 332 represents functions of type
 333
 334         from :: T -> Tring
 335         to   :: Tring -> T
 336
 337 And we should have
 338
 339         to (from x) = x
 340
 341 T and Tring are arbitrary, but typically T is the 'main' type while
 342 Tring is the 'representation' type.  (This just helps us remember
 343 whether to use 'from' or 'to'.
 344
 345 \begin{code}
 346 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 347                  toEP   :: a }  -- :: Tring -> T
 348 \end{code}
 349
 350 Embedding-projection pairs are used in several places:
 351
 352 First of all, each type constructor has an EP associated with it, the
 353 code in EP converts (datatype T) from T to Tring and back again.
 354
 355 Secondly, when we are filling in Generic methods (in the typechecker,
 356 tcMethodBinds), we are constructing bimaps by induction on the structure
 357 of the type of the method signature.
 358
 359
 360 %************************************************************************
 361 %*                                                                      *
 362 \subsection{Occurrence information}
 363 %*                                                                      *
 364 %************************************************************************
 365
 366 This data type is used exclusively by the simplifier, but it appears in a
 367 SubstResult, which is currently defined in VarEnv, which is pretty near
 368 the base of the module hierarchy.  So it seemed simpler to put the
 369 defn of OccInfo here, safely at the bottom
 370
 371 \begin{code}
 372 data OccInfo
 373   = NoOccInfo
 374
 375   | IAmDead             -- Marks unused variables.  Sometimes useful for
 376                         -- lambda and case-bound variables.
 377
 378   | OneOcc !InsideLam
 379            !OneBranch
 380            !InterestingCxt
 381
 382   | IAmALoopBreaker     -- Used by the occurrence analyser to mark loop-breakers
 383                         -- in a group of recursive definitions
 384
 385 isNoOcc :: OccInfo -> Bool
 386 isNoOcc NoOccInfo = True
 387 isNoOcc other     = False
 388
 389 seqOccInfo :: OccInfo -> ()
 390 seqOccInfo occ = occ `seq` ()
 391
 392 -----------------
 393 type InterestingCxt = Bool      -- True <=> Function: is applied
 394                                 --          Data value: scrutinised by a case with
 395                                 --                      at least one non-DEFAULT branch
 396
 397 -----------------
 398 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 399                         -- Substituting a redex for this occurrence is
 400                         -- dangerous because it might duplicate work.
 401 insideLam    = True
 402 notInsideLam = False
 403
 404 -----------------
 405 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 406                         --      so no code-duplication issue to worry about
 407 oneBranch    = True
 408 notOneBranch = False
 409
 410 isLoopBreaker :: OccInfo -> Bool
 411 isLoopBreaker IAmALoopBreaker = True
 412 isLoopBreaker other           = False
 413
 414 isDeadOcc :: OccInfo -> Bool
 415 isDeadOcc IAmDead = True
 416 isDeadOcc other   = False
 417
 418 isOneOcc (OneOcc _ _ _) = True
 419 isOneOcc other          = False
 420
 421 isFragileOcc :: OccInfo -> Bool
 422 isFragileOcc (OneOcc _ _ _) = True
 423 isFragileOcc other          = False
 424 \end{code}
 425
 426 \begin{code}
 427 instance Outputable OccInfo where
 428   -- only used for debugging; never parsed.  KSW 1999-07
 429   ppr NoOccInfo                                   = empty
 430   ppr IAmALoopBreaker                             = ptext SLIT("LoopBreaker")
 431   ppr IAmDead                                     = ptext SLIT("Dead")
 432   ppr (OneOcc inside_lam one_branch int_cxt)
 433         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 434         where
 435           pp_lam | inside_lam = char 'L'
 436                  | otherwise  = empty
 437           pp_br  | one_branch = empty
 438                  | otherwise  = char '*'
 439           pp_args | int_cxt   = char '!'
 440                   | otherwise = empty
 441
 442 instance Show OccInfo where
 443   showsPrec p occ = showsPrecSDoc p (ppr occ)
 444 \end{code}
 445
 446 %************************************************************************
 447 %*                                                                      *
 448 \subsection{Strictness indication}
 449 %*                                                                      *
 450 %************************************************************************
 451
 452 The strictness annotations on types in data type declarations
 453 e.g.    data T = MkT !Int !(Bool,Bool)
 454
 455 \begin{code}
 456 data StrictnessMark     -- Used in interface decls only
 457    = MarkedStrict
 458    | MarkedUnboxed
 459    | NotMarkedStrict
 460    deriving( Eq )
 461
 462 isMarkedUnboxed MarkedUnboxed = True
 463 isMarkedUnboxed other         = False
 464
 465 isMarkedStrict NotMarkedStrict = False
 466 isMarkedStrict other           = True   -- All others are strict
 467
 468 instance Outputable StrictnessMark where
 469   ppr MarkedStrict     = ptext SLIT("!")
 470   ppr MarkedUnboxed    = ptext SLIT("!!")
 471   ppr NotMarkedStrict  = ptext SLIT("_")
 472 \end{code}
 473
 474
 475 %************************************************************************
 476 %*                                                                      *
 477 \subsection{Success flag}
 478 %*                                                                      *
 479 %************************************************************************
 480
 481 \begin{code}
 482 data SuccessFlag = Succeeded | Failed
 483
 484 successIf :: Bool -> SuccessFlag
 485 successIf True  = Succeeded
 486 successIf False = Failed
 487
 488 succeeded, failed :: SuccessFlag -> Bool
 489 succeeded Succeeded = True
 490 succeeded Failed    = False
 491
 492 failed Succeeded = False
 493 failed Failed    = True
 494 \end{code}
 495
 496
 497 %************************************************************************
 498 %*                                                                      *
 499 \subsection{Activation}
 500 %*                                                                      *
 501 %************************************************************************
 502
 503 When a rule or inlining is active
 504
 505 \begin{code}
 506 type CompilerPhase = Int        -- Compilation phase
 507                                 -- Phases decrease towards zero
 508                                 -- Zero is the last phase
 509
 510 data Activation = NeverActive
 511                 | AlwaysActive
 512                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 513                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 514                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 515
 516 data InlineSpec
 517   = Inline
 518         Activation      -- Says during which phases inlining is allowed
 519         Bool            -- True <=> make the RHS look small, so that when inlining
 520                         --          is enabled, it will definitely actually happen
 521   deriving( Eq )
 522
 523 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 524 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 525 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 526
 527 instance Outputable Activation where
 528    ppr AlwaysActive     = empty         -- The default
 529    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 530    ppr (ActiveAfter n)  = brackets (int n)
 531    ppr NeverActive      = ptext SLIT("NEVER")
 532
 533 instance Outputable InlineSpec where
 534    ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
 535    ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
 536
 537 isActive :: CompilerPhase -> Activation -> Bool
 538 isActive p NeverActive      = False
 539 isActive p AlwaysActive     = True
 540 isActive p (ActiveAfter n)  = p <= n
 541 isActive p (ActiveBefore n) = p >  n
 542
 543 isNeverActive, isAlwaysActive :: Activation -> Bool
 544 isNeverActive NeverActive = True
 545 isNeverActive act         = False
 546
 547 isAlwaysActive AlwaysActive = True
 548 isAlwaysActive other        = False
 549 \end{code}
 550