[project @ 2002-04-24 16:31:37 by simonmar]

[ghc-base.git] / GHC / Read.lhs

diff --git a/GHC/Read.lhs b/GHC/Read.lhs
index 949ec59..6a23d61 100644 (file)
--- a/GHC/Read.lhs
+++ b/GHC/Read.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: Read.lhs,v 1.4 2002/04/11 12:03:44 simonpj Exp $
+% $Id: Read.lhs,v 1.6 2002/04/13 14:59:06 panne Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -168,8 +168,9 @@ read s = either error id (readEither s)
 -- H98 compatibility
 
 lex :: ReadS String            -- As defined by H98
-lex = readP_to_S (do { lexeme <- L.lex ;
-                      return (show lexeme) })
+lex "" = [("","")] -- ugly hack
+lex s  = readP_to_S (do { lexeme <- L.lex ;
+                         return (show lexeme) }) s
 
 lexLitChar :: ReadS String     -- As defined by H98
 lexLitChar = readP_to_S (do { lexeme <- L.lexLitChar ;
@@ -384,6 +385,24 @@ readNumber convert =
          _          -> pfail
   )
 
+readIEEENumber :: (RealFloat a) => (Number -> Maybe a) -> ReadPrec a
+-- Read a Float/Double.
+readIEEENumber convert =
+  parens
+  ( do x <- lexP
+       case x of
+         Ident "NaN"      -> return (0/0)
+        Ident "Infinity" -> return (1/0)
+         Symbol "-" -> do n <- readIEEENumber convert
+                          return (negate n)
+       
+         Number y   -> case convert y of
+                         Just n  -> return n
+                         Nothing -> pfail
+         
+         _          -> pfail
+  )
+
 instance Read Int where
   readPrec     = readNumber numberToInt
   readListPrec = readListPrecDefault
@@ -395,12 +414,12 @@ instance Read Integer where
   readList     = readListDefault
 
 instance Read Float where
-  readPrec     = readNumber numberToFloat
+  readPrec     = readIEEENumber numberToFloat
   readListPrec = readListPrecDefault
   readList     = readListDefault
 
 instance Read Double where
-  readPrec     = readNumber numberToDouble
+  readPrec     = readIEEENumber numberToDouble
   readListPrec = readListPrecDefault
   readList     = readListDefault