BasicTypes.hs 37.8 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1997-1998

sof's avatar
sof committed
5 6 7 8 9 10 11 12 13 14
\section[BasicTypes]{Miscellanous types}

This module defines a miscellaneously collection of very simple
types that

\begin{itemize}
\item have no other obvious home
\item don't depend on any other complicated types
\item are used in more than one "part" of the compiler
\end{itemize}
Austin Seipp's avatar
Austin Seipp committed
15
-}
sof's avatar
sof committed
16

17 18
{-# LANGUAGE DeriveDataTypeable #-}

sof's avatar
sof committed
19
module BasicTypes(
20
        Version, bumpVersion, initialVersion,
21

22 23
        ConTag, fIRST_TAG,

24 25 26
        Arity, RepArity,

        Alignment,
27

28
        FunctionOrData(..),
29

30 31 32 33 34 35
        WarningTxt(..),

        Fixity(..), FixityDirection(..),
        defaultFixity, maxPrecedence, minPrecedence,
        negateFixity, funTyFixity,
        compareFixity,
36

37
        RecFlag(..), isRec, isNonRec, boolToRecFlag,
cactus's avatar
cactus committed
38
        Origin(..), isGenerated,
39

40
        RuleName,
41

42
        TopLevelFlag(..), isTopLevel, isNotTopLevel,
43

44
        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
45
        hasOverlappingFlag, hasOverlappableFlag,
46

47
        Boxity(..), isBoxed,
48

batterseapower's avatar
batterseapower committed
49 50
        TupleSort(..), tupleSortBoxity, boxityNormalTupleSort,
        tupleParens,
51

52 53 54 55 56
        -- ** The OneShotInfo type
        OneShotInfo(..),
        noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
        bestOneShot, worstOneShot,

57 58 59
        OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc,
        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isNoOcc,
        strongLoopBreaker, weakLoopBreaker,
60

61 62 63
        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
        InterestingCxt,
64

65 66
        EP(..),

67
        DefMethSpec(..),
68
        SwapFlag(..), flipSwap, unSwap, isSwapped,
69

70 71 72
        CompilerPhase(..), PhaseNum,
        Activation(..), isActive, isActiveIn,
        isNeverActive, isAlwaysActive, isEarlyActive,
73
        RuleMatchInfo(..), isConLike, isFunLike,
mikhail.vorozhtsov's avatar
mikhail.vorozhtsov committed
74
        InlineSpec(..), isEmptyInlineSpec,
75 76 77
        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
        neverInlinePragma, dfunInlinePragma,
        isDefaultInlinePragma,
78
        isInlinePragma, isInlinablePragma, isAnyInlinePragma,
79
        inlinePragmaSpec, inlinePragmaSat,
80 81
        inlinePragmaActivation, inlinePragmaRuleMatchInfo,
        setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
82

83 84
        SuccessFlag(..), succeeded, failed, successIf,

85 86
        FractionalLit(..), negateFractionalLit, integralFractionalLit,

Alan Zimmerman's avatar
Alan Zimmerman committed
87 88 89
        HValue(..),

        SourceText
sof's avatar
sof committed
90 91
   ) where

92
import FastString
sof's avatar
sof committed
93
import Outputable
94
import SrcLoc ( Located,unLoc )
95 96

import Data.Data hiding (Fixity)
97
import Data.Function (on)
98
import GHC.Exts (Any)
99

Austin Seipp's avatar
Austin Seipp committed
100 101 102
{-
************************************************************************
*                                                                      *
sof's avatar
sof committed
103
\subsection[Arity]{Arity}
Austin Seipp's avatar
Austin Seipp committed
104 105 106
*                                                                      *
************************************************************************
-}
sof's avatar
sof committed
107

108 109 110 111
-- | The number of value arguments that can be applied to a value before it does
-- "real work". So:
--  fib 100     has arity 0
--  \x -> fib x has arity 1
sof's avatar
sof committed
112
type Arity = Int
113 114 115 116 117 118 119

-- | The number of represented arguments that can be applied to a value before it does
-- "real work". So:
--  fib 100                    has representation arity 0
--  \x -> fib x                has representation arity 1
--  \(# x, y #) -> fib (x + y) has representation arity 2
type RepArity = Int
sof's avatar
sof committed
120

Austin Seipp's avatar
Austin Seipp committed
121 122 123
{-
************************************************************************
*                                                                      *
124
              Constructor tags
Austin Seipp's avatar
Austin Seipp committed
125 126 127
*                                                                      *
************************************************************************
-}
128 129

-- | Type of the tags associated with each constructor possibility
130
--   or superclass selector
131 132 133 134
type ConTag = Int

fIRST_TAG :: ConTag
-- ^ Tags are allocated from here for real constructors
135
--   or for superclass selectors
136 137
fIRST_TAG =  1

Austin Seipp's avatar
Austin Seipp committed
138 139 140
{-
************************************************************************
*                                                                      *
141
\subsection[Alignment]{Alignment}
Austin Seipp's avatar
Austin Seipp committed
142 143 144
*                                                                      *
************************************************************************
-}
145 146 147

type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).

Austin Seipp's avatar
Austin Seipp committed
148 149 150
{-
************************************************************************
*                                                                      *
151
         One-shot information
Austin Seipp's avatar
Austin Seipp committed
152 153 154
*                                                                      *
************************************************************************
-}
155 156 157 158 159 160 161 162

-- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
-- variable info. Sometimes we know whether the lambda binding this variable
-- is a \"one-shot\" lambda; that is, whether it is applied at most once.
--
-- This information may be useful in optimisation, as computations may
-- safely be floated inside such a lambda without risk of duplicating
-- work.
163 164 165 166 167
data OneShotInfo
  = NoOneShotInfo -- ^ No information
  | ProbOneShot   -- ^ The lambda is probably applied at most once
                  -- See Note [Computing one-shot info, and ProbOneShot] in OccurAnl
  | OneShotLam    -- ^ The lambda is applied at most once.
Peter Wortmann's avatar
Peter Wortmann committed
168
  deriving (Eq)
169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199

-- | It is always safe to assume that an 'Id' has no lambda-bound variable information
noOneShotInfo :: OneShotInfo
noOneShotInfo = NoOneShotInfo

isOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool
isOneShotInfo OneShotLam = True
isOneShotInfo _          = False

hasNoOneShotInfo NoOneShotInfo = True
hasNoOneShotInfo _             = False

worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
worstOneShot NoOneShotInfo _             = NoOneShotInfo
worstOneShot ProbOneShot   NoOneShotInfo = NoOneShotInfo
worstOneShot ProbOneShot   _             = ProbOneShot
worstOneShot OneShotLam    os            = os

bestOneShot NoOneShotInfo os         = os
bestOneShot ProbOneShot   OneShotLam = OneShotLam
bestOneShot ProbOneShot   _          = ProbOneShot
bestOneShot OneShotLam    _          = OneShotLam

pprOneShotInfo :: OneShotInfo -> SDoc
pprOneShotInfo NoOneShotInfo = empty
pprOneShotInfo ProbOneShot   = ptext (sLit "ProbOneShot")
pprOneShotInfo OneShotLam    = ptext (sLit "OneShot")

instance Outputable OneShotInfo where
    ppr = pprOneShotInfo

Austin Seipp's avatar
Austin Seipp committed
200 201 202
{-
************************************************************************
*                                                                      *
203
           Swap flag
Austin Seipp's avatar
Austin Seipp committed
204 205 206
*                                                                      *
************************************************************************
-}
207

208 209
data SwapFlag
  = NotSwapped  -- Args are: actual,   expected
210 211 212 213 214 215 216 217 218 219
  | IsSwapped   -- Args are: expected, actual

instance Outputable SwapFlag where
  ppr IsSwapped  = ptext (sLit "Is-swapped")
  ppr NotSwapped = ptext (sLit "Not-swapped")

flipSwap :: SwapFlag -> SwapFlag
flipSwap IsSwapped  = NotSwapped
flipSwap NotSwapped = IsSwapped

220 221 222 223
isSwapped :: SwapFlag -> Bool
isSwapped IsSwapped  = True
isSwapped NotSwapped = False

224 225 226 227
unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b
unSwap NotSwapped f a b = f a b
unSwap IsSwapped  f a b = f b a

Austin Seipp's avatar
Austin Seipp committed
228 229 230
{-
************************************************************************
*                                                                      *
231
\subsection[FunctionOrData]{FunctionOrData}
Austin Seipp's avatar
Austin Seipp committed
232 233 234
*                                                                      *
************************************************************************
-}
235 236

data FunctionOrData = IsFunction | IsData
237
    deriving (Eq, Ord, Data, Typeable)
238 239 240 241

instance Outputable FunctionOrData where
    ppr IsFunction = text "(function)"
    ppr IsData     = text "(data)"
sof's avatar
sof committed
242

Austin Seipp's avatar
Austin Seipp committed
243 244 245
{-
************************************************************************
*                                                                      *
sof's avatar
sof committed
246
\subsection[Version]{Module and identifier version numbers}
Austin Seipp's avatar
Austin Seipp committed
247 248 249
*                                                                      *
************************************************************************
-}
sof's avatar
sof committed
250 251

type Version = Int
252

253
bumpVersion :: Version -> Version
254
bumpVersion v = v+1
255 256 257

initialVersion :: Version
initialVersion = 1
sof's avatar
sof committed
258

Austin Seipp's avatar
Austin Seipp committed
259 260 261
{-
************************************************************************
*                                                                      *
262
                Deprecations
Austin Seipp's avatar
Austin Seipp committed
263 264 265
*                                                                      *
************************************************************************
-}
266

Ian Lynagh's avatar
Ian Lynagh committed
267
-- reason/explanation from a WARNING or DEPRECATED pragma
Alan Zimmerman's avatar
Alan Zimmerman committed
268 269 270
-- For SourceText usage, see note [Pragma source text]
data WarningTxt = WarningTxt (Located SourceText) [Located FastString]
                | DeprecatedTxt (Located SourceText) [Located FastString]
271
    deriving (Eq, Data, Typeable)
Ian Lynagh's avatar
Ian Lynagh committed
272 273

instance Outputable WarningTxt where
Alan Zimmerman's avatar
Alan Zimmerman committed
274 275 276
    ppr (WarningTxt    _ ws) = doubleQuotes (vcat (map (ftext . unLoc) ws))
    ppr (DeprecatedTxt _ ds) = text "Deprecated:" <+>
                               doubleQuotes (vcat (map (ftext . unLoc) ds))
sof's avatar
sof committed
277

Austin Seipp's avatar
Austin Seipp committed
278 279 280
{-
************************************************************************
*                                                                      *
281
                Rules
Austin Seipp's avatar
Austin Seipp committed
282 283 284
*                                                                      *
************************************************************************
-}
285 286

type RuleName = FastString
287

Austin Seipp's avatar
Austin Seipp committed
288 289 290
{-
************************************************************************
*                                                                      *
sof's avatar
sof committed
291
\subsection[Fixity]{Fixity info}
Austin Seipp's avatar
Austin Seipp committed
292 293 294
*                                                                      *
************************************************************************
-}
sof's avatar
sof committed
295

296
------------------------
sof's avatar
sof committed
297
data Fixity = Fixity Int FixityDirection
298
  deriving (Data, Typeable)
sof's avatar
sof committed
299 300

instance Outputable Fixity where
301
    ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
sof's avatar
sof committed
302

303
instance Eq Fixity where -- Used to determine if two fixities conflict
304 305 306
  (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2

------------------------
307 308
data FixityDirection = InfixL | InfixR | InfixN
                     deriving (Eq, Data, Typeable)
309

sof's avatar
sof committed
310
instance Outputable FixityDirection where
Ian Lynagh's avatar
Ian Lynagh committed
311 312 313
    ppr InfixL = ptext (sLit "infixl")
    ppr InfixR = ptext (sLit "infixr")
    ppr InfixN = ptext (sLit "infix")
sof's avatar
sof committed
314

315
------------------------
316
maxPrecedence, minPrecedence :: Int
317
maxPrecedence = 9
318 319
minPrecedence = 0

320
defaultFixity :: Fixity
sof's avatar
sof committed
321
defaultFixity = Fixity maxPrecedence InfixL
322

323 324
negateFixity, funTyFixity :: Fixity
-- Wired-in fixities
325 326
negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
sof's avatar
sof committed
327

Austin Seipp's avatar
Austin Seipp committed
328
{-
329 330 331
Consider

\begin{verbatim}
332
        a `op1` b `op2` c
333 334 335
\end{verbatim}
@(compareFixity op1 op2)@ tells which way to arrange appication, or
whether there's an error.
Austin Seipp's avatar
Austin Seipp committed
336
-}
337 338

compareFixity :: Fixity -> Fixity
339 340
              -> (Bool,         -- Error please
                  Bool)         -- Associate to the right: a op1 (b op2 c)
341 342
compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
  = case prec1 `compare` prec2 of
343 344 345 346 347 348
        GT -> left
        LT -> right
        EQ -> case (dir1, dir2) of
                        (InfixR, InfixR) -> right
                        (InfixL, InfixL) -> left
                        _                -> error_please
349
  where
350
    right        = (False, True)
351 352
    left         = (False, False)
    error_please = (True,  False)
sof's avatar
sof committed
353

Austin Seipp's avatar
Austin Seipp committed
354 355 356
{-
************************************************************************
*                                                                      *
357
\subsection[Top-level/local]{Top-level/not-top level flag}
Austin Seipp's avatar
Austin Seipp committed
358 359 360
*                                                                      *
************************************************************************
-}
361 362 363 364

data TopLevelFlag
  = TopLevel
  | NotTopLevel
365 366 367 368 369 370

isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool

isNotTopLevel NotTopLevel = True
isNotTopLevel TopLevel    = False

371
isTopLevel TopLevel     = True
372
isTopLevel NotTopLevel  = False
373 374

instance Outputable TopLevelFlag where
Ian Lynagh's avatar
Ian Lynagh committed
375 376
  ppr TopLevel    = ptext (sLit "<TopLevel>")
  ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
377

Austin Seipp's avatar
Austin Seipp committed
378 379 380
{-
************************************************************************
*                                                                      *
381
                Boxity flag
Austin Seipp's avatar
Austin Seipp committed
382 383 384
*                                                                      *
************************************************************************
-}
385 386 387 388

data Boxity
  = Boxed
  | Unboxed
389
  deriving( Eq, Data, Typeable )
390 391 392 393 394

isBoxed :: Boxity -> Bool
isBoxed Boxed   = True
isBoxed Unboxed = False

Austin Seipp's avatar
Austin Seipp committed
395 396 397
{-
************************************************************************
*                                                                      *
398
                Recursive/Non-Recursive flag
Austin Seipp's avatar
Austin Seipp committed
399 400 401
*                                                                      *
************************************************************************
-}
402

403 404 405
data RecFlag = Recursive
             | NonRecursive
             deriving( Eq, Data, Typeable )
sof's avatar
sof committed
406

407 408 409
isRec :: RecFlag -> Bool
isRec Recursive    = True
isRec NonRecursive = False
sof's avatar
sof committed
410

411 412 413
isNonRec :: RecFlag -> Bool
isNonRec Recursive    = False
isNonRec NonRecursive = True
414 415 416 417 418 419

boolToRecFlag :: Bool -> RecFlag
boolToRecFlag True  = Recursive
boolToRecFlag False = NonRecursive

instance Outputable RecFlag where
Ian Lynagh's avatar
Ian Lynagh committed
420 421
  ppr Recursive    = ptext (sLit "Recursive")
  ppr NonRecursive = ptext (sLit "NonRecursive")
422

Austin Seipp's avatar
Austin Seipp committed
423 424 425
{-
************************************************************************
*                                                                      *
cactus's avatar
cactus committed
426
                Code origin
Austin Seipp's avatar
Austin Seipp committed
427 428 429 430
*                                                                      *
************************************************************************
-}

cactus's avatar
cactus committed
431 432 433 434 435 436 437 438 439 440 441 442
data Origin = FromSource
            | Generated
            deriving( Eq, Data, Typeable )

isGenerated :: Origin -> Bool
isGenerated Generated = True
isGenerated FromSource = False

instance Outputable Origin where
  ppr FromSource  = ptext (sLit "FromSource")
  ppr Generated   = ptext (sLit "Generated")

Austin Seipp's avatar
Austin Seipp committed
443 444 445
{-
************************************************************************
*                                                                      *
446
                Instance overlap flag
Austin Seipp's avatar
Austin Seipp committed
447 448 449
*                                                                      *
************************************************************************
-}
450

dterei's avatar
dterei committed
451 452 453
-- | The semantics allowed for overlapping instances for a particular
-- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.lhs`) for a
-- explanation of the `isSafeOverlap` field.
Alan Zimmerman's avatar
Alan Zimmerman committed
454 455 456 457 458 459 460
--
-- - 'ApiAnnotation.AnnKeywordId' :
--      'ApiAnnotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
--                              @'\{-\# OVERLAPPING'@ or
--                              @'\{-\# OVERLAPS'@ or
--                              @'\{-\# INCOHERENT'@,
--      'ApiAnnotation.AnnClose' @`\#-\}`@,
461 462

-- For details on above see note [Api annotations] in ApiAnnotation
463 464 465 466 467 468 469 470 471
data OverlapFlag = OverlapFlag
  { overlapMode   :: OverlapMode
  , isSafeOverlap :: Bool
  } deriving (Eq, Data, Typeable)

setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
setOverlapModeMaybe f Nothing  = f
setOverlapModeMaybe f (Just m) = f { overlapMode = m }

472 473 474
hasOverlappableFlag :: OverlapMode -> Bool
hasOverlappableFlag mode =
  case mode of
Alan Zimmerman's avatar
Alan Zimmerman committed
475 476 477 478
    Overlappable _ -> True
    Overlaps     _ -> True
    Incoherent   _ -> True
    _              -> False
479 480 481 482

hasOverlappingFlag :: OverlapMode -> Bool
hasOverlappingFlag mode =
  case mode of
Alan Zimmerman's avatar
Alan Zimmerman committed
483 484 485 486
    Overlapping  _ -> True
    Overlaps     _ -> True
    Incoherent   _ -> True
    _              -> False
487

488
data OverlapMode  -- See Note [Rules for instance lookup] in InstEnv
Alan Zimmerman's avatar
Alan Zimmerman committed
489 490
  = NoOverlap SourceText
                  -- See Note [Pragma source text]
491 492 493
    -- ^ This instance must not overlap another `NoOverlap` instance.
    -- However, it may be overlapped by `Overlapping` instances,
    -- and it may overlap `Overlappable` instances.
494

495

Alan Zimmerman's avatar
Alan Zimmerman committed
496 497
  | Overlappable SourceText
                  -- See Note [Pragma source text]
498 499 500 501 502 503 504 505 506 507 508
    -- ^ Silently ignore this instance if you find a
    -- more specific one that matches the constraint
    -- you are trying to resolve
    --
    -- Example: constraint (Foo [Int])
    --   instance                      Foo [Int]
    --   instance {-# OVERLAPPABLE #-} Foo [a]
    --
    -- Since the second instance has the Overlappable flag,
    -- the first instance will be chosen (otherwise
    -- its ambiguous which to choose)
509 510


Alan Zimmerman's avatar
Alan Zimmerman committed
511 512
  | Overlapping SourceText
                  -- See Note [Pragma source text]
513 514 515 516 517 518 519 520 521 522
    -- ^ Silently ignore any more general instances that may be
    --   used to solve the constraint.
    --
    -- Example: constraint (Foo [Int])
    --   instance {-# OVERLAPPING #-} Foo [Int]
    --   instance                     Foo [a]
    --
    -- Since the first instance has the Overlapping flag,
    -- the second---more general---instance will be ignored (otherwise
    -- it is ambiguous which to choose)
523 524


Alan Zimmerman's avatar
Alan Zimmerman committed
525 526
  | Overlaps SourceText
                  -- See Note [Pragma source text]
Gabor Greif's avatar
Gabor Greif committed
527
    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
528

Alan Zimmerman's avatar
Alan Zimmerman committed
529 530
  | Incoherent SourceText
                  -- See Note [Pragma source text]
531 532 533 534 535 536 537 538 539 540 541
    -- ^ Behave like Overlappable and Overlapping, and in addition pick
    -- an an arbitrary one if there are multiple matching candidates, and
    -- don't worry about later instantiation
    --
    -- Example: constraint (Foo [b])
    -- instance {-# INCOHERENT -} Foo [Int]
    -- instance                   Foo [a]
    -- Without the Incoherent flag, we'd complain that
    -- instantiating 'b' would change which instance
    -- was chosen. See also note [Incoherent instances] in InstEnv

542
  deriving (Eq, Data, Typeable)
543

544

545
instance Outputable OverlapFlag where
546 547 548
   ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)

instance Outputable OverlapMode where
Alan Zimmerman's avatar
Alan Zimmerman committed
549 550 551 552 553
   ppr (NoOverlap    _) = empty
   ppr (Overlappable _) = ptext (sLit "[overlappable]")
   ppr (Overlapping  _) = ptext (sLit "[overlapping]")
   ppr (Overlaps     _) = ptext (sLit "[overlap ok]")
   ppr (Incoherent   _) = ptext (sLit "[incoherent]")
554

555 556 557
pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap True  = ptext $ sLit "[safe]"
pprSafeOverlap False = empty
558

Austin Seipp's avatar
Austin Seipp committed
559 560 561
{-
************************************************************************
*                                                                      *
562
                Tuples
Austin Seipp's avatar
Austin Seipp committed
563 564 565
*                                                                      *
************************************************************************
-}
566

batterseapower's avatar
batterseapower committed
567 568 569
data TupleSort
  = BoxedTuple
  | UnboxedTuple
570
  | ConstraintTuple
batterseapower's avatar
batterseapower committed
571 572 573
  deriving( Eq, Data, Typeable )

tupleSortBoxity :: TupleSort -> Boxity
574 575 576
tupleSortBoxity BoxedTuple     = Boxed
tupleSortBoxity UnboxedTuple   = Unboxed
tupleSortBoxity ConstraintTuple = Boxed
batterseapower's avatar
batterseapower committed
577 578 579 580 581 582

boxityNormalTupleSort :: Boxity -> TupleSort
boxityNormalTupleSort Boxed   = BoxedTuple
boxityNormalTupleSort Unboxed = UnboxedTuple

tupleParens :: TupleSort -> SDoc -> SDoc
583
tupleParens BoxedTuple      p = parens p
584
tupleParens ConstraintTuple p = parens p -- The user can't write fact tuples
585
                                         -- directly, we overload the (,,) syntax
batterseapower's avatar
batterseapower committed
586
tupleParens UnboxedTuple p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
587

Austin Seipp's avatar
Austin Seipp committed
588 589 590
{-
************************************************************************
*                                                                      *
591
\subsection[Generic]{Generic flag}
Austin Seipp's avatar
Austin Seipp committed
592 593
*                                                                      *
************************************************************************
594

595
This is the "Embedding-Projection pair" datatype, it contains
596
two pieces of code (normally either RenamedExpr's or Id's)
597
If we have a such a pair (EP from to), the idea is that 'from' and 'to'
598
represents functions of type
599

600 601
        from :: T -> Tring
        to   :: Tring -> T
602

603
And we should have
604

605
        to (from x) = x
606 607

T and Tring are arbitrary, but typically T is the 'main' type while
608
Tring is the 'representation' type.  (This just helps us remember
609
whether to use 'from' or 'to'.
Austin Seipp's avatar
Austin Seipp committed
610
-}
611

612 613
data EP a = EP { fromEP :: a,   -- :: T -> Tring
                 toEP   :: a }  -- :: Tring -> T
614

Austin Seipp's avatar
Austin Seipp committed
615
{-
616 617 618 619 620
Embedding-projection pairs are used in several places:

First of all, each type constructor has an EP associated with it, the
code in EP converts (datatype T) from T to Tring and back again.

621
Secondly, when we are filling in Generic methods (in the typechecker,
622 623 624
tcMethodBinds), we are constructing bimaps by induction on the structure
of the type of the method signature.

625

Austin Seipp's avatar
Austin Seipp committed
626 627
************************************************************************
*                                                                      *
628
\subsection{Occurrence information}
Austin Seipp's avatar
Austin Seipp committed
629 630
*                                                                      *
************************************************************************
631 632 633 634 635

This data type is used exclusively by the simplifier, but it appears in a
SubstResult, which is currently defined in VarEnv, which is pretty near
the base of the module hierarchy.  So it seemed simpler to put the
defn of OccInfo here, safely at the bottom
Austin Seipp's avatar
Austin Seipp committed
636
-}
637

batterseapower's avatar
batterseapower committed
638
-- | Identifier occurrence information
639
data OccInfo
Gabor Greif's avatar
Gabor Greif committed
640
  = NoOccInfo           -- ^ There are many occurrences, or unknown occurrences
641

642 643
  | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
                        -- lambda and case-bound variables.
644

batterseapower's avatar
batterseapower committed
645
  | OneOcc
646 647 648
        !InsideLam
        !OneBranch
        !InterestingCxt -- ^ Occurs exactly once, not inside a rule
649

batterseapower's avatar
batterseapower committed
650 651
  -- | This identifier breaks a loop of mutually recursive functions. The field
  -- marks whether it is only a loop breaker due to a reference in a rule
652 653
  | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
        !RulesOnly
654

Peter Wortmann's avatar
Peter Wortmann committed
655 656
  deriving (Eq)

657
type RulesOnly = Bool
658

Austin Seipp's avatar
Austin Seipp committed
659
{-
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
660 661
Note [LoopBreaker OccInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~
662
   IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker
663
                             Do not preInlineUnconditionally
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
664

665 666 667 668
   IAmALoopBreaker False <=> A "strong" loop breaker
                             Do not inline at all

See OccurAnal Note [Weak loop breakers]
Austin Seipp's avatar
Austin Seipp committed
669
-}
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
670

671 672
isNoOcc :: OccInfo -> Bool
isNoOcc NoOccInfo = True
673
isNoOcc _         = False
674

675
seqOccInfo :: OccInfo -> ()
676 677 678
seqOccInfo occ = occ `seq` ()

-----------------
679 680 681
type InterestingCxt = Bool      -- True <=> Function: is applied
                                --          Data value: scrutinised by a case with
                                --                      at least one non-DEFAULT branch
682

683
-----------------
684 685 686
type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
                        -- Substituting a redex for this occurrence is
                        -- dangerous because it might duplicate work.
687
insideLam, notInsideLam :: InsideLam
688 689 690
insideLam    = True
notInsideLam = False

691
-----------------
692 693
type OneBranch = Bool   -- True <=> Occurs in only one case branch
                        --      so no code-duplication issue to worry about
694
oneBranch, notOneBranch :: OneBranch
695 696 697
oneBranch    = True
notOneBranch = False

698 699 700
strongLoopBreaker, weakLoopBreaker :: OccInfo
strongLoopBreaker = IAmALoopBreaker False
weakLoopBreaker   = IAmALoopBreaker True
701

702 703 704
isWeakLoopBreaker :: OccInfo -> Bool
isWeakLoopBreaker (IAmALoopBreaker _) = True
isWeakLoopBreaker _                   = False
705

706 707 708
isStrongLoopBreaker :: OccInfo -> Bool
isStrongLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
isStrongLoopBreaker _                       = False
709

710 711
isDeadOcc :: OccInfo -> Bool
isDeadOcc IAmDead = True
712
isDeadOcc _       = False
713

714
isOneOcc :: OccInfo -> Bool
715 716
isOneOcc (OneOcc {}) = True
isOneOcc _           = False
717

718 719 720
zapFragileOcc :: OccInfo -> OccInfo
zapFragileOcc (OneOcc {}) = NoOccInfo
zapFragileOcc occ         = occ
721 722 723

instance Outputable OccInfo where
  -- only used for debugging; never parsed.  KSW 1999-07
724
  ppr NoOccInfo            = empty
Ian Lynagh's avatar
Ian Lynagh committed
725
  ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
726
  ppr IAmDead              = ptext (sLit "Dead")
727
  ppr (OneOcc inside_lam one_branch int_cxt)
728 729 730 731 732 733 734 735
        = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
        where
          pp_lam | inside_lam = char 'L'
                 | otherwise  = empty
          pp_br  | one_branch = empty
                 | otherwise  = char '*'
          pp_args | int_cxt   = char '!'
                  | otherwise = empty
736

Austin Seipp's avatar
Austin Seipp committed
737 738 739
{-
************************************************************************
*                                                                      *
740
                Default method specfication
Austin Seipp's avatar
Austin Seipp committed
741 742
*                                                                      *
************************************************************************
743 744

The DefMethSpec enumeration just indicates what sort of default method
745 746
is used for a class. It is generated from source code, and present in
interface files; it is converted to Class.DefMeth before begin put in a
747
Class object.
Austin Seipp's avatar
Austin Seipp committed
748
-}
749 750 751 752

data DefMethSpec = NoDM        -- No default method
                 | VanillaDM   -- Default method given with polymorphic code
                 | GenericDM   -- Default method given with generic code
753
  deriving Eq
754 755 756 757 758 759

instance Outputable DefMethSpec where
  ppr NoDM      = empty
  ppr VanillaDM = ptext (sLit "{- Has default method -}")
  ppr GenericDM = ptext (sLit "{- Has generic default method -}")

Austin Seipp's avatar
Austin Seipp committed
760 761 762
{-
************************************************************************
*                                                                      *
763
\subsection{Success flag}
Austin Seipp's avatar
Austin Seipp committed
764 765 766
*                                                                      *
************************************************************************
-}
767 768 769

data SuccessFlag = Succeeded | Failed

Ian Lynagh's avatar
Ian Lynagh committed
770
instance Outputable SuccessFlag where
Ian Lynagh's avatar
Ian Lynagh committed
771 772
    ppr Succeeded = ptext (sLit "Succeeded")
    ppr Failed    = ptext (sLit "Failed")
Ian Lynagh's avatar
Ian Lynagh committed
773

774 775 776 777 778 779 780 781 782 783 784
successIf :: Bool -> SuccessFlag
successIf True  = Succeeded
successIf False = Failed

succeeded, failed :: SuccessFlag -> Bool
succeeded Succeeded = True
succeeded Failed    = False

failed Succeeded = False
failed Failed    = True

Alan Zimmerman's avatar
Alan Zimmerman committed
785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819
{-
************************************************************************
*                                                                      *
\subsection{Source Text}
*                                                                      *
************************************************************************
Keeping Source Text for source to source conversions

Note [Pragma source text]
~~~~~~~~~~~~~~~~~~~~~~~~~
The lexer does a case-insensitive match for pragmas, as well as
accepting both UK and US spelling variants.

So

  {-# SPECIALISE #-}
  {-# SPECIALIZE #-}
  {-# Specialize #-}

will all generate ITspec_prag token for the start of the pragma.

In order to be able to do source to source conversions, the original
source text for the token needs to be preserved, hence the
`SourceText` field.

So the lexer will then generate

  ITspec_prag "{ -# SPECIALISE"
  ITspec_prag "{ -# SPECIALIZE"
  ITspec_prag "{ -# Specialize"

for the cases above.
 [without the space between '{' and '-', otherwise this comment won't parse]


820
Note [Literal source text]
Alan Zimmerman's avatar
Alan Zimmerman committed
821 822 823 824 825 826 827 828
~~~~~~~~~~~~~~~~~~~~~~~~~~
The lexer/parser converts literals from their original source text
versions to an appropriate internal representation. This is a problem
for tools doing source to source conversions, so the original source
text is stored in literals where this can occur.

Motivating examples for HsLit

829 830
  HsChar          '\n'       == '\x20`
  HsCharPrim      '\x41`#    == `A`
Alan Zimmerman's avatar
Alan Zimmerman committed
831
  HsString        "\x20\x41" == " A"
832 833 834 835 836 837 838
  HsStringPrim    "\x20"#    == " "#
  HsInt           001        == 1
  HsIntPrim       002#       == 2#
  HsWordPrim      003##      == 3##
  HsInt64Prim     004##      == 4##
  HsWord64Prim    005##      == 5##
  HsInteger       006        == 6
Alan Zimmerman's avatar
Alan Zimmerman committed
839 840 841

For OverLitVal

842 843
  HsIntegral      003      == 0x003
  HsIsString      "\x41nd" == "And"
Alan Zimmerman's avatar
Alan Zimmerman committed
844 845
-}

846
type SourceText = String -- Note [Literal source text],[Pragma source text]
Alan Zimmerman's avatar
Alan Zimmerman committed
847 848


Austin Seipp's avatar
Austin Seipp committed
849 850 851
{-
************************************************************************
*                                                                      *
852
\subsection{Activation}
Austin Seipp's avatar
Austin Seipp committed
853 854
*                                                                      *
************************************************************************
855 856

When a rule or inlining is active
Austin Seipp's avatar
Austin Seipp committed
857
-}
858

859 860 861 862 863 864 865 866 867 868 869
type PhaseNum = Int  -- Compilation phase
                     -- Phases decrease towards zero
                     -- Zero is the last phase

data CompilerPhase
  = Phase PhaseNum
  | InitialPhase    -- The first phase -- number = infinity!

instance Outputable CompilerPhase where
   ppr (Phase n)    = int n
   ppr InitialPhase = ptext (sLit "InitialPhase")
870 871

data Activation = NeverActive
872
                | AlwaysActive
873 874
                | ActiveBefore PhaseNum -- Active only *before* this phase
                | ActiveAfter PhaseNum  -- Active in this phase and later
875
                deriving( Eq, Data, Typeable )  -- Eq used in comparing rules in HsDecls
876

877
data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
878
                   | FunLike
879
                   deriving( Eq, Data, Typeable, Show )
880
        -- Show needed for Lexer.x
881

882
data InlinePragma            -- Note [InlinePragma]
883
  = InlinePragma
Alan Zimmerman's avatar
Alan Zimmerman committed
884 885
      { inl_src    :: SourceText -- Note [Pragma source text]
      , inl_inline :: InlineSpec
886

887 888 889 890
      , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
                                     --            explicit (non-type, non-dictionary) args
                                     --   That is, inl_sat describes the number of *source-code*
                                     --   arguments the thing must be applied to.  We add on the
891
                                     --   number of implicit, dictionary arguments when making
892
                                     --   the InlineRule, and don't look at inl_sat further
893

894
      , inl_act    :: Activation     -- Says during which phases inlining is allowed
895

896
      , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
897
    } deriving( Eq, Data, Typeable )
898

Gabor Greif's avatar
Gabor Greif committed
899
data InlineSpec   -- What the user's INLINE pragma looked like
900 901 902
  = Inline
  | Inlinable
  | NoInline
Simon Peyton Jones's avatar
Simon Peyton Jones committed
903 904
  | EmptyInlineSpec  -- Used in a place-holder InlinePragma in SpecPrag or IdInfo,
                     -- where there isn't any real inline pragma at all
905
  deriving( Eq, Data, Typeable, Show )
906
        -- Show needed for Lexer.x
907

Austin Seipp's avatar
Austin Seipp committed
908
{-
909 910
Note [InlinePragma]
~~~~~~~~~~~~~~~~~~~
911
This data type mirrors what you can write in an INLINE or NOINLINE pragma in
912 913 914 915 916 917 918
the source program.

If you write nothing at all, you get defaultInlinePragma:
   inl_inline = False
   inl_act    = AlwaysActive
   inl_rule   = FunLike

919
It's not possible to get that combination by *writing* something, so
920 921
if an Id has defaultInlinePragma it means the user didn't specify anything.

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
922 923
If inl_inline = True, then the Id should have an InlineRule unfolding.

924 925 926 927 928 929
Note [CONLIKE pragma]
~~~~~~~~~~~~~~~~~~~~~
The ConLike constructor of a RuleMatchInfo is aimed at the following.
Consider first
    {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
    g b bs = let x = b:bs in ..x...x...(r x)...
930
Now, the rule applies to the (r x) term, because GHC "looks through"
931 932 933 934 935 936 937
the definition of 'x' to see that it is (b:bs).

Now consider
    {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
    g v = let x = f v in ..x...x...(r x)...
Normally the (r x) would *not* match the rule, because GHC would be
scared about duplicating the redex (f v), so it does not "look
938
through" the bindings.
939 940 941 942 943 944