module PrelRead where
-import {-# SOURCE #-} PrelErr ( error )
+import PrelErr ( error )
+import PrelEnum ( Enum(..) )
import PrelNum
+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, fail, userError )
+-- needed for readIO and instance Read Buffermode
+import PrelIOBase ( IO, userError, BufferMode(..) )
+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}
case read_s s of
#ifndef NEW_READS_REP
[x] -> x
- [] -> error "PreludeText.read: no parse"
- _ -> error "PreludeText.read: ambiguous parse"
+ [] -> error "Prelude.read: no parse"
+ _ -> error "Prelude.read: ambiguous parse"
#else
Just x -> x
- Nothing -> error "PreludeText.read: no parse"
+ Nothing -> error "Prelude.read: no parse"
#endif
where
- read_s s = do
- (x,t) <- reads s
- ("","") <- lex t
+ read_s str = do
+ (x,str1) <- reads str
+ ("","") <- lex str1
return x
-- raises an exception instead of an error
readIO s = case (do { (x,t) <- reads s ; ("","") <- lex t ; return x }) of
#ifndef NEW_READS_REP
[x] -> return x
- [] -> fail (userError "PreludeIO.readIO: no parse")
- _ -> fail (userError "PreludeIO.readIO: ambiguous parse")
+ [] -> ioError (userError "Prelude.readIO: no parse")
+ _ -> ioError (userError "Prelude.readIO: ambiguous parse")
#else
Just x -> return x
- Nothing -> fail (userError "PreludeIO.readIO: no parse")
+ Nothing -> ioError (userError "Prelude.readIO: no parse")
#endif
\end{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
+ ('o':rs) -> (isOctDigit, rs, False)
+ ('O':rs) -> (isOctDigit, rs, False)
+ ('x':rs) -> (isHexDigit, rs, False)
+ ('X':rs) -> (isHexDigit, rs, False)
+ _ -> (isDigit, s, True)
+-}
(ds,s) <- return (span isDigit s)
(fe,t) <- lexFracExp s
return (c:ds++fe,t)
- | otherwise = zero -- bad character
+ | otherwise = mzero -- bad character
where
isSingle c = c `elem` ",;()[]{}_`"
isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
- isIdChar c = isAlphanum c || c `elem` "_'"
+ isIdChar c = isAlphaNum c || c `elem` "_'"
- lexFracExp ('.':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
(c:t) <- return s
guard (c `elem` "+-")
- (ds,u) <- lexDigits t
+ (ds,u) <- lexDecDigits t
return (e:c:ds,u)) ++
(do
- (ds,t) <- lexDigits s
+ (ds,t) <- lexDecDigits s
return (e:ds,t))
lexExp s = return ("",s)
-lexDigits :: ReadS String
-lexDigits = nonnull isDigit
+lexDigits :: ReadS String
+lexDigits = lexDecDigits
+
+lexDecDigits :: ReadS String
+lexDecDigits = nonnull isDigit
+
+lexOctDigits :: ReadS String
+lexOctDigits = nonnull isOctDigit
+
+lexHexDigits :: ReadS String
+lexHexDigits = nonnull isHexDigit
-- 0 or more digits
lex0Digits :: ReadS String
lexLitChar ('\\':s) = do
(esc,t) <- lexEsc s
return ('\\':esc, t)
- where
- lexEsc (c:s) | c `elem` "abfnrtv\\\"'" = return ([c],s)
- lexEsc s@(d:_) | isDigit d = lexDigits s
- lexEsc _ = zero
+ where
+ 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` asciiEscTab = return ([x,y,z], ls)
+ fromAsciiLab (x:y:ls) | isUpper y &&
+ [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
+ -- Note: this is assumes that a Char is 8 bits long.
+ if (toAnInt base num) > 255 then
+ mzero
+ else
+ case base of
+ 8 -> return ('o':num, res)
+ 16 -> return ('x':num, res)
+ _ -> return (num, res)
+
+ toAnInt base xs = foldl (\ acc n -> acc*base + n) 0 (map digitToInt xs)
+
lexLitChar (c:s) = return ([c],s)
-lexLitChar "" = zero
+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}
%*********************************************************
\begin{code}
instance Read Char where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\r -> do
('\'':s,t) <- lex r
- (c,_) <- readLitChar s
+ (c,"\'") <- readLitChar s
return (c,t))
readList = readParen False (\r -> do
return (c:cs,u)
instance Read Bool where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\r ->
lex r >>= \ lr ->
(do { ("True", rest) <- return lr ; return (True, rest) }) ++
instance Read Ordering where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\r ->
lex r >>= \ lr ->
(do { ("LT", rest) <- return lr ; return (LT, rest) }) ++
(do { ("GT", rest) <- return lr ; return (GT, rest) }))
instance Read a => Read (Maybe a) where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\r ->
lex r >>= \ lr ->
(do { ("Nothing", rest) <- return lr ; return (Nothing, rest)}) ++
return (Just x, rest2)))
instance (Read a, Read b) => Read (Either a b) where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\r ->
lex r >>= \ lr ->
(do
return (Right x, rest2)))
instance Read Int where
- readsPrec p x = readSigned readDec x
+ readsPrec _ x = readSigned readDec x
instance Read Integer where
- readsPrec p x = readSigned readDec x
+ readsPrec _ x = readSigned readDec x
instance Read Float where
- readsPrec p x = readSigned readFloat x
+ readsPrec _ x = readSigned readFloat x
instance Read Double where
- readsPrec p x = readSigned readFloat x
+ readsPrec _ x = readSigned readFloat x
instance (Integral a, Read a) => Read (Ratio a) where
readsPrec p = readParen (p > ratio_prec)
return (x%y,u))
instance (Read a) => Read [a] where
- readsPrec p = readList
+ readsPrec _ = readList
instance Read () where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\r -> do
("(",s) <- lex r
(")",t) <- lex s
return ((),t))
instance (Read a, Read b) => Read (a,b) where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\r -> do
("(",s) <- lex r
(x,t) <- readsPrec 0 s
return ((x,y), w))
instance (Read a, Read b, Read c) => Read (a, b, c) where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\a -> do
("(",b) <- lex a
(x,c) <- readsPrec 0 b
return ((x,y,z), h))
instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\a -> do
("(",b) <- lex a
(w,c) <- readsPrec 0 b
return ((w,x,y,z), i))
instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
- readsPrec p = readParen False
+ readsPrec _ = readParen False
(\a -> do
("(",b) <- lex a
(v,c) <- readsPrec 0 b
\begin{code}
readLitChar :: ReadS Char
+readLitChar [] = mzero
readLitChar ('\\':s) = readEsc s
where
readEsc ('a':s) = return ('\a',s)
in case [(c,s') | (c, mne) <- table,
([],s') <- [match mne s]]
of (pr:_) -> return pr
- [] -> zero
- readEsc _ = zero
+ [] -> mzero
+ readEsc _ = mzero
readLitChar (c:s) = return (c,s)
return (1/0,t) )
where
readFix r = do
- (ds,s) <- lexDigits r
+ (ds,s) <- lexDecDigits r
(ds',t) <- lexDotDigits s
return (read (ds++ds'), length ds', t)
#endif
\end{code}
+
+%*********************************************************
+%* *
+\subsection{Reading BufferMode}
+%* *
+%*********************************************************
+
+This instance decl is here rather than somewhere more appropriate in
+order that we can avoid both orphan-instance modules and recursive
+dependencies.
+
+\begin{code}
+instance Read BufferMode where
+ readsPrec _ =
+ readParen False
+ (\r -> let lr = lex r
+ in
+ [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++
+ [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++
+ [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
+ (mb, rest2) <- reads rest1])
+
+\end{code}
projects / ghc-hetmet.git / blobdiff