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}