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