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