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' '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}