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 -- | A parser for a type @a@, represented as a function that takes a
 124 -- 'String' and returns a list of possible parses @(a,'String')@ pairs.
 125 type ReadS a = String -> [(a,String)]
 126
 127 ------------------------------------------------------------------------
 128 -- class Read
 129
 130 class Read a where
 131   readsPrec    :: Int -> ReadS a
 132   readList     :: ReadS [a]
 133   readPrec     :: ReadPrec a
 134   readListPrec :: ReadPrec [a]
 135
 136   -- default definitions
 137   readsPrec    = readPrec_to_S readPrec
 138   readList     = readPrec_to_S (list readPrec) 0
 139   readPrec     = readS_to_Prec readsPrec
 140   readListPrec = readS_to_Prec (\_ -> readList)
 141
 142 readListDefault :: Read a => ReadS [a]
 143 readListDefault = readPrec_to_S readListPrec 0
 144
 145 readListPrecDefault :: Read a => ReadPrec [a]
 146 readListPrecDefault = list readPrec
 147
 148 ------------------------------------------------------------------------
 149 -- utility functions
 150
 151 reads :: Read a => ReadS a
 152 reads = readsPrec minPrec
 153
 154 readp :: Read a => ReadP a
 155 readp = readPrec_to_P readPrec minPrec
 156
 157 readEither :: Read a => String -> Either String a
 158 readEither s =
 159   case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
 160     [x] -> Right x
 161     []  -> Left "Prelude.read: no parse"
 162     _   -> Left "Prelude.read: ambiguous parse"
 163  where
 164   read' =
 165     do x <- readPrec
 166        lift P.skipSpaces
 167        return x
 168
 169 read :: Read a => String -> a
 170 read s = either error id (readEither s)
 171
 172 ------------------------------------------------------------------------
 173 -- H98 compatibility
 174
 175 lex :: ReadS String             -- As defined by H98
 176 lex "" = [("","")] -- ugly hack
 177 lex s  = readP_to_S (do { lexeme <- L.lex ;
 178                           return (show lexeme) }) s
 179
 180 lexLitChar :: ReadS String      -- As defined by H98
 181 lexLitChar = readP_to_S (do { lexeme <- L.lexLitChar ;
 182                               return (show lexeme) })
 183
 184 readLitChar :: ReadS Char       -- As defined by H98
 185 readLitChar = readP_to_S (do { Char c <- L.lexLitChar ;
 186                                return c })
 187
 188 lexDigits :: ReadS String
 189 lexDigits = readP_to_S (P.munch1 isDigit)
 190
 191 ------------------------------------------------------------------------
 192 -- utility parsers
 193
 194 lexP :: ReadPrec Lexeme
 195 lexP = lift L.lex
 196
 197 paren :: ReadPrec a -> ReadPrec a
 198 -- (paren p) parses (P0)
 199 --      where p parses P0 in precedence context zero
 200 paren p =
 201   do Single '(' <- lexP
 202      x          <- reset p
 203      Single ')' <- lexP
 204      return x
 205
 206 parens :: ReadPrec a -> ReadPrec a
 207 -- (parens p) parses P, (P0), ((P0)), etc,
 208 --      where p parses P  in the current precedence context
 209 --              parses P0 in precedence context zero
 210 parens p = optional
 211  where
 212   optional  = p +++ mandatory
 213   mandatory = paren optional
 214
 215 list :: ReadPrec a -> ReadPrec [a]
 216 list readx =
 217   parens
 218   ( do Single '[' <- lexP
 219        (listRest False +++ listNext)
 220   )
 221  where
 222   listRest started =
 223     do Single 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
 237 choose sps = foldr ((+++) . try_one) pfail sps
 238            where
 239              try_one (s,p) = do { Ident s' <- lexP ;
 240                                   if s == s' then p else pfail }
 241 \end{code}
 242
 243
 244 %*********************************************************
 245 %*                                                      *
 246 \subsection{Simple instances of Read}
 247 %*                                                      *
 248 %*********************************************************
 249
 250 \begin{code}
 251 instance Read Char where
 252   readPrec =
 253     parens
 254     ( do Char c <- lexP
 255          return c
 256     )
 257
 258   readListPrec =
 259     parens
 260     ( do String s <- lexP       -- Looks for "foo"
 261          return s
 262      +++
 263       readListPrecDefault       -- Looks for ['f','o','o']
 264     )                           -- (more generous than H98 spec)
 265
 266   readList = readListDefault
 267
 268 instance Read Bool where
 269   readPrec =
 270     parens
 271     ( do Ident s <- lexP
 272          case s of
 273            "True"  -> return True
 274            "False" -> return False
 275            _       -> pfail
 276     )
 277
 278   readListPrec = readListPrecDefault
 279   readList     = readListDefault
 280
 281 instance Read Ordering where
 282   readPrec =
 283     parens
 284     ( do Ident s <- lexP
 285          case s of
 286            "LT" -> return LT
 287            "EQ" -> return EQ
 288            "GT" -> return GT
 289            _    -> pfail
 290     )
 291
 292   readListPrec = readListPrecDefault
 293   readList     = readListDefault
 294 \end{code}
 295
 296
 297 %*********************************************************
 298 %*                                                      *
 299 \subsection{Structure instances of Read: Maybe, List etc}
 300 %*                                                      *
 301 %*********************************************************
 302
 303 For structured instances of Read we start using the precedences.  The
 304 idea is then that 'parens (prec k p)' will fail immediately when trying
 305 to parse it in a context with a higher precedence level than k. But if
 306 there is one parenthesis parsed, then the required precedence level
 307 drops to 0 again, and parsing inside p may succeed.
 308
 309 'appPrec' is just the precedence level of function application (maybe
 310 it should be called 'appPrec' instead).  So, if we are parsing
 311 function application, we'd better require the precedence level to be
 312 at least 'appPrec'. Otherwise, we have to put parentheses around it.
 313
 314 'step' is used to increase the precedence levels inside a
 315 parser, and can be used to express left- or right- associativity. For
 316 example, % is defined to be left associative, so we only increase
 317 precedence on the right hand side.
 318
 319 Note how step is used in for example the Maybe parser to increase the
 320 precedence beyond appPrec, so that basically only literals and
 321 parenthesis-like objects such as (...) and [...] can be an argument to
 322 'Just'.
 323
 324 \begin{code}
 325 instance Read a => Read (Maybe a) where
 326   readPrec =
 327     parens
 328     ( prec appPrec
 329       ( do Ident "Nothing" <- lexP
 330            return Nothing
 331        +++
 332         do Ident "Just" <- lexP
 333            x            <- step readPrec
 334            return (Just x)
 335       )
 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 Ident "Left" <- lexP
 346            x            <- step readPrec
 347            return (Left x)
 348        +++
 349         do 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 Read Lexeme where
 364   readPrec     = lexP
 365   readListPrec = readListPrecDefault
 366   readList     = readListDefault
 367 \end{code}
 368
 369
 370 %*********************************************************
 371 %*                                                      *
 372 \subsection{Numeric instances of Read}
 373 %*                                                      *
 374 %*********************************************************
 375
 376 \begin{code}
 377 readNumber :: Num a => (Number -> Maybe a) -> ReadPrec a
 378 -- Read a signed number
 379 readNumber convert =
 380   parens
 381   ( do x <- lexP
 382        case x of
 383          Symbol "-" -> do n <- readNumber convert
 384                           return (negate n)
 385
 386          Number y   -> case convert y of
 387                          Just n  -> return n
 388                          Nothing -> pfail
 389
 390          _          -> pfail
 391   )
 392
 393 readIEEENumber :: (RealFloat a) => (Number -> Maybe a) -> ReadPrec a
 394 -- Read a Float/Double.
 395 readIEEENumber convert =
 396   parens
 397   ( do x <- lexP
 398        case x of
 399          Ident "NaN"      -> return (0/0)
 400          Ident "Infinity" -> return (1/0)
 401          Symbol "-" -> do n <- readIEEENumber convert
 402                           return (negate n)
 403
 404          Number y   -> case convert y of
 405                          Just n  -> return n
 406                          Nothing -> pfail
 407
 408          _          -> pfail
 409   )
 410
 411 instance Read Int where
 412   readPrec     = readNumber numberToInt
 413   readListPrec = readListPrecDefault
 414   readList     = readListDefault
 415
 416 instance Read Integer where
 417   readPrec     = readNumber numberToInteger
 418   readListPrec = readListPrecDefault
 419   readList     = readListDefault
 420
 421 instance Read Float where
 422   readPrec     = readIEEENumber numberToFloat
 423   readListPrec = readListPrecDefault
 424   readList     = readListDefault
 425
 426 instance Read Double where
 427   readPrec     = readIEEENumber numberToDouble
 428   readListPrec = readListPrecDefault
 429   readList     = readListDefault
 430
 431 instance (Integral a, Read a) => Read (Ratio a) where
 432   readPrec =
 433     parens
 434     ( prec ratioPrec
 435       ( do x          <- step readPrec
 436            Symbol "%" <- lexP
 437            y          <- step readPrec
 438            return (x % y)
 439       )
 440     )
 441
 442   readListPrec = readListPrecDefault
 443   readList     = readListDefault
 444 \end{code}
 445
 446
 447 %*********************************************************
 448 %*                                                      *
 449 \subsection{Tuple instances of Read}
 450 %*                                                      *
 451 %*********************************************************
 452
 453 \begin{code}
 454 instance Read () where
 455   readPrec =
 456     parens
 457     ( paren
 458       ( return ()
 459       )
 460     )
 461
 462   readListPrec = readListPrecDefault
 463   readList     = readListDefault
 464
 465 instance (Read a, Read b) => Read (a,b) where
 466   readPrec =
 467     parens
 468     ( paren
 469       ( do x <- readPrec
 470            Single ',' <- lexP
 471            y <- readPrec
 472            return (x,y)
 473       )
 474     )
 475
 476   readListPrec = readListPrecDefault
 477   readList     = readListDefault
 478
 479
 480 instance (Read a, Read b, Read c) => Read (a, b, c) where
 481   readPrec =
 482     parens
 483     ( paren
 484       ( do x <- readPrec
 485            Single ',' <- lexP
 486            y <- readPrec
 487            Single ',' <- lexP
 488            z <- readPrec
 489            return (x,y,z)
 490       )
 491     )
 492
 493   readListPrec = readListPrecDefault
 494   readList     = readListDefault
 495
 496 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
 497   readPrec =
 498     parens
 499     ( paren
 500       ( do w <- readPrec
 501            Single ',' <- lexP
 502            x <- readPrec
 503            Single ',' <- lexP
 504            y <- readPrec
 505            Single ',' <- lexP
 506            z <- readPrec
 507            return (w,x,y,z)
 508       )
 509     )
 510
 511   readListPrec = readListPrecDefault
 512   readList     = readListDefault
 513
 514 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
 515   readPrec =
 516     parens
 517     ( paren
 518       ( do v <- readPrec
 519            Single ',' <- lexP
 520            w <- readPrec
 521            Single ',' <- lexP
 522            x <- readPrec
 523            Single ',' <- lexP
 524            y <- readPrec
 525            Single ',' <- lexP
 526            z <- readPrec
 527            return (v,w,x,y,z)
 528       )
 529     )
 530
 531   readListPrec = readListPrecDefault
 532   readList     = readListDefault
 533 \end{code}