1 % ------------------------------------------------------------------------------
2 % $Id: PrelRead.lhs,v 1.22 2001/11/23 16:20:08 simonpj Exp $
4 % (c) The University of Glasgow, 1994-2000
7 \section[PrelRead]{Module @PrelRead@}
9 Instances of the Read class.
12 {-# OPTIONS -fno-implicit-prelude #-}
16 import {-# SOURCE #-} PrelErr ( error )
17 import PrelEnum ( Enum(..), maxBound )
23 import PrelShow -- isAlpha etc
27 %*********************************************************
29 \subsection{The @Read@ class}
31 %*********************************************************
33 Note: if you compile this with -DNEW_READS_REP, you'll get
34 a (simpler) ReadS representation that only allow one valid
35 parse of a string of characters, instead of a list of
38 [changing the ReadS rep has implications for the deriving
39 machinery for Read, a change that hasn't been made, so you
40 probably won't want to compile in this new rep. except
41 when in an experimental mood.]
46 type ReadS a = String -> [(a,String)]
48 type ReadS a = String -> Maybe (a,String)
52 readsPrec :: Int -> ReadS a
55 readList = readList__ reads
58 In this module we treat [(a,String)] as a monad in MonadPlus
59 But MonadPlus isn't defined yet, so we simply give local
60 declarations for mzero and guard suitable for this particular
61 type. It would also be reasonably to move MonadPlus to PrelBase
62 along with Monad and Functor, but that seems overkill for one
74 %*********************************************************
76 \subsection{Utility functions}
78 %*********************************************************
81 reads :: (Read a) => ReadS a
84 read :: (Read a) => String -> a
89 [] -> error "Prelude.read: no parse"
90 _ -> error "Prelude.read: ambiguous parse"
93 Nothing -> error "Prelude.read: no parse"
103 readParen :: Bool -> ReadS a -> ReadS a
104 readParen b g = if b then mandatory else optional
105 where optional r = g r ++ mandatory r
113 readList__ :: ReadS a -> ReadS [a]
116 = readParen False (\r -> do
120 (do { ("]",t) <- lex s ; return ([],t) }) ++
121 (do { (x,t) <- readx s ; (xs,u) <- readl2 t ; return (x:xs,u) })
124 (do { ("]",t) <- lex s ; return ([],t) }) ++
125 (do { (",",t) <- lex s ; (x,u) <- readx t ; (xs,v) <- readl2 u ; return (x:xs,v) })
130 %*********************************************************
132 \subsection{Lexical analysis}
134 %*********************************************************
136 This lexer is not completely faithful to the Haskell lexical syntax.
138 Qualified names are not handled properly
139 A `--' does not terminate a symbol
140 Octal and hexidecimal numerics are not recognized as a single token
145 lex "" = return ("","")
146 lex (c:s) | isSpace c = lex (dropWhile isSpace s)
148 (ch, '\'':t) <- lexLitChar s
150 return ('\'':ch++"'", t)
152 (str,t) <- lexString s
156 lexString ('"':s) = return ("\"",s)
158 (ch,t) <- lexStrItem s
159 (str,u) <- lexString t
163 lexStrItem ('\\':'&':s) = return ("\\&",s)
164 lexStrItem ('\\':c:s) | isSpace c = do
165 ('\\':t) <- return (dropWhile isSpace s)
167 lexStrItem s = lexLitChar s
169 lex (c:s) | isSingle c = return ([c],s)
171 (sym,t) <- return (span isSym s)
174 (nam,t) <- return (span isIdChar s)
177 {- Removed, 13/03/2000 by SDM.
178 Doesn't work, and not required by Haskell report.
182 ('o':rs) -> (isOctDigit, rs, False)
183 ('O':rs) -> (isOctDigit, rs, False)
184 ('x':rs) -> (isHexDigit, rs, False)
185 ('X':rs) -> (isHexDigit, rs, False)
186 _ -> (isDigit, s, True)
188 (ds,s) <- return (span isDigit s)
189 (fe,t) <- lexFracExp s
191 | otherwise = mzero -- bad character
193 isSingle c = c `elem` ",;()[]{}_`"
194 isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
195 isIdChar c = isAlphaNum c || c `elem` "_'"
197 lexFracExp ('.':c:cs) | isDigit c = do
198 (ds,t) <- lex0Digits cs
200 return ('.':c:ds++e,u)
201 lexFracExp s = return ("",s)
203 lexExp (e:s) | e `elem` "eE" =
206 guard (c `elem` "+-")
207 (ds,u) <- lexDecDigits t
208 return (e:c:ds,u)) ++
210 (ds,t) <- lexDecDigits s
213 lexExp s = return ("",s)
215 lexDigits :: ReadS String
216 lexDigits = lexDecDigits
218 lexDecDigits :: ReadS String
219 lexDecDigits = nonnull isDigit
221 lexOctDigits :: ReadS String
222 lexOctDigits = nonnull isOctDigit
224 lexHexDigits :: ReadS String
225 lexHexDigits = nonnull isHexDigit
228 lex0Digits :: ReadS String
229 lex0Digits s = return (span isDigit s)
231 nonnull :: (Char -> Bool) -> ReadS String
233 (cs@(_:_),t) <- return (span p s)
236 lexLitChar :: ReadS String
237 lexLitChar ('\\':s) = do
241 lexEsc (c:s) | c `elem` escChars = return ([c],s)
242 lexEsc s@(d:_) | isDigit d = checkSize 10 lexDecDigits s
243 lexEsc ('o':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
244 lexEsc ('O':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
245 lexEsc ('x':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
246 lexEsc ('X':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
247 lexEsc ('^':c:s) | c >= '@' && c <= '_' = [(['^',c],s)] -- cf. cntrl in 2.6 of H. report.
248 lexEsc s@(c:_) | isUpper c = fromAsciiLab s
251 escChars = "abfnrtv\\\"'"
253 fromAsciiLab (x:y:z:ls) | isUpper y && (isUpper z || isDigit z) &&
254 [x,y,z] `elem` asciiEscTab = return ([x,y,z], ls)
255 fromAsciiLab (x:y:ls) | isUpper y &&
256 [x,y] `elem` asciiEscTab = return ([x,y], ls)
257 fromAsciiLab _ = mzero
259 asciiEscTab = "DEL" : asciiTab
262 Check that the numerically escaped char literals are
263 within accepted boundaries.
265 Note: this allows char lits with leading zeros, i.e.,
266 \0000000000000000000000000000001.
268 checkSize base f str = do
270 if toAnInteger base num > toInteger (ord maxBound) then
274 8 -> return ('o':num, res)
275 16 -> return ('x':num, res)
276 _ -> return (num, res)
278 toAnInteger base = foldl (\ acc n -> acc*base + toInteger (digitToInt n)) 0
281 lexLitChar (c:s) = return ([c],s)
282 lexLitChar "" = mzero
284 digitToInt :: Char -> Int
286 | isDigit c = fromEnum c - fromEnum '0'
287 | c >= 'a' && c <= 'f' = fromEnum c - fromEnum 'a' + 10
288 | c >= 'A' && c <= 'F' = fromEnum c - fromEnum 'A' + 10
289 | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
292 %*********************************************************
294 \subsection{Instances of @Read@}
296 %*********************************************************
299 instance Read Char where
300 readsPrec _ = readParen False
303 (c,"\'") <- readLitChar s
306 readList = readParen False (\r -> do
310 where readl ('"':s) = return ("",s)
311 readl ('\\':'&':s) = readl s
313 (c,t) <- readLitChar s
317 instance Read Bool where
318 readsPrec _ = readParen False
321 (do { ("True", rest) <- return lr ; return (True, rest) }) ++
322 (do { ("False", rest) <- return lr ; return (False, rest) }))
325 instance Read Ordering where
326 readsPrec _ = readParen False
329 (do { ("LT", rest) <- return lr ; return (LT, rest) }) ++
330 (do { ("EQ", rest) <- return lr ; return (EQ, rest) }) ++
331 (do { ("GT", rest) <- return lr ; return (GT, rest) }))
333 instance Read a => Read (Maybe a) where
334 readsPrec _ = readParen False
337 (do { ("Nothing", rest) <- return lr ; return (Nothing, rest)}) ++
339 ("Just", rest1) <- return lr
340 (x, rest2) <- reads rest1
341 return (Just x, rest2)))
343 instance (Read a, Read b) => Read (Either a b) where
344 readsPrec _ = readParen False
348 ("Left", rest1) <- return lr
349 (x, rest2) <- reads rest1
350 return (Left x, rest2)) ++
352 ("Right", rest1) <- return lr
353 (x, rest2) <- reads rest1
354 return (Right x, rest2)))
356 instance Read Int where
357 readsPrec _ x = readSigned readDec x
359 instance Read Integer where
360 readsPrec _ x = readSigned readDec x
362 instance Read Float where
363 readsPrec _ x = readSigned readFloat x
365 instance Read Double where
366 readsPrec _ x = readSigned readFloat x
368 instance (Integral a, Read a) => Read (Ratio a) where
369 readsPrec p = readParen (p > ratio_prec)
376 instance (Read a) => Read [a] where
377 readsPrec _ = readList
379 instance Read () where
380 readsPrec _ = readParen False
386 instance (Read a, Read b) => Read (a,b) where
387 readsPrec _ = readParen False
390 (x,t) <- readsPrec 0 s
392 (y,v) <- readsPrec 0 u
396 instance (Read a, Read b, Read c) => Read (a, b, c) where
397 readsPrec _ = readParen False
400 (x,c) <- readsPrec 0 b
402 (y,e) <- readsPrec 0 d
404 (z,g) <- readsPrec 0 f
408 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
409 readsPrec _ = readParen False
412 (w,c) <- readsPrec 0 b
414 (x,e) <- readsPrec 0 d
416 (y,g) <- readsPrec 0 f
418 (z,h) <- readsPrec 0 h
420 return ((w,x,y,z), i))
422 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
423 readsPrec _ = readParen False
426 (v,c) <- readsPrec 0 b
428 (w,e) <- readsPrec 0 d
430 (x,g) <- readsPrec 0 f
432 (y,i) <- readsPrec 0 h
434 (z,k) <- readsPrec 0 j
436 return ((v,w,x,y,z), l))
440 %*********************************************************
442 \subsection{Reading characters}
444 %*********************************************************
447 readLitChar :: ReadS Char
449 readLitChar [] = mzero
450 readLitChar ('\\':s) = readEsc s
452 readEsc ('a':s) = return ('\a',s)
453 readEsc ('b':s) = return ('\b',s)
454 readEsc ('f':s) = return ('\f',s)
455 readEsc ('n':s) = return ('\n',s)
456 readEsc ('r':s) = return ('\r',s)
457 readEsc ('t':s) = return ('\t',s)
458 readEsc ('v':s) = return ('\v',s)
459 readEsc ('\\':s) = return ('\\',s)
460 readEsc ('"':s) = return ('"',s)
461 readEsc ('\'':s) = return ('\'',s)
462 readEsc ('^':c:s) | c >= '@' && c <= '_'
463 = return (chr (ord c - ord '@'), s)
464 readEsc s@(d:_) | isDigit d
475 readEsc s@(c:_) | isUpper c
476 = let table = ('\DEL', "DEL") : zip ['\NUL'..] asciiTab
477 in case [(c,s') | (c, mne) <- table,
478 ([],s') <- [match mne s]]
479 of (pr:_) -> return pr
483 readLitChar (c:s) = return (c,s)
485 match :: (Eq a) => [a] -> [a] -> ([a],[a])
486 match (x:xs) (y:ys) | x == y = match xs ys
487 match xs ys = (xs,ys)
492 %*********************************************************
494 \subsection{Reading numbers}
496 %*********************************************************
498 Note: reading numbers at bases different than 10, does not
499 include lexing common prefixes such as '0x' or '0o' etc.
502 {-# SPECIALISE readDec ::
505 readDec :: (Integral a) => ReadS a
506 readDec = readInt 10 isDigit (\d -> ord d - ord '0')
508 {-# SPECIALISE readOct ::
511 readOct :: (Integral a) => ReadS a
512 readOct = readInt 8 isOctDigit (\d -> ord d - ord '0')
514 {-# SPECIALISE readHex ::
517 readHex :: (Integral a) => ReadS a
518 readHex = readInt 16 isHexDigit hex
519 where hex d = ord d - (if isDigit d then ord '0'
520 else ord (if isUpper d then 'A' else 'a') - 10)
522 readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
523 readInt radix isDig digToInt s = do
524 (ds,r) <- nonnull isDig s
525 return (foldl1 (\n d -> n * radix + d)
526 (map (fromInteger . toInteger . digToInt) ds), r)
528 {-# SPECIALISE readSigned ::
529 ReadS Int -> ReadS Int,
530 ReadS Integer -> ReadS Integer,
531 ReadS Double -> ReadS Double #-}
532 readSigned :: (Real a) => ReadS a -> ReadS a
533 readSigned readPos = readParen False read'
534 where read' r = read'' r ++
541 (n,"") <- readPos str
545 The functions readFloat below uses rational arithmetic
546 to ensure correct conversion between the floating-point radix and
547 decimal. It is often possible to use a higher-precision floating-
548 point type to obtain the same results.
551 {-# SPECIALISE readFloat ::
554 readFloat :: (RealFloat a) => ReadS a
557 (x,t) <- readRational r
558 return (fromRational x,t) ) ++
563 ("Infinity",t) <- lex r
566 readRational :: ReadS Rational -- NB: doesn't handle leading "-"
570 return ((n%1)*10^^(k-d), t)
573 (ds,s) <- lexDecDigits r
574 (ds',t) <- lexDotDigits s
575 return (read (ds++ds'), length ds', t)
577 readExp (e:s) | e `elem` "eE" = readExp' s
578 readExp s = return (0,s)
580 readExp' ('+':s) = readDec s
581 readExp' ('-':s) = do
584 readExp' s = readDec s
586 lexDotDigits ('.':s) = lex0Digits s
587 lexDotDigits s = return ("",s)
589 readRational__ :: String -> Rational -- we export this one (non-std)
590 -- NB: *does* handle a leading "-"
593 '-' : xs -> - (read_me xs)
597 = case (do { (x,t) <- readRational s ; ("","") <- lex t ; return x }) of
598 #ifndef NEW_READS_REP
600 [] -> error ("readRational__: no parse:" ++ top_s)
601 _ -> error ("readRational__: ambiguous parse:" ++ top_s)
604 Nothing -> error ("readRational__: no parse:" ++ top_s)