inlinePragmaActivation, inlinePragmaRuleMatchInfo,
setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
- SuccessFlag(..), succeeded, failed, successIf
+ SuccessFlag(..), succeeded, failed, successIf,
+
+ FractionalLit(..)
) where
import FastString
import Outputable
import Data.Data hiding (Fixity)
+import Data.Function (on)
\end{code}
%************************************************************************
isEarlyActive _ = False
\end{code}
+
+
+\begin{code}
+-- Used to represent exactly the floating point literal that we encountered in
+-- the user's source program. This allows us to pretty-print exactly what 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_value :: Rational -- Numeric value of the literal
+ }
+ deriving (Data, Typeable)
+
+-- Comparison operations are needed when grouping literals
+-- for compiling pattern-matching (module MatchLit)
+
+instance Eq FractionalLit where
+ (==) = (==) `on` fl_value
+
+instance Ord FractionalLit where
+ compare = compare `on` fl_value
+\end{code}
import SrcLoc
import UniqSet
import Util
+import BasicTypes
import Outputable
import FastString
\end{code}
-- with other HsLits gotten in the same way
get_lit (LitPat lit) = Just lit
get_lit (NPat (OverLit { ol_val = HsIntegral i}) mb _) = Just (HsIntPrim (mb_neg mb i))
-get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) = Just (HsFloatPrim (mb_neg mb f))
+get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) = Just (HsFloatPrim (mb_neg mb (fl_value f)))
get_lit (NPat (OverLit { ol_val = HsIsString s }) _ _) = Just (HsStringPrim s)
get_lit _ = Nothing
mk_lit :: OverLitVal -> DsM HsLit
mk_lit (HsIntegral i) = mk_integer i
-mk_lit (HsFractional f) = mk_rational f
+mk_lit (HsFractional f) = mk_rational (fl_value f)
mk_lit (HsIsString s) = mk_string s
--------------- Miscellaneous -------------------
import SrcLoc
import Data.Ratio
import Outputable
+import BasicTypes
import Util
import FastString
\end{code}
litValKey :: OverLitVal -> Bool -> Literal
litValKey (HsIntegral i) False = MachInt i
litValKey (HsIntegral i) True = MachInt (-i)
-litValKey (HsFractional r) False = MachFloat r
-litValKey (HsFractional r) True = MachFloat (-r)
+litValKey (HsFractional r) False = MachFloat (fl_value r)
+litValKey (HsFractional r) True = MachFloat (negate (fl_value r))
litValKey (HsIsString s) neg = ASSERT( not neg) MachStr s
\end{code}
mb_rat_lit = case (mb_neg, val) of
(Nothing, HsIntegral i) -> Just (fromInteger i)
(Just _, HsIntegral i) -> Just (fromInteger (-i))
- (Nothing, HsFractional f) -> Just f
- (Just _, HsFractional f) -> Just (-f)
+ (Nothing, HsFractional f) -> Just (fl_value f)
+ (Just _, HsFractional f) -> Just (negate (fl_value f))
_ -> Nothing
mb_str_lit :: Maybe FastString
cvtOverLit (IntegerL i)
= do { force i; return $ mkHsIntegral i placeHolderType}
cvtOverLit (RationalL r)
- = do { force r; return $ mkHsFractional r placeHolderType}
+ = do { force r; return $ mkHsFractional (FL { fl_text = show (fromRational r :: Double), fl_value = r }) placeHolderType}
cvtOverLit (StringL s)
= do { let { s' = mkFastString s }
; force s'
#include "HsVersions.h"
import {-# SOURCE #-} HsExpr( SyntaxExpr, pprExpr )
-import HsTypes (PostTcType)
+import BasicTypes ( FractionalLit(..) )
+import HsTypes ( PostTcType )
import Type ( Type )
import Outputable
import FastString
data OverLitVal
= HsIntegral !Integer -- Integer-looking literals;
- | HsFractional !Rational -- Frac-looking literals
+ | HsFractional !FractionalLit -- Frac-looking literals
| HsIsString !FastString -- String-looking literals
deriving (Data, Typeable)
instance Outputable OverLitVal where
ppr (HsIntegral i) = integer i
- ppr (HsFractional f) = rational f
+ ppr (HsFractional f) = text (fl_text f)
ppr (HsIsString s) = pprHsString s
\end{code}
-- See RnEnv.lookupSyntaxName
mkHsIntegral :: Integer -> PostTcType -> HsOverLit id
-mkHsFractional :: Rational -> PostTcType -> HsOverLit id
+mkHsFractional :: FractionalLit -> PostTcType -> HsOverLit id
mkHsIsString :: FastString -> PostTcType -> HsOverLit id
mkHsDo :: HsStmtContext Name -> [LStmt id] -> HsExpr id
mkHsComp :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> HsExpr id
import DynFlags
import Module
import Ctype
-import BasicTypes ( InlineSpec(..), RuleMatchInfo(..) )
+import BasicTypes ( InlineSpec(..), RuleMatchInfo(..), FractionalLit(..) )
import Util ( readRational )
import Control.Monad
| ITchar Char
| ITstring FastString
| ITinteger Integer
- | ITrational Rational
+ | ITrational FractionalLit
| ITprimchar Char
| ITprimstring FastString
-- readRational can understand negative rationals, exponents, everything.
tok_float, tok_primfloat, tok_primdouble :: String -> Token
-tok_float str = ITrational $! readRational str
+tok_float str = ITrational $! FL { fl_text = str, fl_value = readRational str }
tok_primfloat str = ITprimfloat $! readRational str
tok_primdouble str = ITprimdouble $! readRational str
import SrcLoc
import DynFlags
import Bag
+import BasicTypes
import Maybes
import Util
import Outputable
mkOverLit (HsFractional r)
= do { rat_ty <- tcMetaTy rationalTyConName
- ; return (HsRat r rat_ty) }
+ ; return (HsRat (fl_value r) rat_ty) }
mkOverLit (HsIsString s) = return (HsString s)
\end{code}
| isIntTy ty && inIntRange i = Just (HsLit (HsInt i))
| isWordTy ty && inWordRange i = Just (mkLit wordDataCon (HsWordPrim i))
| isIntegerTy ty = Just (HsLit (HsInteger i ty))
- | otherwise = shortCutLit (HsFractional (fromInteger i)) ty
+ | otherwise = shortCutLit (HsFractional (FL { fl_text = show i, fl_value = fromInteger i })) ty
-- The 'otherwise' case is important
-- Consider (3 :: Float). Syntactically it looks like an IntLit,
-- so we'll call shortCutIntLit, but of course it's a float
-- literals, compiled without -O
shortCutLit (HsFractional f) ty
- | isFloatTy ty = Just (mkLit floatDataCon (HsFloatPrim f))
- | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim f))
+ | isFloatTy ty = Just (mkLit floatDataCon (HsFloatPrim (fl_value f)))
+ | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim (fl_value f)))
| otherwise = Nothing
shortCutLit (HsIsString s) ty