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