[project @ 2002-06-06 16:03:16 by simonpj]
[ghc.git] / libraries / base / 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   , readListDefault, readListPrecDefault,
42
43   -- Temporary
44   , readList__
45   , readParen
46   )
47  where
48
49 import qualified Text.ParserCombinators.ReadP as P
50
51 import Text.ParserCombinators.ReadP
52   ( ReadP
53   , readP_to_S
54   , readS_to_P
55   )
56
57 import qualified Text.Read.Lex as L
58 -- Lex exports 'lex', which is also defined here,
59 -- hence the qualified import.
60 -- We can't import *anything* unqualified, because that
61 -- confuses Haddock.
62
63 import Text.ParserCombinators.ReadPrec
64
65 import Data.Maybe
66 import Data.Either
67
68 import {-# SOURCE #-} GHC.Err           ( error )
69 import GHC.Num
70 import GHC.Real
71 import GHC.Float
72 import GHC.List
73 import GHC.Show         -- isAlpha etc
74 import GHC.Base
75 import GHC.Arr
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 -- | A parser for a type @a@, represented as a function that takes a
121 -- 'String' and returns a list of possible parses @(a,'String')@ pairs.
122 type ReadS a = String -> [(a,String)]
123
124 ------------------------------------------------------------------------
125 -- class Read
126
127 class Read a where
128   readsPrec    :: Int -> ReadS a
129   readList     :: ReadS [a]
130   readPrec     :: ReadPrec a
131   readListPrec :: ReadPrec [a]
132   
133   -- default definitions
134   readsPrec    = readPrec_to_S readPrec
135   readList     = readPrec_to_S (list readPrec) 0
136   readPrec     = readS_to_Prec readsPrec
137   readListPrec = readS_to_Prec (\_ -> readList)
138
139 readListDefault :: Read a => ReadS [a]
140 -- ^ Use this to define the 'readList' method, if you
141 --   don't want a special case
142 readListDefault = readPrec_to_S readListPrec 0
143
144 readListPrecDefault :: Read a => ReadPrec [a]
145 -- ^ Use this to define the 'readListPrec' method, if you
146 --   don't want a special case
147 readListPrecDefault = list readPrec
148
149 ------------------------------------------------------------------------
150 -- utility functions
151
152 reads :: Read a => ReadS a
153 reads = readsPrec minPrec
154
155 readp :: Read a => ReadP a
156 readp = readPrec_to_P readPrec minPrec
157
158 readEither :: Read a => String -> Either String a
159 readEither s =
160   case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
161     [x] -> Right x
162     []  -> Left "Prelude.read: no parse"
163     _   -> Left "Prelude.read: ambiguous parse"
164  where
165   read' =
166     do x <- readPrec
167        lift P.skipSpaces
168        return x
169
170 read :: Read a => String -> a
171 read s = either error id (readEither s)
172
173 ------------------------------------------------------------------------
174 -- H98 compatibility
175
176 lex :: ReadS String             -- As defined by H98
177 lex s  = readP_to_S L.hsLex s
178
179 lexLitChar :: ReadS String      -- As defined by H98
180 lexLitChar = readP_to_S (do { P.skipSpaces ;
181                               (s, L.Char _) <- P.gather L.lex ;
182                               return s })
183
184 readLitChar :: ReadS Char       -- As defined by H98
185 readLitChar = readP_to_S (do { L.Char c <- L.lex ;
186                                return c })
187
188 lexDigits :: ReadS String
189 lexDigits = readP_to_S (P.munch1 isDigit)
190
191 ------------------------------------------------------------------------
192 -- utility parsers
193
194 lexP :: ReadPrec L.Lexeme
195 -- ^ Parse a single lexeme
196 lexP = lift L.lex
197
198 paren :: ReadPrec a -> ReadPrec a
199 -- ^ @(paren p)@ parses "(P0)"
200 --      where @p@ parses "P0" in precedence context zero
201 paren p = do L.Punc "(" <- lexP
202              x          <- reset p
203              L.Punc ")" <- lexP
204              return x
205
206 parens :: ReadPrec a -> ReadPrec a
207 -- ^ @(parens p)@ parses "P", "(P0)", "((P0))", etc, 
208 --      where @p@ parses "P"  in the current precedence context
209 --              parses "P0" in precedence context zero
210 parens p = optional
211  where
212   optional  = p +++ mandatory
213   mandatory = paren optional
214
215 list :: ReadPrec a -> ReadPrec [a]
216 -- ^ @(list p)@ parses a list of things parsed by @p@,
217 -- using the usual square-bracket syntax.
218 list readx =
219   parens
220   ( do L.Punc "[" <- lexP
221        (listRest False +++ listNext)
222   )
223  where
224   listRest started =
225     do L.Punc c <- lexP
226        case c of
227          "]"           -> return []
228          "," | started -> listNext
229          _             -> pfail
230   
231   listNext =
232     do x  <- reset readx
233        xs <- listRest True
234        return (x:xs)
235
236 choose :: [(String, ReadPrec a)] -> ReadPrec a
237 -- ^ Parse the specified lexeme and continue as specified.
238 -- Esp useful for nullary constructors; e.g.
239 --    @choose [("A", return A), ("B", return B)]@
240 choose sps = foldr ((+++) . try_one) pfail sps
241            where
242              try_one (s,p) = do { L.Ident s' <- lexP ;
243                                   if s == s' then p else pfail }
244 \end{code}
245
246
247 %*********************************************************
248 %*                                                      *
249 \subsection{Simple instances of Read}
250 %*                                                      *
251 %*********************************************************
252
253 \begin{code}
254 instance Read Char where
255   readPrec =
256     parens
257     ( do L.Char c <- lexP
258          return c
259     )
260
261   readListPrec =
262     parens
263     ( do L.String s <- lexP     -- Looks for "foo"
264          return s
265      +++
266       readListPrecDefault       -- Looks for ['f','o','o']
267     )                           -- (more generous than H98 spec)
268
269   readList = readListDefault
270
271 instance Read Bool where
272   readPrec =
273     parens
274     ( do L.Ident s <- lexP
275          case s of
276            "True"  -> return True
277            "False" -> return False
278            _       -> pfail
279     )
280
281   readListPrec = readListPrecDefault
282   readList     = readListDefault
283
284 instance Read Ordering where
285   readPrec =
286     parens
287     ( do L.Ident s <- lexP
288          case s of
289            "LT" -> return LT
290            "EQ" -> return EQ
291            "GT" -> return GT
292            _    -> pfail
293     )
294
295   readListPrec = readListPrecDefault
296   readList     = readListDefault
297 \end{code}
298
299
300 %*********************************************************
301 %*                                                      *
302 \subsection{Structure instances of Read: Maybe, List etc}
303 %*                                                      *
304 %*********************************************************
305
306 For structured instances of Read we start using the precedences.  The
307 idea is then that 'parens (prec k p)' will fail immediately when trying
308 to parse it in a context with a higher precedence level than k. But if
309 there is one parenthesis parsed, then the required precedence level
310 drops to 0 again, and parsing inside p may succeed.
311
312 'appPrec' is just the precedence level of function application (maybe
313 it should be called 'appPrec' instead).  So, if we are parsing
314 function application, we'd better require the precedence level to be
315 at least 'appPrec'. Otherwise, we have to put parentheses around it.
316
317 'step' is used to increase the precedence levels inside a
318 parser, and can be used to express left- or right- associativity. For
319 example, % is defined to be left associative, so we only increase
320 precedence on the right hand side.
321
322 Note how step is used in for example the Maybe parser to increase the
323 precedence beyond appPrec, so that basically only literals and
324 parenthesis-like objects such as (...) and [...] can be an argument to
325 'Just'.
326
327 \begin{code}
328 instance Read a => Read (Maybe a) where
329   readPrec =
330     parens
331     ( prec appPrec
332       ( do L.Ident "Nothing" <- lexP
333            return Nothing
334        +++
335         do L.Ident "Just" <- lexP
336            x            <- step readPrec
337            return (Just x)
338       )
339     )
340
341   readListPrec = readListPrecDefault
342   readList     = readListDefault
343
344 instance (Read a, Read b) => Read (Either a b) where
345   readPrec =
346     parens
347     ( prec appPrec
348       ( do L.Ident "Left" <- lexP
349            x            <- step readPrec
350            return (Left x)
351        +++
352         do L.Ident "Right" <- lexP
353            y             <- step readPrec
354            return (Right y)
355       )
356     )
357
358   readListPrec = readListPrecDefault
359   readList     = readListDefault
360
361 instance Read a => Read [a] where
362   readPrec     = readListPrec
363   readListPrec = readListPrecDefault
364   readList     = readListDefault
365
366 instance  (Ix a, Read a, Read b) => Read (Array a b)  where
367     readPrec = parens $ prec appPrec $
368                do L.Ident "array" <- lexP
369                   bounds <- step readPrec
370                   vals   <- step readPrec
371                   return (array bounds vals)
372
373     readListPrec = readListPrecDefault
374     readList     = readListDefault
375
376 instance Read L.Lexeme where
377   readPrec     = lexP
378   readListPrec = readListPrecDefault
379   readList     = readListDefault
380 \end{code}
381
382
383 %*********************************************************
384 %*                                                      *
385 \subsection{Numeric instances of Read}
386 %*                                                      *
387 %*********************************************************
388
389 \begin{code}
390 readNumber :: Num a => (L.Lexeme -> Maybe a) -> ReadPrec a
391 -- Read a signed number
392 readNumber convert =
393   parens
394   ( do x <- lexP
395        case x of
396          L.Symbol "-" -> do n <- readNumber convert
397                             return (negate n)
398        
399          _   -> case convert x of
400                    Just n  -> return n
401                    Nothing -> pfail
402   )
403
404 convertInt :: Num a => L.Lexeme -> Maybe a
405 convertInt (L.Int i) = Just (fromInteger i)
406 convertInt _         = Nothing
407
408 convertFrac :: Fractional a => L.Lexeme -> Maybe a
409 convertFrac (L.Int i) = Just (fromInteger i)
410 convertFrac (L.Rat r) = Just (fromRational r)
411 convertFrac _         = Nothing
412
413 instance Read Int where
414   readPrec     = readNumber convertInt
415   readListPrec = readListPrecDefault
416   readList     = readListDefault
417
418 instance Read Integer where
419   readPrec     = readNumber convertInt
420   readListPrec = readListPrecDefault
421   readList     = readListDefault
422
423 instance Read Float where
424   readPrec     = readNumber convertFrac
425   readListPrec = readListPrecDefault
426   readList     = readListDefault
427
428 instance Read Double where
429   readPrec     = readNumber convertFrac
430   readListPrec = readListPrecDefault
431   readList     = readListDefault
432
433 instance (Integral a, Read a) => Read (Ratio a) where
434   readPrec =
435     parens
436     ( prec ratioPrec
437       ( do x            <- step readPrec
438            L.Symbol "%" <- lexP
439            y            <- step readPrec
440            return (x % y)
441       )
442     )
443
444   readListPrec = readListPrecDefault
445   readList     = readListDefault
446 \end{code}
447
448
449 %*********************************************************
450 %*                                                      *
451 \subsection{Tuple instances of Read}
452 %*                                                      *
453 %*********************************************************
454
455 \begin{code}
456 instance Read () where
457   readPrec =
458     parens
459     ( paren
460       ( return ()
461       )
462     )
463
464   readListPrec = readListPrecDefault
465   readList     = readListDefault
466
467 instance (Read a, Read b) => Read (a,b) where
468   readPrec =
469     parens
470     ( paren
471       ( do x <- readPrec
472            L.Punc "," <- lexP
473            y <- readPrec
474            return (x,y)
475       )
476     )
477
478   readListPrec = readListPrecDefault
479   readList     = readListDefault
480
481
482 instance (Read a, Read b, Read c) => Read (a, b, c) where
483   readPrec =
484     parens
485     ( paren
486       ( do x <- readPrec
487            L.Punc "," <- lexP
488            y <- readPrec
489            L.Punc "," <- lexP
490            z <- readPrec
491            return (x,y,z)
492       )
493     )
494
495   readListPrec = readListPrecDefault
496   readList     = readListDefault
497
498 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
499   readPrec =
500     parens
501     ( paren
502       ( do w <- readPrec
503            L.Punc "," <- lexP
504            x <- readPrec
505            L.Punc "," <- lexP
506            y <- readPrec
507            L.Punc "," <- lexP
508            z <- readPrec
509            return (w,x,y,z)
510       )
511     )
512
513   readListPrec = readListPrecDefault
514   readList     = readListDefault
515
516 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
517   readPrec =
518     parens
519     ( paren
520       ( do v <- readPrec
521            L.Punc "," <- lexP
522            w <- readPrec
523            L.Punc "," <- lexP
524            x <- readPrec
525            L.Punc "," <- lexP
526            y <- readPrec
527            L.Punc "," <- lexP
528            z <- readPrec
529            return (v,w,x,y,z)
530       )
531     )
532
533   readListPrec = readListPrecDefault
534   readList     = readListDefault
535 \end{code}