2 % (c) The AQUA Project, Glasgow University, 1994-1998
5 \section[PrelRead]{Module @PrelRead@}
7 Instances of the Read class.
10 {-# OPTIONS -fcompiling-prelude -fno-implicit-prelude #-}
14 import PrelErr ( error )
15 import PrelEnum ( Enum(..) )
22 import PrelShow -- isAlpha etc
25 -- needed for readIO and instance Read Buffermode
26 import PrelIOBase ( IO, userError, BufferMode(..) )
27 import PrelException ( ioError )
30 %*********************************************************
32 \subsection{The @Read@ class}
34 %*********************************************************
36 Note: if you compile this with -DNEW_READS_REP, you'll get
37 a (simpler) ReadS representation that only allow one valid
38 parse of a string of characters, instead of a list of
41 [changing the ReadS rep has implications for the deriving
42 machinery for Read, a change that hasn't been made, so you
43 probably won't want to compile in this new rep. except
44 when in an experimental mood.]
49 type ReadS a = String -> [(a,String)]
51 type ReadS a = String -> Maybe (a,String)
55 readsPrec :: Int -> ReadS a
58 readList = readList__ reads
61 In this module we treat [(a,String)] as a monad in MonadPlus
62 But MonadPlus isn't defined yet, so we simply give local
63 declarations for mzero and guard suitable for this particular
64 type. It would also be reasonably to move MonadPlus to PrelBase
65 along with Monad and Functor, but that seems overkill for one
77 %*********************************************************
79 \subsection{Utility functions}
81 %*********************************************************
84 reads :: (Read a) => ReadS a
87 read :: (Read a) => String -> a
92 [] -> error "Prelude.read: no parse"
93 _ -> error "Prelude.read: ambiguous parse"
96 Nothing -> error "Prelude.read: no parse"
100 (x,str1) <- reads str
104 -- raises an exception instead of an error
105 readIO :: Read a => String -> IO a
106 readIO s = case (do { (x,t) <- reads s ; ("","") <- lex t ; return x }) of
107 #ifndef NEW_READS_REP
109 [] -> ioError (userError "Prelude.readIO: no parse")
110 _ -> ioError (userError "Prelude.readIO: ambiguous parse")
113 Nothing -> ioError (userError "Prelude.readIO: no parse")
119 readParen :: Bool -> ReadS a -> ReadS a
120 readParen b g = if b then mandatory else optional
121 where optional r = g r ++ mandatory r
129 readList__ :: ReadS a -> ReadS [a]
132 = readParen False (\r -> do
136 (do { ("]",t) <- lex s ; return ([],t) }) ++
137 (do { (x,t) <- readx s ; (xs,u) <- readl2 t ; return (x:xs,u) })
140 (do { ("]",t) <- lex s ; return ([],t) }) ++
141 (do { (",",t) <- lex s ; (x,u) <- readx t ; (xs,v) <- readl2 u ; return (x:xs,v) })
146 %*********************************************************
148 \subsection{Lexical analysis}
150 %*********************************************************
152 This lexer is not completely faithful to the Haskell lexical syntax.
154 Qualified names are not handled properly
155 A `--' does not terminate a symbol
156 Octal and hexidecimal numerics are not recognized as a single token
161 lex "" = return ("","")
162 lex (c:s) | isSpace c = lex (dropWhile isSpace s)
164 (ch, '\'':t) <- lexLitChar s
166 return ('\'':ch++"'", t)
168 (str,t) <- lexString s
172 lexString ('"':s) = return ("\"",s)
174 (ch,t) <- lexStrItem s
175 (str,u) <- lexString t
179 lexStrItem ('\\':'&':s) = return ("\\&",s)
180 lexStrItem ('\\':c:s) | isSpace c = do
181 ('\\':t) <- return (dropWhile isSpace s)
183 lexStrItem s = lexLitChar s
185 lex (c:s) | isSingle c = return ([c],s)
187 (sym,t) <- return (span isSym s)
190 (nam,t) <- return (span isIdChar s)
193 {- Removed, 13/03/2000 by SDM.
194 Doesn't work, and not required by Haskell report.
198 ('o':rs) -> (isOctDigit, rs, False)
199 ('O':rs) -> (isOctDigit, rs, False)
200 ('x':rs) -> (isHexDigit, rs, False)
201 ('X':rs) -> (isHexDigit, rs, False)
202 _ -> (isDigit, s, True)
204 (ds,s) <- return (span isDigit s)
205 (fe,t) <- lexFracExp s
207 | otherwise = mzero -- bad character
209 isSingle c = c `elem` ",;()[]{}_`"
210 isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
211 isIdChar c = isAlphaNum c || c `elem` "_'"
213 lexFracExp ('.':c:cs) | isDigit c = do
214 (ds,t) <- lex0Digits cs
216 return ('.':c:ds++e,u)
217 lexFracExp s = return ("",s)
219 lexExp (e:s) | e `elem` "eE" =
222 guard (c `elem` "+-")
223 (ds,u) <- lexDecDigits t
224 return (e:c:ds,u)) ++
226 (ds,t) <- lexDecDigits s
229 lexExp s = return ("",s)
231 lexDigits :: ReadS String
232 lexDigits = lexDecDigits
234 lexDecDigits :: ReadS String
235 lexDecDigits = nonnull isDigit
237 lexOctDigits :: ReadS String
238 lexOctDigits = nonnull isOctDigit
240 lexHexDigits :: ReadS String
241 lexHexDigits = nonnull isHexDigit
244 lex0Digits :: ReadS String
245 lex0Digits s = return (span isDigit s)
247 nonnull :: (Char -> Bool) -> ReadS String
249 (cs@(_:_),t) <- return (span p s)
252 lexLitChar :: ReadS String
253 lexLitChar ('\\':s) = do
257 lexEsc (c:s) | c `elem` escChars = return ([c],s)
258 lexEsc s@(d:_) | isDigit d = checkSize 10 lexDecDigits s
259 lexEsc ('o':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
260 lexEsc ('O':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
261 lexEsc ('x':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
262 lexEsc ('X':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
263 lexEsc ('^':c:s) | c >= '@' && c <= '_' = [(['^',c],s)] -- cf. cntrl in 2.6 of H. report.
264 lexEsc s@(c:_) | isUpper c = fromAsciiLab s
267 escChars = "abfnrtv\\\"'"
269 fromAsciiLab (x:y:z:ls) | isUpper y && (isUpper z || isDigit z) &&
270 [x,y,z] `elem` asciiEscTab = return ([x,y,z], ls)
271 fromAsciiLab (x:y:ls) | isUpper y &&
272 [x,y] `elem` asciiEscTab = return ([x,y], ls)
273 fromAsciiLab _ = mzero
275 asciiEscTab = "DEL" : asciiTab
278 Check that the numerically escaped char literals are
279 within accepted boundaries.
281 Note: this allows char lits with leading zeros, i.e.,
282 \0000000000000000000000000000001.
284 checkSize base f str = do
286 -- Note: this is assumes that a Char is 8 bits long.
287 if (toAnInt base num) > 255 then
291 8 -> return ('o':num, res)
292 16 -> return ('x':num, res)
293 _ -> return (num, res)
295 toAnInt base xs = foldl (\ acc n -> acc*base + n) 0 (map digitToInt xs)
298 lexLitChar (c:s) = return ([c],s)
299 lexLitChar "" = mzero
301 digitToInt :: Char -> Int
303 | isDigit c = fromEnum c - fromEnum '0'
304 | c >= 'a' && c <= 'f' = fromEnum c - fromEnum 'a' + 10
305 | c >= 'A' && c <= 'F' = fromEnum c - fromEnum 'A' + 10
306 | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
309 %*********************************************************
311 \subsection{Instances of @Read@}
313 %*********************************************************
316 instance Read Char where
317 readsPrec _ = readParen False
320 (c,"\'") <- readLitChar s
323 readList = readParen False (\r -> do
327 where readl ('"':s) = return ("",s)
328 readl ('\\':'&':s) = readl s
330 (c,t) <- readLitChar s
334 instance Read Bool where
335 readsPrec _ = readParen False
338 (do { ("True", rest) <- return lr ; return (True, rest) }) ++
339 (do { ("False", rest) <- return lr ; return (False, rest) }))
342 instance Read Ordering where
343 readsPrec _ = readParen False
346 (do { ("LT", rest) <- return lr ; return (LT, rest) }) ++
347 (do { ("EQ", rest) <- return lr ; return (EQ, rest) }) ++
348 (do { ("GT", rest) <- return lr ; return (GT, rest) }))
350 instance Read a => Read (Maybe a) where
351 readsPrec _ = readParen False
354 (do { ("Nothing", rest) <- return lr ; return (Nothing, rest)}) ++
356 ("Just", rest1) <- return lr
357 (x, rest2) <- reads rest1
358 return (Just x, rest2)))
360 instance (Read a, Read b) => Read (Either a b) where
361 readsPrec _ = readParen False
365 ("Left", rest1) <- return lr
366 (x, rest2) <- reads rest1
367 return (Left x, rest2)) ++
369 ("Right", rest1) <- return lr
370 (x, rest2) <- reads rest1
371 return (Right x, rest2)))
373 instance Read Int where
374 readsPrec _ x = readSigned readDec x
376 instance Read Integer where
377 readsPrec _ x = readSigned readDec x
379 instance Read Float where
380 readsPrec _ x = readSigned readFloat x
382 instance Read Double where
383 readsPrec _ x = readSigned readFloat x
385 instance (Integral a, Read a) => Read (Ratio a) where
386 readsPrec p = readParen (p > ratio_prec)
393 instance (Read a) => Read [a] where
394 readsPrec _ = readList
396 instance Read () where
397 readsPrec _ = readParen False
403 instance (Read a, Read b) => Read (a,b) where
404 readsPrec _ = readParen False
407 (x,t) <- readsPrec 0 s
409 (y,v) <- readsPrec 0 u
413 instance (Read a, Read b, Read c) => Read (a, b, c) where
414 readsPrec _ = readParen False
417 (x,c) <- readsPrec 0 b
419 (y,e) <- readsPrec 0 d
421 (z,g) <- readsPrec 0 f
425 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
426 readsPrec _ = readParen False
429 (w,c) <- readsPrec 0 b
431 (x,e) <- readsPrec 0 d
433 (y,g) <- readsPrec 0 f
435 (z,h) <- readsPrec 0 h
437 return ((w,x,y,z), i))
439 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
440 readsPrec _ = readParen False
443 (v,c) <- readsPrec 0 b
445 (w,e) <- readsPrec 0 d
447 (x,g) <- readsPrec 0 f
449 (y,i) <- readsPrec 0 h
451 (z,k) <- readsPrec 0 j
453 return ((v,w,x,y,z), l))
457 %*********************************************************
459 \subsection{Reading characters}
461 %*********************************************************
464 readLitChar :: ReadS Char
466 readLitChar [] = mzero
467 readLitChar ('\\':s) = readEsc s
469 readEsc ('a':s) = return ('\a',s)
470 readEsc ('b':s) = return ('\b',s)
471 readEsc ('f':s) = return ('\f',s)
472 readEsc ('n':s) = return ('\n',s)
473 readEsc ('r':s) = return ('\r',s)
474 readEsc ('t':s) = return ('\t',s)
475 readEsc ('v':s) = return ('\v',s)
476 readEsc ('\\':s) = return ('\\',s)
477 readEsc ('"':s) = return ('"',s)
478 readEsc ('\'':s) = return ('\'',s)
479 readEsc ('^':c:s) | c >= '@' && c <= '_'
480 = return (chr (ord c - ord '@'), s)
481 readEsc s@(d:_) | isDigit d
492 readEsc s@(c:_) | isUpper c
493 = let table = ('\DEL', "DEL") : zip ['\NUL'..] asciiTab
494 in case [(c,s') | (c, mne) <- table,
495 ([],s') <- [match mne s]]
496 of (pr:_) -> return pr
500 readLitChar (c:s) = return (c,s)
502 match :: (Eq a) => [a] -> [a] -> ([a],[a])
503 match (x:xs) (y:ys) | x == y = match xs ys
504 match xs ys = (xs,ys)
509 %*********************************************************
511 \subsection{Reading numbers}
513 %*********************************************************
515 Note: reading numbers at bases different than 10, does not
516 include lexing common prefixes such as '0x' or '0o' etc.
519 {-# SPECIALISE readDec ::
522 readDec :: (Integral a) => ReadS a
523 readDec = readInt 10 isDigit (\d -> ord d - ord_0)
525 {-# SPECIALISE readOct ::
528 readOct :: (Integral a) => ReadS a
529 readOct = readInt 8 isOctDigit (\d -> ord d - ord_0)
531 {-# SPECIALISE readHex ::
534 readHex :: (Integral a) => ReadS a
535 readHex = readInt 16 isHexDigit hex
536 where hex d = ord d - (if isDigit d then ord_0
537 else ord (if isUpper d then 'A' else 'a') - 10)
539 readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
540 readInt radix isDig digToInt s = do
541 (ds,r) <- nonnull isDig s
542 return (foldl1 (\n d -> n * radix + d) (map (fromInt . digToInt) ds), r)
544 {-# SPECIALISE readSigned ::
545 ReadS Int -> ReadS Int,
546 ReadS Integer -> ReadS Integer,
547 ReadS Double -> ReadS Double #-}
548 readSigned :: (Real a) => ReadS a -> ReadS a
549 readSigned readPos = readParen False read'
550 where read' r = read'' r ++
557 (n,"") <- readPos str
561 The functions readFloat below uses rational arithmetic
562 to ensure correct conversion between the floating-point radix and
563 decimal. It is often possible to use a higher-precision floating-
564 point type to obtain the same results.
567 {-# SPECIALISE readFloat ::
570 readFloat :: (RealFloat a) => ReadS a
572 (x,t) <- readRational r
573 return (fromRational x,t)
575 readRational :: ReadS Rational -- NB: doesn't handle leading "-"
581 return ((n%1)*10^^(k-d), t )) ++
586 ("Infinity",t) <- lex r
590 (ds,s) <- lexDecDigits r
591 (ds',t) <- lexDotDigits s
592 return (read (ds++ds'), length ds', t)
594 readExp (e:s) | e `elem` "eE" = readExp' s
595 readExp s = return (0,s)
597 readExp' ('+':s) = readDec s
598 readExp' ('-':s) = do
601 readExp' s = readDec s
603 lexDotDigits ('.':s) = lex0Digits s
604 lexDotDigits s = return ("",s)
606 readRational__ :: String -> Rational -- we export this one (non-std)
607 -- NB: *does* handle a leading "-"
610 '-' : xs -> - (read_me xs)
614 = case (do { (x,t) <- readRational s ; ("","") <- lex t ; return x }) of
615 #ifndef NEW_READS_REP
617 [] -> error ("readRational__: no parse:" ++ top_s)
618 _ -> error ("readRational__: ambiguous parse:" ++ top_s)
621 Nothing -> error ("readRational__: no parse:" ++ top_s)
626 %*********************************************************
628 \subsection{Reading BufferMode}
630 %*********************************************************
632 This instance decl is here rather than somewhere more appropriate in
633 order that we can avoid both orphan-instance modules and recursive
637 instance Read BufferMode where
640 (\r -> let lr = lex r
642 [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++
643 [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++
644 [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
645 (mb, rest2) <- reads rest1])