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