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