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