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