diff options
Diffstat (limited to 'compiler/basicTypes/BasicTypes.hs')
-rw-r--r-- | compiler/basicTypes/BasicTypes.hs | 62 |
1 files changed, 55 insertions, 7 deletions
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 03e588cd93..b67e6628ee 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -97,7 +97,10 @@ module BasicTypes( SuccessFlag(..), succeeded, failed, successIf, - FractionalLit(..), negateFractionalLit, integralFractionalLit, + IntegralLit(..), FractionalLit(..), + negateIntegralLit, negateFractionalLit, + mkIntegralLit, mkFractionalLit, + integralFractionalLit, SourceText(..), pprWithSourceText, @@ -1404,6 +1407,30 @@ isEarlyActive AlwaysActive = True isEarlyActive (ActiveBefore {}) = True isEarlyActive _ = False +-- | Integral Literal +-- +-- Used (instead of Integer) to represent negative zegative zero which is +-- required for NegativeLiterals extension to correctly parse `-0::Double` +-- as negative zero. See also #13211. +data IntegralLit + = IL { il_text :: SourceText + , il_neg :: Bool -- See Note [Negative zero] + , il_value :: Integer + } + deriving (Data, Show) + +mkIntegralLit :: Integral a => a -> IntegralLit +mkIntegralLit i = IL { il_text = SourceText (show (fromIntegral i :: Int)) + , il_neg = i < 0 + , il_value = toInteger i } + +negateIntegralLit :: IntegralLit -> IntegralLit +negateIntegralLit (IL text neg value) + = case text of + SourceText ('-':src) -> IL (SourceText src) False (negate value) + SourceText src -> IL (SourceText ('-':src)) True (negate value) + NoSourceText -> IL NoSourceText (not neg) (negate value) + -- | Fractional Literal -- -- Used (instead of Rational) to represent exactly the floating point literal that we @@ -1411,22 +1438,43 @@ isEarlyActive _ = False -- the user wrote, which is important e.g. for floating point numbers that can't represented -- as Doubles (we used to via Double for pretty-printing). See also #2245. data FractionalLit - = FL { fl_text :: String -- How the value was written in the source + = FL { fl_text :: SourceText -- How the value was written in the source + , fl_neg :: Bool -- See Note [Negative zero] , fl_value :: Rational -- Numeric value of the literal } deriving (Data, Show) -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on +mkFractionalLit :: Real a => a -> FractionalLit +mkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double)) + , fl_neg = r < 0 + , fl_value = toRational r } + negateFractionalLit :: FractionalLit -> FractionalLit -negateFractionalLit (FL { fl_text = '-':text, fl_value = value }) = FL { fl_text = text, fl_value = negate value } -negateFractionalLit (FL { fl_text = text, fl_value = value }) = FL { fl_text = '-':text, fl_value = negate value } +negateFractionalLit (FL text neg value) + = case text of + SourceText ('-':src) -> FL (SourceText src) False value + SourceText src -> FL (SourceText ('-':src)) True value + NoSourceText -> FL NoSourceText (not neg) (negate value) -integralFractionalLit :: Integer -> FractionalLit -integralFractionalLit i = FL { fl_text = show i, fl_value = fromInteger i } +integralFractionalLit :: Bool -> Integer -> FractionalLit +integralFractionalLit neg i = FL { fl_text = SourceText (show i), + fl_neg = neg, + fl_value = fromInteger i } -- Comparison operations are needed when grouping literals -- for compiling pattern-matching (module MatchLit) +instance Eq IntegralLit where + (==) = (==) `on` il_value + +instance Ord IntegralLit where + compare = compare `on` il_value + +instance Outputable IntegralLit where + ppr (IL (SourceText src) _ _) = text src + ppr (IL NoSourceText _ value) = text (show value) + instance Eq FractionalLit where (==) = (==) `on` fl_value @@ -1434,7 +1482,7 @@ instance Ord FractionalLit where compare = compare `on` fl_value instance Outputable FractionalLit where - ppr = text . fl_text + ppr f = pprWithSourceText (fl_text f) (rational (fl_value f)) {- ************************************************************************ |