Commit 0279b745 authored by Nolan's avatar Nolan Committed by Ben Gamari

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
parent dc3b4af6
...@@ -97,7 +97,10 @@ module BasicTypes( ...@@ -97,7 +97,10 @@ module BasicTypes(
SuccessFlag(..), succeeded, failed, successIf, SuccessFlag(..), succeeded, failed, successIf,
FractionalLit(..), negateFractionalLit, integralFractionalLit, IntegralLit(..), FractionalLit(..),
negateIntegralLit, negateFractionalLit,
mkIntegralLit, mkFractionalLit,
integralFractionalLit,
SourceText(..), pprWithSourceText, SourceText(..), pprWithSourceText,
...@@ -1404,6 +1407,30 @@ isEarlyActive AlwaysActive = True ...@@ -1404,6 +1407,30 @@ isEarlyActive AlwaysActive = True
isEarlyActive (ActiveBefore {}) = True isEarlyActive (ActiveBefore {}) = True
isEarlyActive _ = False 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 -- | Fractional Literal
-- --
-- Used (instead of Rational) to represent exactly the floating point literal that we -- Used (instead of Rational) to represent exactly the floating point literal that we
...@@ -1411,22 +1438,43 @@ isEarlyActive _ = False ...@@ -1411,22 +1438,43 @@ isEarlyActive _ = False
-- the user wrote, which is important e.g. for floating point numbers that can't represented -- 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. -- as Doubles (we used to via Double for pretty-printing). See also #2245.
data FractionalLit 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 , fl_value :: Rational -- Numeric value of the literal
} }
deriving (Data, Show) deriving (Data, Show)
-- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on -- 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 :: FractionalLit -> FractionalLit
negateFractionalLit (FL { fl_text = '-':text, fl_value = value }) = FL { fl_text = text, fl_value = negate value } negateFractionalLit (FL text neg value)
negateFractionalLit (FL { fl_text = text, fl_value = value }) = FL { fl_text = '-':text, fl_value = negate 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 :: Bool -> Integer -> FractionalLit
integralFractionalLit i = FL { fl_text = show i, fl_value = fromInteger i } integralFractionalLit neg i = FL { fl_text = SourceText (show i),
fl_neg = neg,
fl_value = fromInteger i }
-- Comparison operations are needed when grouping literals -- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module MatchLit) -- 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 instance Eq FractionalLit where
(==) = (==) `on` fl_value (==) = (==) `on` fl_value
...@@ -1434,7 +1482,7 @@ instance Ord FractionalLit where ...@@ -1434,7 +1482,7 @@ instance Ord FractionalLit where
compare = compare `on` fl_value compare = compare `on` fl_value
instance Outputable FractionalLit where instance Outputable FractionalLit where
ppr = text . fl_text ppr f = pprWithSourceText (fl_text f) (rational (fl_value f))
{- {-
************************************************************************ ************************************************************************
......
...@@ -19,6 +19,7 @@ module Check ( ...@@ -19,6 +19,7 @@ module Check (
import TmOracle import TmOracle
import BasicTypes
import DynFlags import DynFlags
import HsSyn import HsSyn
import TcHsSyn import TcHsSyn
...@@ -668,15 +669,20 @@ translateNPat :: FamInstEnvs ...@@ -668,15 +669,20 @@ translateNPat :: FamInstEnvs
translateNPat fam_insts (OverLit val False _ ty) mb_neg outer_ty translateNPat fam_insts (OverLit val False _ ty) mb_neg outer_ty
| not type_change, isStringTy ty, HsIsString src s <- val, Nothing <- mb_neg | not type_change, isStringTy ty, HsIsString src s <- val, Nothing <- mb_neg
= translatePat fam_insts (LitPat (HsString src s)) = translatePat fam_insts (LitPat (HsString src s))
| not type_change, isIntTy ty, HsIntegral src i <- val | not type_change, isIntTy ty, HsIntegral i <- val
= translatePat fam_insts (mk_num_lit HsInt src i) = translatePat fam_insts
| not type_change, isWordTy ty, HsIntegral src i <- val (LitPat $ case mb_neg of
= translatePat fam_insts (mk_num_lit HsWordPrim src i) Nothing -> HsInt i
Just _ -> HsInt (negateIntegralLit i))
| not type_change, isWordTy ty, HsIntegral i <- val
= translatePat fam_insts
(LitPat $ case mb_neg of
Nothing -> HsWordPrim (il_text i) (il_value i)
Just _ -> let ni = negateIntegralLit i in
HsWordPrim (il_text ni) (il_value ni))
where where
type_change = not (outer_ty `eqType` ty) type_change = not (outer_ty `eqType` ty)
mk_num_lit c src i = LitPat $ case mb_neg of
Nothing -> c src i
Just _ -> c src (-i)
translateNPat _ ol mb_neg _ translateNPat _ ol mb_neg _
= return [PmLit { pm_lit_lit = PmOLit (isJust mb_neg) ol }] = return [PmLit { pm_lit_lit = PmOLit (isJust mb_neg) ol }]
......
...@@ -277,12 +277,12 @@ ds_expr _ (HsWrap co_fn e) ...@@ -277,12 +277,12 @@ ds_expr _ (HsWrap co_fn e)
; warnAboutIdentities dflags e' wrapped_ty ; warnAboutIdentities dflags e' wrapped_ty
; return wrapped_e } ; return wrapped_e }
ds_expr _ (NegApp (L loc (HsOverLit lit@(OverLit { ol_val = HsIntegral src i }))) ds_expr _ (NegApp (L loc (HsOverLit lit@(OverLit { ol_val = HsIntegral i })))
neg_expr) neg_expr)
= do { expr' <- putSrcSpanDs loc $ do = do { expr' <- putSrcSpanDs loc $ do
{ dflags <- getDynFlags { dflags <- getDynFlags
; warnAboutOverflowedLiterals dflags ; warnAboutOverflowedLiterals dflags
(lit { ol_val = HsIntegral src (-i) }) (lit { ol_val = HsIntegral (negateIntegralLit i) })
; dsOverLit' dflags lit } ; dsOverLit' dflags lit }
; dsSyntaxExpr neg_expr [expr'] } ; dsSyntaxExpr neg_expr [expr'] }
......
...@@ -2371,7 +2371,7 @@ repLiteral lit ...@@ -2371,7 +2371,7 @@ repLiteral lit
= do lit' <- case lit of = do lit' <- case lit of
HsIntPrim _ i -> mk_integer i HsIntPrim _ i -> mk_integer i
HsWordPrim _ w -> mk_integer w HsWordPrim _ w -> mk_integer w
HsInt _ i -> mk_integer i HsInt i -> mk_integer (il_value i)
HsFloatPrim r -> mk_rational r HsFloatPrim r -> mk_rational r
HsDoublePrim r -> mk_rational r HsDoublePrim r -> mk_rational r
HsCharPrim _ c -> mk_char c HsCharPrim _ c -> mk_char c
...@@ -2383,7 +2383,7 @@ repLiteral lit ...@@ -2383,7 +2383,7 @@ repLiteral lit
where where
mb_lit_name = case lit of mb_lit_name = case lit of
HsInteger _ _ _ -> Just integerLName HsInteger _ _ _ -> Just integerLName
HsInt _ _ -> Just integerLName HsInt _ -> Just integerLName
HsIntPrim _ _ -> Just intPrimLName HsIntPrim _ _ -> Just intPrimLName
HsWordPrim _ _ -> Just wordPrimLName HsWordPrim _ _ -> Just wordPrimLName
HsFloatPrim _ -> Just floatPrimLName HsFloatPrim _ -> Just floatPrimLName
...@@ -2397,6 +2397,7 @@ repLiteral lit ...@@ -2397,6 +2397,7 @@ repLiteral lit
mk_integer :: Integer -> DsM HsLit mk_integer :: Integer -> DsM HsLit
mk_integer i = do integer_ty <- lookupType integerTyConName mk_integer i = do integer_ty <- lookupType integerTyConName
return $ HsInteger NoSourceText i integer_ty return $ HsInteger NoSourceText i integer_ty
mk_rational :: FractionalLit -> DsM HsLit mk_rational :: FractionalLit -> DsM HsLit
mk_rational r = do rat_ty <- lookupType rationalTyConName mk_rational r = do rat_ty <- lookupType rationalTyConName
return $ HsRat r rat_ty return $ HsRat r rat_ty
...@@ -2414,7 +2415,7 @@ repOverloadedLiteral (OverLit { ol_val = val}) ...@@ -2414,7 +2415,7 @@ repOverloadedLiteral (OverLit { ol_val = val})
-- and rationalL is sucked in when any TH stuff is used -- and rationalL is sucked in when any TH stuff is used
mk_lit :: OverLitVal -> DsM HsLit mk_lit :: OverLitVal -> DsM HsLit
mk_lit (HsIntegral _ i) = mk_integer i mk_lit (HsIntegral i) = mk_integer (il_value i)
mk_lit (HsFractional f) = mk_rational f mk_lit (HsFractional f) = mk_rational f
mk_lit (HsIsString _ s) = mk_string s mk_lit (HsIsString _ s) = mk_string s
......
...@@ -44,7 +44,7 @@ import Maybes ...@@ -44,7 +44,7 @@ import Maybes
import Util import Util
import Name import Name
import Outputable import Outputable
import BasicTypes ( isGenerated, fl_value ) import BasicTypes ( isGenerated, il_value, fl_value )
import FastString import FastString
import Unique import Unique
import UniqDFM import UniqDFM
...@@ -1093,15 +1093,15 @@ patGroup _ (WildPat {}) = PgAny ...@@ -1093,15 +1093,15 @@ patGroup _ (WildPat {}) = PgAny
patGroup _ (BangPat {}) = PgBang patGroup _ (BangPat {}) = PgBang
patGroup _ (NPat (L _ OverLit {ol_val=oval}) mb_neg _ _) = patGroup _ (NPat (L _ OverLit {ol_val=oval}) mb_neg _ _) =
case (oval, isJust mb_neg) of case (oval, isJust mb_neg) of
(HsIntegral _ i, False) -> PgN (fromInteger i) (HsIntegral i, False) -> PgN (fromInteger (il_value i))
(HsIntegral _ i, True ) -> PgN (-fromInteger i) (HsIntegral i, True ) -> PgN (-fromInteger (il_value i))
(HsFractional r, False) -> PgN (fl_value r) (HsFractional r, False) -> PgN (fl_value r)
(HsFractional r, True ) -> PgN (-fl_value r) (HsFractional r, True ) -> PgN (-fl_value r)
(HsIsString _ s, _) -> ASSERT(isNothing mb_neg) (HsIsString _ s, _) -> ASSERT(isNothing mb_neg)
PgOverS s PgOverS s
patGroup _ (NPlusKPat _ (L _ OverLit {ol_val=oval}) _ _ _ _) = patGroup _ (NPlusKPat _ (L _ OverLit {ol_val=oval}) _ _ _ _) =
case oval of case oval of
HsIntegral _ i -> PgNpK i HsIntegral i -> PgNpK (il_value i)
_ -> pprPanic "patGroup NPlusKPat" (ppr oval) _ -> pprPanic "patGroup NPlusKPat" (ppr oval)
patGroup _ (CoPat _ p _) = PgCo (hsPatType p) -- Type of innelexp pattern patGroup _ (CoPat _ p _) = PgCo (hsPatType p) -- Type of innelexp pattern
patGroup _ (ViewPat expr p _) = PgView expr (hsPatType (unLoc p)) patGroup _ (ViewPat expr p _) = PgView expr (hsPatType (unLoc p))
......
...@@ -82,17 +82,16 @@ dsLit (HsInt64Prim _ i) = return (Lit (MachInt64 i)) ...@@ -82,17 +82,16 @@ dsLit (HsInt64Prim _ i) = return (Lit (MachInt64 i))
dsLit (HsWord64Prim _ w) = return (Lit (MachWord64 w)) dsLit (HsWord64Prim _ w) = return (Lit (MachWord64 w))
dsLit (HsFloatPrim f) = return (Lit (MachFloat (fl_value f))) dsLit (HsFloatPrim f) = return (Lit (MachFloat (fl_value f)))
dsLit (HsDoublePrim d) = return (Lit (MachDouble (fl_value d))) dsLit (HsDoublePrim d) = return (Lit (MachDouble (fl_value d)))
dsLit (HsChar _ c) = return (mkCharExpr c) dsLit (HsChar _ c) = return (mkCharExpr c)
dsLit (HsString _ str) = mkStringExprFS str dsLit (HsString _ str) = mkStringExprFS str
dsLit (HsInteger _ i _) = mkIntegerExpr i dsLit (HsInteger _ i _) = mkIntegerExpr i
dsLit (HsInt _ i) = do dflags <- getDynFlags dsLit (HsInt i) = do dflags <- getDynFlags
return (mkIntExpr dflags i) return (mkIntExpr dflags (il_value i))
dsLit (HsRat r ty) = do dsLit (HsRat (FL _ _ val) ty) = do
num <- mkIntegerExpr (numerator (fl_value r)) num <- mkIntegerExpr (numerator val)
denom <- mkIntegerExpr (denominator (fl_value r)) denom <- mkIntegerExpr (denominator val)
return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom]) return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom])
where where
(ratio_data_con, integer_ty) (ratio_data_con, integer_ty)
= case tcSplitTyConApp ty of = case tcSplitTyConApp ty of
...@@ -243,9 +242,9 @@ getLHsIntegralLit (L _ (HsOverLit over_lit)) = getIntegralLit over_lit ...@@ -243,9 +242,9 @@ getLHsIntegralLit (L _ (HsOverLit over_lit)) = getIntegralLit over_lit
getLHsIntegralLit _ = Nothing getLHsIntegralLit _ = Nothing
getIntegralLit :: HsOverLit Id -> Maybe (Integer, Name) getIntegralLit :: HsOverLit Id -> Maybe (Integer, Name)
getIntegralLit (OverLit { ol_val = HsIntegral _ i, ol_type = ty }) getIntegralLit (OverLit { ol_val = HsIntegral i, ol_type = ty })
| Just tc <- tyConAppTyCon_maybe ty | Just tc <- tyConAppTyCon_maybe ty
= Just (i, tyConName tc) = Just (il_value i, tyConName tc)
getIntegralLit _ = Nothing getIntegralLit _ = Nothing
{- {-
...@@ -313,8 +312,8 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty ...@@ -313,8 +312,8 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty
mb_int_lit :: Maybe Integer mb_int_lit :: Maybe Integer
mb_int_lit = case (mb_neg, val) of mb_int_lit = case (mb_neg, val) of
(Nothing, HsIntegral _ i) -> Just i (Nothing, HsIntegral i) -> Just (il_value i)
(Just _, HsIntegral _ i) -> Just (-i) (Just _, HsIntegral i) -> Just (-(il_value i))
_ -> Nothing _ -> Nothing
mb_str_lit :: Maybe FastString mb_str_lit :: Maybe FastString
......
...@@ -1007,9 +1007,9 @@ cvtpair (PatG gs,rhs) = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs ...@@ -1007,9 +1007,9 @@ cvtpair (PatG gs,rhs) = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
cvtOverLit :: Lit -> CvtM (HsOverLit RdrName) cvtOverLit :: Lit -> CvtM (HsOverLit RdrName)
cvtOverLit (IntegerL i) cvtOverLit (IntegerL i)
= do { force i; return $ mkHsIntegral NoSourceText i placeHolderType} = do { force i; return $ mkHsIntegral (mkIntegralLit i) placeHolderType}
cvtOverLit (RationalL r) cvtOverLit (RationalL r)
= do { force r; return $ mkHsFractional (cvtFractionalLit r) placeHolderType} = do { force r; return $ mkHsFractional (mkFractionalLit r) placeHolderType}
cvtOverLit (StringL s) cvtOverLit (StringL s)
= do { let { s' = mkFastString s } = do { let { s' = mkFastString s }
; force s' ; force s'
...@@ -1043,8 +1043,8 @@ allCharLs xs ...@@ -1043,8 +1043,8 @@ allCharLs xs
cvtLit :: Lit -> CvtM HsLit cvtLit :: Lit -> CvtM HsLit
cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim NoSourceText i } cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim NoSourceText i }
cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim NoSourceText w } cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim NoSourceText w }
cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim (cvtFractionalLit f) } cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim (mkFractionalLit f) }
cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim (cvtFractionalLit f) } cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim (mkFractionalLit f) }
cvtLit (CharL c) = do { force c; return $ HsChar NoSourceText c } cvtLit (CharL c) = do { force c; return $ HsChar NoSourceText c }
cvtLit (CharPrimL c) = do { force c; return $ HsCharPrim NoSourceText c } cvtLit (CharPrimL c) = do { force c; return $ HsCharPrim NoSourceText c }
cvtLit (StringL s) = do { let { s' = mkFastString s } cvtLit (StringL s) = do { let { s' = mkFastString s }
...@@ -1428,9 +1428,6 @@ overloadedLit (IntegerL _) = True ...@@ -1428,9 +1428,6 @@ overloadedLit (IntegerL _) = True
overloadedLit (RationalL _) = True overloadedLit (RationalL _) = True
overloadedLit _ = False overloadedLit _ = False
cvtFractionalLit :: Rational -> FractionalLit
cvtFractionalLit r = FL { fl_text = show (fromRational r :: Double), fl_value = r }
-- Checks that are performed when converting unboxed sum expressions and -- Checks that are performed when converting unboxed sum expressions and
-- patterns alike. -- patterns alike.
unboxedSumChecks :: TH.SumAlt -> TH.SumArity -> CvtM () unboxedSumChecks :: TH.SumAlt -> TH.SumArity -> CvtM ()
......
...@@ -19,7 +19,8 @@ module HsLit where ...@@ -19,7 +19,8 @@ module HsLit where
#include "HsVersions.h" #include "HsVersions.h"
import {-# SOURCE #-} HsExpr( HsExpr, pprExpr ) import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
import BasicTypes ( FractionalLit(..),SourceText(..),pprWithSourceText ) import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,
negateFractionalLit,SourceText(..),pprWithSourceText )
import Type ( Type ) import Type ( Type )
import Outputable import Outputable
import FastString import FastString
...@@ -48,7 +49,7 @@ data HsLit ...@@ -48,7 +49,7 @@ data HsLit
-- ^ String -- ^ String
| HsStringPrim SourceText ByteString | HsStringPrim SourceText ByteString
-- ^ Packed bytes -- ^ Packed bytes
| HsInt SourceText Integer | HsInt IntegralLit
-- ^ Genuinely an Int; arises from -- ^ Genuinely an Int; arises from
-- @TcGenDeriv@, and from TRANSLATION -- @TcGenDeriv@, and from TRANSLATION
| HsIntPrim SourceText Integer | HsIntPrim SourceText Integer
...@@ -78,7 +79,7 @@ instance Eq HsLit where ...@@ -78,7 +79,7 @@ instance Eq HsLit where
(HsCharPrim _ x1) == (HsCharPrim _ x2) = x1==x2 (HsCharPrim _ x1) == (HsCharPrim _ x2) = x1==x2
(HsString _ x1) == (HsString _ x2) = x1==x2 (HsString _ x1) == (HsString _ x2) = x1==x2
(HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2 (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
(HsInt _ x1) == (HsInt _ x2) = x1==x2 (HsInt x1) == (HsInt x2) = x1==x2
(HsIntPrim _ x1) == (HsIntPrim _ x2) = x1==x2 (HsIntPrim _ x1) == (HsIntPrim _ x2) = x1==x2
(HsWordPrim _ x1) == (HsWordPrim _ x2) = x1==x2 (HsWordPrim _ x1) == (HsWordPrim _ x2) = x1==x2
(HsInt64Prim _ x1) == (HsInt64Prim _ x2) = x1==x2 (HsInt64Prim _ x1) == (HsInt64Prim _ x2) = x1==x2
...@@ -102,11 +103,16 @@ deriving instance (DataId id) => Data (HsOverLit id) ...@@ -102,11 +103,16 @@ deriving instance (DataId id) => Data (HsOverLit id)
-- the following -- the following
-- | Overloaded Literal Value -- | Overloaded Literal Value
data OverLitVal data OverLitVal
= HsIntegral !SourceText !Integer -- ^ Integer-looking literals; = HsIntegral !IntegralLit -- ^ Integer-looking literals;
| HsFractional !FractionalLit -- ^ Frac-looking literals | HsFractional !FractionalLit -- ^ Frac-looking literals
| HsIsString !SourceText !FastString -- ^ String-looking literals | HsIsString !SourceText !FastString -- ^ String-looking literals
deriving Data deriving Data
negateOverLitVal :: OverLitVal -> OverLitVal
negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
overLitType :: HsOverLit a -> PostTc a Type overLitType :: HsOverLit a -> PostTc a Type
overLitType = ol_type overLitType = ol_type
...@@ -146,7 +152,7 @@ instance Eq (HsOverLit id) where ...@@ -146,7 +152,7 @@ instance Eq (HsOverLit id) where
(OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2 (OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2
instance Eq OverLitVal where instance Eq OverLitVal where
(HsIntegral _ i1) == (HsIntegral _ i2) = i1 == i2 (HsIntegral i1) == (HsIntegral i2) = i1 == i2
(HsFractional f1) == (HsFractional f2) = f1 == f2 (HsFractional f1) == (HsFractional f2) = f1 == f2
(HsIsString _ s1) == (HsIsString _ s2) = s1 == s2 (HsIsString _ s1) == (HsIsString _ s2) = s1 == s2
_ == _ = False _ == _ = False
...@@ -155,14 +161,14 @@ instance Ord (HsOverLit id) where ...@@ -155,14 +161,14 @@ instance Ord (HsOverLit id) where
compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2 compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2
instance Ord OverLitVal where instance Ord OverLitVal where
compare (HsIntegral _ i1) (HsIntegral _ i2) = i1 `compare` i2 compare (HsIntegral i1) (HsIntegral i2) = i1 `compare` i2
compare (HsIntegral _ _) (HsFractional _) = LT compare (HsIntegral _) (HsFractional _) = LT
compare (HsIntegral _ _) (HsIsString _ _) = LT compare (HsIntegral _) (HsIsString _ _) = LT
compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2 compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
compare (HsFractional _) (HsIntegral _ _) = GT compare (HsFractional _) (HsIntegral _) = GT
compare (HsFractional _) (HsIsString _ _) = LT compare (HsFractional _) (HsIsString _ _) = LT
compare (HsIsString _ s1) (HsIsString _ s2) = s1 `compare` s2 compare (HsIsString _ s1) (HsIsString _ s2) = s1 `compare` s2
compare (HsIsString _ _) (HsIntegral _ _) = GT compare (HsIsString _ _) (HsIntegral _) = GT
compare (HsIsString _ _) (HsFractional _) = GT compare (HsIsString _ _) (HsFractional _) = GT
instance Outputable HsLit where instance Outputable HsLit where
...@@ -170,7 +176,7 @@ instance Outputable HsLit where ...@@ -170,7 +176,7 @@ instance Outputable HsLit where
ppr (HsCharPrim st c) = pp_st_suffix st primCharSuffix (pprPrimChar c) ppr (HsCharPrim st c) = pp_st_suffix st primCharSuffix (pprPrimChar c)
ppr (HsString st s) = pprWithSourceText st (pprHsString s) ppr (HsString st s) = pprWithSourceText st (pprHsString s)
ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s) ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
ppr (HsInt st i) = pprWithSourceText st (integer i) ppr (HsInt i) = pprWithSourceText (il_text i) (integer (il_value i))
ppr (HsInteger st i _) = pprWithSourceText st (integer i) ppr (HsInteger st i _) = pprWithSourceText st (integer i)
ppr (HsRat f _) = ppr f ppr (HsRat f _) = ppr f
ppr (HsFloatPrim f) = ppr f <> primFloatSuffix ppr (HsFloatPrim f) = ppr f <> primFloatSuffix
...@@ -190,7 +196,7 @@ instance (OutputableBndrId id) => Outputable (HsOverLit id) where ...@@ -190,7 +196,7 @@ instance (OutputableBndrId id) => Outputable (HsOverLit id) where
= ppr val <+> (ifPprDebug (parens (pprExpr witness))) = ppr val <+> (ifPprDebug (parens (pprExpr witness)))
instance Outputable OverLitVal where instance Outputable OverLitVal where
ppr (HsIntegral st i) = pprWithSourceText st (integer i) ppr (HsIntegral i) = pprWithSourceText (il_text i) (integer (il_value i))
ppr (HsFractional f) = ppr f ppr (HsFractional f) = ppr f
ppr (HsIsString st s) = pprWithSourceText st (pprHsString s) ppr (HsIsString st s) = pprWithSourceText st (pprHsString s)
...@@ -205,7 +211,7 @@ pmPprHsLit (HsChar _ c) = pprHsChar c ...@@ -205,7 +211,7 @@ pmPprHsLit (HsChar _ c) = pprHsChar c
pmPprHsLit (HsCharPrim _ c) = pprHsChar c pmPprHsLit (HsCharPrim _ c) = pprHsChar c
pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s) pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s)
pmPprHsLit (HsStringPrim _ s) = pprHsBytes s pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
pmPprHsLit (HsInt _ i) = integer i pmPprHsLit (HsInt i) = integer (il_value i)
pmPprHsLit (HsIntPrim _ i) = integer i pmPprHsLit (HsIntPrim _ i) = integer i
pmPprHsLit (HsWordPrim _ w) = integer w pmPprHsLit (HsWordPrim _ w) = integer w
pmPprHsLit (HsInt64Prim _ i) = integer i pmPprHsLit (HsInt64Prim _ i) = integer i
......
...@@ -219,7 +219,7 @@ nlParPat p = noLoc (ParPat p) ...@@ -219,7 +219,7 @@ nlParPat p = noLoc (ParPat p)
-- These are the bits of syntax that contain rebindable names -- These are the bits of syntax that contain rebindable names
-- See RnEnv.lookupSyntaxName -- See RnEnv.lookupSyntaxName
mkHsIntegral :: SourceText -> Integer -> PostTc RdrName Type mkHsIntegral :: IntegralLit -> PostTc RdrName Type
-> HsOverLit RdrName -> HsOverLit RdrName
mkHsFractional :: FractionalLit -> PostTc RdrName Type -> HsOverLit RdrName mkHsFractional :: FractionalLit -> PostTc RdrName Type -> HsOverLit RdrName
mkHsIsString :: SourceText -> FastString -> PostTc RdrName Type mkHsIsString :: SourceText -> FastString -> PostTc RdrName Type
...@@ -245,7 +245,7 @@ emptyRecStmtId :: StmtLR Id Id bodyR ...@@ -245,7 +245,7 @@ emptyRecStmtId :: StmtLR Id Id bodyR
mkRecStmt :: [LStmtLR idL RdrName bodyR] -> StmtLR idL RdrName bodyR mkRecStmt :: [LStmtLR idL RdrName bodyR] -> StmtLR idL RdrName bodyR
mkHsIntegral src i = OverLit (HsIntegral src i) noRebindableInfo noExpr mkHsIntegral i = OverLit (HsIntegral i) noRebindableInfo noExpr
mkHsFractional f = OverLit (HsFractional f) noRebindableInfo noExpr mkHsFractional f = OverLit (HsFractional f) noRebindableInfo noExpr
mkHsIsString src s = OverLit (HsIsString src s) noRebindableInfo noExpr mkHsIsString src s = OverLit (HsIsString src s) noRebindableInfo noExpr