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