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