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, isNonRuleLoopBreaker, 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              -- Occurs exactly once, not inside a rule
 376         !InsideLam
 377         !OneBranch
 378         !InterestingCxt
 379
 380   | IAmALoopBreaker     -- Used by the occurrence analyser to mark loop-breakers
 381                         -- in a group of recursive definitions
 382         !Bool           -- True <=> This loop breaker occurs only the RHS of a RULE
 383 \end{code}
 384
 385 Note [RulesOnly]
 386 ~~~~~~~~~~~~~~~~
 387 The RulesOnly constructor records if an Id occurs only in the RHS of a Rule.
 388 Similarly, the boolean in IAmLoopbreaker True if the only reason the Id is a
 389 loop-breaker only because of recursion through a RULE. In that case,
 390 we can ignore the loop-breaker-ness for inlining purposes.  Example
 391 (from GHC.Enum):
 392
 393   eftInt :: Int# -> Int# -> [Int]
 394   eftInt x y = ...(non-recursive)...
 395
 396   {-# INLINE [0] eftIntFB #-}
 397   eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
 398   eftIntFB c n x y = ...(non-recursive)...
 399
 400   {-# RULES
 401   "eftInt"  [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
 402   "eftIntList"  [1] eftIntFB  (:) [] = eftInt
 403    #-}
 404
 405 The two look mutually recursive only because of their RULES;
 406 we don't want that to inhibit inlining!
 407
 408 \begin{code}
 409 isNoOcc :: OccInfo -> Bool
 410 isNoOcc NoOccInfo = True
 411 isNoOcc other     = False
 412
 413 seqOccInfo :: OccInfo -> ()
 414 seqOccInfo occ = occ `seq` ()
 415
 416 -----------------
 417 type InterestingCxt = Bool      -- True <=> Function: is applied
 418                                 --          Data value: scrutinised by a case with
 419                                 --                      at least one non-DEFAULT branch
 420
 421 -----------------
 422 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 423                         -- Substituting a redex for this occurrence is
 424                         -- dangerous because it might duplicate work.
 425 insideLam    = True
 426 notInsideLam = False
 427
 428 -----------------
 429 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 430                         --      so no code-duplication issue to worry about
 431 oneBranch    = True
 432 notOneBranch = False
 433
 434 isLoopBreaker :: OccInfo -> Bool
 435 isLoopBreaker (IAmALoopBreaker _) = True
 436 isLoopBreaker other               = False
 437
 438 isNonRuleLoopBreaker :: OccInfo -> Bool
 439 isNonRuleLoopBreaker (IAmALoopBreaker False) = True     -- Loop-breaker that breaks a non-rule cycle
 440 isNonRuleLoopBreaker other                   = False
 441
 442 isDeadOcc :: OccInfo -> Bool
 443 isDeadOcc IAmDead = True
 444 isDeadOcc other   = False
 445
 446 isOneOcc (OneOcc _ _ _) = True
 447 isOneOcc other          = False
 448
 449 isFragileOcc :: OccInfo -> Bool
 450 isFragileOcc (OneOcc _ _ _) = True
 451 isFragileOcc other          = False
 452 \end{code}
 453
 454 \begin{code}
 455 instance Outputable OccInfo where
 456   -- only used for debugging; never parsed.  KSW 1999-07
 457   ppr NoOccInfo            = empty
 458   ppr RulesOnly            = ptext SLIT("RulesOnly")
 459   ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty
 460   ppr IAmDead              = ptext SLIT("Dead")
 461   ppr (OneOcc inside_lam one_branch int_cxt)
 462         = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
 463         where
 464           pp_lam | inside_lam = char 'L'
 465                  | otherwise  = empty
 466           pp_br  | one_branch = empty
 467                  | otherwise  = char '*'
 468           pp_args | int_cxt   = char '!'
 469                   | otherwise = empty
 470
 471 instance Show OccInfo where
 472   showsPrec p occ = showsPrecSDoc p (ppr occ)
 473 \end{code}
 474
 475 %************************************************************************
 476 %*                                                                      *
 477 \subsection{Strictness indication}
 478 %*                                                                      *
 479 %************************************************************************
 480
 481 The strictness annotations on types in data type declarations
 482 e.g.    data T = MkT !Int !(Bool,Bool)
 483
 484 \begin{code}
 485 data StrictnessMark     -- Used in interface decls only
 486    = MarkedStrict
 487    | MarkedUnboxed
 488    | NotMarkedStrict
 489    deriving( Eq )
 490
 491 isMarkedUnboxed MarkedUnboxed = True
 492 isMarkedUnboxed other         = False
 493
 494 isMarkedStrict NotMarkedStrict = False
 495 isMarkedStrict other           = True   -- All others are strict
 496
 497 instance Outputable StrictnessMark where
 498   ppr MarkedStrict     = ptext SLIT("!")
 499   ppr MarkedUnboxed    = ptext SLIT("!!")
 500   ppr NotMarkedStrict  = ptext SLIT("_")
 501 \end{code}
 502
 503
 504 %************************************************************************
 505 %*                                                                      *
 506 \subsection{Success flag}
 507 %*                                                                      *
 508 %************************************************************************
 509
 510 \begin{code}
 511 data SuccessFlag = Succeeded | Failed
 512
 513 successIf :: Bool -> SuccessFlag
 514 successIf True  = Succeeded
 515 successIf False = Failed
 516
 517 succeeded, failed :: SuccessFlag -> Bool
 518 succeeded Succeeded = True
 519 succeeded Failed    = False
 520
 521 failed Succeeded = False
 522 failed Failed    = True
 523 \end{code}
 524
 525
 526 %************************************************************************
 527 %*                                                                      *
 528 \subsection{Activation}
 529 %*                                                                      *
 530 %************************************************************************
 531
 532 When a rule or inlining is active
 533
 534 \begin{code}
 535 type CompilerPhase = Int        -- Compilation phase
 536                                 -- Phases decrease towards zero
 537                                 -- Zero is the last phase
 538
 539 data Activation = NeverActive
 540                 | AlwaysActive
 541                 | ActiveBefore CompilerPhase    -- Active only *before* this phase
 542                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 543                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 544
 545 data InlineSpec
 546   = Inline
 547         Activation      -- Says during which phases inlining is allowed
 548         Bool            -- True <=> make the RHS look small, so that when inlining
 549                         --          is enabled, it will definitely actually happen
 550   deriving( Eq )
 551
 552 defaultInlineSpec = Inline AlwaysActive False   -- Inlining is OK, but not forced
 553 alwaysInlineSpec  = Inline AlwaysActive True    -- INLINE always
 554 neverInlineSpec   = Inline NeverActive  False   -- NOINLINE
 555
 556 instance Outputable Activation where
 557    ppr AlwaysActive     = empty         -- The default
 558    ppr (ActiveBefore n) = brackets (char '~' <> int n)
 559    ppr (ActiveAfter n)  = brackets (int n)
 560    ppr NeverActive      = ptext SLIT("NEVER")
 561
 562 instance Outputable InlineSpec where
 563    ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
 564    ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
 565
 566 isActive :: CompilerPhase -> Activation -> Bool
 567 isActive p NeverActive      = False
 568 isActive p AlwaysActive     = True
 569 isActive p (ActiveAfter n)  = p <= n
 570 isActive p (ActiveBefore n) = p >  n
 571
 572 isNeverActive, isAlwaysActive :: Activation -> Bool
 573 isNeverActive NeverActive = True
 574 isNeverActive act         = False
 575
 576 isAlwaysActive AlwaysActive = True
 577 isAlwaysActive other        = False
 578 \end{code}
 579