[project @ 1997-07-05 01:01:11 by sof]

[ghc-hetmet.git] / ghc / lib / ghc / PrelRead.lhs

diff --git a/ghc/lib/ghc/PrelRead.lhs b/ghc/lib/ghc/PrelRead.lhs
index 488f22f..f08cc88 100644 (file)
--- a/ghc/lib/ghc/PrelRead.lhs
+++ b/ghc/lib/ghc/PrelRead.lhs
@@ -2,15 +2,16 @@
 % (c) The AQUA Project, Glasgow University, 1994-1996
 %
 
-\section[PrelRead]{Module @Prelread@}
+\section[PrelRead]{Module @PrelRead@}
 
 The @Read@ class and many of its instances.
 
 \begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
 module PrelRead where
 
-import Prelude ()
-import IOBase  ( error )               {-# SOURCE #-}
+import {-# SOURCE #-}  IOBase  ( error )
 import PrelNum
 import PrelList
 import PrelTup
@@ -291,10 +292,12 @@ readRational :: ReadS Rational -- NB: doesn't handle leading "-"
 
 readRational r
   = [ ( (n%1)*10^^(k-d), t ) | (n,d,s) <- readFix r,
-                              (k,t)   <- readExp s]
+                              (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,'.':s) <- lexDigits r,
-                                         (ds',t)    <- lexDigits s ]
+                                       | (ds,s)  <- lexDigits r,
+                                         (ds',t) <- lexDotDigits s ]
 
                    readExp (e:s) | e `elem` "eE" = readExp' s
                     readExp s                    = [(0,s)]
@@ -303,6 +306,9 @@ readRational r
                     readExp' ('+':s) = readDec s
                     readExp' s      = readDec s
 
+                   lexDotDigits ('.':s) = lex0Digits s
+                   lexDotDigits s       = [("",s)]
+
 readRational__ :: String -> Rational -- we export this one (non-std)
                                    -- NB: *does* handle a leading "-"
 readRational__ top_s
@@ -366,9 +372,9 @@ lex (c:s) | isSingle c = [([c],s)]
               isSym c    =  c `elem` "!@#$%&*+./<=>?\\^|:-~"
               isIdChar c =  isAlphanum c || c `elem` "_'"
 
-              lexFracExp ('.':s) = [('.':ds++e,u) | (ds,t) <- lexDigits s,
-                                                    (e,u)  <- lexExp t]
-              lexFracExp s       = [("",s)]
+              lexFracExp ('.':cs)   = [('.':ds++e,u) | (ds,t) <- lex0Digits cs,
+                                                       (e,u)  <- lexExp t]
+              lexFracExp s          = [("",s)]
 
               lexExp (e:s) | e `elem` "eE"
                        = [(e:c:ds,u) | (c:t)  <- [s], c `elem` "+-",
@@ -379,6 +385,10 @@ lex (c:s) | isSingle c = [([c],s)]
 lexDigits               :: ReadS String 
 lexDigits               =  nonnull isDigit
 
+-- 0 or more digits
+lex0Digits               :: ReadS String 
+lex0Digits  s            =  [span isDigit s]
+
 nonnull                 :: (Char -> Bool) -> ReadS String
 nonnull p s             =  [(cs,t) | (cs@(_:_),t) <- [span p s]]