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