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, isNoOcc,
  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         InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
  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, funTyFixity :: Fixity
 161 -- Wired-in fixities
 162 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
 163 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
 164 \end{code}
 165
 166 Consider
 167
 168 \begin{verbatim}
 169         a `op1` b `op2` c
 170 \end{verbatim}
 171 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 172 whether there's an error.
 173
 174 \begin{code}
 175 compareFixity :: Fixity -> Fixity
 176               -> (Bool,         -- Error please
 177                   Bool)         -- Associate to the right: a op1 (b op2 c)
 178 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 179   = case prec1 `compare` prec2 of
 180         GT -> left
 181         LT -> right
 182         EQ -> case (dir1, dir2) of
 183                         (InfixR, InfixR) -> right
 184                         (InfixL, InfixL) -> left
 185                         _                -> error_please
 186   where
 187     right        = (False, True)
 188     left         = (False, False)
 189     error_please = (True,  False)
 190 \end{code}
 191
 192
 193 %************************************************************************
 194 %*                                                                      *
 195 \subsection[Top-level/local]{Top-level/not-top level flag}
 196 %*                                                                      *
 197 %************************************************************************
 198
 199 \begin{code}
 200 data TopLevelFlag
 201   = TopLevel
 202   | NotTopLevel
 203
 204 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 205
 206 isNotTopLevel NotTopLevel = True
 207 isNotTopLevel TopLevel    = False
 208
 209 isTopLevel TopLevel     = True
 210 isTopLevel NotTopLevel  = False
 211
 212 instance Outputable TopLevelFlag where
 213   ppr TopLevel    = ptext SLIT("<TopLevel>")
 214   ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
 215 \end{code}
 216
 217
 218 %************************************************************************
 219 %*                                                                      *
 220 \subsection[Top-level/local]{Top-level/not-top level flag}
 221 %*                                                                      *
 222 %************************************************************************
 223
 224 \begin{code}
 225 data Boxity
 226   = Boxed
 227   | Unboxed
 228   deriving( Eq )
 229
 230 isBoxed :: Boxity -> Bool
 231 isBoxed Boxed   = True
 232 isBoxed Unboxed = False
 233 \end{code}
 234
 235
 236 %************************************************************************
 237 %*                                                                      *
 238 \subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag}
 239 %*                                                                      *
 240 %************************************************************************
 241
 242 \begin{code}
 243 data RecFlag = Recursive
 244              | NonRecursive
 245              deriving( Eq )
 246
 247 isRec :: RecFlag -> Bool
 248 isRec Recursive    = True
 249 isRec NonRecursive = False
 250
 251 isNonRec :: RecFlag -> Bool
 252 isNonRec Recursive    = False
 253 isNonRec NonRecursive = True
 254
 255 boolToRecFlag :: Bool -> RecFlag
 256 boolToRecFlag True  = Recursive
 257 boolToRecFlag False = NonRecursive
 258
 259 instance Outputable RecFlag where
 260   ppr Recursive    = ptext SLIT("Recursive")
 261   ppr NonRecursive = ptext SLIT("NonRecursive")
 262 \end{code}
 263
 264 %************************************************************************
 265 %*                                                                      *
 266                 Tuples
 267 %*                                                                      *
 268 %************************************************************************
 269
 270 \begin{code}
 271 data TupCon = TupCon Boxity Arity
 272
 273 instance Eq TupCon where
 274   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 275
 276 tupleParens :: Boxity -> SDoc -> SDoc
 277 tupleParens Boxed   p = parens p
 278 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
 279 \end{code}
 280
 281 %************************************************************************
 282 %*                                                                      *
 283 \subsection[Generic]{Generic flag}
 284 %*                                                                      *
 285 %************************************************************************
 286
 287 This is the "Embedding-Projection pair" datatype, it contains
 288 two pieces of code (normally either RenamedExpr's or Id's)
 289 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 290 represents functions of type
 291
 292         from :: T -> Tring
 293         to   :: Tring -> T
 294
 295 And we should have
 296
 297         to (from x) = x
 298
 299 T and Tring are arbitrary, but typically T is the 'main' type while
 300 Tring is the 'representation' type.  (This just helps us remember
 301 whether to use 'from' or 'to'.
 302
 303 \begin{code}
 304 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 305                  toEP   :: a }  -- :: Tring -> T
 306 \end{code}
 307
 308 Embedding-projection pairs are used in several places:
 309
 310 First of all, each type constructor has an EP associated with it, the
 311 code in EP converts (datatype T) from T to Tring and back again.
 312
 313 Secondly, when we are filling in Generic methods (in the typechecker,
 314 tcMethodBinds), we are constructing bimaps by induction on the structure
 315 of the type of the method signature.
 316
 317
 318 %************************************************************************
 319 %*                                                                      *
 320 \subsection{Occurrence information}
 321 %*                                                                      *
 322 %************************************************************************
 323
 324 This data type is used exclusively by the simplifier, but it appears in a
 325 SubstResult, which is currently defined in VarEnv, which is pretty near
 326 the base of the module hierarchy.  So it seemed simpler to put the
 327 defn of OccInfo here, safely at the bottom
 328
 329 \begin{code}
 330 data OccInfo
 331   = NoOccInfo
 332
 333   | IAmDead             -- Marks unused variables.  Sometimes useful for
 334                         -- lambda and case-bound variables.
 335
 336   | OneOcc !InsideLam
 337            !OneBranch
 338            !InterestingCxt
 339
 340   | IAmALoopBreaker     -- Used by the occurrence analyser to mark loop-breakers
 341                         -- in a group of recursive definitions
 342
 343 isNoOcc :: OccInfo -> Bool
 344 isNoOcc NoOccInfo = True
 345 isNoOcc other     = False
 346
 347 seqOccInfo :: OccInfo -> ()
 348 seqOccInfo occ = occ `seq` ()
 349
 350 -----------------
 351 type InterestingCxt = Bool      -- True <=> Function: is applied
 352                                 --          Data value: scrutinised by a case with
 353                                 --                      at least one non-DEFAULT branch
 354
 355 -----------------
 356 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 357                         -- Substituting a redex for this occurrence is
 358                         -- dangerous because it might duplicate work.
 359 insideLam    = True
 360 notInsideLam = False
 361
 362 -----------------
 363 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 364                         --      so no code-duplication issue to worry about
 365 oneBranch    = True
 366 notOneBranch = False
 367
 368 isLoopBreaker :: OccInfo -> Bool
 369 isLoopBreaker IAmALoopBreaker = True
 370 isLoopBreaker other           = False
 371
 372 isDeadOcc :: OccInfo -> Bool
 373 isDeadOcc IAmDead = True
 374 isDeadOcc other   = False
 375
 376 isOneOcc (OneOcc _ _ _) = True
 377 isOneOcc other          = False
 378
 379 isFragileOcc :: OccInfo -> Bool
 380 isFragileOcc (OneOcc _ _ _) = True
 381 isFragileOcc other          = False
 382 \end{code}
 383
 384 \begin{code}
 385 instance Outputable OccInfo where
 386   -- only used for debugging; never parsed.  KSW 1999-07
 387   ppr NoOccInfo                                   = empty
 388   ppr IAmALoopBreaker                             = ptext SLIT("LoopBreaker")
 389   ppr IAmDead                                     = ptext SLIT("Dead")
 390   ppr (OneOcc inside_lam one_branch int_cxt)
 391         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 392         where
 393           pp_lam | inside_lam = char 'L'
 394                  | otherwise  = empty
 395           pp_br  | one_branch = empty
 396                  | otherwise  = char '*'
 397           pp_args | int_cxt   = char '!'
 398                   | otherwise = empty
 399
 400 instance Show OccInfo where
 401   showsPrec p occ = showsPrecSDoc p (ppr occ)
 402 \end{code}
 403
 404 %************************************************************************
 405 %*                                                                      *
 406 \subsection{Strictness indication}
 407 %*                                                                      *
 408 %************************************************************************
 409
 410 The strictness annotations on types in data type declarations
 411 e.g.    data T = MkT !Int !(Bool,Bool)
 412
 413 \begin{code}
 414 data StrictnessMark     -- Used in interface decls only
 415    = MarkedStrict
 416    | MarkedUnboxed
 417    | NotMarkedStrict
 418    deriving( Eq )
 419
 420 isMarkedUnboxed MarkedUnboxed = True
 421 isMarkedUnboxed other         = False
 422
 423 isMarkedStrict NotMarkedStrict = False
 424 isMarkedStrict other           = True   -- All others are strict
 425
 426 instance Outputable StrictnessMark where
 427   ppr MarkedStrict     = ptext SLIT("!")
 428   ppr MarkedUnboxed    = ptext SLIT("!!")
 429   ppr NotMarkedStrict  = ptext SLIT("_")
 430 \end{code}
 431
 432
 433 %************************************************************************
 434 %*                                                                      *
 435 \subsection{Success flag}
 436 %*                                                                      *
 437 %************************************************************************
 438
 439 \begin{code}
 440 data SuccessFlag = Succeeded | Failed
 441
 442 successIf :: Bool -> SuccessFlag
 443 successIf True  = Succeeded
 444 successIf False = Failed
 445
 446 succeeded, failed :: SuccessFlag -> Bool
 447 succeeded Succeeded = True
 448 succeeded Failed    = False
 449
 450 failed Succeeded = False
 451 failed Failed    = True
 452 \end{code}
 453
 454
 455 %************************************************************************
 456 %*                                                                      *
 457 \subsection{Activation}
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 When a rule or inlining is active
 462
 463 \begin{code}
 464 type CompilerPhase = Int        -- Compilation phase
 465                                 -- Phases decrease towards zero
 466                                 -- Zero is the last phase
 467
 468 data Activation = NeverActive
 469                 | AlwaysActive
 470                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 471                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 472                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 473
 474 data InlineSpec
 475   = Inline
 476         Activation      -- Says during which phases inlining is allowed
 477         Bool            -- True <=> make the RHS look small, so that when inlining
 478                         --          is enabled, it will definitely actually happen
 479   deriving( Eq )
 480
 481 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 482 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 483 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 484
 485 instance Outputable Activation where
 486    ppr AlwaysActive     = empty         -- The default
 487    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 488    ppr (ActiveAfter n)  = brackets (int n)
 489    ppr NeverActive      = ptext SLIT("NEVER")
 490
 491 instance Outputable InlineSpec where
 492    ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
 493    ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
 494
 495 isActive :: CompilerPhase -> Activation -> Bool
 496 isActive p NeverActive      = False
 497 isActive p AlwaysActive     = True
 498 isActive p (ActiveAfter n)  = p <= n
 499 isActive p (ActiveBefore n) = p >  n
 500
 501 isNeverActive, isAlwaysActive :: Activation -> Bool
 502 isNeverActive NeverActive = True
 503 isNeverActive act         = False
 504
 505 isAlwaysActive AlwaysActive = True
 506 isAlwaysActive other        = False
 507 \end{code}
 508