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   deriving( Eq )
 299
 300 instance Outputable OverlapFlag where
 301    ppr NoOverlap  = empty
 302    ppr OverlapOk  = ptext SLIT("[overlap ok]")
 303    ppr Incoherent = ptext SLIT("[incoherent]")
 304
 305 \end{code}
 306
 307 %************************************************************************
 308 %*                                                                      *
 309                 Tuples
 310 %*                                                                      *
 311 %************************************************************************
 312
 313 \begin{code}
 314 data TupCon = TupCon Boxity Arity
 315
 316 instance Eq TupCon where
 317   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 318
 319 tupleParens :: Boxity -> SDoc -> SDoc
 320 tupleParens Boxed   p = parens p
 321 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
 322 \end{code}
 323
 324 %************************************************************************
 325 %*                                                                      *
 326 \subsection[Generic]{Generic flag}
 327 %*                                                                      *
 328 %************************************************************************
 329
 330 This is the "Embedding-Projection pair" datatype, it contains
 331 two pieces of code (normally either RenamedExpr's or Id's)
 332 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 333 represents functions of type
 334
 335         from :: T -> Tring
 336         to   :: Tring -> T
 337
 338 And we should have
 339
 340         to (from x) = x
 341
 342 T and Tring are arbitrary, but typically T is the 'main' type while
 343 Tring is the 'representation' type.  (This just helps us remember
 344 whether to use 'from' or 'to'.
 345
 346 \begin{code}
 347 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 348                  toEP   :: a }  -- :: Tring -> T
 349 \end{code}
 350
 351 Embedding-projection pairs are used in several places:
 352
 353 First of all, each type constructor has an EP associated with it, the
 354 code in EP converts (datatype T) from T to Tring and back again.
 355
 356 Secondly, when we are filling in Generic methods (in the typechecker,
 357 tcMethodBinds), we are constructing bimaps by induction on the structure
 358 of the type of the method signature.
 359
 360
 361 %************************************************************************
 362 %*                                                                      *
 363 \subsection{Occurrence information}
 364 %*                                                                      *
 365 %************************************************************************
 366
 367 This data type is used exclusively by the simplifier, but it appears in a
 368 SubstResult, which is currently defined in VarEnv, which is pretty near
 369 the base of the module hierarchy.  So it seemed simpler to put the
 370 defn of OccInfo here, safely at the bottom
 371
 372 \begin{code}
 373 data OccInfo
 374   = NoOccInfo
 375
 376   | IAmDead             -- Marks unused variables.  Sometimes useful for
 377                         -- lambda and case-bound variables.
 378
 379   | OneOcc !InsideLam
 380            !OneBranch
 381            !InterestingCxt
 382
 383   | IAmALoopBreaker     -- Used by the occurrence analyser to mark loop-breakers
 384                         -- in a group of recursive definitions
 385
 386 isNoOcc :: OccInfo -> Bool
 387 isNoOcc NoOccInfo = True
 388 isNoOcc other     = False
 389
 390 seqOccInfo :: OccInfo -> ()
 391 seqOccInfo occ = occ `seq` ()
 392
 393 -----------------
 394 type InterestingCxt = Bool      -- True <=> Function: is applied
 395                                 --          Data value: scrutinised by a case with
 396                                 --                      at least one non-DEFAULT branch
 397
 398 -----------------
 399 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 400                         -- Substituting a redex for this occurrence is
 401                         -- dangerous because it might duplicate work.
 402 insideLam    = True
 403 notInsideLam = False
 404
 405 -----------------
 406 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 407                         --      so no code-duplication issue to worry about
 408 oneBranch    = True
 409 notOneBranch = False
 410
 411 isLoopBreaker :: OccInfo -> Bool
 412 isLoopBreaker IAmALoopBreaker = True
 413 isLoopBreaker other           = False
 414
 415 isDeadOcc :: OccInfo -> Bool
 416 isDeadOcc IAmDead = True
 417 isDeadOcc other   = False
 418
 419 isOneOcc (OneOcc _ _ _) = True
 420 isOneOcc other          = False
 421
 422 isFragileOcc :: OccInfo -> Bool
 423 isFragileOcc (OneOcc _ _ _) = True
 424 isFragileOcc other          = False
 425 \end{code}
 426
 427 \begin{code}
 428 instance Outputable OccInfo where
 429   -- only used for debugging; never parsed.  KSW 1999-07
 430   ppr NoOccInfo                                   = empty
 431   ppr IAmALoopBreaker                             = ptext SLIT("LoopBreaker")
 432   ppr IAmDead                                     = ptext SLIT("Dead")
 433   ppr (OneOcc inside_lam one_branch int_cxt)
 434         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 435         where
 436           pp_lam | inside_lam = char 'L'
 437                  | otherwise  = empty
 438           pp_br  | one_branch = empty
 439                  | otherwise  = char '*'
 440           pp_args | int_cxt   = char '!'
 441                   | otherwise = empty
 442
 443 instance Show OccInfo where
 444   showsPrec p occ = showsPrecSDoc p (ppr occ)
 445 \end{code}
 446
 447 %************************************************************************
 448 %*                                                                      *
 449 \subsection{Strictness indication}
 450 %*                                                                      *
 451 %************************************************************************
 452
 453 The strictness annotations on types in data type declarations
 454 e.g.    data T = MkT !Int !(Bool,Bool)
 455
 456 \begin{code}
 457 data StrictnessMark     -- Used in interface decls only
 458    = MarkedStrict
 459    | MarkedUnboxed
 460    | NotMarkedStrict
 461    deriving( Eq )
 462
 463 isMarkedUnboxed MarkedUnboxed = True
 464 isMarkedUnboxed other         = False
 465
 466 isMarkedStrict NotMarkedStrict = False
 467 isMarkedStrict other           = True   -- All others are strict
 468
 469 instance Outputable StrictnessMark where
 470   ppr MarkedStrict     = ptext SLIT("!")
 471   ppr MarkedUnboxed    = ptext SLIT("!!")
 472   ppr NotMarkedStrict  = ptext SLIT("_")
 473 \end{code}
 474
 475
 476 %************************************************************************
 477 %*                                                                      *
 478 \subsection{Success flag}
 479 %*                                                                      *
 480 %************************************************************************
 481
 482 \begin{code}
 483 data SuccessFlag = Succeeded | Failed
 484
 485 successIf :: Bool -> SuccessFlag
 486 successIf True  = Succeeded
 487 successIf False = Failed
 488
 489 succeeded, failed :: SuccessFlag -> Bool
 490 succeeded Succeeded = True
 491 succeeded Failed    = False
 492
 493 failed Succeeded = False
 494 failed Failed    = True
 495 \end{code}
 496
 497
 498 %************************************************************************
 499 %*                                                                      *
 500 \subsection{Activation}
 501 %*                                                                      *
 502 %************************************************************************
 503
 504 When a rule or inlining is active
 505
 506 \begin{code}
 507 type CompilerPhase = Int        -- Compilation phase
 508                                 -- Phases decrease towards zero
 509                                 -- Zero is the last phase
 510
 511 data Activation = NeverActive
 512                 | AlwaysActive
 513                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 514                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 515                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 516
 517 data InlineSpec
 518   = Inline
 519         Activation      -- Says during which phases inlining is allowed
 520         Bool            -- True <=> make the RHS look small, so that when inlining
 521                         --          is enabled, it will definitely actually happen
 522   deriving( Eq )
 523
 524 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 525 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 526 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 527
 528 instance Outputable Activation where
 529    ppr AlwaysActive     = empty         -- The default
 530    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 531    ppr (ActiveAfter n)  = brackets (int n)
 532    ppr NeverActive      = ptext SLIT("NEVER")
 533
 534 instance Outputable InlineSpec where
 535    ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
 536    ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
 537
 538 isActive :: CompilerPhase -> Activation -> Bool
 539 isActive p NeverActive      = False
 540 isActive p AlwaysActive     = True
 541 isActive p (ActiveAfter n)  = p <= n
 542 isActive p (ActiveBefore n) = p >  n
 543
 544 isNeverActive, isAlwaysActive :: Activation -> Bool
 545 isNeverActive NeverActive = True
 546 isNeverActive act         = False
 547
 548 isAlwaysActive AlwaysActive = True
 549 isAlwaysActive other        = False
 550 \end{code}
 551