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