a8240c60f11456c32240de5c4460207451ffd403
[packages/base.git] / GHC / Read.lhs
1 % ------------------------------------------------------------------------------
2 % $Id: Read.lhs,v 1.5 2002/04/13 05:08:55 sof Exp $
3 %
4 % (c) The University of Glasgow, 1994-2000
5 %
6
7 \section[GHC.Read]{Module @GHC.Read@}
8
9 Instances of the Read class.
10
11 \begin{code}
12 {-# OPTIONS -fno-implicit-prelude #-}
13
14 module GHC.Read 
15   ( Read(..)   -- class
16   
17   -- ReadS type
18   , ReadS      -- :: *; = String -> [(a,String)]
19   
20   -- utility functions
21   , reads      -- :: Read a => ReadS a
22   , readp      -- :: Read a => ReadP a
23   , readEither -- :: Read a => String -> Either String a
24   , read       -- :: Read a => String -> a
25
26   -- H98 compatibility
27   , lex         -- :: ReadS String
28   , lexLitChar  -- :: ReadS String
29   , readLitChar -- :: ReadS Char
30   , lexDigits   -- :: ReadS String
31   
32   -- defining readers
33   , lexP       -- :: ReadPrec Lexeme
34   , paren      -- :: ReadPrec a -> ReadPrec a
35   , parens     -- :: ReadPrec a -> ReadPrec a
36   , list       -- :: ReadPrec a -> ReadPrec [a]
37   , choose     -- :: [(String, ReadPrec a)] -> ReadPrec a
38
39   -- Temporary
40   , readList__
41   , readParen
42   )
43  where
44
45 import qualified Text.ParserCombinators.ReadP as P
46
47 import Text.ParserCombinators.ReadP
48   ( ReadP
49   , readP_to_S
50   , readS_to_P
51   )
52
53 import qualified Text.Read.Lex as L
54
55 import Text.Read.Lex
56   ( Lexeme(..)
57   , Number(..)
58   , numberToInt
59   , numberToInteger
60   , numberToFloat
61   , numberToDouble
62   )
63
64 import Text.ParserCombinators.ReadPrec
65
66 import Data.Maybe
67 import Data.Either
68
69 import {-# SOURCE #-} GHC.Err           ( error )
70 import GHC.Num
71 import GHC.Real
72 import GHC.Float
73 import GHC.List
74 import GHC.Show         -- isAlpha etc
75 import GHC.Base
76
77 ratioPrec = 7   -- Precedence of ':%' constructor
78 appPrec   = 10  -- Precedence of applictaion
79 \end{code}
80 -------------------------------------------------------
81         TEMPORARY UNTIL I DO DERIVED READ
82
83 \begin{code}
84 readParen       :: Bool -> ReadS a -> ReadS a
85 readParen b g   =  if b then mandatory else optional
86                    where optional r  = g r ++ mandatory r
87                          mandatory r = do
88                                 ("(",s) <- lex r
89                                 (x,t)   <- optional s
90                                 (")",u) <- lex t
91                                 return (x,u)
92
93
94 readList__ :: ReadS a -> ReadS [a]
95
96 readList__ readx
97   = readParen False (\r -> do
98                        ("[",s) <- lex r
99                        readl s)
100   where readl  s = 
101            (do { ("]",t) <- lex s ; return ([],t) }) ++
102            (do { (x,t) <- readx s ; (xs,u) <- readl2 t ; return (x:xs,u) })
103
104         readl2 s = 
105            (do { ("]",t) <- lex s ; return ([],t) }) ++
106            (do { (",",t) <- lex s ; (x,u) <- readx t ; (xs,v) <- readl2 u ; return (x:xs,v) })
107 \end{code}
108
109
110 %*********************************************************
111 %*                                                      *
112 \subsection{The @Read@ class and @ReadS@ type}
113 %*                                                      *
114 %*********************************************************
115
116 \begin{code}
117 ------------------------------------------------------------------------
118 -- ReadS
119
120 type ReadS a = String -> [(a,String)]
121
122 ------------------------------------------------------------------------
123 -- class Read
124
125 class Read a where
126   readsPrec    :: Int -> ReadS a
127   readList     :: ReadS [a]
128   readPrec     :: ReadPrec a
129   readListPrec :: ReadPrec [a]
130   
131   -- default definitions
132   readsPrec    = readPrec_to_S readPrec
133   readList     = readPrec_to_S (list readPrec) 0
134   readPrec     = readS_to_Prec readsPrec
135   readListPrec = readS_to_Prec (\_ -> readList)
136
137 readListDefault :: Read a => ReadS [a]
138 readListDefault = readPrec_to_S readListPrec 0
139
140 readListPrecDefault :: Read a => ReadPrec [a]
141 readListPrecDefault = list readPrec
142
143 ------------------------------------------------------------------------
144 -- utility functions
145
146 reads :: Read a => ReadS a
147 reads = readsPrec minPrec
148
149 readp :: Read a => ReadP a
150 readp = readPrec_to_P readPrec minPrec
151
152 readEither :: Read a => String -> Either String a
153 readEither s =
154   case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
155     [x] -> Right x
156     []  -> Left "Prelude.read: no parse"
157     _   -> Left "Prelude.read: ambiguous parse"
158  where
159   read' =
160     do x <- readPrec
161        lift P.skipSpaces
162        return x
163
164 read :: Read a => String -> a
165 read s = either error id (readEither s)
166
167 ------------------------------------------------------------------------
168 -- H98 compatibility
169
170 lex :: ReadS String             -- As defined by H98
171 lex = readP_to_S (do { lexeme <- L.lex ;
172                        return (show lexeme) })
173
174 lexLitChar :: ReadS String      -- As defined by H98
175 lexLitChar = readP_to_S (do { lexeme <- L.lexLitChar ;
176                               return (show lexeme) })
177
178 readLitChar :: ReadS Char       -- As defined by H98
179 readLitChar = readP_to_S (do { Char c <- L.lexLitChar ;
180                                return c })
181
182 lexDigits :: ReadS String
183 lexDigits = readP_to_S (P.munch1 isDigit)
184
185 ------------------------------------------------------------------------
186 -- utility parsers
187
188 lexP :: ReadPrec Lexeme
189 lexP = lift L.lex
190
191 paren :: ReadPrec a -> ReadPrec a
192 -- (paren p) parses (P0) 
193 --      where p parses P0 in precedence context zero
194 paren p =
195   do Single '(' <- lexP
196      x          <- reset p
197      Single ')' <- lexP
198      return x
199
200 parens :: ReadPrec a -> ReadPrec a
201 -- (parens p) parses P, (P0), ((P0)), etc, 
202 --      where p parses P  in the current precedence context
203 --              parses P0 in precedence context zero
204 parens p = optional
205  where
206   optional  = p +++ mandatory
207   mandatory = paren optional
208
209 list :: ReadPrec a -> ReadPrec [a]
210 list readx =
211   parens
212   ( do Single '[' <- lexP
213        (listRest False +++ listNext)
214   )
215  where
216   listRest started =
217     do Single c <- lexP
218        case c of
219          ']'           -> return []
220          ',' | started -> listNext
221          _             -> pfail
222   
223   listNext =
224     do x  <- reset readx
225        xs <- listRest True
226        return (x:xs)
227
228 choose :: [(String, ReadPrec a)] -> ReadPrec a
229 -- Parse the specified lexeme and continue as specified
230 -- Esp useful for nullary constructors
231 choose sps = foldr ((+++) . try_one) pfail sps
232            where
233              try_one (s,p) = do { Ident s' <- lexP ;
234                                   if s == s' then p else pfail }
235 \end{code}
236
237
238 %*********************************************************
239 %*                                                      *
240 \subsection{Simple instances of Read}
241 %*                                                      *
242 %*********************************************************
243
244 \begin{code}
245 instance Read Char where
246   readPrec =
247     parens
248     ( do Char c <- lexP
249          return c
250     )
251
252   readListPrec =
253     parens
254     ( do String s <- lexP       -- Looks for "foo"
255          return s
256      +++
257       readListPrecDefault       -- Looks for ['f','o','o']
258     )                           -- (more generous than H98 spec)
259
260   readList = readListDefault
261
262 instance Read Bool where
263   readPrec =
264     parens
265     ( do Ident s <- lexP
266          case s of
267            "True"  -> return True
268            "False" -> return False
269            _       -> pfail
270     )
271
272   readListPrec = readListPrecDefault
273   readList     = readListDefault
274
275 instance Read Ordering where
276   readPrec =
277     parens
278     ( do Ident s <- lexP
279          case s of
280            "LT" -> return LT
281            "EQ" -> return EQ
282            "GT" -> return GT
283            _    -> pfail
284     )
285
286   readListPrec = readListPrecDefault
287   readList     = readListDefault
288 \end{code}
289
290
291 %*********************************************************
292 %*                                                      *
293 \subsection{Structure instances of Read: Maybe, List etc}
294 %*                                                      *
295 %*********************************************************
296
297 For structured instances of Read we start using the precedences.  The
298 idea is then that 'parens (prec k p)' will fail immediately when trying
299 to parse it in a context with a higher precedence level than k. But if
300 there is one parenthesis parsed, then the required precedence level
301 drops to 0 again, and parsing inside p may succeed.
302
303 'appPrec' is just the precedence level of function application (maybe
304 it should be called 'appPrec' instead).  So, if we are parsing
305 function application, we'd better require the precedence level to be
306 at least 'appPrec'. Otherwise, we have to put parentheses around it.
307
308 'step' is used to increase the precedence levels inside a
309 parser, and can be used to express left- or right- associativity. For
310 example, % is defined to be left associative, so we only increase
311 precedence on the right hand side.
312
313 Note how step is used in for example the Maybe parser to increase the
314 precedence beyond appPrec, so that basically only literals and
315 parenthesis-like objects such as (...) and [...] can be an argument to
316 'Just'.
317
318 \begin{code}
319 instance Read a => Read (Maybe a) where
320   readPrec =
321     parens
322     ( prec appPrec
323       ( do Ident "Nothing" <- lexP
324            return Nothing
325        +++
326         do Ident "Just" <- lexP
327            x            <- step readPrec
328            return (Just x)
329       )
330     )
331
332   readListPrec = readListPrecDefault
333   readList     = readListDefault
334
335 instance (Read a, Read b) => Read (Either a b) where
336   readPrec =
337     parens
338     ( prec appPrec
339       ( do Ident "Left" <- lexP
340            x            <- step readPrec
341            return (Left x)
342        +++
343         do Ident "Right" <- lexP
344            y             <- step readPrec
345            return (Right y)
346       )
347     )
348
349   readListPrec = readListPrecDefault
350   readList     = readListDefault
351
352 instance Read a => Read [a] where
353   readPrec     = readListPrec
354   readListPrec = readListPrecDefault
355   readList     = readListDefault
356
357 instance Read Lexeme where
358   readPrec     = lexP
359   readListPrec = readListPrecDefault
360   readList     = readListDefault
361 \end{code}
362
363
364 %*********************************************************
365 %*                                                      *
366 \subsection{Numeric instances of Read}
367 %*                                                      *
368 %*********************************************************
369
370 \begin{code}
371 readNumber :: Num a => (Number -> Maybe a) -> ReadPrec a
372 -- Read a signed number
373 readNumber convert =
374   parens
375   ( do x <- lexP
376        case x of
377          Symbol "-" -> do n <- readNumber convert
378                           return (negate n)
379        
380          Number y   -> case convert y of
381                          Just n  -> return n
382                          Nothing -> pfail
383          
384          _          -> pfail
385   )
386
387 readIEEENumber :: (RealFloat a) => (Number -> Maybe a) -> ReadPrec a
388 -- Read a Float/Double.
389 readIEEENumber convert =
390   parens
391   ( do x <- lexP
392        case x of
393          Ident "NaN"      -> return (0/0)
394          Ident "Infinity" -> return (1/0)
395          Symbol "-" -> do n <- readIEEENumber convert
396                           return (negate n)
397        
398          Number y   -> case convert y of
399                          Just n  -> return n
400                          Nothing -> pfail
401          
402          _          -> pfail
403   )
404
405 instance Read Int where
406   readPrec     = readNumber numberToInt
407   readListPrec = readListPrecDefault
408   readList     = readListDefault
409
410 instance Read Integer where
411   readPrec     = readNumber numberToInteger
412   readListPrec = readListPrecDefault
413   readList     = readListDefault
414
415 instance Read Float where
416   readPrec     = readIEEENumber numberToFloat
417   readListPrec = readListPrecDefault
418   readList     = readListDefault
419
420 instance Read Double where
421   readPrec     = readIEEENumber numberToDouble
422   readListPrec = readListPrecDefault
423   readList     = readListDefault
424
425 instance (Integral a, Read a) => Read (Ratio a) where
426   readPrec =
427     parens
428     ( prec ratioPrec
429       ( do x          <- step readPrec
430            Symbol "%" <- lexP
431            y          <- step readPrec
432            return (x % y)
433       )
434     )
435
436   readListPrec = readListPrecDefault
437   readList     = readListDefault
438 \end{code}
439
440
441 %*********************************************************
442 %*                                                      *
443 \subsection{Tuple instances of Read}
444 %*                                                      *
445 %*********************************************************
446
447 \begin{code}
448 instance Read () where
449   readPrec =
450     parens
451     ( paren
452       ( return ()
453       )
454     )
455
456   readListPrec = readListPrecDefault
457   readList     = readListDefault
458
459 instance (Read a, Read b) => Read (a,b) where
460   readPrec =
461     parens
462     ( paren
463       ( do x <- readPrec
464            Single ',' <- lexP
465            y <- readPrec
466            return (x,y)
467       )
468     )
469
470   readListPrec = readListPrecDefault
471   readList     = readListDefault
472
473
474 instance (Read a, Read b, Read c) => Read (a, b, c) where
475   readPrec =
476     parens
477     ( paren
478       ( do x <- readPrec
479            Single ',' <- lexP
480            y <- readPrec
481            Single ',' <- lexP
482            z <- readPrec
483            return (x,y,z)
484       )
485     )
486
487   readListPrec = readListPrecDefault
488   readList     = readListDefault
489
490 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
491   readPrec =
492     parens
493     ( paren
494       ( do w <- readPrec
495            Single ',' <- lexP
496            x <- readPrec
497            Single ',' <- lexP
498            y <- readPrec
499            Single ',' <- lexP
500            z <- readPrec
501            return (w,x,y,z)
502       )
503     )
504
505   readListPrec = readListPrecDefault
506   readList     = readListDefault
507
508 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
509   readPrec =
510     parens
511     ( paren
512       ( do v <- readPrec
513            Single ',' <- lexP
514            w <- readPrec
515            Single ',' <- lexP
516            x <- readPrec
517            Single ',' <- lexP
518            y <- readPrec
519            Single ',' <- lexP
520            z <- readPrec
521            return (v,w,x,y,z)
522       )
523     )
524
525   readListPrec = readListPrecDefault
526   readList     = readListDefault
527 \end{code}