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