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