2 % (c) The AQUA Project, Glasgow University, 1994-1998
5 \section[PrelRead]{Module @PrelRead@}
7 Instances of the Read class.
10 {-# OPTIONS -fno-implicit-prelude #-}
14 import PrelErr ( error )
15 import PrelEnum ( Enum(..) )
22 import PrelShow -- isAlpha etc
26 -- needed for readIO and instance Read Buffermode
27 import PrelIOBase ( IO, userError, BufferMode(..) )
28 import PrelException ( ioError )
31 %*********************************************************
33 \subsection{The @Read@ class}
35 %*********************************************************
37 Note: if you compile this with -DNEW_READS_REP, you'll get
38 a (simpler) ReadS representation that only allow one valid
39 parse of a string of characters, instead of a list of
42 [changing the ReadS rep has implications for the deriving
43 machinery for Read, a change that hasn't been made, so you
44 probably won't want to compile in this new rep. except
45 when in an experimental mood.]
50 type ReadS a = String -> [(a,String)]
52 type ReadS a = String -> Maybe (a,String)
56 readsPrec :: Int -> ReadS a
59 readList = readList__ reads
62 %*********************************************************
64 \subsection{Utility functions}
66 %*********************************************************
69 reads :: (Read a) => ReadS a
72 read :: (Read a) => String -> a
77 [] -> error "Prelude.read: no parse"
78 _ -> error "Prelude.read: ambiguous parse"
81 Nothing -> error "Prelude.read: no parse"
89 -- raises an exception instead of an error
90 readIO :: Read a => String -> IO a
91 readIO s = case (do { (x,t) <- reads s ; ("","") <- lex t ; return x }) of
94 [] -> ioError (userError "Prelude.readIO: no parse")
95 _ -> ioError (userError "Prelude.readIO: ambiguous parse")
98 Nothing -> ioError (userError "Prelude.readIO: no parse")
104 readParen :: Bool -> ReadS a -> ReadS a
105 readParen b g = if b then mandatory else optional
106 where optional r = g r ++ mandatory r
114 readList__ :: ReadS a -> ReadS [a]
117 = readParen False (\r -> do
121 (do { ("]",t) <- lex s ; return ([],t) }) ++
122 (do { (x,t) <- readx s ; (xs,u) <- readl2 t ; return (x:xs,u) })
125 (do { ("]",t) <- lex s ; return ([],t) }) ++
126 (do { (",",t) <- lex s ; (x,u) <- readx t ; (xs,v) <- readl2 u ; return (x:xs,v) })
131 %*********************************************************
133 \subsection{Lexical analysis}
135 %*********************************************************
137 This lexer is not completely faithful to the Haskell lexical syntax.
139 Qualified names are not handled properly
140 A `--' does not terminate a symbol
141 Octal and hexidecimal numerics are not recognized as a single token
146 lex "" = return ("","")
147 lex (c:s) | isSpace c = lex (dropWhile isSpace s)
149 (ch, '\'':t) <- lexLitChar s
151 return ('\'':ch++"'", t)
153 (str,t) <- lexString s
157 lexString ('"':s) = return ("\"",s)
159 (ch,t) <- lexStrItem s
160 (str,u) <- lexString t
164 lexStrItem ('\\':'&':s) = return ("\\&",s)
165 lexStrItem ('\\':c:s) | isSpace c = do
166 ('\\':t) <- return (dropWhile isSpace s)
168 lexStrItem s = lexLitChar s
170 lex (c:s) | isSingle c = return ([c],s)
172 (sym,t) <- return (span isSym s)
175 (nam,t) <- return (span isIdChar s)
178 {- Removed, 13/03/2000 by SDM.
179 Doesn't work, and not required by Haskell report.
183 ('o':rs) -> (isOctDigit, rs, False)
184 ('O':rs) -> (isOctDigit, rs, False)
185 ('x':rs) -> (isHexDigit, rs, False)
186 ('X':rs) -> (isHexDigit, rs, False)
187 _ -> (isDigit, s, True)
189 (ds,s) <- return (span isDigit s)
190 (fe,t) <- lexFracExp s
192 | otherwise = mzero -- bad character
194 isSingle c = c `elem` ",;()[]{}_`"
195 isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
196 isIdChar c = isAlphaNum c || c `elem` "_'"
198 lexFracExp ('.':c:cs) | isDigit c = do
199 (ds,t) <- lex0Digits cs
201 return ('.':c:ds++e,u)
202 lexFracExp s = return ("",s)
204 lexExp (e:s) | e `elem` "eE" =
207 guard (c `elem` "+-")
208 (ds,u) <- lexDecDigits t
209 return (e:c:ds,u)) ++
211 (ds,t) <- lexDecDigits s
214 lexExp s = return ("",s)
216 lexDigits :: ReadS String
217 lexDigits = lexDecDigits
219 lexDecDigits :: ReadS String
220 lexDecDigits = nonnull isDigit
222 lexOctDigits :: ReadS String
223 lexOctDigits = nonnull isOctDigit
225 lexHexDigits :: ReadS String
226 lexHexDigits = nonnull isHexDigit
229 lex0Digits :: ReadS String
230 lex0Digits s = return (span isDigit s)
232 nonnull :: (Char -> Bool) -> ReadS String
234 (cs@(_:_),t) <- return (span p s)
237 lexLitChar :: ReadS String
238 lexLitChar ('\\':s) = do
242 lexEsc (c:s) | c `elem` escChars = return ([c],s)
243 lexEsc s@(d:_) | isDigit d = checkSize 10 lexDecDigits s
244 lexEsc ('o':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
245 lexEsc ('O':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
246 lexEsc ('x':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
247 lexEsc ('X':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
248 lexEsc ('^':c:s) | c >= '@' && c <= '_' = [(['^',c],s)] -- cf. cntrl in 2.6 of H. report.
249 lexEsc s@(c:_) | isUpper c = fromAsciiLab s
252 escChars = "abfnrtv\\\"'"
254 fromAsciiLab (x:y:z:ls) | isUpper y && (isUpper z || isDigit z) &&
255 [x,y,z] `elem` asciiEscTab = return ([x,y,z], ls)
256 fromAsciiLab (x:y:ls) | isUpper y &&
257 [x,y] `elem` asciiEscTab = return ([x,y], ls)
258 fromAsciiLab _ = mzero
260 asciiEscTab = "DEL" : asciiTab
263 Check that the numerically escaped char literals are
264 within accepted boundaries.
266 Note: this allows char lits with leading zeros, i.e.,
267 \0000000000000000000000000000001.
269 checkSize base f str = do
271 -- Note: this is assumes that a Char is 8 bits long.
272 if (toAnInt base num) > 255 then
276 8 -> return ('o':num, res)
277 16 -> return ('x':num, res)
278 _ -> return (num, res)
280 toAnInt base xs = foldl (\ acc n -> acc*base + n) 0 (map digitToInt xs)
283 lexLitChar (c:s) = return ([c],s)
284 lexLitChar "" = mzero
286 digitToInt :: Char -> Int
288 | isDigit c = fromEnum c - fromEnum '0'
289 | c >= 'a' && c <= 'f' = fromEnum c - fromEnum 'a' + 10
290 | c >= 'A' && c <= 'F' = fromEnum c - fromEnum 'A' + 10
291 | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
294 %*********************************************************
296 \subsection{Instances of @Read@}
298 %*********************************************************
301 instance Read Char where
302 readsPrec _ = readParen False
305 (c,"\'") <- readLitChar s
308 readList = readParen False (\r -> do
312 where readl ('"':s) = return ("",s)
313 readl ('\\':'&':s) = readl s
315 (c,t) <- readLitChar s
319 instance Read Bool where
320 readsPrec _ = readParen False
323 (do { ("True", rest) <- return lr ; return (True, rest) }) ++
324 (do { ("False", rest) <- return lr ; return (False, rest) }))
327 instance Read Ordering where
328 readsPrec _ = readParen False
331 (do { ("LT", rest) <- return lr ; return (LT, rest) }) ++
332 (do { ("EQ", rest) <- return lr ; return (EQ, rest) }) ++
333 (do { ("GT", rest) <- return lr ; return (GT, rest) }))
335 instance Read a => Read (Maybe a) where
336 readsPrec _ = readParen False
339 (do { ("Nothing", rest) <- return lr ; return (Nothing, rest)}) ++
341 ("Just", rest1) <- return lr
342 (x, rest2) <- reads rest1
343 return (Just x, rest2)))
345 instance (Read a, Read b) => Read (Either a b) where
346 readsPrec _ = readParen False
350 ("Left", rest1) <- return lr
351 (x, rest2) <- reads rest1
352 return (Left x, rest2)) ++
354 ("Right", rest1) <- return lr
355 (x, rest2) <- reads rest1
356 return (Right x, rest2)))
358 instance Read Int where
359 readsPrec _ x = readSigned readDec x
361 instance Read Integer where
362 readsPrec _ x = readSigned readDec x
364 instance Read Float where
365 readsPrec _ x = readSigned readFloat x
367 instance Read Double where
368 readsPrec _ x = readSigned readFloat x
370 instance (Integral a, Read a) => Read (Ratio a) where
371 readsPrec p = readParen (p > ratio_prec)
378 instance (Read a) => Read [a] where
379 readsPrec _ = readList
381 instance Read () where
382 readsPrec _ = readParen False
388 instance (Read a, Read b) => Read (a,b) where
389 readsPrec _ = readParen False
392 (x,t) <- readsPrec 0 s
394 (y,v) <- readsPrec 0 u
398 instance (Read a, Read b, Read c) => Read (a, b, c) where
399 readsPrec _ = readParen False
402 (x,c) <- readsPrec 0 b
404 (y,e) <- readsPrec 0 d
406 (z,g) <- readsPrec 0 f
410 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
411 readsPrec _ = readParen False
414 (w,c) <- readsPrec 0 b
416 (x,e) <- readsPrec 0 d
418 (y,g) <- readsPrec 0 f
420 (z,h) <- readsPrec 0 h
422 return ((w,x,y,z), i))
424 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
425 readsPrec _ = readParen False
428 (v,c) <- readsPrec 0 b
430 (w,e) <- readsPrec 0 d
432 (x,g) <- readsPrec 0 f
434 (y,i) <- readsPrec 0 h
436 (z,k) <- readsPrec 0 j
438 return ((v,w,x,y,z), l))
442 %*********************************************************
444 \subsection{Reading characters}
446 %*********************************************************
449 readLitChar :: ReadS Char
451 readLitChar [] = mzero
452 readLitChar ('\\':s) = readEsc s
454 readEsc ('a':s) = return ('\a',s)
455 readEsc ('b':s) = return ('\b',s)
456 readEsc ('f':s) = return ('\f',s)
457 readEsc ('n':s) = return ('\n',s)
458 readEsc ('r':s) = return ('\r',s)
459 readEsc ('t':s) = return ('\t',s)
460 readEsc ('v':s) = return ('\v',s)
461 readEsc ('\\':s) = return ('\\',s)
462 readEsc ('"':s) = return ('"',s)
463 readEsc ('\'':s) = return ('\'',s)
464 readEsc ('^':c:s) | c >= '@' && c <= '_'
465 = return (chr (ord c - ord '@'), s)
466 readEsc s@(d:_) | isDigit d
477 readEsc s@(c:_) | isUpper c
478 = let table = ('\DEL', "DEL") : zip ['\NUL'..] asciiTab
479 in case [(c,s') | (c, mne) <- table,
480 ([],s') <- [match mne s]]
481 of (pr:_) -> return pr
485 readLitChar (c:s) = return (c,s)
487 match :: (Eq a) => [a] -> [a] -> ([a],[a])
488 match (x:xs) (y:ys) | x == y = match xs ys
489 match xs ys = (xs,ys)
494 %*********************************************************
496 \subsection{Reading numbers}
498 %*********************************************************
500 Note: reading numbers at bases different than 10, does not
501 include lexing common prefixes such as '0x' or '0o' etc.
504 {-# SPECIALISE readDec ::
507 readDec :: (Integral a) => ReadS a
508 readDec = readInt 10 isDigit (\d -> ord d - ord_0)
510 {-# SPECIALISE readOct ::
513 readOct :: (Integral a) => ReadS a
514 readOct = readInt 8 isOctDigit (\d -> ord d - ord_0)
516 {-# SPECIALISE readHex ::
519 readHex :: (Integral a) => ReadS a
520 readHex = readInt 16 isHexDigit hex
521 where hex d = ord d - (if isDigit d then ord_0
522 else ord (if isUpper d then 'A' else 'a') - 10)
524 readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
525 readInt radix isDig digToInt s = do
526 (ds,r) <- nonnull isDig s
527 return (foldl1 (\n d -> n * radix + d) (map (fromInt . digToInt) ds), r)
529 {-# SPECIALISE readSigned ::
530 ReadS Int -> ReadS Int,
531 ReadS Integer -> ReadS Integer,
532 ReadS Double -> ReadS Double #-}
533 readSigned :: (Real a) => ReadS a -> ReadS a
534 readSigned readPos = readParen False read'
535 where read' r = read'' r ++
542 (n,"") <- readPos str
546 The functions readFloat below uses rational arithmetic
547 to ensure correct conversion between the floating-point radix and
548 decimal. It is often possible to use a higher-precision floating-
549 point type to obtain the same results.
552 {-# SPECIALISE readFloat ::
555 readFloat :: (RealFloat a) => ReadS a
557 (x,t) <- readRational r
558 return (fromRational x,t)
560 readRational :: ReadS Rational -- NB: doesn't handle leading "-"
566 return ((n%1)*10^^(k-d), t )) ++
571 ("Infinity",t) <- lex r
575 (ds,s) <- lexDecDigits r
576 (ds',t) <- lexDotDigits s
577 return (read (ds++ds'), length ds', t)
579 readExp (e:s) | e `elem` "eE" = readExp' s
580 readExp s = return (0,s)
582 readExp' ('+':s) = readDec s
583 readExp' ('-':s) = do
586 readExp' s = readDec s
588 lexDotDigits ('.':s) = lex0Digits s
589 lexDotDigits s = return ("",s)
591 readRational__ :: String -> Rational -- we export this one (non-std)
592 -- NB: *does* handle a leading "-"
595 '-' : xs -> - (read_me xs)
599 = case (do { (x,t) <- readRational s ; ("","") <- lex t ; return x }) of
600 #ifndef NEW_READS_REP
602 [] -> error ("readRational__: no parse:" ++ top_s)
603 _ -> error ("readRational__: ambiguous parse:" ++ top_s)
606 Nothing -> error ("readRational__: no parse:" ++ top_s)
611 %*********************************************************
613 \subsection{Reading BufferMode}
615 %*********************************************************
617 This instance decl is here rather than somewhere more appropriate in
618 order that we can avoid both orphan-instance modules and recursive
622 instance Read BufferMode where
625 (\r -> let lr = lex r
627 [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++
628 [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++
629 [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
630 (mb, rest2) <- reads rest1])