From 1983c5a2f48f054cbbf738dd2a89d7c1f080c361 Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Mon, 11 May 1998 16:19:57 +0000
Subject: [PATCH] [project @ 1998-05-11 16:19:46 by simonm] Convert floating
point literals from interfaces directly to Rationals, rather than go via
Doubles.
---
ghc/compiler/reader/Lex.lhs | 20 ++++++++++++++------
ghc/compiler/rename/ParseIface.y | 6 +++---
2 files changed, 17 insertions(+), 9 deletions(-)
diff --git a/ghc/compiler/reader/Lex.lhs b/ghc/compiler/reader/Lex.lhs
index 643bb532b9e3..beea1efe0952 100644
--- a/ghc/compiler/reader/Lex.lhs
+++ b/ghc/compiler/reader/Lex.lhs
@@ -53,6 +53,8 @@ import FastString
import StringBuffer
import GlaExts
import ST ( runST )
+
+import PrelRead ( readRational__ ) -- Glasgow non-std
\end{code}
%************************************************************************
@@ -219,7 +221,7 @@ data IfaceToken
| ITccall (Bool,Bool) -- (is_casm, may_gc)
| ITscc CostCentre
| ITchar Char | ITstring FAST_STRING
- | ITinteger Integer | ITdouble Double
+ | ITinteger Integer | ITrational Rational
| ITinteger_lit | ITfloat_lit | ITrational_lit | ITaddr_lit | ITlit_lit | ITstring_lit
| ITunknown String -- Used when the lexer can't make sense of it
| ITeof -- end of file token
@@ -443,13 +445,19 @@ lex_num cont minus acc# buf =
-- presence of floating point numbers in interface
-- files is not that common. (ToDo)
case expandWhile (isDigit) (incLexeme buf') of
- buf'' -> -- points to first non digit char
- case reads (lexemeToString buf'') of
- [(v,_)] -> cont (ITdouble v) (stepOverLexeme buf'')
+ buf2 -> -- points to first non digit char
+ let l = case currentChar# buf2 of
+ 'e'# -> let buf3 = incLexeme buf2 in
+ case currentChar# buf3 of
+ '-'# -> expandWhile (isDigit) (incLexeme buf3)
+ _ -> expandWhile (isDigit) buf3
+ _ -> buf2
+ in let v = readRational__ (lexemeToString l) in
+ cont (ITrational v) (stepOverLexeme l)
+
_ -> cont (ITinteger (fromInt (minus acc'))) (stepOverLexeme buf')
--- case reads (lexemeToString buf') of
--- [(i,_)] -> cont (ITinteger i) (stepOverLexeme buf')
+
------------
lex_keyword cont buf =
diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 96fac18cedb2..03bdde8eb305 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -102,7 +102,7 @@ import Outputable
CHAR { ITchar $$ }
STRING { ITstring $$ }
INTEGER { ITinteger $$ }
- DOUBLE { ITdouble $$ }
+ RATIONAL { ITrational $$ }
INTEGER_LIT { ITinteger_lit }
FLOAT_LIT { ITfloat_lit }
@@ -572,8 +572,8 @@ core_lit : INTEGER { MachInt $1 True }
| CHAR { MachChar $1 }
| STRING { MachStr $1 }
| STRING_LIT STRING { NoRepStr $2 }
- | DOUBLE { MachDouble (toRational $1) }
- | FLOAT_LIT DOUBLE { MachFloat (toRational $2) }
+ | RATIONAL { MachDouble $1 }
+ | FLOAT_LIT RATIONAL { MachFloat $2 }
| INTEGER_LIT INTEGER { NoRepInteger $2 (panic "NoRepInteger type")
-- The type checker will add the types
--
GitLab