2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
5 \section[BasicTypes]{Miscellanous types}
7 This module defines a miscellaneously collection of very simple
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
17 {-# LANGUAGE DeriveDataTypeable #-}
20 Version, bumpVersion, initialVersion,
28 Fixity(..), FixityDirection(..),
29 defaultFixity, maxPrecedence,
30 negateFixity, funTyFixity,
33 IPName(..), ipNameName, mapIPName,
35 RecFlag(..), isRec, isNonRec, boolToRecFlag,
39 TopLevelFlag(..), isTopLevel, isNotTopLevel,
45 TupCon(..), tupleParens,
47 OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc,
48 isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
51 InsideLam, insideLam, notInsideLam,
52 OneBranch, oneBranch, notOneBranch,
57 HsBang(..), isBanged, isMarkedUnboxed,
58 StrictnessMark(..), isMarkedStrict,
62 CompilerPhase(..), PhaseNum,
63 Activation(..), isActive, isActiveIn,
64 isNeverActive, isAlwaysActive, isEarlyActive,
65 RuleMatchInfo(..), isConLike, isFunLike,
67 InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
68 neverInlinePragma, dfunInlinePragma,
69 isDefaultInlinePragma,
70 isInlinePragma, isInlinablePragma, isAnyInlinePragma,
71 inlinePragmaSpec, inlinePragmaSat,
72 inlinePragmaActivation, inlinePragmaRuleMatchInfo,
73 setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
75 SuccessFlag(..), succeeded, failed, successIf,
77 FractionalLit(..), negateFractionalLit, integralFractionalLit
83 import Data.Data hiding (Fixity)
84 import Data.Function (on)
87 %************************************************************************
89 \subsection[Arity]{Arity}
91 %************************************************************************
97 %************************************************************************
99 \subsection[FunctionOrData]{FunctionOrData}
101 %************************************************************************
104 data FunctionOrData = IsFunction | IsData
105 deriving (Eq, Ord, Data, Typeable)
107 instance Outputable FunctionOrData where
108 ppr IsFunction = text "(function)"
109 ppr IsData = text "(data)"
113 %************************************************************************
115 \subsection[Version]{Module and identifier version numbers}
117 %************************************************************************
122 bumpVersion :: Version -> Version
125 initialVersion :: Version
129 %************************************************************************
133 %************************************************************************
137 -- reason/explanation from a WARNING or DEPRECATED pragma
138 data WarningTxt = WarningTxt [FastString]
139 | DeprecatedTxt [FastString]
140 deriving (Eq, Data, Typeable)
142 instance Outputable WarningTxt where
143 ppr (WarningTxt ws) = doubleQuotes (vcat (map ftext ws))
144 ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
145 doubleQuotes (vcat (map ftext ds))
148 %************************************************************************
150 \subsection{Implicit parameter identity}
152 %************************************************************************
154 The @IPName@ type is here because it is used in TypeRep (i.e. very
155 early in the hierarchy), but also in HsSyn.
158 newtype IPName name = IPName name -- ?x
159 deriving( Eq, Ord, Data, Typeable )
160 -- Ord is used in the IP name cache finite map
161 -- (used in HscTypes.OrigIParamCache)
163 ipNameName :: IPName name -> name
164 ipNameName (IPName n) = n
166 mapIPName :: (a->b) -> IPName a -> IPName b
167 mapIPName f (IPName n) = IPName (f n)
169 instance Outputable name => Outputable (IPName name) where
170 ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
173 %************************************************************************
177 %************************************************************************
180 type RuleName = FastString
183 %************************************************************************
185 \subsection[Fixity]{Fixity info}
187 %************************************************************************
190 ------------------------
191 data Fixity = Fixity Int FixityDirection
192 deriving (Data, Typeable)
194 instance Outputable Fixity where
195 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
197 instance Eq Fixity where -- Used to determine if two fixities conflict
198 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
200 ------------------------
201 data FixityDirection = InfixL | InfixR | InfixN
202 deriving (Eq, Data, Typeable)
204 instance Outputable FixityDirection where
205 ppr InfixL = ptext (sLit "infixl")
206 ppr InfixR = ptext (sLit "infixr")
207 ppr InfixN = ptext (sLit "infix")
209 ------------------------
212 defaultFixity :: Fixity
213 defaultFixity = Fixity maxPrecedence InfixL
215 negateFixity, funTyFixity :: Fixity
217 negateFixity = Fixity 6 InfixL -- Fixity of unary negate
218 funTyFixity = Fixity 0 InfixR -- Fixity of '->'
226 @(compareFixity op1 op2)@ tells which way to arrange appication, or
227 whether there's an error.
230 compareFixity :: Fixity -> Fixity
231 -> (Bool, -- Error please
232 Bool) -- Associate to the right: a op1 (b op2 c)
233 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
234 = case prec1 `compare` prec2 of
237 EQ -> case (dir1, dir2) of
238 (InfixR, InfixR) -> right
239 (InfixL, InfixL) -> left
242 right = (False, True)
243 left = (False, False)
244 error_please = (True, False)
248 %************************************************************************
250 \subsection[Top-level/local]{Top-level/not-top level flag}
252 %************************************************************************
259 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
261 isNotTopLevel NotTopLevel = True
262 isNotTopLevel TopLevel = False
264 isTopLevel TopLevel = True
265 isTopLevel NotTopLevel = False
267 instance Outputable TopLevelFlag where
268 ppr TopLevel = ptext (sLit "<TopLevel>")
269 ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
273 %************************************************************************
275 Top-level/not-top level flag
277 %************************************************************************
283 deriving( Eq, Data, Typeable )
285 isBoxed :: Boxity -> Bool
287 isBoxed Unboxed = False
291 %************************************************************************
293 Recursive/Non-Recursive flag
295 %************************************************************************
298 data RecFlag = Recursive
300 deriving( Eq, Data, Typeable )
302 isRec :: RecFlag -> Bool
303 isRec Recursive = True
304 isRec NonRecursive = False
306 isNonRec :: RecFlag -> Bool
307 isNonRec Recursive = False
308 isNonRec NonRecursive = True
310 boolToRecFlag :: Bool -> RecFlag
311 boolToRecFlag True = Recursive
312 boolToRecFlag False = NonRecursive
314 instance Outputable RecFlag where
315 ppr Recursive = ptext (sLit "Recursive")
316 ppr NonRecursive = ptext (sLit "NonRecursive")
319 %************************************************************************
321 Instance overlap flag
323 %************************************************************************
327 = NoOverlap -- This instance must not overlap another
329 | OverlapOk -- Silently ignore this instance if you find a
330 -- more specific one that matches the constraint
331 -- you are trying to resolve
333 -- Example: constraint (Foo [Int])
334 -- instances (Foo [Int])
336 -- (Foo [a]) OverlapOk
337 -- Since the second instance has the OverlapOk flag,
338 -- the first instance will be chosen (otherwise
339 -- its ambiguous which to choose)
341 | Incoherent -- Like OverlapOk, but also ignore this instance
342 -- if it doesn't match the constraint you are
343 -- trying to resolve, but could match if the type variables
344 -- in the constraint were instantiated
346 -- Example: constraint (Foo [b])
347 -- instances (Foo [Int]) Incoherent
349 -- Without the Incoherent flag, we'd complain that
350 -- instantiating 'b' would change which instance
354 instance Outputable OverlapFlag where
355 ppr NoOverlap = empty
356 ppr OverlapOk = ptext (sLit "[overlap ok]")
357 ppr Incoherent = ptext (sLit "[incoherent]")
361 %************************************************************************
365 %************************************************************************
368 data TupCon = TupCon Boxity Arity
370 instance Eq TupCon where
371 (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
373 tupleParens :: Boxity -> SDoc -> SDoc
374 tupleParens Boxed p = parens p
375 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
378 %************************************************************************
380 \subsection[Generic]{Generic flag}
382 %************************************************************************
384 This is the "Embedding-Projection pair" datatype, it contains
385 two pieces of code (normally either RenamedExpr's or Id's)
386 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
387 represents functions of type
396 T and Tring are arbitrary, but typically T is the 'main' type while
397 Tring is the 'representation' type. (This just helps us remember
398 whether to use 'from' or 'to'.
401 data EP a = EP { fromEP :: a, -- :: T -> Tring
402 toEP :: a } -- :: Tring -> T
405 Embedding-projection pairs are used in several places:
407 First of all, each type constructor has an EP associated with it, the
408 code in EP converts (datatype T) from T to Tring and back again.
410 Secondly, when we are filling in Generic methods (in the typechecker,
411 tcMethodBinds), we are constructing bimaps by induction on the structure
412 of the type of the method signature.
415 %************************************************************************
417 \subsection{Occurrence information}
419 %************************************************************************
421 This data type is used exclusively by the simplifier, but it appears in a
422 SubstResult, which is currently defined in VarEnv, which is pretty near
423 the base of the module hierarchy. So it seemed simpler to put the
424 defn of OccInfo here, safely at the bottom
427 -- | Identifier occurrence information
429 = NoOccInfo -- ^ There are many occurrences, or unknown occurences
431 | IAmDead -- ^ Marks unused variables. Sometimes useful for
432 -- lambda and case-bound variables.
437 !InterestingCxt -- ^ Occurs exactly once, not inside a rule
439 -- | This identifier breaks a loop of mutually recursive functions. The field
440 -- marks whether it is only a loop breaker due to a reference in a rule
441 | IAmALoopBreaker -- Note [LoopBreaker OccInfo]
442 !RulesOnly -- True <=> This is a weak or rules-only loop breaker
443 -- See OccurAnal Note [Weak loop breakers]
445 type RulesOnly = Bool
448 Note [LoopBreaker OccInfo]
449 ~~~~~~~~~~~~~~~~~~~~~~~~~~
450 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
451 analyser in two ways:
452 (a) to mark loop-breakers in a group of recursive
453 definitions (hence the name)
454 (b) to mark binders that must not be inlined in this phase
455 (perhaps it has a NOINLINE pragma)
456 Things with (IAmLoopBreaker False) do not get an unfolding
457 pinned on to them, so they are completely opaque.
459 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
463 isNoOcc :: OccInfo -> Bool
464 isNoOcc NoOccInfo = True
467 seqOccInfo :: OccInfo -> ()
468 seqOccInfo occ = occ `seq` ()
471 type InterestingCxt = Bool -- True <=> Function: is applied
472 -- Data value: scrutinised by a case with
473 -- at least one non-DEFAULT branch
476 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
477 -- Substituting a redex for this occurrence is
478 -- dangerous because it might duplicate work.
479 insideLam, notInsideLam :: InsideLam
484 type OneBranch = Bool -- True <=> Occurs in only one case branch
485 -- so no code-duplication issue to worry about
486 oneBranch, notOneBranch :: OneBranch
490 isLoopBreaker :: OccInfo -> Bool
491 isLoopBreaker (IAmALoopBreaker _) = True
492 isLoopBreaker _ = False
494 isNonRuleLoopBreaker :: OccInfo -> Bool
495 isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
496 isNonRuleLoopBreaker _ = False
498 nonRuleLoopBreaker :: OccInfo
499 nonRuleLoopBreaker = IAmALoopBreaker False
501 isDeadOcc :: OccInfo -> Bool
502 isDeadOcc IAmDead = True
505 isOneOcc :: OccInfo -> Bool
506 isOneOcc (OneOcc {}) = True
509 zapFragileOcc :: OccInfo -> OccInfo
510 zapFragileOcc (OneOcc {}) = NoOccInfo
511 zapFragileOcc occ = occ
515 instance Outputable OccInfo where
516 -- only used for debugging; never parsed. KSW 1999-07
517 ppr NoOccInfo = empty
518 ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
519 ppr IAmDead = ptext (sLit "Dead")
520 ppr (OneOcc inside_lam one_branch int_cxt)
521 = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
523 pp_lam | inside_lam = char 'L'
525 pp_br | one_branch = empty
526 | otherwise = char '*'
527 pp_args | int_cxt = char '!'
530 instance Show OccInfo where
531 showsPrec p occ = showsPrecSDoc p (ppr occ)
534 %************************************************************************
536 Strictness indication
538 %************************************************************************
540 The strictness annotations on types in data type declarations
541 e.g. data T = MkT !Int !(Bool,Bool)
544 -------------------------
545 -- HsBang describes what the *programmer* wrote
546 -- This info is retained in the DataCon.dcStrictMarks field
547 data HsBang = HsNoBang
551 | HsUnpack -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
553 | HsUnpackFailed -- An UNPACK pragma that we could not make
554 -- use of, because the type isn't unboxable;
555 -- equivalant to HsStrict except for checkValidDataCon
556 deriving (Eq, Data, Typeable)
558 instance Outputable HsBang where
560 ppr HsStrict = char '!'
561 ppr HsUnpack = ptext (sLit "{-# UNPACK #-} !")
562 ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
564 isBanged :: HsBang -> Bool
565 isBanged HsNoBang = False
568 isMarkedUnboxed :: HsBang -> Bool
569 isMarkedUnboxed HsUnpack = True
570 isMarkedUnboxed _ = False
572 -------------------------
573 -- StrictnessMark is internal only, used to indicate strictness
574 -- of the DataCon *worker* fields
575 data StrictnessMark = MarkedStrict | NotMarkedStrict
577 instance Outputable StrictnessMark where
578 ppr MarkedStrict = ptext (sLit "!")
579 ppr NotMarkedStrict = empty
581 isMarkedStrict :: StrictnessMark -> Bool
582 isMarkedStrict NotMarkedStrict = False
583 isMarkedStrict _ = True -- All others are strict
587 %************************************************************************
589 Default method specfication
591 %************************************************************************
593 The DefMethSpec enumeration just indicates what sort of default method
594 is used for a class. It is generated from source code, and present in
595 interface files; it is converted to Class.DefMeth before begin put in a
599 data DefMethSpec = NoDM -- No default method
600 | VanillaDM -- Default method given with polymorphic code
601 | GenericDM -- Default method given with generic code
603 instance Outputable DefMethSpec where
605 ppr VanillaDM = ptext (sLit "{- Has default method -}")
606 ppr GenericDM = ptext (sLit "{- Has generic default method -}")
609 %************************************************************************
611 \subsection{Success flag}
613 %************************************************************************
616 data SuccessFlag = Succeeded | Failed
618 instance Outputable SuccessFlag where
619 ppr Succeeded = ptext (sLit "Succeeded")
620 ppr Failed = ptext (sLit "Failed")
622 successIf :: Bool -> SuccessFlag
623 successIf True = Succeeded
624 successIf False = Failed
626 succeeded, failed :: SuccessFlag -> Bool
627 succeeded Succeeded = True
628 succeeded Failed = False
630 failed Succeeded = False
635 %************************************************************************
637 \subsection{Activation}
639 %************************************************************************
641 When a rule or inlining is active
644 type PhaseNum = Int -- Compilation phase
645 -- Phases decrease towards zero
646 -- Zero is the last phase
650 | InitialPhase -- The first phase -- number = infinity!
652 instance Outputable CompilerPhase where
653 ppr (Phase n) = int n
654 ppr InitialPhase = ptext (sLit "InitialPhase")
656 data Activation = NeverActive
658 | ActiveBefore PhaseNum -- Active only *before* this phase
659 | ActiveAfter PhaseNum -- Active in this phase and later
660 deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
662 data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
664 deriving( Eq, Data, Typeable, Show )
665 -- Show needed for Lexer.x
667 data InlinePragma -- Note [InlinePragma]
669 { inl_inline :: InlineSpec
671 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
672 -- explicit (non-type, non-dictionary) args
673 -- That is, inl_sat describes the number of *source-code*
674 -- arguments the thing must be applied to. We add on the
675 -- number of implicit, dictionary arguments when making
676 -- the InlineRule, and don't look at inl_sat further
678 , inl_act :: Activation -- Says during which phases inlining is allowed
680 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
681 } deriving( Eq, Data, Typeable )
683 data InlineSpec -- What the user's INLINE pragama looked like
688 deriving( Eq, Data, Typeable, Show )
689 -- Show needed for Lexer.x
694 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
697 If you write nothing at all, you get defaultInlinePragma:
699 inl_act = AlwaysActive
702 It's not possible to get that combination by *writing* something, so
703 if an Id has defaultInlinePragma it means the user didn't specify anything.
705 If inl_inline = True, then the Id should have an InlineRule unfolding.
707 Note [CONLIKE pragma]
708 ~~~~~~~~~~~~~~~~~~~~~
709 The ConLike constructor of a RuleMatchInfo is aimed at the following.
711 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
712 g b bs = let x = b:bs in ..x...x...(r x)...
713 Now, the rule applies to the (r x) term, because GHC "looks through"
714 the definition of 'x' to see that it is (b:bs).
717 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
718 g v = let x = f v in ..x...x...(r x)...
719 Normally the (r x) would *not* match the rule, because GHC would be
720 scared about duplicating the redex (f v), so it does not "look
721 through" the bindings.
723 However the CONLIKE modifier says to treat 'f' like a constructor in
724 this situation, and "look through" the unfolding for x. So (r x)
725 fires, yielding (f (v+1)).
727 This is all controlled with a user-visible pragma:
728 {-# NOINLINE CONLIKE [1] f #-}
730 The main effects of CONLIKE are:
732 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
733 CONLIKE thing like constructors, by ANF-ing them
735 - New function coreUtils.exprIsExpandable is like exprIsCheap, but
736 additionally spots applications of CONLIKE functions
738 - A CoreUnfolding has a field that caches exprIsExpandable
740 - The rule matcher consults this field. See
741 Note [Expanding variables] in Rules.lhs.
744 isConLike :: RuleMatchInfo -> Bool
745 isConLike ConLike = True
748 isFunLike :: RuleMatchInfo -> Bool
749 isFunLike FunLike = True
752 isEmptyInlineSpec :: InlineSpec -> Bool
753 isEmptyInlineSpec EmptyInlineSpec = True
754 isEmptyInlineSpec _ = False
756 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
758 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
760 , inl_inline = EmptyInlineSpec
761 , inl_sat = Nothing }
763 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
764 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
766 inlinePragmaSpec :: InlinePragma -> InlineSpec
767 inlinePragmaSpec = inl_inline
769 -- A DFun has an always-active inline activation so that
770 -- exprIsConApp_maybe can "see" its unfolding
771 -- (However, its actual Unfolding is a DFunUnfolding, which is
772 -- never inlined other than via exprIsConApp_maybe.)
773 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
774 , inl_rule = ConLike }
776 isDefaultInlinePragma :: InlinePragma -> Bool
777 isDefaultInlinePragma (InlinePragma { inl_act = activation
778 , inl_rule = match_info
779 , inl_inline = inline })
780 = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
782 isInlinePragma :: InlinePragma -> Bool
783 isInlinePragma prag = case inl_inline prag of
787 isInlinablePragma :: InlinePragma -> Bool
788 isInlinablePragma prag = case inl_inline prag of
792 isAnyInlinePragma :: InlinePragma -> Bool
793 -- INLINE or INLINABLE
794 isAnyInlinePragma prag = case inl_inline prag of
799 inlinePragmaSat :: InlinePragma -> Maybe Arity
800 inlinePragmaSat = inl_sat
802 inlinePragmaActivation :: InlinePragma -> Activation
803 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
805 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
806 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
808 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
809 setInlinePragmaActivation prag activation = prag { inl_act = activation }
811 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
812 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
814 instance Outputable Activation where
815 ppr AlwaysActive = brackets (ptext (sLit "ALWAYS"))
816 ppr NeverActive = brackets (ptext (sLit "NEVER"))
817 ppr (ActiveBefore n) = brackets (char '~' <> int n)
818 ppr (ActiveAfter n) = brackets (int n)
820 instance Outputable RuleMatchInfo where
821 ppr ConLike = ptext (sLit "CONLIKE")
822 ppr FunLike = ptext (sLit "FUNLIKE")
824 instance Outputable InlineSpec where
825 ppr Inline = ptext (sLit "INLINE")
826 ppr NoInline = ptext (sLit "NOINLINE")
827 ppr Inlinable = ptext (sLit "INLINABLE")
828 ppr EmptyInlineSpec = empty
830 instance Outputable InlinePragma where
831 ppr (InlinePragma { inl_inline = inline, inl_act = activation
832 , inl_rule = info, inl_sat = mb_arity })
833 = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
835 pp_act Inline AlwaysActive = empty
836 pp_act NoInline NeverActive = empty
837 pp_act _ act = ppr act
839 pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
841 pp_info | isFunLike info = empty
842 | otherwise = ppr info
844 isActive :: CompilerPhase -> Activation -> Bool
845 isActive InitialPhase AlwaysActive = True
846 isActive InitialPhase (ActiveBefore {}) = True
847 isActive InitialPhase _ = False
848 isActive (Phase p) act = isActiveIn p act
850 isActiveIn :: PhaseNum -> Activation -> Bool
851 isActiveIn _ NeverActive = False
852 isActiveIn _ AlwaysActive = True
853 isActiveIn p (ActiveAfter n) = p <= n
854 isActiveIn p (ActiveBefore n) = p > n
856 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
857 isNeverActive NeverActive = True
858 isNeverActive _ = False
860 isAlwaysActive AlwaysActive = True
861 isAlwaysActive _ = False
863 isEarlyActive AlwaysActive = True
864 isEarlyActive (ActiveBefore {}) = True
865 isEarlyActive _ = False
871 -- Used (instead of Rational) to represent exactly the floating point literal that we
872 -- encountered in the user's source program. This allows us to pretty-print exactly what
873 -- the user wrote, which is important e.g. for floating point numbers that can't represented
874 -- as Doubles (we used to via Double for pretty-printing). See also #2245.
876 = FL { fl_text :: String -- How the value was written in the source
877 , fl_value :: Rational -- Numeric value of the literal
879 deriving (Data, Typeable, Show)
880 -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on
882 negateFractionalLit :: FractionalLit -> FractionalLit
883 negateFractionalLit (FL { fl_text = '-':text, fl_value = value }) = FL { fl_text = text, fl_value = negate value }
884 negateFractionalLit (FL { fl_text = text, fl_value = value }) = FL { fl_text = '-':text, fl_value = negate value }
886 integralFractionalLit :: Integer -> FractionalLit
887 integralFractionalLit i = FL { fl_text = show i, fl_value = fromInteger i }
889 -- Comparison operations are needed when grouping literals
890 -- for compiling pattern-matching (module MatchLit)
892 instance Eq FractionalLit where
893 (==) = (==) `on` fl_value
895 instance Ord FractionalLit where
896 compare = compare `on` fl_value
898 instance Outputable FractionalLit where