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         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
  44         EP(..),
  45
  46         StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
  47
  48         CompilerPhase,
  49         Activation(..), isActive, isNeverActive, isAlwaysActive,
  50
  51         SuccessFlag(..), succeeded, failed, successIf
  52    ) where
  53
  54 #include "HsVersions.h"
  55
  56 import FastString( FastString )
  57 import Outputable
  58 \end{code}
  59
  60 %************************************************************************
  61 %*                                                                      *
  62 \subsection[Arity]{Arity}
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 \begin{code}
  67 type Arity = Int
  68 \end{code}
  69
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection[Version]{Module and identifier version numbers}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 type Version = Int
  79
  80 bumpVersion :: Version -> Version
  81 bumpVersion v = v+1
  82
  83 initialVersion :: Version
  84 initialVersion = 1
  85 \end{code}
  86
  87 %************************************************************************
  88 %*                                                                      *
  89                 Deprecations
  90 %*                                                                      *
  91 %************************************************************************
  92
  93
  94 \begin{code}
  95 type DeprecTxt = FastString     -- reason/explanation for deprecation
  96 \end{code}
  97
  98 %************************************************************************
  99 %*                                                                      *
 100 \subsection{Implicit parameter identity}
 101 %*                                                                      *
 102 %************************************************************************
 103
 104 The @IPName@ type is here because it is used in TypeRep (i.e. very
 105 early in the hierarchy), but also in HsSyn.
 106
 107 \begin{code}
 108 data IPName name
 109   = Dupable   name      -- ?x: you can freely duplicate this implicit parameter
 110   | Linear name         -- %x: you must use the splitting function to duplicate it
 111   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 112                         --      (used in HscTypes.OrigIParamCache)
 113
 114
 115 ipNameName :: IPName name -> name
 116 ipNameName (Dupable n) = n
 117 ipNameName (Linear  n) = n
 118
 119 mapIPName :: (a->b) -> IPName a -> IPName b
 120 mapIPName f (Dupable n) = Dupable (f n)
 121 mapIPName f (Linear  n) = Linear  (f n)
 122
 123 instance Outputable name => Outputable (IPName name) where
 124     ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters
 125     ppr (Linear  n) = char '%' <> ppr n -- Splittable implicit parameters
 126 \end{code}
 127
 128
 129 %************************************************************************
 130 %*                                                                      *
 131 \subsection[Fixity]{Fixity info}
 132 %*                                                                      *
 133 %************************************************************************
 134
 135 \begin{code}
 136 ------------------------
 137 data Fixity = Fixity Int FixityDirection
 138
 139 instance Outputable Fixity where
 140     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 141
 142 instance Eq Fixity where                -- Used to determine if two fixities conflict
 143   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 144
 145 ------------------------
 146 data FixityDirection = InfixL | InfixR | InfixN
 147                      deriving(Eq)
 148
 149 instance Outputable FixityDirection where
 150     ppr InfixL = ptext SLIT("infixl")
 151     ppr InfixR = ptext SLIT("infixr")
 152     ppr InfixN = ptext SLIT("infix")
 153
 154 ------------------------
 155 maxPrecedence = (9::Int)
 156 defaultFixity = Fixity maxPrecedence InfixL
 157
 158 negateFixity :: Fixity
 159 negateFixity     = Fixity negatePrecedence InfixL       -- Precedence of unary negate is wired in as infixl 6!
 160
 161 negatePrecedence :: Int
 162 negatePrecedence = 6
 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
 337            OneBranch
 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 (OneOcc in_lam once) = in_lam `seq` once `seq` ()
 344 seqOccInfo occ                  = ()
 345
 346 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 347                         -- Substituting a redex for this occurrence is
 348                         -- dangerous because it might duplicate work.
 349 insideLam    = True
 350 notInsideLam = False
 351
 352 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 353                         --      so no code-duplication issue to worry about
 354 oneBranch    = True
 355 notOneBranch = False
 356
 357 isLoopBreaker :: OccInfo -> Bool
 358 isLoopBreaker IAmALoopBreaker = True
 359 isLoopBreaker other           = False
 360
 361 isDeadOcc :: OccInfo -> Bool
 362 isDeadOcc IAmDead = True
 363 isDeadOcc other   = False
 364
 365 isOneOcc (OneOcc _ _) = True
 366 isOneOcc other        = False
 367
 368 isFragileOcc :: OccInfo -> Bool
 369 isFragileOcc (OneOcc _ _) = True
 370 isFragileOcc other        = False
 371 \end{code}
 372
 373 \begin{code}
 374 instance Outputable OccInfo where
 375   -- only used for debugging; never parsed.  KSW 1999-07
 376   ppr NoOccInfo                                   = empty
 377   ppr IAmALoopBreaker                             = ptext SLIT("LoopBreaker")
 378   ppr IAmDead                                     = ptext SLIT("Dead")
 379   ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("OnceInLam")
 380                                      | one_branch = ptext SLIT("Once")
 381                                      | otherwise  = ptext SLIT("OnceEachBranch")
 382
 383 instance Show OccInfo where
 384   showsPrec p occ = showsPrecSDoc p (ppr occ)
 385 \end{code}
 386
 387 %************************************************************************
 388 %*                                                                      *
 389 \subsection{Strictness indication}
 390 %*                                                                      *
 391 %************************************************************************
 392
 393 The strictness annotations on types in data type declarations
 394 e.g.    data T = MkT !Int !(Bool,Bool)
 395
 396 \begin{code}
 397 data StrictnessMark     -- Used in interface decls only
 398    = MarkedStrict
 399    | MarkedUnboxed
 400    | NotMarkedStrict
 401    deriving( Eq )
 402
 403 isMarkedUnboxed MarkedUnboxed = True
 404 isMarkedUnboxed other         = False
 405
 406 isMarkedStrict NotMarkedStrict = False
 407 isMarkedStrict other           = True   -- All others are strict
 408
 409 instance Outputable StrictnessMark where
 410   ppr MarkedStrict     = ptext SLIT("!")
 411   ppr MarkedUnboxed    = ptext SLIT("!!")
 412   ppr NotMarkedStrict  = ptext SLIT("_")
 413 \end{code}
 414
 415
 416 %************************************************************************
 417 %*                                                                      *
 418 \subsection{Success flag}
 419 %*                                                                      *
 420 %************************************************************************
 421
 422 \begin{code}
 423 data SuccessFlag = Succeeded | Failed
 424
 425 successIf :: Bool -> SuccessFlag
 426 successIf True  = Succeeded
 427 successIf False = Failed
 428
 429 succeeded, failed :: SuccessFlag -> Bool
 430 succeeded Succeeded = True
 431 succeeded Failed    = False
 432
 433 failed Succeeded = False
 434 failed Failed    = True
 435 \end{code}
 436
 437
 438 %************************************************************************
 439 %*                                                                      *
 440 \subsection{Activation}
 441 %*                                                                      *
 442 %************************************************************************
 443
 444 When a rule or inlining is active
 445
 446 \begin{code}
 447 type CompilerPhase = Int        -- Compilation phase
 448                                 -- Phases decrease towards zero
 449                                 -- Zero is the last phase
 450
 451 data Activation = NeverActive
 452                 | AlwaysActive
 453                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 454                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 455                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 456
 457 instance Outputable Activation where
 458    ppr AlwaysActive     = empty         -- The default
 459    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 460    ppr (ActiveAfter n)  = brackets (int n)
 461    ppr NeverActive      = ptext SLIT("NEVER")
 462
 463 isActive :: CompilerPhase -> Activation -> Bool
 464 isActive p NeverActive      = False
 465 isActive p AlwaysActive     = True
 466 isActive p (ActiveAfter n)  = p <= n
 467 isActive p (ActiveBefore n) = p >  n
 468
 469 isNeverActive, isAlwaysActive :: Activation -> Bool
 470 isNeverActive NeverActive = True
 471 isNeverActive act         = False
 472
 473 isAlwaysActive AlwaysActive = True
 474 isAlwaysActive other        = False
 475 \end{code}
 476