1 % ------------------------------------------------------------------------------
2 % $Id: PrelRead.lhs,v 1.15 2000/06/30 13:39:36 simonmar 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 PrelErr ( error )
17 import PrelEnum ( Enum(..) )
23 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 In this module we treat [(a,String)] as a monad in MonadPlus
63 But MonadPlus isn't defined yet, so we simply give local
64 declarations for mzero and guard suitable for this particular
65 type. It would also be reasonably to move MonadPlus to PrelBase
66 along with Monad and Functor, but that seems overkill for one
78 %*********************************************************
80 \subsection{Utility functions}
82 %*********************************************************
85 reads :: (Read a) => ReadS a
88 read :: (Read a) => String -> a
93 [] -> error "Prelude.read: no parse"
94 _ -> error "Prelude.read: ambiguous parse"
97 Nothing -> error "Prelude.read: no parse"
101 (x,str1) <- reads str
105 -- raises an exception instead of an error
106 readIO :: Read a => String -> IO a
107 readIO s = case (do { (x,t) <- reads s ; ("","") <- lex t ; return x }) of
108 #ifndef NEW_READS_REP
110 [] -> ioError (userError "Prelude.readIO: no parse")
111 _ -> ioError (userError "Prelude.readIO: ambiguous parse")
114 Nothing -> ioError (userError "Prelude.readIO: no parse")
120 readParen :: Bool -> ReadS a -> ReadS a
121 readParen b g = if b then mandatory else optional
122 where optional r = g r ++ mandatory r
130 readList__ :: ReadS a -> ReadS [a]
133 = readParen False (\r -> do
137 (do { ("]",t) <- lex s ; return ([],t) }) ++
138 (do { (x,t) <- readx s ; (xs,u) <- readl2 t ; return (x:xs,u) })
141 (do { ("]",t) <- lex s ; return ([],t) }) ++
142 (do { (",",t) <- lex s ; (x,u) <- readx t ; (xs,v) <- readl2 u ; return (x:xs,v) })
147 %*********************************************************
149 \subsection{Lexical analysis}
151 %*********************************************************
153 This lexer is not completely faithful to the Haskell lexical syntax.
155 Qualified names are not handled properly
156 A `--' does not terminate a symbol
157 Octal and hexidecimal numerics are not recognized as a single token
162 lex "" = return ("","")
163 lex (c:s) | isSpace c = lex (dropWhile isSpace s)
165 (ch, '\'':t) <- lexLitChar s
167 return ('\'':ch++"'", t)
169 (str,t) <- lexString s
173 lexString ('"':s) = return ("\"",s)
175 (ch,t) <- lexStrItem s
176 (str,u) <- lexString t
180 lexStrItem ('\\':'&':s) = return ("\\&",s)
181 lexStrItem ('\\':c:s) | isSpace c = do
182 ('\\':t) <- return (dropWhile isSpace s)
184 lexStrItem s = lexLitChar s
186 lex (c:s) | isSingle c = return ([c],s)
188 (sym,t) <- return (span isSym s)
191 (nam,t) <- return (span isIdChar s)
194 {- Removed, 13/03/2000 by SDM.
195 Doesn't work, and not required by Haskell report.
199 ('o':rs) -> (isOctDigit, rs, False)
200 ('O':rs) -> (isOctDigit, rs, False)
201 ('x':rs) -> (isHexDigit, rs, False)
202 ('X':rs) -> (isHexDigit, rs, False)
203 _ -> (isDigit, s, True)
205 (ds,s) <- return (span isDigit s)
206 (fe,t) <- lexFracExp s
208 | otherwise = mzero -- bad character
210 isSingle c = c `elem` ",;()[]{}_`"
211 isSym c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
212 isIdChar c = isAlphaNum c || c `elem` "_'"
214 lexFracExp ('.':c:cs) | isDigit c = do
215 (ds,t) <- lex0Digits cs
217 return ('.':c:ds++e,u)
218 lexFracExp s = return ("",s)
220 lexExp (e:s) | e `elem` "eE" =
223 guard (c `elem` "+-")
224 (ds,u) <- lexDecDigits t
225 return (e:c:ds,u)) ++
227 (ds,t) <- lexDecDigits s
230 lexExp s = return ("",s)
232 lexDigits :: ReadS String
233 lexDigits = lexDecDigits
235 lexDecDigits :: ReadS String
236 lexDecDigits = nonnull isDigit
238 lexOctDigits :: ReadS String
239 lexOctDigits = nonnull isOctDigit
241 lexHexDigits :: ReadS String
242 lexHexDigits = nonnull isHexDigit
245 lex0Digits :: ReadS String
246 lex0Digits s = return (span isDigit s)
248 nonnull :: (Char -> Bool) -> ReadS String
250 (cs@(_:_),t) <- return (span p s)
253 lexLitChar :: ReadS String
254 lexLitChar ('\\':s) = do
258 lexEsc (c:s) | c `elem` escChars = return ([c],s)
259 lexEsc s@(d:_) | isDigit d = checkSize 10 lexDecDigits s
260 lexEsc ('o':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
261 lexEsc ('O':d:s) | isOctDigit d = checkSize 8 lexOctDigits (d:s)
262 lexEsc ('x':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
263 lexEsc ('X':d:s) | isHexDigit d = checkSize 16 lexHexDigits (d:s)
264 lexEsc ('^':c:s) | c >= '@' && c <= '_' = [(['^',c],s)] -- cf. cntrl in 2.6 of H. report.
265 lexEsc s@(c:_) | isUpper c = fromAsciiLab s
268 escChars = "abfnrtv\\\"'"
270 fromAsciiLab (x:y:z:ls) | isUpper y && (isUpper z || isDigit z) &&
271 [x,y,z] `elem` asciiEscTab = return ([x,y,z], ls)
272 fromAsciiLab (x:y:ls) | isUpper y &&
273 [x,y] `elem` asciiEscTab = return ([x,y], ls)
274 fromAsciiLab _ = mzero
276 asciiEscTab = "DEL" : asciiTab
279 Check that the numerically escaped char literals are
280 within accepted boundaries.
282 Note: this allows char lits with leading zeros, i.e.,
283 \0000000000000000000000000000001.
285 checkSize base f str = do
287 -- Note: this is assumes that a Char is 8 bits long.
288 if (toAnInt base num) > 255 then
292 8 -> return ('o':num, res)
293 16 -> return ('x':num, res)
294 _ -> return (num, res)
296 toAnInt base xs = foldl (\ acc n -> acc*base + n) 0 (map digitToInt xs)
299 lexLitChar (c:s) = return ([c],s)
300 lexLitChar "" = mzero
302 digitToInt :: Char -> Int
304 | isDigit c = fromEnum c - fromEnum '0'
305 | c >= 'a' && c <= 'f' = fromEnum c - fromEnum 'a' + 10
306 | c >= 'A' && c <= 'F' = fromEnum c - fromEnum 'A' + 10
307 | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
310 %*********************************************************
312 \subsection{Instances of @Read@}
314 %*********************************************************
317 instance Read Char where
318 readsPrec _ = readParen False
321 (c,"\'") <- readLitChar s
324 readList = readParen False (\r -> do
328 where readl ('"':s) = return ("",s)
329 readl ('\\':'&':s) = readl s
331 (c,t) <- readLitChar s
335 instance Read Bool where
336 readsPrec _ = readParen False
339 (do { ("True", rest) <- return lr ; return (True, rest) }) ++
340 (do { ("False", rest) <- return lr ; return (False, rest) }))
343 instance Read Ordering where
344 readsPrec _ = readParen False
347 (do { ("LT", rest) <- return lr ; return (LT, rest) }) ++
348 (do { ("EQ", rest) <- return lr ; return (EQ, rest) }) ++
349 (do { ("GT", rest) <- return lr ; return (GT, rest) }))
351 instance Read a => Read (Maybe a) where
352 readsPrec _ = readParen False
355 (do { ("Nothing", rest) <- return lr ; return (Nothing, rest)}) ++
357 ("Just", rest1) <- return lr
358 (x, rest2) <- reads rest1
359 return (Just x, rest2)))
361 instance (Read a, Read b) => Read (Either a b) where
362 readsPrec _ = readParen False
366 ("Left", rest1) <- return lr
367 (x, rest2) <- reads rest1
368 return (Left x, rest2)) ++
370 ("Right", rest1) <- return lr
371 (x, rest2) <- reads rest1
372 return (Right x, rest2)))
374 instance Read Int where
375 readsPrec _ x = readSigned readDec x
377 instance Read Integer where
378 readsPrec _ x = readSigned readDec x
380 instance Read Float where
381 readsPrec _ x = readSigned readFloat x
383 instance Read Double where
384 readsPrec _ x = readSigned readFloat x
386 instance (Integral a, Read a) => Read (Ratio a) where
387 readsPrec p = readParen (p > ratio_prec)
394 instance (Read a) => Read [a] where
395 readsPrec _ = readList
397 instance Read () where
398 readsPrec _ = readParen False
404 instance (Read a, Read b) => Read (a,b) where
405 readsPrec _ = readParen False
408 (x,t) <- readsPrec 0 s
410 (y,v) <- readsPrec 0 u
414 instance (Read a, Read b, Read c) => Read (a, b, c) where
415 readsPrec _ = readParen False
418 (x,c) <- readsPrec 0 b
420 (y,e) <- readsPrec 0 d
422 (z,g) <- readsPrec 0 f
426 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
427 readsPrec _ = readParen False
430 (w,c) <- readsPrec 0 b
432 (x,e) <- readsPrec 0 d
434 (y,g) <- readsPrec 0 f
436 (z,h) <- readsPrec 0 h
438 return ((w,x,y,z), i))
440 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
441 readsPrec _ = readParen False
444 (v,c) <- readsPrec 0 b
446 (w,e) <- readsPrec 0 d
448 (x,g) <- readsPrec 0 f
450 (y,i) <- readsPrec 0 h
452 (z,k) <- readsPrec 0 j
454 return ((v,w,x,y,z), l))
458 %*********************************************************
460 \subsection{Reading characters}
462 %*********************************************************
465 readLitChar :: ReadS Char
467 readLitChar [] = mzero
468 readLitChar ('\\':s) = readEsc s
470 readEsc ('a':s) = return ('\a',s)
471 readEsc ('b':s) = return ('\b',s)
472 readEsc ('f':s) = return ('\f',s)
473 readEsc ('n':s) = return ('\n',s)
474 readEsc ('r':s) = return ('\r',s)
475 readEsc ('t':s) = return ('\t',s)
476 readEsc ('v':s) = return ('\v',s)
477 readEsc ('\\':s) = return ('\\',s)
478 readEsc ('"':s) = return ('"',s)
479 readEsc ('\'':s) = return ('\'',s)
480 readEsc ('^':c:s) | c >= '@' && c <= '_'
481 = return (chr (ord c - ord '@'), s)
482 readEsc s@(d:_) | isDigit d
493 readEsc s@(c:_) | isUpper c
494 = let table = ('\DEL', "DEL") : zip ['\NUL'..] asciiTab
495 in case [(c,s') | (c, mne) <- table,
496 ([],s') <- [match mne s]]
497 of (pr:_) -> return pr
501 readLitChar (c:s) = return (c,s)
503 match :: (Eq a) => [a] -> [a] -> ([a],[a])
504 match (x:xs) (y:ys) | x == y = match xs ys
505 match xs ys = (xs,ys)
510 %*********************************************************
512 \subsection{Reading numbers}
514 %*********************************************************
516 Note: reading numbers at bases different than 10, does not
517 include lexing common prefixes such as '0x' or '0o' etc.
520 {-# SPECIALISE readDec ::
523 readDec :: (Integral a) => ReadS a
524 readDec = readInt 10 isDigit (\d -> ord d - ord_0)
526 {-# SPECIALISE readOct ::
529 readOct :: (Integral a) => ReadS a
530 readOct = readInt 8 isOctDigit (\d -> ord d - ord_0)
532 {-# SPECIALISE readHex ::
535 readHex :: (Integral a) => ReadS a
536 readHex = readInt 16 isHexDigit hex
537 where hex d = ord d - (if isDigit d then ord_0
538 else ord (if isUpper d then 'A' else 'a') - 10)
540 readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
541 readInt radix isDig digToInt s = do
542 (ds,r) <- nonnull isDig s
543 return (foldl1 (\n d -> n * radix + d) (map (fromInt . digToInt) ds), r)
545 {-# SPECIALISE readSigned ::
546 ReadS Int -> ReadS Int,
547 ReadS Integer -> ReadS Integer,
548 ReadS Double -> ReadS Double #-}
549 readSigned :: (Real a) => ReadS a -> ReadS a
550 readSigned readPos = readParen False read'
551 where read' r = read'' r ++
558 (n,"") <- readPos str
562 The functions readFloat below uses rational arithmetic
563 to ensure correct conversion between the floating-point radix and
564 decimal. It is often possible to use a higher-precision floating-
565 point type to obtain the same results.
568 {-# SPECIALISE readFloat ::
571 readFloat :: (RealFloat a) => ReadS a
573 (x,t) <- readRational r
574 return (fromRational x,t)
576 readRational :: ReadS Rational -- NB: doesn't handle leading "-"
582 return ((n%1)*10^^(k-d), t )) ++
587 ("Infinity",t) <- lex r
591 (ds,s) <- lexDecDigits r
592 (ds',t) <- lexDotDigits s
593 return (read (ds++ds'), length ds', t)
595 readExp (e:s) | e `elem` "eE" = readExp' s
596 readExp s = return (0,s)
598 readExp' ('+':s) = readDec s
599 readExp' ('-':s) = do
602 readExp' s = readDec s
604 lexDotDigits ('.':s) = lex0Digits s
605 lexDotDigits s = return ("",s)
607 readRational__ :: String -> Rational -- we export this one (non-std)
608 -- NB: *does* handle a leading "-"
611 '-' : xs -> - (read_me xs)
615 = case (do { (x,t) <- readRational s ; ("","") <- lex t ; return x }) of
616 #ifndef NEW_READS_REP
618 [] -> error ("readRational__: no parse:" ++ top_s)
619 _ -> error ("readRational__: ambiguous parse:" ++ top_s)
622 Nothing -> error ("readRational__: no parse:" ++ top_s)
627 %*********************************************************
629 \subsection{Reading BufferMode}
631 %*********************************************************
633 This instance decl is here rather than somewhere more appropriate in
634 order that we can avoid both orphan-instance modules and recursive
638 instance Read BufferMode where
641 (\r -> let lr = lex r
643 [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++
644 [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++
645 [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
646 (mb, rest2) <- reads rest1])