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         OverlapFlag(..),
  35
  36         Boxity(..), isBoxed,
  37
  38         TupCon(..), tupleParens,
  39
  40         OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
  41         isDeadOcc, isLoopBreaker, isNoOcc,
  42
  43         InsideLam, insideLam, notInsideLam,
  44         OneBranch, oneBranch, notOneBranch,
  45         InterestingCxt,
  46
  47         EP(..),
  48
  49         StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
  50
  51         CompilerPhase,
  52         Activation(..), isActive, isNeverActive, isAlwaysActive,
  53         InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
  54
  55         SuccessFlag(..), succeeded, failed, successIf
  56    ) where
  57
  58 #include "HsVersions.h"
  59
  60 import FastString( FastString )
  61 import Outputable
  62 \end{code}
  63
  64 %************************************************************************
  65 %*                                                                      *
  66 \subsection[Arity]{Arity}
  67 %*                                                                      *
  68 %************************************************************************
  69
  70 \begin{code}
  71 type Arity = Int
  72 \end{code}
  73
  74
  75 %************************************************************************
  76 %*                                                                      *
  77 \subsection[Version]{Module and identifier version numbers}
  78 %*                                                                      *
  79 %************************************************************************
  80
  81 \begin{code}
  82 type Version = Int
  83
  84 bumpVersion :: Version -> Version
  85 bumpVersion v = v+1
  86
  87 initialVersion :: Version
  88 initialVersion = 1
  89 \end{code}
  90
  91 %************************************************************************
  92 %*                                                                      *
  93                 Deprecations
  94 %*                                                                      *
  95 %************************************************************************
  96
  97
  98 \begin{code}
  99 type DeprecTxt = FastString     -- reason/explanation for deprecation
 100 \end{code}
 101
 102 %************************************************************************
 103 %*                                                                      *
 104 \subsection{Implicit parameter identity}
 105 %*                                                                      *
 106 %************************************************************************
 107
 108 The @IPName@ type is here because it is used in TypeRep (i.e. very
 109 early in the hierarchy), but also in HsSyn.
 110
 111 \begin{code}
 112 newtype IPName name = IPName name       -- ?x
 113   deriving( Eq, Ord )   -- Ord is used in the IP name cache finite map
 114                         --      (used in HscTypes.OrigIParamCache)
 115
 116 ipNameName :: IPName name -> name
 117 ipNameName (IPName n) = n
 118
 119 mapIPName :: (a->b) -> IPName a -> IPName b
 120 mapIPName f (IPName n) = IPName (f n)
 121
 122 instance Outputable name => Outputable (IPName name) where
 123     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
 124 \end{code}
 125
 126
 127 %************************************************************************
 128 %*                                                                      *
 129 \subsection[Fixity]{Fixity info}
 130 %*                                                                      *
 131 %************************************************************************
 132
 133 \begin{code}
 134 ------------------------
 135 data Fixity = Fixity Int FixityDirection
 136
 137 instance Outputable Fixity where
 138     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 139
 140 instance Eq Fixity where                -- Used to determine if two fixities conflict
 141   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 142
 143 ------------------------
 144 data FixityDirection = InfixL | InfixR | InfixN
 145                      deriving(Eq)
 146
 147 instance Outputable FixityDirection where
 148     ppr InfixL = ptext SLIT("infixl")
 149     ppr InfixR = ptext SLIT("infixr")
 150     ppr InfixN = ptext SLIT("infix")
 151
 152 ------------------------
 153 maxPrecedence = (9::Int)
 154 defaultFixity = Fixity maxPrecedence InfixL
 155
 156 negateFixity, funTyFixity :: Fixity
 157 -- Wired-in fixities
 158 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
 159 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
 160 \end{code}
 161
 162 Consider
 163
 164 \begin{verbatim}
 165         a `op1` b `op2` c
 166 \end{verbatim}
 167 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 168 whether there's an error.
 169
 170 \begin{code}
 171 compareFixity :: Fixity -> Fixity
 172               -> (Bool,         -- Error please
 173                   Bool)         -- Associate to the right: a op1 (b op2 c)
 174 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 175   = case prec1 `compare` prec2 of
 176         GT -> left
 177         LT -> right
 178         EQ -> case (dir1, dir2) of
 179                         (InfixR, InfixR) -> right
 180                         (InfixL, InfixL) -> left
 181                         _                -> error_please
 182   where
 183     right        = (False, True)
 184     left         = (False, False)
 185     error_please = (True,  False)
 186 \end{code}
 187
 188
 189 %************************************************************************
 190 %*                                                                      *
 191 \subsection[Top-level/local]{Top-level/not-top level flag}
 192 %*                                                                      *
 193 %************************************************************************
 194
 195 \begin{code}
 196 data TopLevelFlag
 197   = TopLevel
 198   | NotTopLevel
 199
 200 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 201
 202 isNotTopLevel NotTopLevel = True
 203 isNotTopLevel TopLevel    = False
 204
 205 isTopLevel TopLevel     = True
 206 isTopLevel NotTopLevel  = False
 207
 208 instance Outputable TopLevelFlag where
 209   ppr TopLevel    = ptext SLIT("<TopLevel>")
 210   ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
 211 \end{code}
 212
 213
 214 %************************************************************************
 215 %*                                                                      *
 216                 Top-level/not-top level flag
 217 %*                                                                      *
 218 %************************************************************************
 219
 220 \begin{code}
 221 data Boxity
 222   = Boxed
 223   | Unboxed
 224   deriving( Eq )
 225
 226 isBoxed :: Boxity -> Bool
 227 isBoxed Boxed   = True
 228 isBoxed Unboxed = False
 229 \end{code}
 230
 231
 232 %************************************************************************
 233 %*                                                                      *
 234                 Recursive/Non-Recursive flag
 235 %*                                                                      *
 236 %************************************************************************
 237
 238 \begin{code}
 239 data RecFlag = Recursive
 240              | NonRecursive
 241              deriving( Eq )
 242
 243 isRec :: RecFlag -> Bool
 244 isRec Recursive    = True
 245 isRec NonRecursive = False
 246
 247 isNonRec :: RecFlag -> Bool
 248 isNonRec Recursive    = False
 249 isNonRec NonRecursive = True
 250
 251 boolToRecFlag :: Bool -> RecFlag
 252 boolToRecFlag True  = Recursive
 253 boolToRecFlag False = NonRecursive
 254
 255 instance Outputable RecFlag where
 256   ppr Recursive    = ptext SLIT("Recursive")
 257   ppr NonRecursive = ptext SLIT("NonRecursive")
 258 \end{code}
 259
 260 %************************************************************************
 261 %*                                                                      *
 262                 Instance overlap flag
 263 %*                                                                      *
 264 %************************************************************************
 265
 266 \begin{code}
 267 data OverlapFlag
 268   = NoOverlap   -- This instance must not overlap another
 269
 270   | OverlapOk   -- Silently ignore this instance if you find a
 271                 -- more specific one that matches the constraint
 272                 -- you are trying to resolve
 273                 --
 274                 -- Example: constraint (Foo [Int])
 275                 --          instances  (Foo [Int])
 276                 --                     (Foo [a])        OverlapOk
 277                 -- Since the second instance has the OverlapOk flag,
 278                 -- the first instance will be chosen (otherwise
 279                 -- its ambiguous which to choose)
 280
 281   | Incoherent  -- Like OverlapOk, but also ignore this instance
 282                 -- if it doesn't match the constraint you are
 283                 -- trying to resolve, but could match if the type variables
 284                 -- in the constraint were instantiated
 285                 --
 286                 -- Example: constraint (Foo [b])
 287                 --          instances  (Foo [Int])      Incoherent
 288                 --                     (Foo [a])
 289                 -- Without the Incoherent flag, we'd complain that
 290                 -- instantiating 'b' would change which instance
 291                 -- was chosen
 292   deriving( Eq )
 293
 294 instance Outputable OverlapFlag where
 295    ppr NoOverlap  = empty
 296    ppr OverlapOk  = ptext SLIT("[overlap ok]")
 297    ppr Incoherent = ptext SLIT("[incoherent]")
 298
 299 \end{code}
 300
 301 %************************************************************************
 302 %*                                                                      *
 303                 Tuples
 304 %*                                                                      *
 305 %************************************************************************
 306
 307 \begin{code}
 308 data TupCon = TupCon Boxity Arity
 309
 310 instance Eq TupCon where
 311   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
 312
 313 tupleParens :: Boxity -> SDoc -> SDoc
 314 tupleParens Boxed   p = parens p
 315 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
 316 \end{code}
 317
 318 %************************************************************************
 319 %*                                                                      *
 320 \subsection[Generic]{Generic flag}
 321 %*                                                                      *
 322 %************************************************************************
 323
 324 This is the "Embedding-Projection pair" datatype, it contains
 325 two pieces of code (normally either RenamedExpr's or Id's)
 326 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 327 represents functions of type
 328
 329         from :: T -> Tring
 330         to   :: Tring -> T
 331
 332 And we should have
 333
 334         to (from x) = x
 335
 336 T and Tring are arbitrary, but typically T is the 'main' type while
 337 Tring is the 'representation' type.  (This just helps us remember
 338 whether to use 'from' or 'to'.
 339
 340 \begin{code}
 341 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 342                  toEP   :: a }  -- :: Tring -> T
 343 \end{code}
 344
 345 Embedding-projection pairs are used in several places:
 346
 347 First of all, each type constructor has an EP associated with it, the
 348 code in EP converts (datatype T) from T to Tring and back again.
 349
 350 Secondly, when we are filling in Generic methods (in the typechecker,
 351 tcMethodBinds), we are constructing bimaps by induction on the structure
 352 of the type of the method signature.
 353
 354
 355 %************************************************************************
 356 %*                                                                      *
 357 \subsection{Occurrence information}
 358 %*                                                                      *
 359 %************************************************************************
 360
 361 This data type is used exclusively by the simplifier, but it appears in a
 362 SubstResult, which is currently defined in VarEnv, which is pretty near
 363 the base of the module hierarchy.  So it seemed simpler to put the
 364 defn of OccInfo here, safely at the bottom
 365
 366 \begin{code}
 367 data OccInfo
 368   = NoOccInfo           -- Many occurrences, or unknown
 369
 370   | RulesOnly           -- Occurs only in the RHS of one or more rules
 371
 372   | IAmDead             -- Marks unused variables.  Sometimes useful for
 373                         -- lambda and case-bound variables.
 374
 375   | OneOcc !InsideLam   -- Occurs exactly once, not inside a rule
 376            !OneBranch
 377            !InterestingCxt
 378
 379   | IAmALoopBreaker     -- Used by the occurrence analyser to mark loop-breakers
 380                         -- in a group of recursive definitions
 381
 382 isNoOcc :: OccInfo -> Bool
 383 isNoOcc NoOccInfo = True
 384 isNoOcc other     = False
 385
 386 seqOccInfo :: OccInfo -> ()
 387 seqOccInfo occ = occ `seq` ()
 388
 389 -----------------
 390 type InterestingCxt = Bool      -- True <=> Function: is applied
 391                                 --          Data value: scrutinised by a case with
 392                                 --                      at least one non-DEFAULT branch
 393
 394 -----------------
 395 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 396                         -- Substituting a redex for this occurrence is
 397                         -- dangerous because it might duplicate work.
 398 insideLam    = True
 399 notInsideLam = False
 400
 401 -----------------
 402 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 403                         --      so no code-duplication issue to worry about
 404 oneBranch    = True
 405 notOneBranch = False
 406
 407 isLoopBreaker :: OccInfo -> Bool
 408 isLoopBreaker IAmALoopBreaker = True
 409 isLoopBreaker other           = False
 410
 411 isDeadOcc :: OccInfo -> Bool
 412 isDeadOcc IAmDead = True
 413 isDeadOcc other   = False
 414
 415 isOneOcc (OneOcc _ _ _) = True
 416 isOneOcc other          = False
 417
 418 isFragileOcc :: OccInfo -> Bool
 419 isFragileOcc (OneOcc _ _ _) = True
 420 isFragileOcc other          = False
 421 \end{code}
 422
 423 \begin{code}
 424 instance Outputable OccInfo where
 425   -- only used for debugging; never parsed.  KSW 1999-07
 426   ppr NoOccInfo                                   = empty
 427   ppr RulesOnly                                   = ptext SLIT("RulesOnly")
 428   ppr IAmALoopBreaker                             = ptext SLIT("LoopBreaker")
 429   ppr IAmDead                                     = ptext SLIT("Dead")
 430   ppr (OneOcc inside_lam one_branch int_cxt)
 431         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 432         where
 433           pp_lam | inside_lam = char 'L'
 434                  | otherwise  = empty
 435           pp_br  | one_branch = empty
 436                  | otherwise  = char '*'
 437           pp_args | int_cxt   = char '!'
 438                   | otherwise = empty
 439
 440 instance Show OccInfo where
 441   showsPrec p occ = showsPrecSDoc p (ppr occ)
 442 \end{code}
 443
 444 %************************************************************************
 445 %*                                                                      *
 446 \subsection{Strictness indication}
 447 %*                                                                      *
 448 %************************************************************************
 449
 450 The strictness annotations on types in data type declarations
 451 e.g.    data T = MkT !Int !(Bool,Bool)
 452
 453 \begin{code}
 454 data StrictnessMark     -- Used in interface decls only
 455    = MarkedStrict
 456    | MarkedUnboxed
 457    | NotMarkedStrict
 458    deriving( Eq )
 459
 460 isMarkedUnboxed MarkedUnboxed = True
 461 isMarkedUnboxed other         = False
 462
 463 isMarkedStrict NotMarkedStrict = False
 464 isMarkedStrict other           = True   -- All others are strict
 465
 466 instance Outputable StrictnessMark where
 467   ppr MarkedStrict     = ptext SLIT("!")
 468   ppr MarkedUnboxed    = ptext SLIT("!!")
 469   ppr NotMarkedStrict  = ptext SLIT("_")
 470 \end{code}
 471
 472
 473 %************************************************************************
 474 %*                                                                      *
 475 \subsection{Success flag}
 476 %*                                                                      *
 477 %************************************************************************
 478
 479 \begin{code}
 480 data SuccessFlag = Succeeded | Failed
 481
 482 successIf :: Bool -> SuccessFlag
 483 successIf True  = Succeeded
 484 successIf False = Failed
 485
 486 succeeded, failed :: SuccessFlag -> Bool
 487 succeeded Succeeded = True
 488 succeeded Failed    = False
 489
 490 failed Succeeded = False
 491 failed Failed    = True
 492 \end{code}
 493
 494
 495 %************************************************************************
 496 %*                                                                      *
 497 \subsection{Activation}
 498 %*                                                                      *
 499 %************************************************************************
 500
 501 When a rule or inlining is active
 502
 503 \begin{code}
 504 type CompilerPhase = Int        -- Compilation phase
 505                                 -- Phases decrease towards zero
 506                                 -- Zero is the last phase
 507
 508 data Activation = NeverActive
 509                 | AlwaysActive
 510                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 511                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 512                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 513
 514 data InlineSpec
 515   = Inline
 516         Activation      -- Says during which phases inlining is allowed
 517         Bool            -- True <=> make the RHS look small, so that when inlining
 518                         --          is enabled, it will definitely actually happen
 519   deriving( Eq )
 520
 521 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 522 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 523 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 524
 525 instance Outputable Activation where
 526    ppr AlwaysActive     = empty         -- The default
 527    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 528    ppr (ActiveAfter n)  = brackets (int n)
 529    ppr NeverActive      = ptext SLIT("NEVER")
 530
 531 instance Outputable InlineSpec where
 532    ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
 533    ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
 534
 535 isActive :: CompilerPhase -> Activation -> Bool
 536 isActive p NeverActive      = False
 537 isActive p AlwaysActive     = True
 538 isActive p (ActiveAfter n)  = p <= n
 539 isActive p (ActiveBefore n) = p >  n
 540
 541 isNeverActive, isAlwaysActive :: Activation -> Bool
 542 isNeverActive NeverActive = True
 543 isNeverActive act         = False
 544
 545 isAlwaysActive AlwaysActive = True
 546 isAlwaysActive other        = False
 547 \end{code}
 548