+% ------------------------------------------------------------------------------
+% $Id: PrelRead.lhs,v 1.22 2001/11/23 16:20:08 simonpj Exp $
%
-% (c) The AQUA Project, Glasgow University, 1994-1998
+% (c) The University of Glasgow, 1994-2000
%
\section[PrelRead]{Module @PrelRead@}
module PrelRead where
-import PrelErr ( error )
-import PrelEnum ( Enum(..) )
+import {-# SOURCE #-} PrelErr ( error )
+import PrelEnum ( Enum(..), maxBound )
import PrelNum
import PrelReal
import PrelFloat
import PrelList
-import PrelTup
import PrelMaybe
import PrelShow -- isAlpha etc
import PrelBase
-import Monad
-
--- 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}
(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}
fromAsciiLab (x:y:ls) | isUpper y &&
[x,y] `elem` asciiEscTab = return ([x,y], ls)
fromAsciiLab _ = mzero
-
+
asciiEscTab = "DEL" : asciiTab
{-
-}
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
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)
(x,s) <- reads r
("%",t) <- lex s
(y,u) <- reads t
- return (x%y,u))
+ return (x % y,u))
instance (Read a) => Read [a] where
readsPrec _ = readList
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,
ReadS Double,
ReadS Float #-}
readFloat :: (RealFloat a) => ReadS a
-readFloat r = do
- (x,t) <- readRational r
- return (fromRational x,t)
-
-readRational :: ReadS Rational -- NB: doesn't handle leading "-"
-
-readRational r =
- (do
- (n,d,s) <- readFix r
- (k,t) <- readExp s
- return ((n%1)*10^^(k-d), t )) ++
+readFloat r =
+ (do
+ (x,t) <- readRational r
+ return (fromRational x,t) ) ++
(do
("NaN",t) <- lex r
return (0/0,t) ) ++
(do
("Infinity",t) <- lex r
return (1/0,t) )
+
+readRational :: ReadS Rational -- NB: doesn't handle leading "-"
+readRational r = do
+ (n,d,s) <- readFix r
+ (k,t) <- readExp s
+ return ((n%1)*10^^(k-d), t)
where
readFix r = do
(ds,s) <- lexDecDigits r
#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