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