[project @ 2001-08-04 06:19:54 by ken]

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

diff --git a/ghc/lib/std/PrelRead.lhs b/ghc/lib/std/PrelRead.lhs
index a03963b..f8a2636 100644 (file)
--- a/ghc/lib/std/PrelRead.lhs
+++ b/ghc/lib/std/PrelRead.lhs
@@ -1,5 +1,7 @@
+% ------------------------------------------------------------------------------
+% $Id: PrelRead.lhs,v 1.20 2001/05/23 09:28:44 simonmar Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1998
+% (c) The University of Glasgow, 1994-2000
 %
 
 \section[PrelRead]{Module @PrelRead@}
@@ -11,19 +13,15 @@ Instances of the Read class.
 
 module PrelRead where
 
-import {-# SOURCE #-} PrelErr ( error )
+import {-# SOURCE #-} PrelErr          ( error )
+import PrelEnum                ( Enum(..), maxBound )
 import PrelNum
-import PrelNumExtra
+import PrelReal
+import PrelFloat
 import PrelList
-import PrelTup
 import PrelMaybe
-import PrelEither
+import PrelShow                -- isAlpha etc
 import PrelBase
-import Monad
-
--- needed for readIO.
-import PrelIOBase ( IO, userError )
-import PrelException ( ioError )
 \end{code}
 
 %*********************************************************
@@ -57,6 +55,22 @@ class  Read a  where
     readList   = readList__ reads
 \end{code}
 
+In this module we treat [(a,String)] as a monad in MonadPlus
+But MonadPlus isn't defined yet, so we simply give local
+declarations for mzero and guard suitable for this particular
+type.  It would also be reasonably to move MonadPlus to PrelBase
+along with Monad and Functor, but that seems overkill for one 
+example
+
+\begin{code}
+mzero :: [a]
+mzero = []
+
+guard :: Bool -> [()]
+guard True  = [()]
+guard False = []
+\end{code}
+
 %*********************************************************
 %*                                                     *
 \subsection{Utility functions}
@@ -83,19 +97,6 @@ read s          =
     (x,str1) <- reads str
     ("","")  <- lex str1
     return x
-
-  -- raises an exception instead of an error
-readIO          :: Read a => String -> IO a
-readIO s        =  case (do { (x,t) <- reads s ; ("","") <- lex t ; return x }) of
-#ifndef NEW_READS_REP
-                       [x]    -> return x
-                       []     -> ioError (userError "Prelude.readIO: no parse")
-                       _      -> ioError (userError "Prelude.readIO: ambiguous parse")
-#else
-                        Just x -> return x
-                        Nothing  -> ioError (userError "Prelude.readIO: no parse")
-#endif
-
 \end{code}
 
 \begin{code}
@@ -173,6 +174,8 @@ lex (c:s) | isSingle c = return ([c],s)
                (nam,t) <- return (span isIdChar s)
                return (c:nam, t)
           | isDigit c  = do
+{- Removed, 13/03/2000 by SDM.
+   Doesn't work, and not required by Haskell report.
                 let
                  (pred, s', isDec) =
                    case s of
@@ -181,9 +184,9 @@ lex (c:s) | isSingle c = return ([c],s)
                      ('x':rs) -> (isHexDigit, rs, False)
                      ('X':rs) -> (isHexDigit, rs, False)
                      _        -> (isDigit, s, True)
-
-                (ds,s)  <- return (span pred s')
-                (fe,t)  <- lexFracExp isDec s
+-}
+                (ds,s)  <- return (span isDigit s)
+                (fe,t)  <- lexFracExp s
                 return (c:ds++fe,t)
           | otherwise  = mzero    -- bad character
              where
@@ -191,11 +194,11 @@ lex (c:s) | isSingle c = return ([c],s)
               isSym c    =  c `elem` "!@#$%&*+./<=>?\\^|:-~"
               isIdChar c =  isAlphaNum c || c `elem` "_'"
 
-              lexFracExp True ('.':cs)   = do
+              lexFracExp ('.':c:cs) | isDigit c = do
                        (ds,t) <- lex0Digits cs
                        (e,u)  <- lexExp t
-                       return ('.':ds++e,u)
-              lexFracExp _ s        = return ("",s)
+                       return ('.':c:ds++e,u)
+              lexFracExp s        = return ("",s)
 
               lexExp (e:s) | e `elem` "eE" = 
                  (do
@@ -252,7 +255,7 @@ lexLitChar ('\\':s)     =  do
         fromAsciiLab (x:y:ls)   | isUpper y &&
                                   [x,y]   `elem` asciiEscTab = return ([x,y], ls)
         fromAsciiLab _                                       = mzero
-                                  
+
         asciiEscTab = "DEL" : asciiTab
 
         {-
@@ -264,8 +267,7 @@ lexLitChar ('\\':s)     =  do
         -}
         checkSize base f str = do
           (num, res) <- f str
-             -- Note: this is assumes that a Char is 8 bits long.
-          if (toAnInt base num) > 255 then 
+          if toAnInteger base num > toInteger (ord maxBound) then 
              mzero
            else
              case base of
@@ -273,7 +275,7 @@ lexLitChar ('\\':s)     =  do
                 16 -> return ('x':num, res)
                 _  -> return (num, res)
 
-       toAnInt base xs = foldl (\ acc n -> acc*base + n) 0 (map digitToInt xs)
+       toAnInteger base = foldl (\ acc n -> acc*base + toInteger (digitToInt n)) 0
 
 
 lexLitChar (c:s)        =  return ([c],s)
@@ -501,26 +503,27 @@ include lexing common prefixes such as '0x' or '0o' etc.
                ReadS Int,
                ReadS Integer #-}
 readDec :: (Integral a) => ReadS a
-readDec = readInt 10 isDigit (\d -> ord d - ord_0)
+readDec = readInt 10 isDigit (\d -> ord d - ord '0')
 
 {-# SPECIALISE readOct :: 
                ReadS Int,
                ReadS Integer #-}
 readOct :: (Integral a) => ReadS a
-readOct = readInt 8 isOctDigit (\d -> ord d - ord_0)
+readOct = readInt 8 isOctDigit (\d -> ord d - ord '0')
 
 {-# SPECIALISE readHex :: 
                ReadS Int,
                ReadS Integer #-}
 readHex :: (Integral a) => ReadS a
 readHex = readInt 16 isHexDigit hex
-           where hex d = ord d - (if isDigit d then ord_0
+           where hex d = ord d - (if isDigit d then ord '0'
                                   else ord (if isUpper d then 'A' else 'a') - 10)
 
 readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
 readInt radix isDig digToInt s = do
     (ds,r) <- nonnull isDig s
-    return (foldl1 (\n d -> n * radix + d) (map (fromInt . digToInt) ds), r)
+    return (foldl1 (\n d -> n * radix + d)
+                   (map (fromInteger . toInteger . digToInt) ds), r)
 
 {-# SPECIALISE readSigned ::
                ReadS Int     -> ReadS Int,