ghc/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, bogusVersion,
  18
  19         Arity,
  20
  21         DeprecTxt,
  22
  23         Unused, unused,
  24
  25         Fixity(..), FixityDirection(..),
  26         defaultFixity, maxPrecedence,
  27         arrowFixity, negateFixity, negatePrecedence,
  28         compareFixity,
  29
  30         IPName(..), ipNameName, mapIPName,
  31
  32         NewOrData(..),
  33
  34         RecFlag(..), isRec, isNonRec, boolToRecFlag,
  35
  36         TopLevelFlag(..), isTopLevel, isNotTopLevel,
  37
  38         Boxity(..), isBoxed,
  39
  40         TupCon(..), tupParens, tupleParens,
  41
  42         OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
  43         isDeadOcc, isLoopBreaker,
  44
  45         InsideLam, insideLam, notInsideLam,
  46         OneBranch, oneBranch, notOneBranch,
  47
  48         EP(..),
  49
  50         StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
  51
  52         CompilerPhase,
  53         Activation(..), isActive, isNeverActive, isAlwaysActive,
  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[Unused]{Unused}
  67 %*                                                                      *
  68 %************************************************************************
  69
  70 Used as a placeholder in types.
  71
  72 \begin{code}
  73 type Unused = ()
  74
  75 unused :: Unused
  76 unused = error "Unused is used!"
  77 \end{code}
  78
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsection[Arity]{Arity}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 \begin{code}
  87 type Arity = Int
  88 \end{code}
  89
  90
  91 %************************************************************************
  92 %*                                                                      *
  93 \subsection[Version]{Module and identifier version numbers}
  94 %*                                                                      *
  95 %************************************************************************
  96
  97 \begin{code}
  98 type Version = Int
  99
 100 bogusVersion :: Version -- Shouldn't look at these
 101 bogusVersion = error "bogusVersion"
 102
 103 bumpVersion :: Version -> Version
 104 bumpVersion v = v+1
 105
 106 initialVersion :: Version
 107 initialVersion = 1
 108 \end{code}
 109
 110 %************************************************************************
 111 %*                                                                      *
 112                 Deprecations
 113 %*                                                                      *
 114 %************************************************************************
 115
 116
 117 \begin{code}
 118 type DeprecTxt = FastString     -- reason/explanation for deprecation
 119 \end{code}
 120
 121 %************************************************************************
 122 %*                                                                      *
 123 \subsection{Implicit parameter identity}
 124 %*                                                                      *
 125 %************************************************************************
 126
 127 The @IPName@ type is here because it is used in TypeRep (i.e. very
 128 early in the hierarchy), but also in HsSyn.
 129
 130 \begin{code}
 131 data IPName name
 132   = Dupable   name      -- ?x: you can freely duplicate this implicit parameter
 133   | Linear name         -- %x: you must use the splitting function to duplicate it
 134   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 135                         --      (used in HscTypes.OrigIParamCache)
 136
 137
 138 ipNameName :: IPName name -> name
 139 ipNameName (Dupable n) = n
 140 ipNameName (Linear  n) = n
 141
 142 mapIPName :: (a->b) -> IPName a -> IPName b
 143 mapIPName f (Dupable n) = Dupable (f n)
 144 mapIPName f (Linear  n) = Linear  (f n)
 145
 146 instance Outputable name => Outputable (IPName name) where
 147     ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters
 148     ppr (Linear  n) = char '%' <> ppr n -- Splittable implicit parameters
 149 \end{code}
 150
 151
 152 %************************************************************************
 153 %*                                                                      *
 154 \subsection[Fixity]{Fixity info}
 155 %*                                                                      *
 156 %************************************************************************
 157
 158 \begin{code}
 159 ------------------------
 160 data Fixity = Fixity Int FixityDirection
 161
 162 instance Outputable Fixity where
 163     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 164
 165 instance Eq Fixity where                -- Used to determine if two fixities conflict
 166   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 167
 168 ------------------------
 169 data FixityDirection = InfixL | InfixR | InfixN
 170                      deriving(Eq)
 171
 172 instance Outputable FixityDirection where
 173     ppr InfixL = ptext SLIT("infixl")
 174     ppr InfixR = ptext SLIT("infixr")
 175     ppr InfixN = ptext SLIT("infix")
 176
 177 ------------------------
 178 maxPrecedence = (9::Int)
 179 defaultFixity = Fixity maxPrecedence InfixL
 180
 181 negateFixity :: Fixity
 182 negateFixity     = Fixity negatePrecedence InfixL       -- Precedence of unary negate is wired in as infixl 6!
 183
 184 arrowFixity :: Fixity   -- Fixity of '->' in types
 185 arrowFixity = Fixity 0 InfixR
 186
 187 negatePrecedence :: Int
 188 negatePrecedence = 6
 189 \end{code}
 190
 191 Consider
 192
 193 \begin{verbatim}
 194         a `op1` b `op2` c
 195 \end{verbatim}
 196 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 197 whether there's an error.
 198
 199 \begin{code}
 200 compareFixity :: Fixity -> Fixity
 201               -> (Bool,         -- Error please
 202                   Bool)         -- Associate to the right: a op1 (b op2 c)
 203 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 204   = case prec1 `compare` prec2 of
 205         GT -> left
 206         LT -> right
 207         EQ -> case (dir1, dir2) of
 208                         (InfixR, InfixR) -> right
 209                         (InfixL, InfixL) -> left
 210                         _                -> error_please
 211   where
 212     right        = (False, True)
 213     left         = (False, False)
 214     error_please = (True,  False)
 215 \end{code}
 216
 217
 218 %************************************************************************
 219 %*                                                                      *
 220 \subsection[NewType/DataType]{NewType/DataType flag}
 221 %*                                                                      *
 222 %************************************************************************
 223
 224 \begin{code}
 225 data NewOrData
 226   = NewType     -- "newtype Blah ..."
 227   | DataType    -- "data Blah ..."
 228   deriving( Eq )        -- Needed because Demand derives Eq
 229
 230 instance Outputable NewOrData where
 231   ppr NewType  = ptext SLIT("newtype")
 232   ppr DataType = ptext SLIT("data")
 233 \end{code}
 234
 235
 236 %************************************************************************
 237 %*                                                                      *
 238 \subsection[Top-level/local]{Top-level/not-top level flag}
 239 %*                                                                      *
 240 %************************************************************************
 241
 242 \begin{code}
 243 data TopLevelFlag
 244   = TopLevel
 245   | NotTopLevel
 246
 247 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 248
 249 isNotTopLevel NotTopLevel = True
 250 isNotTopLevel TopLevel    = False
 251
 252 isTopLevel TopLevel     = True
 253 isTopLevel NotTopLevel  = False
 254
 255 instance Outputable TopLevelFlag where
 256   ppr TopLevel    = ptext SLIT("<TopLevel>")
 257   ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
 258 \end{code}
 259
 260
 261 %************************************************************************
 262 %*                                                                      *
 263 \subsection[Top-level/local]{Top-level/not-top level flag}
 264 %*                                                                      *
 265 %************************************************************************
 266
 267 \begin{code}
 268 data Boxity
 269   = Boxed
 270   | Unboxed
 271   deriving( Eq )
 272
 273 isBoxed :: Boxity -> Bool
 274 isBoxed Boxed   = True
 275 isBoxed Unboxed = False
 276 \end{code}
 277
 278
 279 %************************************************************************
 280 %*                                                                      *
 281 \subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag}
 282 %*                                                                      *
 283 %************************************************************************
 284
 285 \begin{code}
 286 data RecFlag = Recursive
 287              | NonRecursive
 288              deriving( Eq )
 289
 290 isRec :: RecFlag -> Bool
 291 isRec Recursive    = True
 292 isRec NonRecursive = False
 293
 294 isNonRec :: RecFlag -> Bool
 295 isNonRec Recursive    = False
 296 isNonRec NonRecursive = True
 297
 298 boolToRecFlag :: Bool -> RecFlag
 299 boolToRecFlag True  = Recursive
 300 boolToRecFlag False = NonRecursive
 301
 302 instance Outputable RecFlag where
 303   ppr Recursive    = ptext SLIT("Recursive")
 304   ppr NonRecursive = ptext SLIT("NonRecursive")
 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 tupParens :: TupCon -> SDoc -> SDoc
 320 tupParens (TupCon b _) p = tupleParens b p
 321
 322 tupleParens :: Boxity -> SDoc -> SDoc
 323 tupleParens Boxed   p = parens p
 324 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
 325 \end{code}
 326
 327 %************************************************************************
 328 %*                                                                      *
 329 \subsection[Generic]{Generic flag}
 330 %*                                                                      *
 331 %************************************************************************
 332
 333 This is the "Embedding-Projection pair" datatype, it contains
 334 two pieces of code (normally either RenamedExpr's or Id's)
 335 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 336 represents functions of type
 337
 338         from :: T -> Tring
 339         to   :: Tring -> T
 340
 341 And we should have
 342
 343         to (from x) = x
 344
 345 T and Tring are arbitrary, but typically T is the 'main' type while
 346 Tring is the 'representation' type.  (This just helps us remember
 347 whether to use 'from' or 'to'.
 348
 349 \begin{code}
 350 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 351                  toEP   :: a }  -- :: Tring -> T
 352 \end{code}
 353
 354 Embedding-projection pairs are used in several places:
 355
 356 First of all, each type constructor has an EP associated with it, the
 357 code in EP converts (datatype T) from T to Tring and back again.
 358
 359 Secondly, when we are filling in Generic methods (in the typechecker,
 360 tcMethodBinds), we are constructing bimaps by induction on the structure
 361 of the type of the method signature.
 362
 363
 364 %************************************************************************
 365 %*                                                                      *
 366 \subsection{Occurrence information}
 367 %*                                                                      *
 368 %************************************************************************
 369
 370 This data type is used exclusively by the simplifier, but it appears in a
 371 SubstResult, which is currently defined in VarEnv, which is pretty near
 372 the base of the module hierarchy.  So it seemed simpler to put the
 373 defn of OccInfo here, safely at the bottom
 374
 375 \begin{code}
 376 data OccInfo
 377   = NoOccInfo
 378
 379   | IAmDead             -- Marks unused variables.  Sometimes useful for
 380                         -- lambda and case-bound variables.
 381
 382   | OneOcc InsideLam
 383
 384            OneBranch
 385
 386   | IAmALoopBreaker     -- Used by the occurrence analyser to mark loop-breakers
 387                         -- in a group of recursive definitions
 388
 389 seqOccInfo :: OccInfo -> ()
 390 seqOccInfo (OneOcc in_lam once) = in_lam `seq` once `seq` ()
 391 seqOccInfo occ                  = ()
 392
 393 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 394                         -- Substituting a redex for this occurrence is
 395                         -- dangerous because it might duplicate work.
 396 insideLam    = True
 397 notInsideLam = False
 398
 399 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 400                         --      so no code-duplication issue to worry about
 401 oneBranch    = True
 402 notOneBranch = False
 403
 404 isLoopBreaker :: OccInfo -> Bool
 405 isLoopBreaker IAmALoopBreaker = True
 406 isLoopBreaker other           = False
 407
 408 isDeadOcc :: OccInfo -> Bool
 409 isDeadOcc IAmDead = True
 410 isDeadOcc other   = False
 411
 412 isOneOcc (OneOcc _ _) = True
 413 isOneOcc other        = False
 414
 415 isFragileOcc :: OccInfo -> Bool
 416 isFragileOcc (OneOcc _ _) = True
 417 isFragileOcc other        = False
 418 \end{code}
 419
 420 \begin{code}
 421 instance Outputable OccInfo where
 422   -- only used for debugging; never parsed.  KSW 1999-07
 423   ppr NoOccInfo                                   = empty
 424   ppr IAmALoopBreaker                             = ptext SLIT("_Kx")
 425   ppr IAmDead                                     = ptext SLIT("_Kd")
 426   ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("_Kl")
 427                                      | one_branch = ptext SLIT("_Ks")
 428                                      | otherwise  = ptext SLIT("_Ks*")
 429
 430 instance Show OccInfo where
 431   showsPrec p occ = showsPrecSDoc p (ppr occ)
 432 \end{code}
 433
 434 %************************************************************************
 435 %*                                                                      *
 436 \subsection{Strictness indication}
 437 %*                                                                      *
 438 %************************************************************************
 439
 440 The strictness annotations on types in data type declarations
 441 e.g.    data T = MkT !Int !(Bool,Bool)
 442
 443 \begin{code}
 444 data StrictnessMark     -- Used in interface decls only
 445    = MarkedStrict
 446    | MarkedUnboxed
 447    | NotMarkedStrict
 448    deriving( Eq )
 449
 450 isMarkedUnboxed MarkedUnboxed = True
 451 isMarkedUnboxed other         = False
 452
 453 isMarkedStrict NotMarkedStrict = False
 454 isMarkedStrict other           = True   -- All others are strict
 455
 456 instance Outputable StrictnessMark where
 457   ppr MarkedStrict     = ptext SLIT("!")
 458   ppr MarkedUnboxed    = ptext SLIT("!!")
 459   ppr NotMarkedStrict  = ptext SLIT("_")
 460 \end{code}
 461
 462
 463 %************************************************************************
 464 %*                                                                      *
 465 \subsection{Success flag}
 466 %*                                                                      *
 467 %************************************************************************
 468
 469 \begin{code}
 470 data SuccessFlag = Succeeded | Failed
 471
 472 successIf :: Bool -> SuccessFlag
 473 successIf True  = Succeeded
 474 successIf False = Failed
 475
 476 succeeded, failed :: SuccessFlag -> Bool
 477 succeeded Succeeded = True
 478 succeeded Failed    = False
 479
 480 failed Succeeded = False
 481 failed Failed    = True
 482 \end{code}
 483
 484
 485 %************************************************************************
 486 %*                                                                      *
 487 \subsection{Activation}
 488 %*                                                                      *
 489 %************************************************************************
 490
 491 When a rule or inlining is active
 492
 493 \begin{code}
 494 type CompilerPhase = Int        -- Compilation phase
 495                                 -- Phases decrease towards zero
 496                                 -- Zero is the last phase
 497
 498 data Activation = NeverActive
 499                 | AlwaysActive
 500                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 501                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 502                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 503
 504 instance Outputable Activation where
 505    ppr AlwaysActive     = empty         -- The default
 506    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 507    ppr (ActiveAfter n)  = brackets (int n)
 508    ppr NeverActive      = ptext SLIT("NEVER")
 509
 510 isActive :: CompilerPhase -> Activation -> Bool
 511 isActive p NeverActive      = False
 512 isActive p AlwaysActive     = True
 513 isActive p (ActiveAfter n)  = p <= n
 514 isActive p (ActiveBefore n) = p >  n
 515
 516 isNeverActive, isAlwaysActive :: Activation -> Bool
 517 isNeverActive NeverActive = True
 518 isNeverActive act         = False
 519
 520 isAlwaysActive AlwaysActive = True
 521 isAlwaysActive other        = False
 522 \end{code}
 523