7fe4cb9c541a158abef849d96452d2118b2c193f
[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 ConTag, fIRST_TAG,
23
24 Arity, RepArity,
25
26 Alignment,
27
28 FunctionOrData(..),
29
30 WarningTxt(..), StringLiteral(..),
31
32 Fixity(..), FixityDirection(..),
33 defaultFixity, maxPrecedence, minPrecedence,
34 negateFixity, funTyFixity,
35 compareFixity,
36
37 RecFlag(..), isRec, isNonRec, boolToRecFlag,
38 Origin(..), isGenerated,
39
40 RuleName, pprRuleName,
41
42 TopLevelFlag(..), isTopLevel, isNotTopLevel,
43
44 OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
45 hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,
46
47 Boxity(..), isBoxed,
48
49 TupleSort(..), tupleSortBoxity, boxityTupleSort,
50 tupleParens,
51
52 -- ** The OneShotInfo type
53 OneShotInfo(..),
54 noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
55 bestOneShot, worstOneShot,
56
57 OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc,
58 isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isNoOcc,
59 strongLoopBreaker, weakLoopBreaker,
60
61 InsideLam, insideLam, notInsideLam,
62 OneBranch, oneBranch, notOneBranch,
63 InterestingCxt,
64
65 EP(..),
66
67 DefMethSpec(..),
68 SwapFlag(..), flipSwap, unSwap, isSwapped,
69
70 CompilerPhase(..), PhaseNum,
71
72 Activation(..), isActive, isActiveIn, competesWith,
73 isNeverActive, isAlwaysActive, isEarlyActive,
74
75 RuleMatchInfo(..), isConLike, isFunLike,
76 InlineSpec(..), isEmptyInlineSpec,
77 InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
78 neverInlinePragma, dfunInlinePragma,
79 isDefaultInlinePragma,
80 isInlinePragma, isInlinablePragma, isAnyInlinePragma,
81 inlinePragmaSpec, inlinePragmaSat,
82 inlinePragmaActivation, inlinePragmaRuleMatchInfo,
83 setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
84
85 SuccessFlag(..), succeeded, failed, successIf,
86
87 FractionalLit(..), negateFractionalLit, integralFractionalLit,
88
89 SourceText,
90
91 IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit
92 ) where
93
94 import FastString
95 import Outputable
96 import SrcLoc ( Located,unLoc )
97 import StaticFlags( opt_PprStyle_Debug )
98 import Data.Data hiding (Fixity)
99 import Data.Function (on)
100
101 {-
102 ************************************************************************
103 * *
104 \subsection[Arity]{Arity}
105 * *
106 ************************************************************************
107 -}
108
109 -- | The number of value arguments that can be applied to a value before it does
110 -- "real work". So:
111 -- fib 100 has arity 0
112 -- \x -> fib x has arity 1
113 -- See also Note [Definition of arity] in CoreArity
114 type Arity = Int
115
116 -- | The number of represented arguments that can be applied to a value before it does
117 -- "real work". So:
118 -- fib 100 has representation arity 0
119 -- \x -> fib x has representation arity 1
120 -- \(# x, y #) -> fib (x + y) has representation arity 2
121 type RepArity = Int
122
123 {-
124 ************************************************************************
125 * *
126 Constructor tags
127 * *
128 ************************************************************************
129 -}
130
131 -- | Type of the tags associated with each constructor possibility
132 -- or superclass selector
133 type ConTag = Int
134
135 fIRST_TAG :: ConTag
136 -- ^ Tags are allocated from here for real constructors
137 -- or for superclass selectors
138 fIRST_TAG = 1
139
140 {-
141 ************************************************************************
142 * *
143 \subsection[Alignment]{Alignment}
144 * *
145 ************************************************************************
146 -}
147
148 type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
149
150 {-
151 ************************************************************************
152 * *
153 One-shot information
154 * *
155 ************************************************************************
156 -}
157
158 -- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
159 -- variable info. Sometimes we know whether the lambda binding this variable
160 -- is a \"one-shot\" lambda; that is, whether it is applied at most once.
161 --
162 -- This information may be useful in optimisation, as computations may
163 -- safely be floated inside such a lambda without risk of duplicating
164 -- work.
165 data OneShotInfo
166 = NoOneShotInfo -- ^ No information
167 | ProbOneShot -- ^ The lambda is probably applied at most once
168 -- See Note [Computing one-shot info, and ProbOneShot] in Demand
169 | OneShotLam -- ^ The lambda is applied at most once.
170 deriving (Eq)
171
172 -- | It is always safe to assume that an 'Id' has no lambda-bound variable information
173 noOneShotInfo :: OneShotInfo
174 noOneShotInfo = NoOneShotInfo
175
176 isOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool
177 isOneShotInfo OneShotLam = True
178 isOneShotInfo _ = False
179
180 hasNoOneShotInfo NoOneShotInfo = True
181 hasNoOneShotInfo _ = False
182
183 worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
184 worstOneShot NoOneShotInfo _ = NoOneShotInfo
185 worstOneShot ProbOneShot NoOneShotInfo = NoOneShotInfo
186 worstOneShot ProbOneShot _ = ProbOneShot
187 worstOneShot OneShotLam os = os
188
189 bestOneShot NoOneShotInfo os = os
190 bestOneShot ProbOneShot OneShotLam = OneShotLam
191 bestOneShot ProbOneShot _ = ProbOneShot
192 bestOneShot OneShotLam _ = OneShotLam
193
194 pprOneShotInfo :: OneShotInfo -> SDoc
195 pprOneShotInfo NoOneShotInfo = empty
196 pprOneShotInfo ProbOneShot = text "ProbOneShot"
197 pprOneShotInfo OneShotLam = text "OneShot"
198
199 instance Outputable OneShotInfo where
200 ppr = pprOneShotInfo
201
202 {-
203 ************************************************************************
204 * *
205 Swap flag
206 * *
207 ************************************************************************
208 -}
209
210 data SwapFlag
211 = NotSwapped -- Args are: actual, expected
212 | IsSwapped -- Args are: expected, actual
213
214 instance Outputable SwapFlag where
215 ppr IsSwapped = text "Is-swapped"
216 ppr NotSwapped = text "Not-swapped"
217
218 flipSwap :: SwapFlag -> SwapFlag
219 flipSwap IsSwapped = NotSwapped
220 flipSwap NotSwapped = IsSwapped
221
222 isSwapped :: SwapFlag -> Bool
223 isSwapped IsSwapped = True
224 isSwapped NotSwapped = False
225
226 unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b
227 unSwap NotSwapped f a b = f a b
228 unSwap IsSwapped f a b = f b a
229
230 {-
231 ************************************************************************
232 * *
233 \subsection[FunctionOrData]{FunctionOrData}
234 * *
235 ************************************************************************
236 -}
237
238 data FunctionOrData = IsFunction | IsData
239 deriving (Eq, Ord, Data)
240
241 instance Outputable FunctionOrData where
242 ppr IsFunction = text "(function)"
243 ppr IsData = text "(data)"
244
245 {-
246 ************************************************************************
247 * *
248 \subsection[Version]{Module and identifier version numbers}
249 * *
250 ************************************************************************
251 -}
252
253 type Version = Int
254
255 bumpVersion :: Version -> Version
256 bumpVersion v = v+1
257
258 initialVersion :: Version
259 initialVersion = 1
260
261 {-
262 ************************************************************************
263 * *
264 Deprecations
265 * *
266 ************************************************************************
267 -}
268
269 -- |A String Literal in the source, including its original raw format for use by
270 -- source to source manipulation tools.
271 data StringLiteral = StringLiteral
272 { sl_st :: SourceText, -- literal raw source.
273 -- See not [Literal source text]
274 sl_fs :: FastString -- literal string value
275 } deriving Data
276
277 instance Eq StringLiteral where
278 (StringLiteral _ a) == (StringLiteral _ b) = a == b
279
280 -- reason/explanation from a WARNING or DEPRECATED pragma
281 data WarningTxt = WarningTxt (Located SourceText)
282 [Located StringLiteral]
283 | DeprecatedTxt (Located SourceText)
284 [Located StringLiteral]
285 deriving (Eq, Data)
286
287 instance Outputable WarningTxt where
288 ppr (WarningTxt _ ws)
289 = doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws))
290 ppr (DeprecatedTxt _ ds)
291 = text "Deprecated:" <+>
292 doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds))
293
294 {-
295 ************************************************************************
296 * *
297 Rules
298 * *
299 ************************************************************************
300 -}
301
302 type RuleName = FastString
303
304 pprRuleName :: RuleName -> SDoc
305 pprRuleName rn = doubleQuotes (ftext rn)
306
307 {-
308 ************************************************************************
309 * *
310 \subsection[Fixity]{Fixity info}
311 * *
312 ************************************************************************
313 -}
314
315 ------------------------
316 data Fixity = Fixity SourceText Int FixityDirection
317 -- Note [Pragma source text]
318 deriving Data
319
320 instance Outputable Fixity where
321 ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
322
323 instance Eq Fixity where -- Used to determine if two fixities conflict
324 (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2
325
326 ------------------------
327 data FixityDirection = InfixL | InfixR | InfixN
328 deriving (Eq, Data)
329
330 instance Outputable FixityDirection where
331 ppr InfixL = text "infixl"
332 ppr InfixR = text "infixr"
333 ppr InfixN = text "infix"
334
335 ------------------------
336 maxPrecedence, minPrecedence :: Int
337 maxPrecedence = 9
338 minPrecedence = 0
339
340 defaultFixity :: Fixity
341 defaultFixity = Fixity (show maxPrecedence) maxPrecedence InfixL
342
343 negateFixity, funTyFixity :: Fixity
344 -- Wired-in fixities
345 negateFixity = Fixity "6" 6 InfixL -- Fixity of unary negate
346 funTyFixity = Fixity "0" 0 InfixR -- Fixity of '->'
347
348 {-
349 Consider
350
351 \begin{verbatim}
352 a `op1` b `op2` c
353 \end{verbatim}
354 @(compareFixity op1 op2)@ tells which way to arrange appication, or
355 whether there's an error.
356 -}
357
358 compareFixity :: Fixity -> Fixity
359 -> (Bool, -- Error please
360 Bool) -- Associate to the right: a op1 (b op2 c)
361 compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
362 = case prec1 `compare` prec2 of
363 GT -> left
364 LT -> right
365 EQ -> case (dir1, dir2) of
366 (InfixR, InfixR) -> right
367 (InfixL, InfixL) -> left
368 _ -> error_please
369 where
370 right = (False, True)
371 left = (False, False)
372 error_please = (True, False)
373
374 {-
375 ************************************************************************
376 * *
377 \subsection[Top-level/local]{Top-level/not-top level flag}
378 * *
379 ************************************************************************
380 -}
381
382 data TopLevelFlag
383 = TopLevel
384 | NotTopLevel
385
386 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
387
388 isNotTopLevel NotTopLevel = True
389 isNotTopLevel TopLevel = False
390
391 isTopLevel TopLevel = True
392 isTopLevel NotTopLevel = False
393
394 instance Outputable TopLevelFlag where
395 ppr TopLevel = text "<TopLevel>"
396 ppr NotTopLevel = text "<NotTopLevel>"
397
398 {-
399 ************************************************************************
400 * *
401 Boxity flag
402 * *
403 ************************************************************************
404 -}
405
406 data Boxity
407 = Boxed
408 | Unboxed
409 deriving( Eq, Data )
410
411 isBoxed :: Boxity -> Bool
412 isBoxed Boxed = True
413 isBoxed Unboxed = False
414
415 instance Outputable Boxity where
416 ppr Boxed = text "Boxed"
417 ppr Unboxed = text "Unboxed"
418
419 {-
420 ************************************************************************
421 * *
422 Recursive/Non-Recursive flag
423 * *
424 ************************************************************************
425 -}
426
427 data RecFlag = Recursive
428 | NonRecursive
429 deriving( Eq, Data )
430
431 isRec :: RecFlag -> Bool
432 isRec Recursive = True
433 isRec NonRecursive = False
434
435 isNonRec :: RecFlag -> Bool
436 isNonRec Recursive = False
437 isNonRec NonRecursive = True
438
439 boolToRecFlag :: Bool -> RecFlag
440 boolToRecFlag True = Recursive
441 boolToRecFlag False = NonRecursive
442
443 instance Outputable RecFlag where
444 ppr Recursive = text "Recursive"
445 ppr NonRecursive = text "NonRecursive"
446
447 {-
448 ************************************************************************
449 * *
450 Code origin
451 * *
452 ************************************************************************
453 -}
454
455 data Origin = FromSource
456 | Generated
457 deriving( Eq, Data )
458
459 isGenerated :: Origin -> Bool
460 isGenerated Generated = True
461 isGenerated FromSource = False
462
463 instance Outputable Origin where
464 ppr FromSource = text "FromSource"
465 ppr Generated = text "Generated"
466
467 {-
468 ************************************************************************
469 * *
470 Instance overlap flag
471 * *
472 ************************************************************************
473 -}
474
475 -- | The semantics allowed for overlapping instances for a particular
476 -- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.hs`) for a
477 -- explanation of the `isSafeOverlap` field.
478 --
479 -- - 'ApiAnnotation.AnnKeywordId' :
480 -- 'ApiAnnotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
481 -- @'\{-\# OVERLAPPING'@ or
482 -- @'\{-\# OVERLAPS'@ or
483 -- @'\{-\# INCOHERENT'@,
484 -- 'ApiAnnotation.AnnClose' @`\#-\}`@,
485
486 -- For details on above see note [Api annotations] in ApiAnnotation
487 data OverlapFlag = OverlapFlag
488 { overlapMode :: OverlapMode
489 , isSafeOverlap :: Bool
490 } deriving (Eq, Data)
491
492 setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
493 setOverlapModeMaybe f Nothing = f
494 setOverlapModeMaybe f (Just m) = f { overlapMode = m }
495
496 hasIncoherentFlag :: OverlapMode -> Bool
497 hasIncoherentFlag mode =
498 case mode of
499 Incoherent _ -> True
500 _ -> False
501
502 hasOverlappableFlag :: OverlapMode -> Bool
503 hasOverlappableFlag mode =
504 case mode of
505 Overlappable _ -> True
506 Overlaps _ -> True
507 Incoherent _ -> True
508 _ -> False
509
510 hasOverlappingFlag :: OverlapMode -> Bool
511 hasOverlappingFlag mode =
512 case mode of
513 Overlapping _ -> True
514 Overlaps _ -> True
515 Incoherent _ -> True
516 _ -> False
517
518 data OverlapMode -- See Note [Rules for instance lookup] in InstEnv
519 = NoOverlap SourceText
520 -- See Note [Pragma source text]
521 -- ^ This instance must not overlap another `NoOverlap` instance.
522 -- However, it may be overlapped by `Overlapping` instances,
523 -- and it may overlap `Overlappable` instances.
524
525
526 | Overlappable SourceText
527 -- See Note [Pragma source text]
528 -- ^ Silently ignore this instance if you find a
529 -- more specific one that matches the constraint
530 -- you are trying to resolve
531 --
532 -- Example: constraint (Foo [Int])
533 -- instance Foo [Int]
534 -- instance {-# OVERLAPPABLE #-} Foo [a]
535 --
536 -- Since the second instance has the Overlappable flag,
537 -- the first instance will be chosen (otherwise
538 -- its ambiguous which to choose)
539
540
541 | Overlapping SourceText
542 -- See Note [Pragma source text]
543 -- ^ Silently ignore any more general instances that may be
544 -- used to solve the constraint.
545 --
546 -- Example: constraint (Foo [Int])
547 -- instance {-# OVERLAPPING #-} Foo [Int]
548 -- instance Foo [a]
549 --
550 -- Since the first instance has the Overlapping flag,
551 -- the second---more general---instance will be ignored (otherwise
552 -- it is ambiguous which to choose)
553
554
555 | Overlaps SourceText
556 -- See Note [Pragma source text]
557 -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
558
559 | Incoherent SourceText
560 -- See Note [Pragma source text]
561 -- ^ Behave like Overlappable and Overlapping, and in addition pick
562 -- an an arbitrary one if there are multiple matching candidates, and
563 -- don't worry about later instantiation
564 --
565 -- Example: constraint (Foo [b])
566 -- instance {-# INCOHERENT -} Foo [Int]
567 -- instance Foo [a]
568 -- Without the Incoherent flag, we'd complain that
569 -- instantiating 'b' would change which instance
570 -- was chosen. See also note [Incoherent instances] in InstEnv
571
572 deriving (Eq, Data)
573
574
575 instance Outputable OverlapFlag where
576 ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
577
578 instance Outputable OverlapMode where
579 ppr (NoOverlap _) = empty
580 ppr (Overlappable _) = text "[overlappable]"
581 ppr (Overlapping _) = text "[overlapping]"
582 ppr (Overlaps _) = text "[overlap ok]"
583 ppr (Incoherent _) = text "[incoherent]"
584
585 pprSafeOverlap :: Bool -> SDoc
586 pprSafeOverlap True = text "[safe]"
587 pprSafeOverlap False = empty
588
589 {-
590 ************************************************************************
591 * *
592 Tuples
593 * *
594 ************************************************************************
595 -}
596
597 data TupleSort
598 = BoxedTuple
599 | UnboxedTuple
600 | ConstraintTuple
601 deriving( Eq, Data )
602
603 tupleSortBoxity :: TupleSort -> Boxity
604 tupleSortBoxity BoxedTuple = Boxed
605 tupleSortBoxity UnboxedTuple = Unboxed
606 tupleSortBoxity ConstraintTuple = Boxed
607
608 boxityTupleSort :: Boxity -> TupleSort
609 boxityTupleSort Boxed = BoxedTuple
610 boxityTupleSort Unboxed = UnboxedTuple
611
612 tupleParens :: TupleSort -> SDoc -> SDoc
613 tupleParens BoxedTuple p = parens p
614 tupleParens UnboxedTuple p = text "(#" <+> p <+> ptext (sLit "#)")
615 tupleParens ConstraintTuple p -- In debug-style write (% Eq a, Ord b %)
616 | opt_PprStyle_Debug = text "(%" <+> p <+> ptext (sLit "%)")
617 | otherwise = parens p
618
619 {-
620 ************************************************************************
621 * *
622 \subsection[Generic]{Generic flag}
623 * *
624 ************************************************************************
625
626 This is the "Embedding-Projection pair" datatype, it contains
627 two pieces of code (normally either RenamedExpr's or Id's)
628 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
629 represents functions of type
630
631 from :: T -> Tring
632 to :: Tring -> T
633
634 And we should have
635
636 to (from x) = x
637
638 T and Tring are arbitrary, but typically T is the 'main' type while
639 Tring is the 'representation' type. (This just helps us remember
640 whether to use 'from' or 'to'.
641 -}
642
643 data EP a = EP { fromEP :: a, -- :: T -> Tring
644 toEP :: a } -- :: Tring -> T
645
646 {-
647 Embedding-projection pairs are used in several places:
648
649 First of all, each type constructor has an EP associated with it, the
650 code in EP converts (datatype T) from T to Tring and back again.
651
652 Secondly, when we are filling in Generic methods (in the typechecker,
653 tcMethodBinds), we are constructing bimaps by induction on the structure
654 of the type of the method signature.
655
656
657 ************************************************************************
658 * *
659 \subsection{Occurrence information}
660 * *
661 ************************************************************************
662
663 This data type is used exclusively by the simplifier, but it appears in a
664 SubstResult, which is currently defined in VarEnv, which is pretty near
665 the base of the module hierarchy. So it seemed simpler to put the
666 defn of OccInfo here, safely at the bottom
667 -}
668
669 -- | Identifier occurrence information
670 data OccInfo
671 = NoOccInfo -- ^ There are many occurrences, or unknown occurrences
672
673 | IAmDead -- ^ Marks unused variables. Sometimes useful for
674 -- lambda and case-bound variables.
675
676 | OneOcc
677 !InsideLam
678 !OneBranch
679 !InterestingCxt -- ^ Occurs exactly once, not inside a rule
680
681 -- | This identifier breaks a loop of mutually recursive functions. The field
682 -- marks whether it is only a loop breaker due to a reference in a rule
683 | IAmALoopBreaker -- Note [LoopBreaker OccInfo]
684 !RulesOnly
685
686 deriving (Eq)
687
688 type RulesOnly = Bool
689
690 {-
691 Note [LoopBreaker OccInfo]
692 ~~~~~~~~~~~~~~~~~~~~~~~~~~
693 IAmALoopBreaker True <=> A "weak" or rules-only loop breaker
694 Do not preInlineUnconditionally
695
696 IAmALoopBreaker False <=> A "strong" loop breaker
697 Do not inline at all
698
699 See OccurAnal Note [Weak loop breakers]
700 -}
701
702 isNoOcc :: OccInfo -> Bool
703 isNoOcc NoOccInfo = True
704 isNoOcc _ = False
705
706 seqOccInfo :: OccInfo -> ()
707 seqOccInfo occ = occ `seq` ()
708
709 -----------------
710 type InterestingCxt = Bool -- True <=> Function: is applied
711 -- Data value: scrutinised by a case with
712 -- at least one non-DEFAULT branch
713
714 -----------------
715 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
716 -- Substituting a redex for this occurrence is
717 -- dangerous because it might duplicate work.
718 insideLam, notInsideLam :: InsideLam
719 insideLam = True
720 notInsideLam = False
721
722 -----------------
723 type OneBranch = Bool -- True <=> Occurs in only one case branch
724 -- so no code-duplication issue to worry about
725 oneBranch, notOneBranch :: OneBranch
726 oneBranch = True
727 notOneBranch = False
728
729 strongLoopBreaker, weakLoopBreaker :: OccInfo
730 strongLoopBreaker = IAmALoopBreaker False
731 weakLoopBreaker = IAmALoopBreaker True
732
733 isWeakLoopBreaker :: OccInfo -> Bool
734 isWeakLoopBreaker (IAmALoopBreaker _) = True
735 isWeakLoopBreaker _ = False
736
737 isStrongLoopBreaker :: OccInfo -> Bool
738 isStrongLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
739 isStrongLoopBreaker _ = False
740
741 isDeadOcc :: OccInfo -> Bool
742 isDeadOcc IAmDead = True
743 isDeadOcc _ = False
744
745 isOneOcc :: OccInfo -> Bool
746 isOneOcc (OneOcc {}) = True
747 isOneOcc _ = False
748
749 zapFragileOcc :: OccInfo -> OccInfo
750 zapFragileOcc (OneOcc {}) = NoOccInfo
751 zapFragileOcc occ = occ
752
753 instance Outputable OccInfo where
754 -- only used for debugging; never parsed. KSW 1999-07
755 ppr NoOccInfo = empty
756 ppr (IAmALoopBreaker ro) = text "LoopBreaker" <> if ro then char '!' else empty
757 ppr IAmDead = text "Dead"
758 ppr (OneOcc inside_lam one_branch int_cxt)
759 = text "Once" <> pp_lam <> pp_br <> pp_args
760 where
761 pp_lam | inside_lam = char 'L'
762 | otherwise = empty
763 pp_br | one_branch = empty
764 | otherwise = char '*'
765 pp_args | int_cxt = char '!'
766 | otherwise = empty
767
768 {-
769 ************************************************************************
770 * *
771 Default method specfication
772 * *
773 ************************************************************************
774
775 The DefMethSpec enumeration just indicates what sort of default method
776 is used for a class. It is generated from source code, and present in
777 interface files; it is converted to Class.DefMethInfo before begin put in a
778 Class object.
779 -}
780
781 data DefMethSpec ty
782 = VanillaDM -- Default method given with polymorphic code
783 | GenericDM ty -- Default method given with code of this type
784
785 instance Outputable (DefMethSpec ty) where
786 ppr VanillaDM = text "{- Has default method -}"
787 ppr (GenericDM {}) = text "{- Has generic default method -}"
788
789 {-
790 ************************************************************************
791 * *
792 \subsection{Success flag}
793 * *
794 ************************************************************************
795 -}
796
797 data SuccessFlag = Succeeded | Failed
798
799 instance Outputable SuccessFlag where
800 ppr Succeeded = text "Succeeded"
801 ppr Failed = text "Failed"
802
803 successIf :: Bool -> SuccessFlag
804 successIf True = Succeeded
805 successIf False = Failed
806
807 succeeded, failed :: SuccessFlag -> Bool
808 succeeded Succeeded = True
809 succeeded Failed = False
810
811 failed Succeeded = False
812 failed Failed = True
813
814 {-
815 ************************************************************************
816 * *
817 \subsection{Source Text}
818 * *
819 ************************************************************************
820 Keeping Source Text for source to source conversions
821
822 Note [Pragma source text]
823 ~~~~~~~~~~~~~~~~~~~~~~~~~
824 The lexer does a case-insensitive match for pragmas, as well as
825 accepting both UK and US spelling variants.
826
827 So
828
829 {-# SPECIALISE #-}
830 {-# SPECIALIZE #-}
831 {-# Specialize #-}
832
833 will all generate ITspec_prag token for the start of the pragma.
834
835 In order to be able to do source to source conversions, the original
836 source text for the token needs to be preserved, hence the
837 `SourceText` field.
838
839 So the lexer will then generate
840
841 ITspec_prag "{ -# SPECIALISE"
842 ITspec_prag "{ -# SPECIALIZE"
843 ITspec_prag "{ -# Specialize"
844
845 for the cases above.
846 [without the space between '{' and '-', otherwise this comment won't parse]
847
848
849 Note [Literal source text]
850 ~~~~~~~~~~~~~~~~~~~~~~~~~~
851 The lexer/parser converts literals from their original source text
852 versions to an appropriate internal representation. This is a problem
853 for tools doing source to source conversions, so the original source
854 text is stored in literals where this can occur.
855
856 Motivating examples for HsLit
857
858 HsChar '\n' == '\x20`
859 HsCharPrim '\x41`# == `A`
860 HsString "\x20\x41" == " A"
861 HsStringPrim "\x20"# == " "#
862 HsInt 001 == 1
863 HsIntPrim 002# == 2#
864 HsWordPrim 003## == 3##
865 HsInt64Prim 004## == 4##
866 HsWord64Prim 005## == 5##
867 HsInteger 006 == 6
868
869 For OverLitVal
870
871 HsIntegral 003 == 0x003
872 HsIsString "\x41nd" == "And"
873 -}
874
875 type SourceText = String -- Note [Literal source text],[Pragma source text]
876
877
878 {-
879 ************************************************************************
880 * *
881 \subsection{Activation}
882 * *
883 ************************************************************************
884
885 When a rule or inlining is active
886 -}
887
888 type PhaseNum = Int -- Compilation phase
889 -- Phases decrease towards zero
890 -- Zero is the last phase
891
892 data CompilerPhase
893 = Phase PhaseNum
894 | InitialPhase -- The first phase -- number = infinity!
895
896 instance Outputable CompilerPhase where
897 ppr (Phase n) = int n
898 ppr InitialPhase = text "InitialPhase"
899
900 -- See note [Pragma source text]
901 data Activation = NeverActive
902 | AlwaysActive
903 | ActiveBefore SourceText PhaseNum
904 -- Active only *strictly before* this phase
905 | ActiveAfter SourceText PhaseNum
906 -- Active in this phase and later
907 deriving( Eq, Data )
908 -- Eq used in comparing rules in HsDecls
909
910 data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
911 | FunLike
912 deriving( Eq, Data, Show )
913 -- Show needed for Lexer.x
914
915 data InlinePragma -- Note [InlinePragma]
916 = InlinePragma
917 { inl_src :: SourceText -- Note [Pragma source text]
918 , inl_inline :: InlineSpec
919
920 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
921 -- explicit (non-type, non-dictionary) args
922 -- That is, inl_sat describes the number of *source-code*
923 -- arguments the thing must be applied to. We add on the
924 -- number of implicit, dictionary arguments when making
925 -- the InlineRule, and don't look at inl_sat further
926
927 , inl_act :: Activation -- Says during which phases inlining is allowed
928
929 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
930 } deriving( Eq, Data )
931
932 data InlineSpec -- What the user's INLINE pragma looked like
933 = Inline
934 | Inlinable
935 | NoInline
936 | EmptyInlineSpec -- Used in a place-holder InlinePragma in SpecPrag or IdInfo,
937 -- where there isn't any real inline pragma at all
938 deriving( Eq, Data, Show )
939 -- Show needed for Lexer.x
940
941 {-
942 Note [InlinePragma]
943 ~~~~~~~~~~~~~~~~~~~
944 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
945 the source program.
946
947 If you write nothing at all, you get defaultInlinePragma:
948 inl_inline = False
949 inl_act = AlwaysActive
950 inl_rule = FunLike
951
952 It's not possible to get that combination by *writing* something, so
953 if an Id has defaultInlinePragma it means the user didn't specify anything.
954
955 If inl_inline = True, then the Id should have an InlineRule unfolding.
956
957 Note [CONLIKE pragma]
958 ~~~~~~~~~~~~~~~~~~~~~
959 The ConLike constructor of a RuleMatchInfo is aimed at the following.
960 Consider first
961 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
962 g b bs = let x = b:bs in ..x...x...(r x)...
963 Now, the rule applies to the (r x) term, because GHC "looks through"
964 the definition of 'x' to see that it is (b:bs).
965
966 Now consider
967 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
968 g v = let x = f v in ..x...x...(r x)...
969 Normally the (r x) would *not* match the rule, because GHC would be
970 scared about duplicating the redex (f v), so it does not "look
971 through" the bindings.
972
973 However the CONLIKE modifier says to treat 'f' like a constructor in
974 this situation, and "look through" the unfolding for x. So (r x)
975 fires, yielding (f (v+1)).
976
977 This is all controlled with a user-visible pragma:
978 {-# NOINLINE CONLIKE [1] f #-}
979
980 The main effects of CONLIKE are:
981
982 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
983 CONLIKE thing like constructors, by ANF-ing them
984
985 - New function coreUtils.exprIsExpandable is like exprIsCheap, but
986 additionally spots applications of CONLIKE functions
987
988 - A CoreUnfolding has a field that caches exprIsExpandable
989
990 - The rule matcher consults this field. See
991 Note [Expanding variables] in Rules.hs.
992 -}
993
994 isConLike :: RuleMatchInfo -> Bool
995 isConLike ConLike = True
996 isConLike _ = False
997
998 isFunLike :: RuleMatchInfo -> Bool
999 isFunLike FunLike = True
1000 isFunLike _ = False
1001
1002 isEmptyInlineSpec :: InlineSpec -> Bool
1003 isEmptyInlineSpec EmptyInlineSpec = True
1004 isEmptyInlineSpec _ = False
1005
1006 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
1007 :: InlinePragma
1008 defaultInlinePragma = InlinePragma { inl_src = "{-# INLINE"
1009 , inl_act = AlwaysActive
1010 , inl_rule = FunLike
1011 , inl_inline = EmptyInlineSpec
1012 , inl_sat = Nothing }
1013
1014 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
1015 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
1016
1017 inlinePragmaSpec :: InlinePragma -> InlineSpec
1018 inlinePragmaSpec = inl_inline
1019
1020 -- A DFun has an always-active inline activation so that
1021 -- exprIsConApp_maybe can "see" its unfolding
1022 -- (However, its actual Unfolding is a DFunUnfolding, which is
1023 -- never inlined other than via exprIsConApp_maybe.)
1024 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
1025 , inl_rule = ConLike }
1026
1027 isDefaultInlinePragma :: InlinePragma -> Bool
1028 isDefaultInlinePragma (InlinePragma { inl_act = activation
1029 , inl_rule = match_info
1030 , inl_inline = inline })
1031 = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
1032
1033 isInlinePragma :: InlinePragma -> Bool
1034 isInlinePragma prag = case inl_inline prag of
1035 Inline -> True
1036 _ -> False
1037
1038 isInlinablePragma :: InlinePragma -> Bool
1039 isInlinablePragma prag = case inl_inline prag of
1040 Inlinable -> True
1041 _ -> False
1042
1043 isAnyInlinePragma :: InlinePragma -> Bool
1044 -- INLINE or INLINABLE
1045 isAnyInlinePragma prag = case inl_inline prag of
1046 Inline -> True
1047 Inlinable -> True
1048 _ -> False
1049
1050 inlinePragmaSat :: InlinePragma -> Maybe Arity
1051 inlinePragmaSat = inl_sat
1052
1053 inlinePragmaActivation :: InlinePragma -> Activation
1054 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
1055
1056 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
1057 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
1058
1059 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
1060 setInlinePragmaActivation prag activation = prag { inl_act = activation }
1061
1062 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
1063 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
1064
1065 instance Outputable Activation where
1066 ppr AlwaysActive = brackets (text "ALWAYS")
1067 ppr NeverActive = brackets (text "NEVER")
1068 ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
1069 ppr (ActiveAfter _ n) = brackets (int n)
1070
1071 instance Outputable RuleMatchInfo where
1072 ppr ConLike = text "CONLIKE"
1073 ppr FunLike = text "FUNLIKE"
1074
1075 instance Outputable InlineSpec where
1076 ppr Inline = text "INLINE"
1077 ppr NoInline = text "NOINLINE"
1078 ppr Inlinable = text "INLINABLE"
1079 ppr EmptyInlineSpec = empty
1080
1081 instance Outputable InlinePragma where
1082 ppr (InlinePragma { inl_inline = inline, inl_act = activation
1083 , inl_rule = info, inl_sat = mb_arity })
1084 = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
1085 where
1086 pp_act Inline AlwaysActive = empty
1087 pp_act NoInline NeverActive = empty
1088 pp_act _ act = ppr act
1089
1090 pp_sat | Just ar <- mb_arity = parens (text "sat-args=" <> int ar)
1091 | otherwise = empty
1092 pp_info | isFunLike info = empty
1093 | otherwise = ppr info
1094
1095 isActive :: CompilerPhase -> Activation -> Bool
1096 isActive InitialPhase AlwaysActive = True
1097 isActive InitialPhase (ActiveBefore {}) = True
1098 isActive InitialPhase _ = False
1099 isActive (Phase p) act = isActiveIn p act
1100
1101 isActiveIn :: PhaseNum -> Activation -> Bool
1102 isActiveIn _ NeverActive = False
1103 isActiveIn _ AlwaysActive = True
1104 isActiveIn p (ActiveAfter _ n) = p <= n
1105 isActiveIn p (ActiveBefore _ n) = p > n
1106
1107 competesWith :: Activation -> Activation -> Bool
1108 -- See Note [Activation competition]
1109 competesWith NeverActive _ = False
1110 competesWith _ NeverActive = False
1111 competesWith AlwaysActive _ = True
1112
1113 competesWith (ActiveBefore {}) AlwaysActive = True
1114 competesWith (ActiveBefore {}) (ActiveBefore {}) = True
1115 competesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b
1116
1117 competesWith (ActiveAfter {}) AlwaysActive = False
1118 competesWith (ActiveAfter {}) (ActiveBefore {}) = False
1119 competesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b
1120
1121 {- Note [Competing activations]
1122 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1123 Sometimes a RULE and an inlining may compete, or two RULES.
1124 See Note [Rules and inlining/other rules] in Desugar.
1125
1126 We say that act1 "competes with" act2 iff
1127 act1 is active in the phase when act2 *becomes* active
1128 NB: remember that phases count *down*: 2, 1, 0!
1129
1130 It's too conservative to ensure that the two are never simultaneously
1131 active. For example, a rule might be always active, and an inlining
1132 might switch on in phase 2. We could switch off the rule, but it does
1133 no harm.
1134 -}
1135
1136 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
1137 isNeverActive NeverActive = True
1138 isNeverActive _ = False
1139
1140 isAlwaysActive AlwaysActive = True
1141 isAlwaysActive _ = False
1142
1143 isEarlyActive AlwaysActive = True
1144 isEarlyActive (ActiveBefore {}) = True
1145 isEarlyActive _ = False
1146
1147 -- Used (instead of Rational) to represent exactly the floating point literal that we
1148 -- encountered in the user's source program. This allows us to pretty-print exactly what
1149 -- the user wrote, which is important e.g. for floating point numbers that can't represented
1150 -- as Doubles (we used to via Double for pretty-printing). See also #2245.
1151 data FractionalLit
1152 = FL { fl_text :: String -- How the value was written in the source
1153 , fl_value :: Rational -- Numeric value of the literal
1154 }
1155 deriving (Data, Show)
1156 -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on
1157
1158 negateFractionalLit :: FractionalLit -> FractionalLit
1159 negateFractionalLit (FL { fl_text = '-':text, fl_value = value }) = FL { fl_text = text, fl_value = negate value }
1160 negateFractionalLit (FL { fl_text = text, fl_value = value }) = FL { fl_text = '-':text, fl_value = negate value }
1161
1162 integralFractionalLit :: Integer -> FractionalLit
1163 integralFractionalLit i = FL { fl_text = show i, fl_value = fromInteger i }
1164
1165 -- Comparison operations are needed when grouping literals
1166 -- for compiling pattern-matching (module MatchLit)
1167
1168 instance Eq FractionalLit where
1169 (==) = (==) `on` fl_value
1170
1171 instance Ord FractionalLit where
1172 compare = compare `on` fl_value
1173
1174 instance Outputable FractionalLit where
1175 ppr = text . fl_text
1176
1177 {-
1178 ************************************************************************
1179 * *
1180 IntWithInf
1181 * *
1182 ************************************************************************
1183
1184 Represents an integer or positive infinity
1185
1186 -}
1187
1188 -- | An integer or infinity
1189 data IntWithInf = Int {-# UNPACK #-} !Int
1190 | Infinity
1191 deriving Eq
1192
1193 -- | A representation of infinity
1194 infinity :: IntWithInf
1195 infinity = Infinity
1196
1197 instance Ord IntWithInf where
1198 compare Infinity Infinity = EQ
1199 compare (Int _) Infinity = LT
1200 compare Infinity (Int _) = GT
1201 compare (Int a) (Int b) = a `compare` b
1202
1203 instance Outputable IntWithInf where
1204 ppr Infinity = char ''
1205 ppr (Int n) = int n
1206
1207 instance Num IntWithInf where
1208 (+) = plusWithInf
1209 (*) = mulWithInf
1210
1211 abs Infinity = Infinity
1212 abs (Int n) = Int (abs n)
1213
1214 signum Infinity = Int 1
1215 signum (Int n) = Int (signum n)
1216
1217 fromInteger = Int . fromInteger
1218
1219 (-) = panic "subtracting IntWithInfs"
1220
1221 intGtLimit :: Int -> IntWithInf -> Bool
1222 intGtLimit _ Infinity = False
1223 intGtLimit n (Int m) = n > m
1224
1225 -- | Add two 'IntWithInf's
1226 plusWithInf :: IntWithInf -> IntWithInf -> IntWithInf
1227 plusWithInf Infinity _ = Infinity
1228 plusWithInf _ Infinity = Infinity
1229 plusWithInf (Int a) (Int b) = Int (a + b)
1230
1231 -- | Multiply two 'IntWithInf's
1232 mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf
1233 mulWithInf Infinity _ = Infinity
1234 mulWithInf _ Infinity = Infinity
1235 mulWithInf (Int a) (Int b) = Int (a * b)
1236
1237 -- | Turn a positive number into an 'IntWithInf', where 0 represents infinity
1238 treatZeroAsInf :: Int -> IntWithInf
1239 treatZeroAsInf 0 = Infinity
1240 treatZeroAsInf n = Int n
1241
1242 -- | Inject any integer into an 'IntWithInf'
1243 mkIntWithInf :: Int -> IntWithInf
1244 mkIntWithInf = Int