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