[project @ 2005-01-26 14:55:41 by simonmar]
[packages/old-time.git] / GHC / Read.lhs
1 \begin{code}
2 {-# OPTIONS_GHC -fno-implicit-prelude #-}
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module      :  GHC.Read
6 -- Copyright   :  (c) The University of Glasgow, 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   , ReadS
53   , readP_to_S
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 #ifndef __HADDOCK__
69 import {-# SOURCE #-} GHC.Unicode       ( isDigit )
70 #endif
71 import GHC.Num
72 import GHC.Real
73 import GHC.Float
74 import GHC.List
75 import GHC.Show
76 import GHC.Base
77 import GHC.Arr
78 \end{code}
79
80
81 \begin{code}
82 -- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
83 -- parentheses.
84 --
85 -- @'readParen' 'False' p@ parses what @p@ parses, but optionally
86 -- surrounded with parentheses.
87 readParen       :: Bool -> ReadS a -> ReadS a
88 -- A Haskell 98 function
89 readParen b g   =  if b then mandatory else optional
90                    where optional r  = g r ++ mandatory r
91                          mandatory r = do
92                                 ("(",s) <- lex r
93                                 (x,t)   <- optional s
94                                 (")",u) <- lex t
95                                 return (x,u)
96 \end{code}
97
98
99 %*********************************************************
100 %*                                                      *
101 \subsection{The @Read@ class}
102 %*                                                      *
103 %*********************************************************
104
105 \begin{code}
106 ------------------------------------------------------------------------
107 -- class Read
108
109 -- | Parsing of 'String's, producing values.
110 --
111 -- Minimal complete definition: 'readsPrec' (or, for GHC only, 'readPrec')
112 --
113 -- Derived instances of 'Read' make the following assumptions, which
114 -- derived instances of 'Text.Show.Show' obey:
115 --
116 -- * If the constructor is defined to be an infix operator, then the
117 --   derived 'Read' instance will parse only infix applications of
118 --   the constructor (not the prefix form).
119 --
120 -- * Associativity is not used to reduce the occurrence of parentheses,
121 --   although precedence may be.
122 --
123 -- * If the constructor is defined using record syntax, the derived 'Read'
124 --   will parse only the record-syntax form, and furthermore, the fields
125 --   must be given in the same order as the original declaration.
126 --
127 -- * The derived 'Read' instance allows arbitrary Haskell whitespace
128 --   between tokens of the input string.  Extra parentheses are also
129 --   allowed.
130 --
131 -- For example, given the declarations
132 --
133 -- > infixr 5 :^:
134 -- > data Tree a =  Leaf a  |  Tree a :^: Tree a
135 --
136 -- the derived instance of 'Read' is equivalent to
137 --
138 -- > instance (Read a) => Read (Tree a) where
139 -- >
140 -- >         readsPrec d r =  readParen (d > up_prec)
141 -- >                          (\r -> [(u:^:v,w) |
142 -- >                                  (u,s) <- readsPrec (up_prec+1) r,
143 -- >                                  (":^:",t) <- lex s,
144 -- >                                  (v,w) <- readsPrec (up_prec+1) t]) r
145 -- >
146 -- >                       ++ readParen (d > app_prec)
147 -- >                          (\r -> [(Leaf m,t) |
148 -- >                                  ("Leaf",s) <- lex r,
149 -- >                                  (m,t) <- readsPrec (app_prec+1) s]) r
150 -- >
151 -- >           where up_prec = 5
152 -- >                 app_prec = 10
153 --
154 -- Note that right-associativity of @:^:@ is unused.
155
156 class Read a where
157   -- | attempts to parse a value from the front of the string, returning
158   -- a list of (parsed value, remaining string) pairs.  If there is no
159   -- successful parse, the returned list is empty.
160   --
161   -- Derived instances of 'Read' and 'Text.Show.Show' satisfy the following:
162   --
163   -- * @(x,\"\")@ is an element of
164   --   @('readsPrec' d ('Text.Show.showsPrec' d x \"\"))@.
165   --
166   -- That is, 'readsPrec' parses the string produced by
167   -- 'Text.Show.showsPrec', and delivers the value that
168   -- 'Text.Show.showsPrec' started with.
169
170   readsPrec    :: Int   -- ^ the operator precedence of the enclosing
171                         -- context (a number from @0@ to @11@).
172                         -- Function application has precedence @10@.
173                 -> ReadS a
174
175   -- | The method 'readList' is provided to allow the programmer to
176   -- give a specialised way of parsing lists of values.
177   -- For example, this is used by the predefined 'Read' instance of
178   -- the 'Char' type, where values of type 'String' should be are
179   -- expected to use double quotes, rather than square brackets.
180   readList     :: ReadS [a]
181
182   -- | Proposed replacement for 'readsPrec' using new-style parsers (GHC only).
183   readPrec     :: ReadPrec a
184
185   -- | Proposed replacement for 'readList' using new-style parsers (GHC only).
186   readListPrec :: ReadPrec [a]
187   
188   -- default definitions
189   readsPrec    = readPrec_to_S readPrec
190   readList     = readPrec_to_S (list readPrec) 0
191   readPrec     = readS_to_Prec readsPrec
192   readListPrec = readS_to_Prec (\_ -> readList)
193
194 readListDefault :: Read a => ReadS [a]
195 -- ^ Use this to define the 'readList' method, if you don't want a special
196 --   case (GHC only; for other systems the default suffices).
197 readListDefault = readPrec_to_S readListPrec 0
198
199 readListPrecDefault :: Read a => ReadPrec [a]
200 -- ^ Use this to define the 'readListPrec' method, if you
201 --   don't want a special case (GHC only).
202 readListPrecDefault = list readPrec
203
204 ------------------------------------------------------------------------
205 -- utility functions
206
207 -- | equivalent to 'readsPrec' with a precedence of 0.
208 reads :: Read a => ReadS a
209 reads = readsPrec minPrec
210
211 readp :: Read a => ReadP a
212 readp = readPrec_to_P readPrec minPrec
213
214 readEither :: Read a => String -> Either String a
215 readEither s =
216   case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
217     [x] -> Right x
218     []  -> Left "Prelude.read: no parse"
219     _   -> Left "Prelude.read: ambiguous parse"
220  where
221   read' =
222     do x <- readPrec
223        lift P.skipSpaces
224        return x
225
226 -- | The 'read' function reads input from a string, which must be
227 -- completely consumed by the input process.
228 read :: Read a => String -> a
229 read s = either error id (readEither s)
230
231 ------------------------------------------------------------------------
232 -- H98 compatibility
233
234 -- | The 'lex' function reads a single lexeme from the input, discarding
235 -- initial white space, and returning the characters that constitute the
236 -- lexeme.  If the input string contains only white space, 'lex' returns a
237 -- single successful \`lexeme\' consisting of the empty string.  (Thus
238 -- @'lex' \"\" = [(\"\",\"\")]@.)  If there is no legal lexeme at the
239 -- beginning of the input string, 'lex' fails (i.e. returns @[]@).
240 --
241 -- This lexer is not completely faithful to the Haskell lexical syntax
242 -- in the following respects:
243 --
244 -- * Qualified names are not handled properly
245 --
246 -- * Octal and hexadecimal numerics are not recognized as a single token
247 --
248 -- * Comments are not treated properly
249 lex :: ReadS String             -- As defined by H98
250 lex s  = readP_to_S L.hsLex s
251
252 -- | Read a string representation of a character, using Haskell
253 -- source-language escape conventions.  For example:
254 --
255 -- > lexLitChar  "\\nHello"  =  [("\\n", "Hello")]
256 --
257 lexLitChar :: ReadS String      -- As defined by H98
258 lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ;
259                               return s })
260         -- There was a skipSpaces before the P.gather L.lexChar,
261         -- but that seems inconsistent with readLitChar
262
263 -- | Read a string representation of a character, using Haskell
264 -- source-language escape conventions, and convert it to the character
265 -- that it encodes.  For example:
266 --
267 -- > readLitChar "\\nHello"  =  [('\n', "Hello")]
268 --
269 readLitChar :: ReadS Char       -- As defined by H98
270 readLitChar = readP_to_S L.lexChar
271
272 -- | Reads a non-empty string of decimal digits.
273 lexDigits :: ReadS String
274 lexDigits = readP_to_S (P.munch1 isDigit)
275
276 ------------------------------------------------------------------------
277 -- utility parsers
278
279 lexP :: ReadPrec L.Lexeme
280 -- ^ Parse a single lexeme
281 lexP = lift L.lex
282
283 paren :: ReadPrec a -> ReadPrec a
284 -- ^ @(paren p)@ parses \"(P0)\"
285 --      where @p@ parses \"P0\" in precedence context zero
286 paren p = do L.Punc "(" <- lexP
287              x          <- reset p
288              L.Punc ")" <- lexP
289              return x
290
291 parens :: ReadPrec a -> ReadPrec a
292 -- ^ @(parens p)@ parses \"P\", \"(P0)\", \"((P0))\", etc, 
293 --      where @p@ parses \"P\"  in the current precedence context
294 --              parses \"P0\" in precedence context zero
295 parens p = optional
296  where
297   optional  = p +++ mandatory
298   mandatory = paren optional
299
300 list :: ReadPrec a -> ReadPrec [a]
301 -- ^ @(list p)@ parses a list of things parsed by @p@,
302 -- using the usual square-bracket syntax.
303 list readx =
304   parens
305   ( do L.Punc "[" <- lexP
306        (listRest False +++ listNext)
307   )
308  where
309   listRest started =
310     do L.Punc c <- lexP
311        case c of
312          "]"           -> return []
313          "," | started -> listNext
314          _             -> pfail
315   
316   listNext =
317     do x  <- reset readx
318        xs <- listRest True
319        return (x:xs)
320
321 choose :: [(String, ReadPrec a)] -> ReadPrec a
322 -- ^ Parse the specified lexeme and continue as specified.
323 -- Esp useful for nullary constructors; e.g.
324 --    @choose [(\"A\", return A), (\"B\", return B)]@
325 choose sps = foldr ((+++) . try_one) pfail sps
326            where
327              try_one (s,p) = do { L.Ident s' <- lexP ;
328                                   if s == s' then p else pfail }
329 \end{code}
330
331
332 %*********************************************************
333 %*                                                      *
334 \subsection{Simple instances of Read}
335 %*                                                      *
336 %*********************************************************
337
338 \begin{code}
339 instance Read Char where
340   readPrec =
341     parens
342     ( do L.Char c <- lexP
343          return c
344     )
345
346   readListPrec =
347     parens
348     ( do L.String s <- lexP     -- Looks for "foo"
349          return s
350      +++
351       readListPrecDefault       -- Looks for ['f','o','o']
352     )                           -- (more generous than H98 spec)
353
354   readList = readListDefault
355
356 instance Read Bool where
357   readPrec =
358     parens
359     ( do L.Ident s <- lexP
360          case s of
361            "True"  -> return True
362            "False" -> return False
363            _       -> pfail
364     )
365
366   readListPrec = readListPrecDefault
367   readList     = readListDefault
368
369 instance Read Ordering where
370   readPrec =
371     parens
372     ( do L.Ident s <- lexP
373          case s of
374            "LT" -> return LT
375            "EQ" -> return EQ
376            "GT" -> return GT
377            _    -> pfail
378     )
379
380   readListPrec = readListPrecDefault
381   readList     = readListDefault
382 \end{code}
383
384
385 %*********************************************************
386 %*                                                      *
387 \subsection{Structure instances of Read: Maybe, List etc}
388 %*                                                      *
389 %*********************************************************
390
391 For structured instances of Read we start using the precedences.  The
392 idea is then that 'parens (prec k p)' will fail immediately when trying
393 to parse it in a context with a higher precedence level than k. But if
394 there is one parenthesis parsed, then the required precedence level
395 drops to 0 again, and parsing inside p may succeed.
396
397 'appPrec' is just the precedence level of function application.  So,
398 if we are parsing function application, we'd better require the
399 precedence level to be at least 'appPrec'. Otherwise, we have to put
400 parentheses around it.
401
402 'step' is used to increase the precedence levels inside a
403 parser, and can be used to express left- or right- associativity. For
404 example, % is defined to be left associative, so we only increase
405 precedence on the right hand side.
406
407 Note how step is used in for example the Maybe parser to increase the
408 precedence beyond appPrec, so that basically only literals and
409 parenthesis-like objects such as (...) and [...] can be an argument to
410 'Just'.
411
412 \begin{code}
413 instance Read a => Read (Maybe a) where
414   readPrec =
415     parens
416     (do L.Ident "Nothing" <- lexP
417         return Nothing
418      +++
419      prec appPrec (
420         do L.Ident "Just" <- lexP
421            x              <- step readPrec
422            return (Just x))
423     )
424
425   readListPrec = readListPrecDefault
426   readList     = readListDefault
427
428 instance (Read a, Read b) => Read (Either a b) where
429   readPrec =
430     parens
431     ( prec appPrec
432       ( do L.Ident "Left" <- lexP
433            x            <- step readPrec
434            return (Left x)
435        +++
436         do L.Ident "Right" <- lexP
437            y             <- step readPrec
438            return (Right y)
439       )
440     )
441
442   readListPrec = readListPrecDefault
443   readList     = readListDefault
444
445 instance Read a => Read [a] where
446   readPrec     = readListPrec
447   readListPrec = readListPrecDefault
448   readList     = readListDefault
449
450 instance  (Ix a, Read a, Read b) => Read (Array a b)  where
451     readPrec = parens $ prec appPrec $
452                do L.Ident "array" <- lexP
453                   bounds <- step readPrec
454                   vals   <- step readPrec
455                   return (array bounds vals)
456
457     readListPrec = readListPrecDefault
458     readList     = readListDefault
459
460 instance Read L.Lexeme where
461   readPrec     = lexP
462   readListPrec = readListPrecDefault
463   readList     = readListDefault
464 \end{code}
465
466
467 %*********************************************************
468 %*                                                      *
469 \subsection{Numeric instances of Read}
470 %*                                                      *
471 %*********************************************************
472
473 \begin{code}
474 readNumber :: Num a => (L.Lexeme -> Maybe a) -> ReadPrec a
475 -- Read a signed number
476 readNumber convert =
477   parens
478   ( do x <- lexP
479        case x of
480          L.Symbol "-" -> do n <- readNumber convert
481                             return (negate n)
482        
483          _   -> case convert x of
484                    Just n  -> return n
485                    Nothing -> pfail
486   )
487
488 convertInt :: Num a => L.Lexeme -> Maybe a
489 convertInt (L.Int i) = Just (fromInteger i)
490 convertInt _         = Nothing
491
492 convertFrac :: Fractional a => L.Lexeme -> Maybe a
493 convertFrac (L.Int i) = Just (fromInteger i)
494 convertFrac (L.Rat r) = Just (fromRational r)
495 convertFrac _         = Nothing
496
497 instance Read Int where
498   readPrec     = readNumber convertInt
499   readListPrec = readListPrecDefault
500   readList     = readListDefault
501
502 instance Read Integer where
503   readPrec     = readNumber convertInt
504   readListPrec = readListPrecDefault
505   readList     = readListDefault
506
507 instance Read Float where
508   readPrec     = readNumber convertFrac
509   readListPrec = readListPrecDefault
510   readList     = readListDefault
511
512 instance Read Double where
513   readPrec     = readNumber convertFrac
514   readListPrec = readListPrecDefault
515   readList     = readListDefault
516
517 instance (Integral a, Read a) => Read (Ratio a) where
518   readPrec =
519     parens
520     ( prec ratioPrec
521       ( do x            <- step readPrec
522            L.Symbol "%" <- lexP
523            y            <- step readPrec
524            return (x % y)
525       )
526     )
527
528   readListPrec = readListPrecDefault
529   readList     = readListDefault
530 \end{code}
531
532
533 %*********************************************************
534 %*                                                      *
535 \subsection{Tuple instances of Read}
536 %*                                                      *
537 %*********************************************************
538
539 \begin{code}
540 instance Read () where
541   readPrec =
542     parens
543     ( paren
544       ( return ()
545       )
546     )
547
548   readListPrec = readListPrecDefault
549   readList     = readListDefault
550
551 instance (Read a, Read b) => Read (a,b) where
552   readPrec =
553     parens
554     ( paren
555       ( do x <- readPrec
556            L.Punc "," <- lexP
557            y <- readPrec
558            return (x,y)
559       )
560     )
561
562   readListPrec = readListPrecDefault
563   readList     = readListDefault
564
565
566 instance (Read a, Read b, Read c) => Read (a, b, c) where
567   readPrec =
568     parens
569     ( paren
570       ( do x <- readPrec
571            L.Punc "," <- lexP
572            y <- readPrec
573            L.Punc "," <- lexP
574            z <- readPrec
575            return (x,y,z)
576       )
577     )
578
579   readListPrec = readListPrecDefault
580   readList     = readListDefault
581
582 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
583   readPrec =
584     parens
585     ( paren
586       ( do w <- readPrec
587            L.Punc "," <- lexP
588            x <- readPrec
589            L.Punc "," <- lexP
590            y <- readPrec
591            L.Punc "," <- lexP
592            z <- readPrec
593            return (w,x,y,z)
594       )
595     )
596
597   readListPrec = readListPrecDefault
598   readList     = readListDefault
599
600 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
601   readPrec =
602     parens
603     ( paren
604       ( do v <- readPrec
605            L.Punc "," <- lexP
606            w <- readPrec
607            L.Punc "," <- lexP
608            x <- readPrec
609            L.Punc "," <- lexP
610            y <- readPrec
611            L.Punc "," <- lexP
612            z <- readPrec
613            return (v,w,x,y,z)
614       )
615     )
616
617   readListPrec = readListPrecDefault
618   readList     = readListDefault
619 \end{code}