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