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
6ddfe9b1
Commit
6ddfe9b1
authored
May 15, 2011
by
batterseapower
Browse files
Use FractionalLit more extensively to improve other pretty printers
parent
3391a035
Changes
9
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/BasicTypes.lhs
View file @
6ddfe9b1
...
...
@@ -74,7 +74,7 @@ module BasicTypes(
SuccessFlag(..), succeeded, failed, successIf,
FractionalLit(..)
FractionalLit(..)
, negateFractionalLit, integralFractionalLit
) where
import FastString
...
...
@@ -868,9 +868,9 @@ isEarlyActive _ = False
\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
-- Used
(instead of Rational)
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
...
...
@@ -878,6 +878,13 @@ data FractionalLit
}
deriving (Data, Typeable)
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 }
integralFractionalLit :: Integer -> FractionalLit
integralFractionalLit i = FL { fl_text = show i, fl_value = fromInteger i }
-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module MatchLit)
...
...
@@ -886,4 +893,7 @@ instance Eq FractionalLit where
instance Ord FractionalLit where
compare = compare `on` fl_value
instance Outputable FractionalLit where
ppr = text . fl_text
\end{code}
compiler/deSugar/Check.lhs
View file @
6ddfe9b1
...
...
@@ -437,14 +437,14 @@ get_lit :: Pat id -> Maybe HsLit
-- It doesn't matter which one, because they will only be compared
-- 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 (fl_value f)
))
get_lit (NPat (OverLit { ol_val = HsIntegral i}) mb _) = Just (HsIntPrim (mb_neg
negate
mb i))
get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) = Just (HsFloatPrim (mb_neg
negateFractionalLit mb f
))
get_lit (NPat (OverLit { ol_val = HsIsString s }) _ _) = Just (HsStringPrim s)
get_lit _ = Nothing
mb_neg ::
Num a =
> Maybe b -> a -> a
mb_neg Nothing v = v
mb_neg (Just _) v =
-
v
mb_neg ::
(a -> a) -
> Maybe b -> a -> a
mb_neg
_
Nothing v = v
mb_neg
negate
(Just _) v =
negate
v
get_unused_cons :: [Pat Id] -> [DataCon]
get_unused_cons used_cons = ASSERT( not (null used_cons) ) unused_cons
...
...
compiler/deSugar/DsMeta.hs
View file @
6ddfe9b1
...
...
@@ -1580,7 +1580,7 @@ repLiteral lit
mk_integer
::
Integer
->
DsM
HsLit
mk_integer
i
=
do
integer_ty
<-
lookupType
integerTyConName
return
$
HsInteger
i
integer_ty
mk_rational
::
Ra
tional
->
DsM
HsLit
mk_rational
::
Frac
tional
Lit
->
DsM
HsLit
mk_rational
r
=
do
rat_ty
<-
lookupType
rationalTyConName
return
$
HsRat
r
rat_ty
mk_string
::
FastString
->
DsM
HsLit
...
...
@@ -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
(
fl_value
f
)
mk_lit
(
HsFractional
f
)
=
mk_rational
f
mk_lit
(
HsIsString
s
)
=
mk_string
s
--------------- Miscellaneous -------------------
...
...
compiler/deSugar/MatchLit.lhs
View file @
6ddfe9b1
...
...
@@ -65,8 +65,8 @@ dsLit (HsStringPrim s) = return (Lit (MachStr s))
dsLit (HsCharPrim c) = return (Lit (MachChar c))
dsLit (HsIntPrim i) = return (Lit (MachInt i))
dsLit (HsWordPrim w) = return (Lit (MachWord w))
dsLit (HsFloatPrim f) = return (Lit (MachFloat
f
))
dsLit (HsDoublePrim d) = return (Lit (MachDouble
d
))
dsLit (HsFloatPrim f) = return (Lit (MachFloat
(fl_value f)
))
dsLit (HsDoublePrim d) = return (Lit (MachDouble
(fl_value d)
))
dsLit (HsChar c) = return (mkCharExpr c)
dsLit (HsString str) = mkStringExprFS str
...
...
@@ -74,8 +74,8 @@ dsLit (HsInteger i _) = mkIntegerExpr i
dsLit (HsInt i) = return (mkIntExpr i)
dsLit (HsRat r ty) = do
num <- mkIntegerExpr (numerator r)
denom <- mkIntegerExpr (denominator r)
num <- mkIntegerExpr (numerator
(fl_value
r)
)
denom <- mkIntegerExpr (denominator
(fl_value
r)
)
return (mkConApp ratio_data_con [Type integer_ty, num, denom])
where
(ratio_data_con, integer_ty)
...
...
@@ -113,8 +113,8 @@ hsLitKey (HsIntPrim i) = mkMachInt i
hsLitKey (HsWordPrim w) = mkMachWord w
hsLitKey (HsCharPrim c) = MachChar c
hsLitKey (HsStringPrim s) = MachStr s
hsLitKey (HsFloatPrim f) = MachFloat
f
hsLitKey (HsDoublePrim d) = MachDouble
d
hsLitKey (HsFloatPrim f) = MachFloat
(fl_value f)
hsLitKey (HsDoublePrim d) = MachDouble
(fl_value d)
hsLitKey (HsString s) = MachStr s
hsLitKey l = pprPanic "hsLitKey" (ppr l)
...
...
@@ -187,12 +187,12 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _
(Just _, HsIntegral i) -> Just (-i)
_ -> Nothing
mb_rat_lit :: Maybe
Ra
tional
mb_rat_lit :: Maybe
Frac
tional
Lit
mb_rat_lit = case (mb_neg, val) of
(Nothing, HsIntegral i) -> Just (fromInteger i)
(Just _, HsIntegral i) -> Just (fromInteger (-i))
(Nothing, HsFractional f) -> Just
(fl_value f)
(Just _, HsFractional f) -> Just (negate
(fl_value
f)
)
(Nothing, HsIntegral i) -> Just
(integralFractionalLit
(fromInteger i)
)
(Just _, HsIntegral i) -> Just
(integralFractionalLit
(fromInteger (-i))
)
(Nothing, HsFractional f) -> Just
f
(Just _, HsFractional f) -> Just (negate
FractionalLit
f)
_ -> Nothing
mb_str_lit :: Maybe FastString
...
...
compiler/hsSyn/Convert.lhs
View file @
6ddfe9b1
...
...
@@ -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 (
FL { fl_text = show (fromRational r :: Double), fl_value = r }
) placeHolderType}
= do { force r; return $ mkHsFractional (
cvtFractionalLit r
) placeHolderType}
cvtOverLit (StringL s)
= do { let { s' = mkFastString s }
; force s'
...
...
@@ -602,8 +602,8 @@ allCharLs xs
cvtLit :: Lit -> CvtM HsLit
cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim i }
cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim w }
cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim
f
}
cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim
f
}
cvtLit (FloatPrimL f) = do { force f; return $ HsFloatPrim
(cvtFractionalLit f)
}
cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim
(cvtFractionalLit f)
}
cvtLit (CharL c) = do { force c; return $ HsChar c }
cvtLit (StringL s) = do { let { s' = mkFastString s }
; force s'
...
...
@@ -768,6 +768,9 @@ overloadedLit _ = False
void :: Type.Type
void = placeHolderType
cvtFractionalLit :: Rational -> FractionalLit
cvtFractionalLit r = FL { fl_text = show (fromRational r :: Double), fl_value = r }
--------------------------------------------------------------------
-- Turning Name back into RdrName
--------------------------------------------------------------------
...
...
compiler/hsSyn/HsLit.lhs
View file @
6ddfe9b1
...
...
@@ -41,10 +41,10 @@ data HsLit
| HsWordPrim Integer -- Unboxed Word
| HsInteger Integer Type -- Genuinely an integer; arises only from TRANSLATION
-- (overloaded literals are done with HsOverLit)
| HsRat
Ra
tional Type -- Genuinely a rational; arises only from TRANSLATION
| HsRat
Frac
tional
Lit
Type -- Genuinely a rational; arises only from TRANSLATION
-- (overloaded literals are done with HsOverLit)
| HsFloatPrim
Ra
tional
-- Unboxed Float
| HsDoublePrim
Ra
tional
-- Unboxed Double
| HsFloatPrim
Frac
tional
Lit
-- Unboxed Float
| HsDoublePrim
Frac
tional
Lit
-- Unboxed Double
deriving (Data, Typeable)
instance Eq HsLit where
...
...
@@ -143,9 +143,9 @@ instance Outputable HsLit where
ppr (HsStringPrim s) = pprHsString s <> char '#'
ppr (HsInt i) = integer i
ppr (HsInteger i _) = integer i
ppr (HsRat f _) =
rational
f
ppr (HsFloatPrim f) =
rational
f <> char '#'
ppr (HsDoublePrim d) =
rational
d <> text "##"
ppr (HsRat f _) =
ppr
f
ppr (HsFloatPrim f) =
ppr
f <> char '#'
ppr (HsDoublePrim d) =
ppr
d <> text "##"
ppr (HsIntPrim i) = integer i <> char '#'
ppr (HsWordPrim w) = integer w <> text "##"
...
...
@@ -156,6 +156,6 @@ instance OutputableBndr id => Outputable (HsOverLit id) where
instance Outputable OverLitVal where
ppr (HsIntegral i) = integer i
ppr (HsFractional f) =
text (fl_text f)
ppr (HsFractional f) =
ppr f
ppr (HsIsString s) = pprHsString s
\end{code}
compiler/parser/Lexer.x
View file @
6ddfe9b1
...
...
@@ -547,8 +547,8 @@ data Token
| ITprimstring FastString
| ITprimint Integer
| ITprimword Integer
| ITprimfloat
Ra
tional
| ITprimdouble
Ra
tional
| ITprimfloat
Frac
tional
Lit
| ITprimdouble
Frac
tional
Lit
-- Template Haskell extension tokens
| ITopenExpQuote -- [| or [e|
...
...
@@ -1061,9 +1061,12 @@ hexadecimal = (16,hexDigit)
-- readRational can understand negative rationals, exponents, everything.
tok_float, tok_primfloat, tok_primdouble :: String -> Token
tok_float str = ITrational $! FL { fl_text = str, fl_value = readRational str }
tok_primfloat str = ITprimfloat $! readRational str
tok_primdouble str = ITprimdouble $! readRational str
tok_float str = ITrational $! readFractionalLit str
tok_primfloat str = ITprimfloat $! readFractionalLit str
tok_primdouble str = ITprimdouble $! readFractionalLit str
readFractionalLit :: String -> FractionalLit
readFractionalLit str = (FL $! str) $! readRational str
-- -----------------------------------------------------------------------------
-- Layout processing
...
...
compiler/typecheck/Inst.lhs
View file @
6ddfe9b1
...
...
@@ -56,7 +56,6 @@ import PrelNames
import SrcLoc
import DynFlags
import Bag
import BasicTypes
import Maybes
import Util
import Outputable
...
...
@@ -277,7 +276,7 @@ mkOverLit (HsIntegral i)
mkOverLit (HsFractional r)
= do { rat_ty <- tcMetaTy rationalTyConName
; return (HsRat
(fl_value r)
rat_ty) }
; return (HsRat
r
rat_ty) }
mkOverLit (HsIsString s) = return (HsString s)
\end{code}
...
...
compiler/typecheck/TcHsSyn.lhs
View file @
6ddfe9b1
...
...
@@ -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 (
FL { fl_text = show i, fl_value = fromInteger i }
)) ty
| otherwise = shortCutLit (HsFractional (
integralFractionalLit 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
(fl_value f)
))
| isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim
(fl_value f)
))
| isFloatTy ty = Just (mkLit floatDataCon (HsFloatPrim
f
))
| isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim
f
))
| otherwise = Nothing
shortCutLit (HsIsString s) ty
...
...
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