X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FLexCore.hs;h=1a545a3e43b79d2998197b031094b5dcb303d540;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=93c7d1fcf79af809f7f742c75d21bb1bc0dfbd20;hpb=957bf3756ffd56f5329a2aabe1022d6f996dd641;p=ghc-hetmet.git

diff --git a/ghc/compiler/parser/LexCore.hs b/ghc/compiler/parser/LexCore.hs
index 93c7d1f..1a545a3 100644
--- a/ghc/compiler/parser/LexCore.hs
+++ b/ghc/compiler/parser/LexCore.hs
@@ -3,7 +3,7 @@ module LexCore where
 import ParserCoreUtils
 import Ratio
 import Char
-import Numeric( readFloat )
+import qualified Numeric( readFloat, readDec )
 
 isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'') 
 isKeywordChar c = isAlpha c || (c == '_') 
@@ -66,10 +66,10 @@ lexNum cont cs =
  where f sgn cs = 
          case span isDigit cs of
           (digits,'.':c:rest) 
-		| isDigit c -> cont (TKrational r) rest'
+		| isDigit c -> cont (TKrational (fromInteger sgn * r)) rest'
 	        where ((r,rest'):_) = readFloat (digits ++ ('.':c:rest))
 		-- When reading a floating-point number, which is
-		-- a bit comlicated, use the Haskell 98 library function
+		-- a bit complicated, use the Haskell 98 library function
           (digits,rest) -> cont (TKinteger (sgn * (read digits))) rest
 
 lexName cont cstr cs = cont (cstr name) rest
@@ -92,3 +92,39 @@ lexKeyword cont cs =
       ("_",rest) -> cont TKwild rest
       _ -> failP "invalid keyword" ('%':cs) 
 
+
+#if __GLASGOW_HASKELL__ >= 504
+-- The readFloat in the Numeric library will do the job
+
+readFloat :: (RealFrac a) => ReadS a
+readFloat = Numeric.readFloat
+
+#else
+-- Haskell 98's Numeric.readFloat used to have a bogusly restricted signature
+-- so it was incapable of reading a rational.  
+-- So for GHCs that have that old bogus library, here is the code, written out longhand.
+
+readFloat r    = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,
+                                                       (k,t)   <- readExp s] ++
+                 [ (0/0, t) | ("NaN",t)      <- lex r] ++
+                 [ (1/0, t) | ("Infinity",t) <- lex r]
+               where 
+                 readFix r = [(read (ds++ds'), length ds', t)
+                             | (ds,d) <- lexDigits r,
+                               (ds',t) <- lexFrac d ]
+               
+                 lexFrac ('.':ds) = lexDigits ds
+                 lexFrac s        = [("",s)]        
+                 
+                 readExp (e:s) | e `elem` "eE" = readExp' s
+                 readExp s                     = [(0,s)]
+                 
+                 readExp' ('-':s) = [(-k,t) | (k,t) <- Numeric.readDec s]
+                 readExp' ('+':s) = Numeric.readDec s
+                 readExp' s       = Numeric.readDec s
+
+lexDigits :: ReadS String 
+lexDigits s =  case span isDigit s of
+		 (cs,s') | not (null cs) -> [(cs,s')]
+		 otherwise		 -> []
+#endif