c6ffaad0d42f06f3d2551f94a2b4298ceb5ff357
[ghc.git] / compiler / basicTypes / BasicTypes.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
4
5 \section[BasicTypes]{Miscellanous types}
6
7 This module defines a miscellaneously collection of very simple
8 types that
9
10 \begin{itemize}
11 \item have no other obvious home
12 \item don't depend on any other complicated types
13 \item are used in more than one "part" of the compiler
14 \end{itemize}
15 -}
16
17 {-# LANGUAGE DeriveDataTypeable #-}
18
19 module BasicTypes(
20 Version, bumpVersion, initialVersion,
21
22 LeftOrRight(..),
23 pickLR,
24
25 ConTag, ConTagZ, fIRST_TAG,
26
27 Arity, RepArity, JoinArity,
28
29 Alignment,
30
31 FunctionOrData(..),
32
33 WarningTxt(..), pprWarningTxtForMsg, StringLiteral(..),
34
35 Fixity(..), FixityDirection(..),
36 defaultFixity, maxPrecedence, minPrecedence,
37 negateFixity, funTyFixity,
38 compareFixity,
39 LexicalFixity(..),
40
41 RecFlag(..), isRec, isNonRec, boolToRecFlag,
42 Origin(..), isGenerated,
43
44 RuleName, pprRuleName,
45
46 TopLevelFlag(..), isTopLevel, isNotTopLevel,
47
48 DerivStrategy(..),
49
50 OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
51 hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,
52
53 Boxity(..), isBoxed,
54
55 TyPrec(..), maybeParen,
56
57 TupleSort(..), tupleSortBoxity, boxityTupleSort,
58 tupleParens,
59
60 sumParens, pprAlternative,
61
62 -- ** The OneShotInfo type
63 OneShotInfo(..),
64 noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
65 bestOneShot, worstOneShot,
66
67 OccInfo(..), noOccInfo, seqOccInfo, zapFragileOcc, isOneOcc,
68 isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
69 strongLoopBreaker, weakLoopBreaker,
70
71 InsideLam, insideLam, notInsideLam,
72 OneBranch, oneBranch, notOneBranch,
73 InterestingCxt,
74 TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
75 isAlwaysTailCalled,
76
77 EP(..),
78
79 DefMethSpec(..),
80 SwapFlag(..), flipSwap, unSwap, isSwapped,
81
82 CompilerPhase(..), PhaseNum,
83
84 Activation(..), isActive, isActiveIn, competesWith,
85 isNeverActive, isAlwaysActive, isEarlyActive,
86
87 RuleMatchInfo(..), isConLike, isFunLike,
88 InlineSpec(..), isEmptyInlineSpec,
89 InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
90 neverInlinePragma, dfunInlinePragma,
91 isDefaultInlinePragma,
92 isInlinePragma, isInlinablePragma, isAnyInlinePragma,
93 inlinePragmaSpec, inlinePragmaSat,
94 inlinePragmaActivation, inlinePragmaRuleMatchInfo,
95 setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
96 pprInline, pprInlineDebug,
97
98 SuccessFlag(..), succeeded, failed, successIf,
99
100 IntegralLit(..), FractionalLit(..),
101 negateIntegralLit, negateFractionalLit,
102 mkIntegralLit, mkFractionalLit,
103 integralFractionalLit,
104
105 SourceText(..), pprWithSourceText,
106
107 IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit,
108
109 SpliceExplicitFlag(..)
110 ) where
111
112 import FastString
113 import Outputable
114 import SrcLoc ( Located,unLoc )
115 import Data.Data hiding (Fixity, Prefix, Infix)
116 import Data.Function (on)
117
118 {-
119 ************************************************************************
120 * *
121 Binary choice
122 * *
123 ************************************************************************
124 -}
125
126 data LeftOrRight = CLeft | CRight
127 deriving( Eq, Data )
128
129 pickLR :: LeftOrRight -> (a,a) -> a
130 pickLR CLeft (l,_) = l
131 pickLR CRight (_,r) = r
132
133 instance Outputable LeftOrRight where
134 ppr CLeft = text "Left"
135 ppr CRight = text "Right"
136
137 {-
138 ************************************************************************
139 * *
140 \subsection[Arity]{Arity}
141 * *
142 ************************************************************************
143 -}
144
145 -- | The number of value arguments that can be applied to a value before it does
146 -- "real work". So:
147 -- fib 100 has arity 0
148 -- \x -> fib x has arity 1
149 -- See also Note [Definition of arity] in CoreArity
150 type Arity = Int
151
152 -- | Representation Arity
153 --
154 -- The number of represented arguments that can be applied to a value before it does
155 -- "real work". So:
156 -- fib 100 has representation arity 0
157 -- \x -> fib x has representation arity 1
158 -- \(# x, y #) -> fib (x + y) has representation arity 2
159 type RepArity = Int
160
161 -- | The number of arguments that a join point takes. Unlike the arity of a
162 -- function, this is a purely syntactic property and is fixed when the join
163 -- point is created (or converted from a value). Both type and value arguments
164 -- are counted.
165 type JoinArity = Int
166
167 {-
168 ************************************************************************
169 * *
170 Constructor tags
171 * *
172 ************************************************************************
173 -}
174
175 -- | Constructor Tag
176 --
177 -- Type of the tags associated with each constructor possibility or superclass
178 -- selector
179 type ConTag = Int
180
181 -- | A *zero-indexed* constructor tag
182 type ConTagZ = Int
183
184 fIRST_TAG :: ConTag
185 -- ^ Tags are allocated from here for real constructors
186 -- or for superclass selectors
187 fIRST_TAG = 1
188
189 {-
190 ************************************************************************
191 * *
192 \subsection[Alignment]{Alignment}
193 * *
194 ************************************************************************
195 -}
196
197 type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
198
199 {-
200 ************************************************************************
201 * *
202 One-shot information
203 * *
204 ************************************************************************
205 -}
206
207 -- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
208 -- variable info. Sometimes we know whether the lambda binding this variable
209 -- is a \"one-shot\" lambda; that is, whether it is applied at most once.
210 --
211 -- This information may be useful in optimisation, as computations may
212 -- safely be floated inside such a lambda without risk of duplicating
213 -- work.
214 data OneShotInfo
215 = NoOneShotInfo -- ^ No information
216 | OneShotLam -- ^ The lambda is applied at most once.
217 deriving (Eq)
218
219 -- | It is always safe to assume that an 'Id' has no lambda-bound variable information
220 noOneShotInfo :: OneShotInfo
221 noOneShotInfo = NoOneShotInfo
222
223 isOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool
224 isOneShotInfo OneShotLam = True
225 isOneShotInfo _ = False
226
227 hasNoOneShotInfo NoOneShotInfo = True
228 hasNoOneShotInfo _ = False
229
230 worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
231 worstOneShot NoOneShotInfo _ = NoOneShotInfo
232 worstOneShot OneShotLam os = os
233
234 bestOneShot NoOneShotInfo os = os
235 bestOneShot OneShotLam _ = OneShotLam
236
237 pprOneShotInfo :: OneShotInfo -> SDoc
238 pprOneShotInfo NoOneShotInfo = empty
239 pprOneShotInfo OneShotLam = text "OneShot"
240
241 instance Outputable OneShotInfo where
242 ppr = pprOneShotInfo
243
244 {-
245 ************************************************************************
246 * *
247 Swap flag
248 * *
249 ************************************************************************
250 -}
251
252 data SwapFlag
253 = NotSwapped -- Args are: actual, expected
254 | IsSwapped -- Args are: expected, actual
255
256 instance Outputable SwapFlag where
257 ppr IsSwapped = text "Is-swapped"
258 ppr NotSwapped = text "Not-swapped"
259
260 flipSwap :: SwapFlag -> SwapFlag
261 flipSwap IsSwapped = NotSwapped
262 flipSwap NotSwapped = IsSwapped
263
264 isSwapped :: SwapFlag -> Bool
265 isSwapped IsSwapped = True
266 isSwapped NotSwapped = False
267
268 unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b
269 unSwap NotSwapped f a b = f a b
270 unSwap IsSwapped f a b = f b a
271
272 {-
273 ************************************************************************
274 * *
275 \subsection[FunctionOrData]{FunctionOrData}
276 * *
277 ************************************************************************
278 -}
279
280 data FunctionOrData = IsFunction | IsData
281 deriving (Eq, Ord, Data)
282
283 instance Outputable FunctionOrData where
284 ppr IsFunction = text "(function)"
285 ppr IsData = text "(data)"
286
287 {-
288 ************************************************************************
289 * *
290 \subsection[Version]{Module and identifier version numbers}
291 * *
292 ************************************************************************
293 -}
294
295 type Version = Int
296
297 bumpVersion :: Version -> Version
298 bumpVersion v = v+1
299
300 initialVersion :: Version
301 initialVersion = 1
302
303 {-
304 ************************************************************************
305 * *
306 Deprecations
307 * *
308 ************************************************************************
309 -}
310
311 -- | A String Literal in the source, including its original raw format for use by
312 -- source to source manipulation tools.
313 data StringLiteral = StringLiteral
314 { sl_st :: SourceText, -- literal raw source.
315 -- See not [Literal source text]
316 sl_fs :: FastString -- literal string value
317 } deriving Data
318
319 instance Eq StringLiteral where
320 (StringLiteral _ a) == (StringLiteral _ b) = a == b
321
322 instance Outputable StringLiteral where
323 ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl)
324
325 -- | Warning Text
326 --
327 -- reason/explanation from a WARNING or DEPRECATED pragma
328 data WarningTxt = WarningTxt (Located SourceText)
329 [Located StringLiteral]
330 | DeprecatedTxt (Located SourceText)
331 [Located StringLiteral]
332 deriving (Eq, Data)
333
334 instance Outputable WarningTxt where
335 ppr (WarningTxt lsrc ws)
336 = case unLoc lsrc of
337 NoSourceText -> pp_ws ws
338 SourceText src -> text src <+> pp_ws ws <+> text "#-}"
339
340 ppr (DeprecatedTxt lsrc ds)
341 = case unLoc lsrc of
342 NoSourceText -> pp_ws ds
343 SourceText src -> text src <+> pp_ws ds <+> text "#-}"
344
345 pp_ws :: [Located StringLiteral] -> SDoc
346 pp_ws [l] = ppr $ unLoc l
347 pp_ws ws
348 = text "["
349 <+> vcat (punctuate comma (map (ppr . unLoc) ws))
350 <+> text "]"
351
352
353 pprWarningTxtForMsg :: WarningTxt -> SDoc
354 pprWarningTxtForMsg (WarningTxt _ ws)
355 = doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws))
356 pprWarningTxtForMsg (DeprecatedTxt _ ds)
357 = text "Deprecated:" <+>
358 doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds))
359
360 {-
361 ************************************************************************
362 * *
363 Rules
364 * *
365 ************************************************************************
366 -}
367
368 type RuleName = FastString
369
370 pprRuleName :: RuleName -> SDoc
371 pprRuleName rn = doubleQuotes (ftext rn)
372
373 {-
374 ************************************************************************
375 * *
376 \subsection[Fixity]{Fixity info}
377 * *
378 ************************************************************************
379 -}
380
381 ------------------------
382 data Fixity = Fixity SourceText Int FixityDirection
383 -- Note [Pragma source text]
384 deriving Data
385
386 instance Outputable Fixity where
387 ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
388
389 instance Eq Fixity where -- Used to determine if two fixities conflict
390 (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2
391
392 ------------------------
393 data FixityDirection = InfixL | InfixR | InfixN
394 deriving (Eq, Data)
395
396 instance Outputable FixityDirection where
397 ppr InfixL = text "infixl"
398 ppr InfixR = text "infixr"
399 ppr InfixN = text "infix"
400
401 ------------------------
402 maxPrecedence, minPrecedence :: Int
403 maxPrecedence = 9
404 minPrecedence = 0
405
406 defaultFixity :: Fixity
407 defaultFixity = Fixity NoSourceText maxPrecedence InfixL
408
409 negateFixity, funTyFixity :: Fixity
410 -- Wired-in fixities
411 negateFixity = Fixity NoSourceText 6 InfixL -- Fixity of unary negate
412 funTyFixity = Fixity NoSourceText 0 InfixR -- Fixity of '->'
413
414 {-
415 Consider
416
417 \begin{verbatim}
418 a `op1` b `op2` c
419 \end{verbatim}
420 @(compareFixity op1 op2)@ tells which way to arrange application, or
421 whether there's an error.
422 -}
423
424 compareFixity :: Fixity -> Fixity
425 -> (Bool, -- Error please
426 Bool) -- Associate to the right: a op1 (b op2 c)
427 compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
428 = case prec1 `compare` prec2 of
429 GT -> left
430 LT -> right
431 EQ -> case (dir1, dir2) of
432 (InfixR, InfixR) -> right
433 (InfixL, InfixL) -> left
434 _ -> error_please
435 where
436 right = (False, True)
437 left = (False, False)
438 error_please = (True, False)
439
440 -- |Captures the fixity of declarations as they are parsed. This is not
441 -- necessarily the same as the fixity declaration, as the normal fixity may be
442 -- overridden using parens or backticks.
443 data LexicalFixity = Prefix | Infix deriving (Typeable,Data,Eq)
444
445 instance Outputable LexicalFixity where
446 ppr Prefix = text "Prefix"
447 ppr Infix = text "Infix"
448
449 {-
450 ************************************************************************
451 * *
452 \subsection[Top-level/local]{Top-level/not-top level flag}
453 * *
454 ************************************************************************
455 -}
456
457 data TopLevelFlag
458 = TopLevel
459 | NotTopLevel
460
461 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
462
463 isNotTopLevel NotTopLevel = True
464 isNotTopLevel TopLevel = False
465
466 isTopLevel TopLevel = True
467 isTopLevel NotTopLevel = False
468
469 instance Outputable TopLevelFlag where
470 ppr TopLevel = text "<TopLevel>"
471 ppr NotTopLevel = text "<NotTopLevel>"
472
473 {-
474 ************************************************************************
475 * *
476 Boxity flag
477 * *
478 ************************************************************************
479 -}
480
481 data Boxity
482 = Boxed
483 | Unboxed
484 deriving( Eq, Data )
485
486 isBoxed :: Boxity -> Bool
487 isBoxed Boxed = True
488 isBoxed Unboxed = False
489
490 instance Outputable Boxity where
491 ppr Boxed = text "Boxed"
492 ppr Unboxed = text "Unboxed"
493
494 {-
495 ************************************************************************
496 * *
497 Recursive/Non-Recursive flag
498 * *
499 ************************************************************************
500 -}
501
502 -- | Recursivity Flag
503 data RecFlag = Recursive
504 | NonRecursive
505 deriving( Eq, Data )
506
507 isRec :: RecFlag -> Bool
508 isRec Recursive = True
509 isRec NonRecursive = False
510
511 isNonRec :: RecFlag -> Bool
512 isNonRec Recursive = False
513 isNonRec NonRecursive = True
514
515 boolToRecFlag :: Bool -> RecFlag
516 boolToRecFlag True = Recursive
517 boolToRecFlag False = NonRecursive
518
519 instance Outputable RecFlag where
520 ppr Recursive = text "Recursive"
521 ppr NonRecursive = text "NonRecursive"
522
523 {-
524 ************************************************************************
525 * *
526 Code origin
527 * *
528 ************************************************************************
529 -}
530
531 data Origin = FromSource
532 | Generated
533 deriving( Eq, Data )
534
535 isGenerated :: Origin -> Bool
536 isGenerated Generated = True
537 isGenerated FromSource = False
538
539 instance Outputable Origin where
540 ppr FromSource = text "FromSource"
541 ppr Generated = text "Generated"
542
543 {-
544 ************************************************************************
545 * *
546 Deriving strategies
547 * *
548 ************************************************************************
549 -}
550
551 -- | Which technique the user explicitly requested when deriving an instance.
552 data DerivStrategy
553 -- See Note [Deriving strategies] in TcDeriv
554 = StockStrategy -- ^ GHC's \"standard\" strategy, which is to implement a
555 -- custom instance for the data type. This only works
556 -- for certain types that GHC knows about (e.g., 'Eq',
557 -- 'Show', 'Functor' when @-XDeriveFunctor@ is enabled,
558 -- etc.)
559 | AnyclassStrategy -- ^ @-XDeriveAnyClass@
560 | NewtypeStrategy -- ^ @-XGeneralizedNewtypeDeriving@
561 deriving (Eq, Data)
562
563 instance Outputable DerivStrategy where
564 ppr StockStrategy = text "stock"
565 ppr AnyclassStrategy = text "anyclass"
566 ppr NewtypeStrategy = text "newtype"
567
568 {-
569 ************************************************************************
570 * *
571 Instance overlap flag
572 * *
573 ************************************************************************
574 -}
575
576 -- | The semantics allowed for overlapping instances for a particular
577 -- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.hs`) for a
578 -- explanation of the `isSafeOverlap` field.
579 --
580 -- - 'ApiAnnotation.AnnKeywordId' :
581 -- 'ApiAnnotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
582 -- @'\{-\# OVERLAPPING'@ or
583 -- @'\{-\# OVERLAPS'@ or
584 -- @'\{-\# INCOHERENT'@,
585 -- 'ApiAnnotation.AnnClose' @`\#-\}`@,
586
587 -- For details on above see note [Api annotations] in ApiAnnotation
588 data OverlapFlag = OverlapFlag
589 { overlapMode :: OverlapMode
590 , isSafeOverlap :: Bool
591 } deriving (Eq, Data)
592
593 setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
594 setOverlapModeMaybe f Nothing = f
595 setOverlapModeMaybe f (Just m) = f { overlapMode = m }
596
597 hasIncoherentFlag :: OverlapMode -> Bool
598 hasIncoherentFlag mode =
599 case mode of
600 Incoherent _ -> True
601 _ -> False
602
603 hasOverlappableFlag :: OverlapMode -> Bool
604 hasOverlappableFlag mode =
605 case mode of
606 Overlappable _ -> True
607 Overlaps _ -> True
608 Incoherent _ -> True
609 _ -> False
610
611 hasOverlappingFlag :: OverlapMode -> Bool
612 hasOverlappingFlag mode =
613 case mode of
614 Overlapping _ -> True
615 Overlaps _ -> True
616 Incoherent _ -> True
617 _ -> False
618
619 data OverlapMode -- See Note [Rules for instance lookup] in InstEnv
620 = NoOverlap SourceText
621 -- See Note [Pragma source text]
622 -- ^ This instance must not overlap another `NoOverlap` instance.
623 -- However, it may be overlapped by `Overlapping` instances,
624 -- and it may overlap `Overlappable` instances.
625
626
627 | Overlappable SourceText
628 -- See Note [Pragma source text]
629 -- ^ Silently ignore this instance if you find a
630 -- more specific one that matches the constraint
631 -- you are trying to resolve
632 --
633 -- Example: constraint (Foo [Int])
634 -- instance Foo [Int]
635 -- instance {-# OVERLAPPABLE #-} Foo [a]
636 --
637 -- Since the second instance has the Overlappable flag,
638 -- the first instance will be chosen (otherwise
639 -- its ambiguous which to choose)
640
641
642 | Overlapping SourceText
643 -- See Note [Pragma source text]
644 -- ^ Silently ignore any more general instances that may be
645 -- used to solve the constraint.
646 --
647 -- Example: constraint (Foo [Int])
648 -- instance {-# OVERLAPPING #-} Foo [Int]
649 -- instance Foo [a]
650 --
651 -- Since the first instance has the Overlapping flag,
652 -- the second---more general---instance will be ignored (otherwise
653 -- it is ambiguous which to choose)
654
655
656 | Overlaps SourceText
657 -- See Note [Pragma source text]
658 -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
659
660 | Incoherent SourceText
661 -- See Note [Pragma source text]
662 -- ^ Behave like Overlappable and Overlapping, and in addition pick
663 -- an an arbitrary one if there are multiple matching candidates, and
664 -- don't worry about later instantiation
665 --
666 -- Example: constraint (Foo [b])
667 -- instance {-# INCOHERENT -} Foo [Int]
668 -- instance Foo [a]
669 -- Without the Incoherent flag, we'd complain that
670 -- instantiating 'b' would change which instance
671 -- was chosen. See also note [Incoherent instances] in InstEnv
672
673 deriving (Eq, Data)
674
675
676 instance Outputable OverlapFlag where
677 ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
678
679 instance Outputable OverlapMode where
680 ppr (NoOverlap _) = empty
681 ppr (Overlappable _) = text "[overlappable]"
682 ppr (Overlapping _) = text "[overlapping]"
683 ppr (Overlaps _) = text "[overlap ok]"
684 ppr (Incoherent _) = text "[incoherent]"
685
686 pprSafeOverlap :: Bool -> SDoc
687 pprSafeOverlap True = text "[safe]"
688 pprSafeOverlap False = empty
689
690 {-
691 ************************************************************************
692 * *
693 Type precedence
694 * *
695 ************************************************************************
696 -}
697
698 data TyPrec -- See Note [Precedence in types] in TyCoRep.hs
699 = TopPrec -- No parens
700 | FunPrec -- Function args; no parens for tycon apps
701 | TyOpPrec -- Infix operator
702 | TyConPrec -- Tycon args; no parens for atomic
703
704 instance Eq TyPrec where
705 (==) a b = case compare a b of
706 EQ -> True
707 _ -> False
708
709 instance Ord TyPrec where
710 compare TopPrec TopPrec = EQ
711 compare TopPrec _ = LT
712
713 compare FunPrec TopPrec = GT
714 compare FunPrec FunPrec = EQ
715 compare FunPrec TyOpPrec = EQ -- See Note [Type operator precedence]
716 compare FunPrec TyConPrec = LT
717
718 compare TyOpPrec TopPrec = GT
719 compare TyOpPrec FunPrec = EQ -- See Note [Type operator precedence]
720 compare TyOpPrec TyOpPrec = EQ
721 compare TyOpPrec TyConPrec = LT
722
723 compare TyConPrec TyConPrec = EQ
724 compare TyConPrec _ = GT
725
726 maybeParen :: TyPrec -> TyPrec -> SDoc -> SDoc
727 maybeParen ctxt_prec inner_prec pretty
728 | ctxt_prec < inner_prec = pretty
729 | otherwise = parens pretty
730
731 {- Note [Precedence in types]
732 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
733 Many pretty-printing functions have type
734 ppr_ty :: TyPrec -> Type -> SDoc
735
736 The TyPrec gives the binding strength of the context. For example, in
737 T ty1 ty2
738 we will pretty-print 'ty1' and 'ty2' with the call
739 (ppr_ty TyConPrec ty)
740 to indicate that the context is that of an argument of a TyConApp.
741
742 We use this consistently for Type and HsType.
743
744 Note [Type operator precedence]
745 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
746 We don't keep the fixity of type operators in the operator. So the
747 pretty printer follows the following precedence order:
748
749 TyConPrec Type constructor application
750 TyOpPrec/FunPrec Operator application and function arrow
751
752 We have FunPrec and TyOpPrec to represent the precedence of function
753 arrow and type operators respectively, but currently we implement
754 FunPred == TyOpPrec, so that we don't distinguish the two. Reason:
755 it's hard to parse a type like
756 a ~ b => c * d -> e - f
757
758 By treating TyOpPrec = FunPrec we end up with more parens
759 (a ~ b) => (c * d) -> (e - f)
760
761 But the two are different constructors of TyPrec so we could make
762 (->) bind more or less tightly if we wanted.
763 -}
764
765 {-
766 ************************************************************************
767 * *
768 Tuples
769 * *
770 ************************************************************************
771 -}
772
773 data TupleSort
774 = BoxedTuple
775 | UnboxedTuple
776 | ConstraintTuple
777 deriving( Eq, Data )
778
779 tupleSortBoxity :: TupleSort -> Boxity
780 tupleSortBoxity BoxedTuple = Boxed
781 tupleSortBoxity UnboxedTuple = Unboxed
782 tupleSortBoxity ConstraintTuple = Boxed
783
784 boxityTupleSort :: Boxity -> TupleSort
785 boxityTupleSort Boxed = BoxedTuple
786 boxityTupleSort Unboxed = UnboxedTuple
787
788 tupleParens :: TupleSort -> SDoc -> SDoc
789 tupleParens BoxedTuple p = parens p
790 tupleParens UnboxedTuple p = text "(#" <+> p <+> ptext (sLit "#)")
791 tupleParens ConstraintTuple p -- In debug-style write (% Eq a, Ord b %)
792 = ifPprDebug (text "(%" <+> p <+> ptext (sLit "%)"))
793 (parens p)
794
795 {-
796 ************************************************************************
797 * *
798 Sums
799 * *
800 ************************************************************************
801 -}
802
803 sumParens :: SDoc -> SDoc
804 sumParens p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
805
806 -- | Pretty print an alternative in an unboxed sum e.g. "| a | |".
807 pprAlternative :: (a -> SDoc) -- ^ The pretty printing function to use
808 -> a -- ^ The things to be pretty printed
809 -> ConTag -- ^ Alternative (one-based)
810 -> Arity -- ^ Arity
811 -> SDoc -- ^ 'SDoc' where the alternative havs been pretty
812 -- printed and finally packed into a paragraph.
813 pprAlternative pp x alt arity =
814 fsep (replicate (alt - 1) vbar ++ [pp x] ++ replicate (arity - alt) vbar)
815
816 {-
817 ************************************************************************
818 * *
819 \subsection[Generic]{Generic flag}
820 * *
821 ************************************************************************
822
823 This is the "Embedding-Projection pair" datatype, it contains
824 two pieces of code (normally either RenamedExpr's or Id's)
825 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
826 represents functions of type
827
828 from :: T -> Tring
829 to :: Tring -> T
830
831 And we should have
832
833 to (from x) = x
834
835 T and Tring are arbitrary, but typically T is the 'main' type while
836 Tring is the 'representation' type. (This just helps us remember
837 whether to use 'from' or 'to'.
838 -}
839
840 -- | Embedding Projection pair
841 data EP a = EP { fromEP :: a, -- :: T -> Tring
842 toEP :: a } -- :: Tring -> T
843
844 {-
845 Embedding-projection pairs are used in several places:
846
847 First of all, each type constructor has an EP associated with it, the
848 code in EP converts (datatype T) from T to Tring and back again.
849
850 Secondly, when we are filling in Generic methods (in the typechecker,
851 tcMethodBinds), we are constructing bimaps by induction on the structure
852 of the type of the method signature.
853
854
855 ************************************************************************
856 * *
857 \subsection{Occurrence information}
858 * *
859 ************************************************************************
860
861 This data type is used exclusively by the simplifier, but it appears in a
862 SubstResult, which is currently defined in VarEnv, which is pretty near
863 the base of the module hierarchy. So it seemed simpler to put the
864 defn of OccInfo here, safely at the bottom
865 -}
866
867 -- | identifier Occurrence Information
868 data OccInfo
869 = ManyOccs { occ_tail :: !TailCallInfo }
870 -- ^ There are many occurrences, or unknown occurrences
871
872 | IAmDead -- ^ Marks unused variables. Sometimes useful for
873 -- lambda and case-bound variables.
874
875 | OneOcc { occ_in_lam :: !InsideLam
876 , occ_one_br :: !OneBranch
877 , occ_int_cxt :: !InterestingCxt
878 , occ_tail :: !TailCallInfo }
879 -- ^ Occurs exactly once (per branch), not inside a rule
880
881 -- | This identifier breaks a loop of mutually recursive functions. The field
882 -- marks whether it is only a loop breaker due to a reference in a rule
883 | IAmALoopBreaker { occ_rules_only :: !RulesOnly
884 , occ_tail :: !TailCallInfo }
885 -- Note [LoopBreaker OccInfo]
886
887 deriving (Eq)
888
889 type RulesOnly = Bool
890
891 {-
892 Note [LoopBreaker OccInfo]
893 ~~~~~~~~~~~~~~~~~~~~~~~~~~
894 IAmALoopBreaker True <=> A "weak" or rules-only loop breaker
895 Do not preInlineUnconditionally
896
897 IAmALoopBreaker False <=> A "strong" loop breaker
898 Do not inline at all
899
900 See OccurAnal Note [Weak loop breakers]
901 -}
902
903 noOccInfo :: OccInfo
904 noOccInfo = ManyOccs { occ_tail = NoTailCallInfo }
905
906 isManyOccs :: OccInfo -> Bool
907 isManyOccs ManyOccs{} = True
908 isManyOccs _ = False
909
910 seqOccInfo :: OccInfo -> ()
911 seqOccInfo occ = occ `seq` ()
912
913 -----------------
914 -- | Interesting Context
915 type InterestingCxt = Bool -- True <=> Function: is applied
916 -- Data value: scrutinised by a case with
917 -- at least one non-DEFAULT branch
918
919 -----------------
920 -- | Inside Lambda
921 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
922 -- Substituting a redex for this occurrence is
923 -- dangerous because it might duplicate work.
924 insideLam, notInsideLam :: InsideLam
925 insideLam = True
926 notInsideLam = False
927
928 -----------------
929 type OneBranch = Bool -- True <=> Occurs in only one case branch
930 -- so no code-duplication issue to worry about
931 oneBranch, notOneBranch :: OneBranch
932 oneBranch = True
933 notOneBranch = False
934
935 -----------------
936 data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]
937 | NoTailCallInfo
938 deriving (Eq)
939
940 tailCallInfo :: OccInfo -> TailCallInfo
941 tailCallInfo IAmDead = NoTailCallInfo
942 tailCallInfo other = occ_tail other
943
944 zapOccTailCallInfo :: OccInfo -> OccInfo
945 zapOccTailCallInfo IAmDead = IAmDead
946 zapOccTailCallInfo occ = occ { occ_tail = NoTailCallInfo }
947
948 isAlwaysTailCalled :: OccInfo -> Bool
949 isAlwaysTailCalled occ
950 = case tailCallInfo occ of AlwaysTailCalled{} -> True
951 NoTailCallInfo -> False
952
953 instance Outputable TailCallInfo where
954 ppr (AlwaysTailCalled ar) = sep [ text "Tail", int ar ]
955 ppr _ = empty
956
957 -----------------
958 strongLoopBreaker, weakLoopBreaker :: OccInfo
959 strongLoopBreaker = IAmALoopBreaker False NoTailCallInfo
960 weakLoopBreaker = IAmALoopBreaker True NoTailCallInfo
961
962 isWeakLoopBreaker :: OccInfo -> Bool
963 isWeakLoopBreaker (IAmALoopBreaker{}) = True
964 isWeakLoopBreaker _ = False
965
966 isStrongLoopBreaker :: OccInfo -> Bool
967 isStrongLoopBreaker (IAmALoopBreaker { occ_rules_only = False }) = True
968 -- Loop-breaker that breaks a non-rule cycle
969 isStrongLoopBreaker _ = False
970
971 isDeadOcc :: OccInfo -> Bool
972 isDeadOcc IAmDead = True
973 isDeadOcc _ = False
974
975 isOneOcc :: OccInfo -> Bool
976 isOneOcc (OneOcc {}) = True
977 isOneOcc _ = False
978
979 zapFragileOcc :: OccInfo -> OccInfo
980 -- Keep only the most robust data: deadness, loop-breaker-hood
981 zapFragileOcc (OneOcc {}) = noOccInfo
982 zapFragileOcc occ = zapOccTailCallInfo occ
983
984 instance Outputable OccInfo where
985 -- only used for debugging; never parsed. KSW 1999-07
986 ppr (ManyOccs tails) = pprShortTailCallInfo tails
987 ppr IAmDead = text "Dead"
988 ppr (IAmALoopBreaker rule_only tails)
989 = text "LoopBreaker" <> pp_ro <> pprShortTailCallInfo tails
990 where
991 pp_ro | rule_only = char '!'
992 | otherwise = empty
993 ppr (OneOcc inside_lam one_branch int_cxt tail_info)
994 = text "Once" <> pp_lam <> pp_br <> pp_args <> pp_tail
995 where
996 pp_lam | inside_lam = char 'L'
997 | otherwise = empty
998 pp_br | one_branch = empty
999 | otherwise = char '*'
1000 pp_args | int_cxt = char '!'
1001 | otherwise = empty
1002 pp_tail = pprShortTailCallInfo tail_info
1003
1004 pprShortTailCallInfo :: TailCallInfo -> SDoc
1005 pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar)
1006 pprShortTailCallInfo NoTailCallInfo = empty
1007
1008 {-
1009 Note [TailCallInfo]
1010 ~~~~~~~~~~~~~~~~~~~
1011 The occurrence analyser determines what can be made into a join point, but it
1012 doesn't change the binder into a JoinId because then it would be inconsistent
1013 with the occurrences. Thus it's left to the simplifier (or to simpleOptExpr) to
1014 change the IdDetails.
1015
1016 The AlwaysTailCalled marker actually means slightly more than simply that the
1017 function is always tail-called. See Note [Invariants on join points].
1018
1019 This info is quite fragile and should not be relied upon unless the occurrence
1020 analyser has *just* run. Use 'Id.isJoinId_maybe' for the permanent state of
1021 the join-point-hood of a binder; a join id itself will not be marked
1022 AlwaysTailCalled.
1023
1024 Note that there is a 'TailCallInfo' on a 'ManyOccs' value. One might expect that
1025 being tail-called would mean that the variable could only appear once per branch
1026 (thus getting a `OneOcc { occ_one_br = True }` occurrence info), but a join
1027 point can also be invoked from other join points, not just from case branches:
1028
1029 let j1 x = ...
1030 j2 y = ... j1 z {- tail call -} ...
1031 in case w of
1032 A -> j1 v
1033 B -> j2 u
1034 C -> j2 q
1035
1036 Here both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get
1037 ManyOccs and j2 will get `OneOcc { occ_one_br = True }`.
1038
1039 ************************************************************************
1040 * *
1041 Default method specification
1042 * *
1043 ************************************************************************
1044
1045 The DefMethSpec enumeration just indicates what sort of default method
1046 is used for a class. It is generated from source code, and present in
1047 interface files; it is converted to Class.DefMethInfo before begin put in a
1048 Class object.
1049 -}
1050
1051 -- | Default Method Specification
1052 data DefMethSpec ty
1053 = VanillaDM -- Default method given with polymorphic code
1054 | GenericDM ty -- Default method given with code of this type
1055
1056 instance Outputable (DefMethSpec ty) where
1057 ppr VanillaDM = text "{- Has default method -}"
1058 ppr (GenericDM {}) = text "{- Has generic default method -}"
1059
1060 {-
1061 ************************************************************************
1062 * *
1063 \subsection{Success flag}
1064 * *
1065 ************************************************************************
1066 -}
1067
1068 data SuccessFlag = Succeeded | Failed
1069
1070 instance Outputable SuccessFlag where
1071 ppr Succeeded = text "Succeeded"
1072 ppr Failed = text "Failed"
1073
1074 successIf :: Bool -> SuccessFlag
1075 successIf True = Succeeded
1076 successIf False = Failed
1077
1078 succeeded, failed :: SuccessFlag -> Bool
1079 succeeded Succeeded = True
1080 succeeded Failed = False
1081
1082 failed Succeeded = False
1083 failed Failed = True
1084
1085 {-
1086 ************************************************************************
1087 * *
1088 \subsection{Source Text}
1089 * *
1090 ************************************************************************
1091 Keeping Source Text for source to source conversions
1092
1093 Note [Pragma source text]
1094 ~~~~~~~~~~~~~~~~~~~~~~~~~
1095 The lexer does a case-insensitive match for pragmas, as well as
1096 accepting both UK and US spelling variants.
1097
1098 So
1099
1100 {-# SPECIALISE #-}
1101 {-# SPECIALIZE #-}
1102 {-# Specialize #-}
1103
1104 will all generate ITspec_prag token for the start of the pragma.
1105
1106 In order to be able to do source to source conversions, the original
1107 source text for the token needs to be preserved, hence the
1108 `SourceText` field.
1109
1110 So the lexer will then generate
1111
1112 ITspec_prag "{ -# SPECIALISE"
1113 ITspec_prag "{ -# SPECIALIZE"
1114 ITspec_prag "{ -# Specialize"
1115
1116 for the cases above.
1117 [without the space between '{' and '-', otherwise this comment won't parse]
1118
1119
1120 Note [Literal source text]
1121 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1122 The lexer/parser converts literals from their original source text
1123 versions to an appropriate internal representation. This is a problem
1124 for tools doing source to source conversions, so the original source
1125 text is stored in literals where this can occur.
1126
1127 Motivating examples for HsLit
1128
1129 HsChar '\n' == '\x20`
1130 HsCharPrim '\x41`# == `A`
1131 HsString "\x20\x41" == " A"
1132 HsStringPrim "\x20"# == " "#
1133 HsInt 001 == 1
1134 HsIntPrim 002# == 2#
1135 HsWordPrim 003## == 3##
1136 HsInt64Prim 004## == 4##
1137 HsWord64Prim 005## == 5##
1138 HsInteger 006 == 6
1139
1140 For OverLitVal
1141
1142 HsIntegral 003 == 0x003
1143 HsIsString "\x41nd" == "And"
1144 -}
1145
1146 -- Note [Literal source text],[Pragma source text]
1147 data SourceText = SourceText String
1148 | NoSourceText -- ^ For when code is generated, e.g. TH,
1149 -- deriving. The pretty printer will then make
1150 -- its own representation of the item.
1151 deriving (Data, Show, Eq )
1152
1153 instance Outputable SourceText where
1154 ppr (SourceText s) = text "SourceText" <+> text s
1155 ppr NoSourceText = text "NoSourceText"
1156
1157 -- | Special combinator for showing string literals.
1158 pprWithSourceText :: SourceText -> SDoc -> SDoc
1159 pprWithSourceText NoSourceText d = d
1160 pprWithSourceText (SourceText src) _ = text src
1161
1162 {-
1163 ************************************************************************
1164 * *
1165 \subsection{Activation}
1166 * *
1167 ************************************************************************
1168
1169 When a rule or inlining is active
1170 -}
1171
1172 -- | Phase Number
1173 type PhaseNum = Int -- Compilation phase
1174 -- Phases decrease towards zero
1175 -- Zero is the last phase
1176
1177 data CompilerPhase
1178 = Phase PhaseNum
1179 | InitialPhase -- The first phase -- number = infinity!
1180
1181 instance Outputable CompilerPhase where
1182 ppr (Phase n) = int n
1183 ppr InitialPhase = text "InitialPhase"
1184
1185 -- See note [Pragma source text]
1186 data Activation = NeverActive
1187 | AlwaysActive
1188 | ActiveBefore SourceText PhaseNum
1189 -- Active only *strictly before* this phase
1190 | ActiveAfter SourceText PhaseNum
1191 -- Active in this phase and later
1192 deriving( Eq, Data )
1193 -- Eq used in comparing rules in HsDecls
1194
1195 -- | Rule Match Information
1196 data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
1197 | FunLike
1198 deriving( Eq, Data, Show )
1199 -- Show needed for Lexer.x
1200
1201 data InlinePragma -- Note [InlinePragma]
1202 = InlinePragma
1203 { inl_src :: SourceText -- Note [Pragma source text]
1204 , inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]
1205
1206 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
1207 -- explicit (non-type, non-dictionary) args
1208 -- That is, inl_sat describes the number of *source-code*
1209 -- arguments the thing must be applied to. We add on the
1210 -- number of implicit, dictionary arguments when making
1211 -- the Unfolding, and don't look at inl_sat further
1212
1213 , inl_act :: Activation -- Says during which phases inlining is allowed
1214 -- See Note [inl_inline and inl_act]
1215
1216 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
1217 } deriving( Eq, Data )
1218
1219 -- | Inline Specification
1220 data InlineSpec -- What the user's INLINE pragma looked like
1221 = Inline
1222 | Inlinable
1223 | NoInline
1224 | EmptyInlineSpec -- Used in a place-holder InlinePragma in SpecPrag or IdInfo,
1225 -- where there isn't any real inline pragma at all
1226 deriving( Eq, Data, Show )
1227 -- Show needed for Lexer.x
1228
1229 {- Note [InlinePragma]
1230 ~~~~~~~~~~~~~~~~~~~~~~
1231 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
1232 the source program.
1233
1234 If you write nothing at all, you get defaultInlinePragma:
1235 inl_inline = EmptyInlineSpec
1236 inl_act = AlwaysActive
1237 inl_rule = FunLike
1238
1239 It's not possible to get that combination by *writing* something, so
1240 if an Id has defaultInlinePragma it means the user didn't specify anything.
1241
1242 If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding.
1243
1244 If you want to know where InlinePragmas take effect: Look in DsBinds.makeCorePair
1245
1246 Note [inl_inline and inl_act]
1247 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1248 * inl_inline says what the user wrote: did she say INLINE, NOINLINE,
1249 INLINABLE, or nothing at all
1250
1251 * inl_act says in what phases the unfolding is active or inactive
1252 E.g If you write INLINE[1] then inl_act will be set to ActiveAfter 1
1253 If you write NOINLINE[1] then inl_act will be set to ActiveBefore 1
1254 If you write NOINLINE[~1] then inl_act will be set to ActiveAfter 1
1255 So note that inl_act does not say what pragma you wrote: it just
1256 expresses its consequences
1257
1258 * inl_act just says when the unfolding is active; it doesn't say what
1259 to inline. If you say INLINE f, then f's inl_act will be AlwaysActive,
1260 but in addition f will get a "stable unfolding" with UnfoldingGuidance
1261 that tells the inliner to be pretty eager about it.
1262
1263 Note [CONLIKE pragma]
1264 ~~~~~~~~~~~~~~~~~~~~~
1265 The ConLike constructor of a RuleMatchInfo is aimed at the following.
1266 Consider first
1267 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
1268 g b bs = let x = b:bs in ..x...x...(r x)...
1269 Now, the rule applies to the (r x) term, because GHC "looks through"
1270 the definition of 'x' to see that it is (b:bs).
1271
1272 Now consider
1273 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
1274 g v = let x = f v in ..x...x...(r x)...
1275 Normally the (r x) would *not* match the rule, because GHC would be
1276 scared about duplicating the redex (f v), so it does not "look
1277 through" the bindings.
1278
1279 However the CONLIKE modifier says to treat 'f' like a constructor in
1280 this situation, and "look through" the unfolding for x. So (r x)
1281 fires, yielding (f (v+1)).
1282
1283 This is all controlled with a user-visible pragma:
1284 {-# NOINLINE CONLIKE [1] f #-}
1285
1286 The main effects of CONLIKE are:
1287
1288 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
1289 CONLIKE thing like constructors, by ANF-ing them
1290
1291 - New function coreUtils.exprIsExpandable is like exprIsCheap, but
1292 additionally spots applications of CONLIKE functions
1293
1294 - A CoreUnfolding has a field that caches exprIsExpandable
1295
1296 - The rule matcher consults this field. See
1297 Note [Expanding variables] in Rules.hs.
1298 -}
1299
1300 isConLike :: RuleMatchInfo -> Bool
1301 isConLike ConLike = True
1302 isConLike _ = False
1303
1304 isFunLike :: RuleMatchInfo -> Bool
1305 isFunLike FunLike = True
1306 isFunLike _ = False
1307
1308 isEmptyInlineSpec :: InlineSpec -> Bool
1309 isEmptyInlineSpec EmptyInlineSpec = True
1310 isEmptyInlineSpec _ = False
1311
1312 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
1313 :: InlinePragma
1314 defaultInlinePragma = InlinePragma { inl_src = SourceText "{-# INLINE"
1315 , inl_act = AlwaysActive
1316 , inl_rule = FunLike
1317 , inl_inline = EmptyInlineSpec
1318 , inl_sat = Nothing }
1319
1320 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
1321 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
1322
1323 inlinePragmaSpec :: InlinePragma -> InlineSpec
1324 inlinePragmaSpec = inl_inline
1325
1326 -- A DFun has an always-active inline activation so that
1327 -- exprIsConApp_maybe can "see" its unfolding
1328 -- (However, its actual Unfolding is a DFunUnfolding, which is
1329 -- never inlined other than via exprIsConApp_maybe.)
1330 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
1331 , inl_rule = ConLike }
1332
1333 isDefaultInlinePragma :: InlinePragma -> Bool
1334 isDefaultInlinePragma (InlinePragma { inl_act = activation
1335 , inl_rule = match_info
1336 , inl_inline = inline })
1337 = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
1338
1339 isInlinePragma :: InlinePragma -> Bool
1340 isInlinePragma prag = case inl_inline prag of
1341 Inline -> True
1342 _ -> False
1343
1344 isInlinablePragma :: InlinePragma -> Bool
1345 isInlinablePragma prag = case inl_inline prag of
1346 Inlinable -> True
1347 _ -> False
1348
1349 isAnyInlinePragma :: InlinePragma -> Bool
1350 -- INLINE or INLINABLE
1351 isAnyInlinePragma prag = case inl_inline prag of
1352 Inline -> True
1353 Inlinable -> True
1354 _ -> False
1355
1356 inlinePragmaSat :: InlinePragma -> Maybe Arity
1357 inlinePragmaSat = inl_sat
1358
1359 inlinePragmaActivation :: InlinePragma -> Activation
1360 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
1361
1362 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
1363 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
1364
1365 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
1366 setInlinePragmaActivation prag activation = prag { inl_act = activation }
1367
1368 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
1369 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
1370
1371 instance Outputable Activation where
1372 ppr AlwaysActive = empty
1373 ppr NeverActive = brackets (text "~")
1374 ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
1375 ppr (ActiveAfter _ n) = brackets (int n)
1376
1377 instance Outputable RuleMatchInfo where
1378 ppr ConLike = text "CONLIKE"
1379 ppr FunLike = text "FUNLIKE"
1380
1381 instance Outputable InlineSpec where
1382 ppr Inline = text "INLINE"
1383 ppr NoInline = text "NOINLINE"
1384 ppr Inlinable = text "INLINABLE"
1385 ppr EmptyInlineSpec = empty
1386
1387 instance Outputable InlinePragma where
1388 ppr = pprInline
1389
1390 pprInline :: InlinePragma -> SDoc
1391 pprInline = pprInline' True
1392
1393 pprInlineDebug :: InlinePragma -> SDoc
1394 pprInlineDebug = pprInline' False
1395
1396 pprInline' :: Bool -> InlinePragma -> SDoc
1397 pprInline' emptyInline (InlinePragma { inl_inline = inline, inl_act = activation
1398 , inl_rule = info, inl_sat = mb_arity })
1399 = pp_inl inline <> pp_act inline activation <+> pp_sat <+> pp_info
1400 where
1401 pp_inl x = if emptyInline then empty else ppr x
1402
1403 pp_act Inline AlwaysActive = empty
1404 pp_act NoInline NeverActive = empty
1405 pp_act _ act = ppr act
1406
1407 pp_sat | Just ar <- mb_arity = parens (text "sat-args=" <> int ar)
1408 | otherwise = empty
1409 pp_info | isFunLike info = empty
1410 | otherwise = ppr info
1411
1412 isActive :: CompilerPhase -> Activation -> Bool
1413 isActive InitialPhase AlwaysActive = True
1414 isActive InitialPhase (ActiveBefore {}) = True
1415 isActive InitialPhase _ = False
1416 isActive (Phase p) act = isActiveIn p act
1417
1418 isActiveIn :: PhaseNum -> Activation -> Bool
1419 isActiveIn _ NeverActive = False
1420 isActiveIn _ AlwaysActive = True
1421 isActiveIn p (ActiveAfter _ n) = p <= n
1422 isActiveIn p (ActiveBefore _ n) = p > n
1423
1424 competesWith :: Activation -> Activation -> Bool
1425 -- See Note [Activation competition]
1426 competesWith NeverActive _ = False
1427 competesWith _ NeverActive = False
1428 competesWith AlwaysActive _ = True
1429
1430 competesWith (ActiveBefore {}) AlwaysActive = True
1431 competesWith (ActiveBefore {}) (ActiveBefore {}) = True
1432 competesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b
1433
1434 competesWith (ActiveAfter {}) AlwaysActive = False
1435 competesWith (ActiveAfter {}) (ActiveBefore {}) = False
1436 competesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b
1437
1438 {- Note [Competing activations]
1439 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1440 Sometimes a RULE and an inlining may compete, or two RULES.
1441 See Note [Rules and inlining/other rules] in Desugar.
1442
1443 We say that act1 "competes with" act2 iff
1444 act1 is active in the phase when act2 *becomes* active
1445 NB: remember that phases count *down*: 2, 1, 0!
1446
1447 It's too conservative to ensure that the two are never simultaneously
1448 active. For example, a rule might be always active, and an inlining
1449 might switch on in phase 2. We could switch off the rule, but it does
1450 no harm.
1451 -}
1452
1453 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
1454 isNeverActive NeverActive = True
1455 isNeverActive _ = False
1456
1457 isAlwaysActive AlwaysActive = True
1458 isAlwaysActive _ = False
1459
1460 isEarlyActive AlwaysActive = True
1461 isEarlyActive (ActiveBefore {}) = True
1462 isEarlyActive _ = False
1463
1464 -- | Integral Literal
1465 --
1466 -- Used (instead of Integer) to represent negative zegative zero which is
1467 -- required for NegativeLiterals extension to correctly parse `-0::Double`
1468 -- as negative zero. See also #13211.
1469 data IntegralLit
1470 = IL { il_text :: SourceText
1471 , il_neg :: Bool -- See Note [Negative zero]
1472 , il_value :: Integer
1473 }
1474 deriving (Data, Show)
1475
1476 mkIntegralLit :: Integral a => a -> IntegralLit
1477 mkIntegralLit i = IL { il_text = SourceText (show (fromIntegral i :: Int))
1478 , il_neg = i < 0
1479 , il_value = toInteger i }
1480
1481 negateIntegralLit :: IntegralLit -> IntegralLit
1482 negateIntegralLit (IL text neg value)
1483 = case text of
1484 SourceText ('-':src) -> IL (SourceText src) False (negate value)
1485 SourceText src -> IL (SourceText ('-':src)) True (negate value)
1486 NoSourceText -> IL NoSourceText (not neg) (negate value)
1487
1488 -- | Fractional Literal
1489 --
1490 -- Used (instead of Rational) to represent exactly the floating point literal that we
1491 -- encountered in the user's source program. This allows us to pretty-print exactly what
1492 -- the user wrote, which is important e.g. for floating point numbers that can't represented
1493 -- as Doubles (we used to via Double for pretty-printing). See also #2245.
1494 data FractionalLit
1495 = FL { fl_text :: SourceText -- How the value was written in the source
1496 , fl_neg :: Bool -- See Note [Negative zero]
1497 , fl_value :: Rational -- Numeric value of the literal
1498 }
1499 deriving (Data, Show)
1500 -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on
1501
1502 mkFractionalLit :: Real a => a -> FractionalLit
1503 mkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double))
1504 , fl_neg = r < 0
1505 , fl_value = toRational r }
1506
1507 negateFractionalLit :: FractionalLit -> FractionalLit
1508 negateFractionalLit (FL text neg value)
1509 = case text of
1510 SourceText ('-':src) -> FL (SourceText src) False value
1511 SourceText src -> FL (SourceText ('-':src)) True value
1512 NoSourceText -> FL NoSourceText (not neg) (negate value)
1513
1514 integralFractionalLit :: Bool -> Integer -> FractionalLit
1515 integralFractionalLit neg i = FL { fl_text = SourceText (show i),
1516 fl_neg = neg,
1517 fl_value = fromInteger i }
1518
1519 -- Comparison operations are needed when grouping literals
1520 -- for compiling pattern-matching (module MatchLit)
1521
1522 instance Eq IntegralLit where
1523 (==) = (==) `on` il_value
1524
1525 instance Ord IntegralLit where
1526 compare = compare `on` il_value
1527
1528 instance Outputable IntegralLit where
1529 ppr (IL (SourceText src) _ _) = text src
1530 ppr (IL NoSourceText _ value) = text (show value)
1531
1532 instance Eq FractionalLit where
1533 (==) = (==) `on` fl_value
1534
1535 instance Ord FractionalLit where
1536 compare = compare `on` fl_value
1537
1538 instance Outputable FractionalLit where
1539 ppr f = pprWithSourceText (fl_text f) (rational (fl_value f))
1540
1541 {-
1542 ************************************************************************
1543 * *
1544 IntWithInf
1545 * *
1546 ************************************************************************
1547
1548 Represents an integer or positive infinity
1549
1550 -}
1551
1552 -- | An integer or infinity
1553 data IntWithInf = Int {-# UNPACK #-} !Int
1554 | Infinity
1555 deriving Eq
1556
1557 -- | A representation of infinity
1558 infinity :: IntWithInf
1559 infinity = Infinity
1560
1561 instance Ord IntWithInf where
1562 compare Infinity Infinity = EQ
1563 compare (Int _) Infinity = LT
1564 compare Infinity (Int _) = GT
1565 compare (Int a) (Int b) = a `compare` b
1566
1567 instance Outputable IntWithInf where
1568 ppr Infinity = char ''
1569 ppr (Int n) = int n
1570
1571 instance Num IntWithInf where
1572 (+) = plusWithInf
1573 (*) = mulWithInf
1574
1575 abs Infinity = Infinity
1576 abs (Int n) = Int (abs n)
1577
1578 signum Infinity = Int 1
1579 signum (Int n) = Int (signum n)
1580
1581 fromInteger = Int . fromInteger
1582
1583 (-) = panic "subtracting IntWithInfs"
1584
1585 intGtLimit :: Int -> IntWithInf -> Bool
1586 intGtLimit _ Infinity = False
1587 intGtLimit n (Int m) = n > m
1588
1589 -- | Add two 'IntWithInf's
1590 plusWithInf :: IntWithInf -> IntWithInf -> IntWithInf
1591 plusWithInf Infinity _ = Infinity
1592 plusWithInf _ Infinity = Infinity
1593 plusWithInf (Int a) (Int b) = Int (a + b)
1594
1595 -- | Multiply two 'IntWithInf's
1596 mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf
1597 mulWithInf Infinity _ = Infinity
1598 mulWithInf _ Infinity = Infinity
1599 mulWithInf (Int a) (Int b) = Int (a * b)
1600
1601 -- | Turn a positive number into an 'IntWithInf', where 0 represents infinity
1602 treatZeroAsInf :: Int -> IntWithInf
1603 treatZeroAsInf 0 = Infinity
1604 treatZeroAsInf n = Int n
1605
1606 -- | Inject any integer into an 'IntWithInf'
1607 mkIntWithInf :: Int -> IntWithInf
1608 mkIntWithInf = Int
1609
1610 data SpliceExplicitFlag
1611 = ExplicitSplice | -- ^ <=> $(f x y)
1612 ImplicitSplice -- ^ <=> f x y, i.e. a naked top level expression
1613 deriving Data