+% ------------------------------------------------------------------------------
+% $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@}
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}
%*********************************************************
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}
(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}
(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
('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
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
(esc,t) <- lexEsc s
return ('\\':esc, t)
where
- lexEsc (c:s) | c `elem` "abfnrtv\\\"'" = return ([c],s)
- lexEsc s@(d:_) | isDigit d = lexDecDigits s
- lexEsc ('o':d:s) | isDigit d = lexOctDigits (d:s)
- lexEsc ('O':d:s) | isDigit d = lexOctDigits (d:s)
- lexEsc ('x':d:s) | isDigit d = lexHexDigits (d:s)
- lexEsc ('X':d:s) | isDigit d = lexHexDigits (d:s)
- lexEsc ('^':c:s) | '@' <= c && c <= '_' = [(['^',c],s)] -- cf. cntrl in 2.6 of H. report.
- lexEsc s@(c:_) | isUpper c = fromAsciiLab s
- lexEsc _ = mzero
+ lexEsc (c:s) | c `elem` escChars = return ([c],s)
+ lexEsc s@(d:_) | isDigit d = checkSize 10 lexDecDigits s
+ lexEsc ('o':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
+ lexEsc ('O':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
+ lexEsc ('x':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
+ lexEsc ('X':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
+ lexEsc ('^':c:s) | c >= '@' && c <= '_' = [(['^',c],s)] -- cf. cntrl in 2.6 of H. report.
+ lexEsc s@(c:_) | isUpper c = fromAsciiLab s
+ lexEsc _ = mzero
+
+ escChars = "abfnrtv\\\"'"
fromAsciiLab (x:y:z:ls) | isUpper y && (isUpper z || isDigit z) &&
- [x,y,z] `elem` asciiTab = return ([x,y,z], ls)
+ [x,y,z] `elem` asciiEscTab = return ([x,y,z], ls)
fromAsciiLab (x:y:ls) | isUpper y &&
- [x,y] `elem` asciiTab = return ([x,y], ls)
- fromAsciiLab _ = mzero
-
+ [x,y] `elem` asciiEscTab = return ([x,y], ls)
+ fromAsciiLab _ = mzero
+
+ asciiEscTab = "DEL" : asciiTab
+
+ {-
+ Check that the numerically escaped char literals are
+ within accepted boundaries.
+
+ Note: this allows char lits with leading zeros, i.e.,
+ \0000000000000000000000000000001.
+ -}
+ checkSize base f str = do
+ (num, res) <- f str
+ if toAnInteger base num > toInteger (ord maxBound) then
+ mzero
+ else
+ case base of
+ 8 -> return ('o':num, res)
+ 16 -> return ('x':num, res)
+ _ -> return (num, res)
+
+ toAnInteger base = foldl (\ acc n -> acc*base + toInteger (digitToInt n)) 0
+
lexLitChar (c:s) = return ([c],s)
lexLitChar "" = mzero
+
+digitToInt :: Char -> Int
+digitToInt c
+ | isDigit c = fromEnum c - fromEnum '0'
+ | c >= 'a' && c <= 'f' = fromEnum c - fromEnum 'a' + 10
+ | c >= 'A' && c <= 'F' = fromEnum c - fromEnum 'A' + 10
+ | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
\end{code}
%*********************************************************
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,
projects / ghc-hetmet.git / blobdiff