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