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