Make XNegativeLiterals treat -0.0 as negative 0

Reviewers: austin, goldfire, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, mpickering

GHC Trac Issues: #13211

Differential Revision: https://phabricator.haskell.org/D3543

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))
 
 {-
 ************************************************************************