GHC/Read.lhs

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