Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
3391a035
Commit
3391a035
authored
May 15, 2011
by
batterseapower
Browse files
Record the original text along with parsed Rationals: fixes
#2245
parent
ee5addcc
Changes
10
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/BasicTypes.lhs
View file @
3391a035
...
...
@@ -72,13 +72,16 @@ module BasicTypes(
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}
%************************************************************************
...
...
@@ -862,3 +865,25 @@ isEarlyActive (ActiveBefore {}) = True
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}
compiler/deSugar/Check.lhs
View file @
3391a035
...
...
@@ -30,6 +30,7 @@ import Type
import SrcLoc
import UniqSet
import Util
import BasicTypes
import Outputable
import FastString
\end{code}
...
...
@@ -437,7 +438,7 @@ get_lit :: Pat id -> Maybe HsLit
-- 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
...
...
compiler/deSugar/DsMeta.hs
View file @
3391a035
...
...
@@ -1595,7 +1595,7 @@ repOverloadedLiteral (OverLit { ol_val = val})
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 -------------------
...
...
compiler/deSugar/MatchLit.lhs
View file @
3391a035
...
...
@@ -33,6 +33,7 @@ import Literal
import SrcLoc
import Data.Ratio
import Outputable
import BasicTypes
import Util
import FastString
\end{code}
...
...
@@ -124,8 +125,8 @@ hsOverLitKey (OverLit { ol_val = l }) neg = litValKey l neg
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}
...
...
@@ -190,8 +191,8 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _
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
...
...
compiler/hsSyn/Convert.lhs
View file @
3391a035
...
...
@@ -568,7 +568,7 @@ cvtOverLit :: Lit -> CvtM (HsOverLit RdrName)
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'
...
...
compiler/hsSyn/HsLit.lhs
View file @
3391a035
...
...
@@ -12,7 +12,8 @@ module HsLit where
#include "HsVersions.h"
import {-# SOURCE #-} HsExpr( SyntaxExpr, pprExpr )
import HsTypes (PostTcType)
import BasicTypes ( FractionalLit(..) )
import HsTypes ( PostTcType )
import Type ( Type )
import Outputable
import FastString
...
...
@@ -70,7 +71,7 @@ data HsOverLit id -- An overloaded literal
data OverLitVal
= HsIntegral !Integer -- Integer-looking literals;
| HsFractional !
Ra
tional
-- Frac-looking literals
| HsFractional !
Frac
tional
Lit
-- Frac-looking literals
| HsIsString !FastString -- String-looking literals
deriving (Data, Typeable)
...
...
@@ -155,6 +156,6 @@ instance OutputableBndr id => Outputable (HsOverLit id) where
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}
compiler/hsSyn/HsUtils.lhs
View file @
3391a035
...
...
@@ -187,7 +187,7 @@ mkSimpleHsAlt pat expr
-- See RnEnv.lookupSyntaxName
mkHsIntegral :: Integer -> PostTcType -> HsOverLit id
mkHsFractional ::
Ra
tional -> PostTcType -> HsOverLit id
mkHsFractional ::
Frac
tional
Lit
-> PostTcType -> HsOverLit id
mkHsIsString :: FastString -> PostTcType -> HsOverLit id
mkHsDo :: HsStmtContext Name -> [LStmt id] -> HsExpr id
mkHsComp :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> HsExpr id
...
...
compiler/parser/Lexer.x
View file @
3391a035
...
...
@@ -68,7 +68,7 @@ import UniqFM
import DynFlags
import Module
import Ctype
import BasicTypes ( InlineSpec(..), RuleMatchInfo(..) )
import BasicTypes ( InlineSpec(..), RuleMatchInfo(..)
, FractionalLit(..)
)
import Util ( readRational )
import Control.Monad
...
...
@@ -541,7 +541,7 @@ data Token
| ITchar Char
| ITstring FastString
| ITinteger Integer
| ITrational
Ra
tional
| ITrational
Frac
tional
Lit
| ITprimchar Char
| ITprimstring FastString
...
...
@@ -1061,7 +1061,7 @@ hexadecimal = (16,hexDigit)
-- 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
...
...
compiler/typecheck/Inst.lhs
View file @
3391a035
...
...
@@ -56,6 +56,7 @@ import PrelNames
import SrcLoc
import DynFlags
import Bag
import BasicTypes
import Maybes
import Util
import Outputable
...
...
@@ -276,7 +277,7 @@ mkOverLit (HsIntegral i)
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}
...
...
compiler/typecheck/TcHsSyn.lhs
View file @
3391a035
...
...
@@ -121,7 +121,7 @@ shortCutLit (HsIntegral i) ty
| 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
...
...
@@ -129,8 +129,8 @@ shortCutLit (HsIntegral i) ty
-- 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
...
...
batterseapower
@trac-batterseapower
mentioned in issue
#2245 (closed)
·
Apr 28, 2008
mentioned in issue
#2245 (closed)
mentioned in issue #2245
Toggle commit list
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment