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         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 seqOccInfo :: OccInfo -> ()
 344 seqOccInfo occ = occ `seq` ()
 345
 346 -----------------
 347 type InterestingCxt = Bool      -- True <=> Function: is applied
 348                                 --          Data value: scrutinised by a case with
 349                                 --                      at least one non-DEFAULT branch
 350
 351 -----------------
 352 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 353                         -- Substituting a redex for this occurrence is
 354                         -- dangerous because it might duplicate work.
 355 insideLam    = True
 356 notInsideLam = False
 357
 358 -----------------
 359 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 360                         --      so no code-duplication issue to worry about
 361 oneBranch    = True
 362 notOneBranch = False
 363
 364 isLoopBreaker :: OccInfo -> Bool
 365 isLoopBreaker IAmALoopBreaker = True
 366 isLoopBreaker other           = False
 367
 368 isDeadOcc :: OccInfo -> Bool
 369 isDeadOcc IAmDead = True
 370 isDeadOcc other   = False
 371
 372 isOneOcc (OneOcc _ _ _) = True
 373 isOneOcc other          = False
 374
 375 isFragileOcc :: OccInfo -> Bool
 376 isFragileOcc (OneOcc _ _ _) = True
 377 isFragileOcc other          = False
 378 \end{code}
 379
 380 \begin{code}
 381 instance Outputable OccInfo where
 382   -- only used for debugging; never parsed.  KSW 1999-07
 383   ppr NoOccInfo                                   = empty
 384   ppr IAmALoopBreaker                             = ptext SLIT("LoopBreaker")
 385   ppr IAmDead                                     = ptext SLIT("Dead")
 386   ppr (OneOcc inside_lam one_branch int_cxt)
 387         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 388         where
 389           pp_lam | inside_lam = char 'L'
 390                  | otherwise  = empty
 391           pp_br  | one_branch = empty
 392                  | otherwise  = char '*'
 393           pp_args | int_cxt   = char '!'
 394                   | otherwise = empty
 395
 396 instance Show OccInfo where
 397   showsPrec p occ = showsPrecSDoc p (ppr occ)
 398 \end{code}
 399
 400 %************************************************************************
 401 %*                                                                      *
 402 \subsection{Strictness indication}
 403 %*                                                                      *
 404 %************************************************************************
 405
 406 The strictness annotations on types in data type declarations
 407 e.g.    data T = MkT !Int !(Bool,Bool)
 408
 409 \begin{code}
 410 data StrictnessMark     -- Used in interface decls only
 411    = MarkedStrict
 412    | MarkedUnboxed
 413    | NotMarkedStrict
 414    deriving( Eq )
 415
 416 isMarkedUnboxed MarkedUnboxed = True
 417 isMarkedUnboxed other         = False
 418
 419 isMarkedStrict NotMarkedStrict = False
 420 isMarkedStrict other           = True   -- All others are strict
 421
 422 instance Outputable StrictnessMark where
 423   ppr MarkedStrict     = ptext SLIT("!")
 424   ppr MarkedUnboxed    = ptext SLIT("!!")
 425   ppr NotMarkedStrict  = ptext SLIT("_")
 426 \end{code}
 427
 428
 429 %************************************************************************
 430 %*                                                                      *
 431 \subsection{Success flag}
 432 %*                                                                      *
 433 %************************************************************************
 434
 435 \begin{code}
 436 data SuccessFlag = Succeeded | Failed
 437
 438 successIf :: Bool -> SuccessFlag
 439 successIf True  = Succeeded
 440 successIf False = Failed
 441
 442 succeeded, failed :: SuccessFlag -> Bool
 443 succeeded Succeeded = True
 444 succeeded Failed    = False
 445
 446 failed Succeeded = False
 447 failed Failed    = True
 448 \end{code}
 449
 450
 451 %************************************************************************
 452 %*                                                                      *
 453 \subsection{Activation}
 454 %*                                                                      *
 455 %************************************************************************
 456
 457 When a rule or inlining is active
 458
 459 \begin{code}
 460 type CompilerPhase = Int        -- Compilation phase
 461                                 -- Phases decrease towards zero
 462                                 -- Zero is the last phase
 463
 464 data Activation = NeverActive
 465                 | AlwaysActive
 466                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 467                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 468                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 469
 470 data InlineSpec
 471   = Inline
 472         Activation      -- Says during which phases inlining is allowed
 473         Bool            -- True <=> make the RHS look small, so that when inlining
 474                         --          is enabled, it will definitely actually happen
 475   deriving( Eq )
 476
 477 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 478 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 479 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 480
 481 instance Outputable Activation where
 482    ppr AlwaysActive     = empty         -- The default
 483    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 484    ppr (ActiveAfter n)  = brackets (int n)
 485    ppr NeverActive      = ptext SLIT("NEVER")
 486
 487 instance Outputable InlineSpec where
 488    ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
 489    ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
 490
 491 isActive :: CompilerPhase -> Activation -> Bool
 492 isActive p NeverActive      = False
 493 isActive p AlwaysActive     = True
 494 isActive p (ActiveAfter n)  = p <= n
 495 isActive p (ActiveBefore n) = p >  n
 496
 497 isNeverActive, isAlwaysActive :: Activation -> Bool
 498 isNeverActive NeverActive = True
 499 isNeverActive act         = False
 500
 501 isAlwaysActive AlwaysActive = True
 502 isAlwaysActive other        = False
 503 \end{code}
 504