GHC/Read.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: Read.lhs,v 1.5 2002/04/13 05:08:55 sof 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 = readP_to_S (do { lexeme <- L.lex ;
 172                        return (show lexeme) })
 173
 174 lexLitChar :: ReadS String      -- As defined by H98
 175 lexLitChar = readP_to_S (do { lexeme <- L.lexLitChar ;
 176                               return (show lexeme) })
 177
 178 readLitChar :: ReadS Char       -- As defined by H98
 179 readLitChar = readP_to_S (do { Char c <- L.lexLitChar ;
 180                                return c })
 181
 182 lexDigits :: ReadS String
 183 lexDigits = readP_to_S (P.munch1 isDigit)
 184
 185 ------------------------------------------------------------------------
 186 -- utility parsers
 187
 188 lexP :: ReadPrec Lexeme
 189 lexP = lift L.lex
 190
 191 paren :: ReadPrec a -> ReadPrec a
 192 -- (paren p) parses (P0)
 193 --      where p parses P0 in precedence context zero
 194 paren p =
 195   do Single '(' <- lexP
 196      x          <- reset p
 197      Single ')' <- lexP
 198      return x
 199
 200 parens :: ReadPrec a -> ReadPrec a
 201 -- (parens p) parses P, (P0), ((P0)), etc,
 202 --      where p parses P  in the current precedence context
 203 --              parses P0 in precedence context zero
 204 parens p = optional
 205  where
 206   optional  = p +++ mandatory
 207   mandatory = paren optional
 208
 209 list :: ReadPrec a -> ReadPrec [a]
 210 list readx =
 211   parens
 212   ( do Single '[' <- lexP
 213        (listRest False +++ listNext)
 214   )
 215  where
 216   listRest started =
 217     do Single c <- lexP
 218        case c of
 219          ']'           -> return []
 220          ',' | started -> listNext
 221          _             -> pfail
 222
 223   listNext =
 224     do x  <- reset readx
 225        xs <- listRest True
 226        return (x:xs)
 227
 228 choose :: [(String, ReadPrec a)] -> ReadPrec a
 229 -- Parse the specified lexeme and continue as specified
 230 -- Esp useful for nullary constructors
 231 choose sps = foldr ((+++) . try_one) pfail sps
 232            where
 233              try_one (s,p) = do { Ident s' <- lexP ;
 234                                   if s == s' then p else pfail }
 235 \end{code}
 236
 237
 238 %*********************************************************
 239 %*                                                      *
 240 \subsection{Simple instances of Read}
 241 %*                                                      *
 242 %*********************************************************
 243
 244 \begin{code}
 245 instance Read Char where
 246   readPrec =
 247     parens
 248     ( do Char c <- lexP
 249          return c
 250     )
 251
 252   readListPrec =
 253     parens
 254     ( do String s <- lexP       -- Looks for "foo"
 255          return s
 256      +++
 257       readListPrecDefault       -- Looks for ['f','o','o']
 258     )                           -- (more generous than H98 spec)
 259
 260   readList = readListDefault
 261
 262 instance Read Bool where
 263   readPrec =
 264     parens
 265     ( do Ident s <- lexP
 266          case s of
 267            "True"  -> return True
 268            "False" -> return False
 269            _       -> pfail
 270     )
 271
 272   readListPrec = readListPrecDefault
 273   readList     = readListDefault
 274
 275 instance Read Ordering where
 276   readPrec =
 277     parens
 278     ( do Ident s <- lexP
 279          case s of
 280            "LT" -> return LT
 281            "EQ" -> return EQ
 282            "GT" -> return GT
 283            _    -> pfail
 284     )
 285
 286   readListPrec = readListPrecDefault
 287   readList     = readListDefault
 288 \end{code}
 289
 290
 291 %*********************************************************
 292 %*                                                      *
 293 \subsection{Structure instances of Read: Maybe, List etc}
 294 %*                                                      *
 295 %*********************************************************
 296
 297 For structured instances of Read we start using the precedences.  The
 298 idea is then that 'parens (prec k p)' will fail immediately when trying
 299 to parse it in a context with a higher precedence level than k. But if
 300 there is one parenthesis parsed, then the required precedence level
 301 drops to 0 again, and parsing inside p may succeed.
 302
 303 'appPrec' is just the precedence level of function application (maybe
 304 it should be called 'appPrec' instead).  So, if we are parsing
 305 function application, we'd better require the precedence level to be
 306 at least 'appPrec'. Otherwise, we have to put parentheses around it.
 307
 308 'step' is used to increase the precedence levels inside a
 309 parser, and can be used to express left- or right- associativity. For
 310 example, % is defined to be left associative, so we only increase
 311 precedence on the right hand side.
 312
 313 Note how step is used in for example the Maybe parser to increase the
 314 precedence beyond appPrec, so that basically only literals and
 315 parenthesis-like objects such as (...) and [...] can be an argument to
 316 'Just'.
 317
 318 \begin{code}
 319 instance Read a => Read (Maybe a) where
 320   readPrec =
 321     parens
 322     ( prec appPrec
 323       ( do Ident "Nothing" <- lexP
 324            return Nothing
 325        +++
 326         do Ident "Just" <- lexP
 327            x            <- step readPrec
 328            return (Just x)
 329       )
 330     )
 331
 332   readListPrec = readListPrecDefault
 333   readList     = readListDefault
 334
 335 instance (Read a, Read b) => Read (Either a b) where
 336   readPrec =
 337     parens
 338     ( prec appPrec
 339       ( do Ident "Left" <- lexP
 340            x            <- step readPrec
 341            return (Left x)
 342        +++
 343         do Ident "Right" <- lexP
 344            y             <- step readPrec
 345            return (Right y)
 346       )
 347     )
 348
 349   readListPrec = readListPrecDefault
 350   readList     = readListDefault
 351
 352 instance Read a => Read [a] where
 353   readPrec     = readListPrec
 354   readListPrec = readListPrecDefault
 355   readList     = readListDefault
 356
 357 instance Read Lexeme where
 358   readPrec     = lexP
 359   readListPrec = readListPrecDefault
 360   readList     = readListDefault
 361 \end{code}
 362
 363
 364 %*********************************************************
 365 %*                                                      *
 366 \subsection{Numeric instances of Read}
 367 %*                                                      *
 368 %*********************************************************
 369
 370 \begin{code}
 371 readNumber :: Num a => (Number -> Maybe a) -> ReadPrec a
 372 -- Read a signed number
 373 readNumber convert =
 374   parens
 375   ( do x <- lexP
 376        case x of
 377          Symbol "-" -> do n <- readNumber convert
 378                           return (negate n)
 379
 380          Number y   -> case convert y of
 381                          Just n  -> return n
 382                          Nothing -> pfail
 383
 384          _          -> pfail
 385   )
 386
 387 readIEEENumber :: (RealFloat a) => (Number -> Maybe a) -> ReadPrec a
 388 -- Read a Float/Double.
 389 readIEEENumber convert =
 390   parens
 391   ( do x <- lexP
 392        case x of
 393          Ident "NaN"      -> return (0/0)
 394          Ident "Infinity" -> return (1/0)
 395          Symbol "-" -> do n <- readIEEENumber convert
 396                           return (negate n)
 397
 398          Number y   -> case convert y of
 399                          Just n  -> return n
 400                          Nothing -> pfail
 401
 402          _          -> pfail
 403   )
 404
 405 instance Read Int where
 406   readPrec     = readNumber numberToInt
 407   readListPrec = readListPrecDefault
 408   readList     = readListDefault
 409
 410 instance Read Integer where
 411   readPrec     = readNumber numberToInteger
 412   readListPrec = readListPrecDefault
 413   readList     = readListDefault
 414
 415 instance Read Float where
 416   readPrec     = readIEEENumber numberToFloat
 417   readListPrec = readListPrecDefault
 418   readList     = readListDefault
 419
 420 instance Read Double where
 421   readPrec     = readIEEENumber numberToDouble
 422   readListPrec = readListPrecDefault
 423   readList     = readListDefault
 424
 425 instance (Integral a, Read a) => Read (Ratio a) where
 426   readPrec =
 427     parens
 428     ( prec ratioPrec
 429       ( do x          <- step readPrec
 430            Symbol "%" <- lexP
 431            y          <- step readPrec
 432            return (x % y)
 433       )
 434     )
 435
 436   readListPrec = readListPrecDefault
 437   readList     = readListDefault
 438 \end{code}
 439
 440
 441 %*********************************************************
 442 %*                                                      *
 443 \subsection{Tuple instances of Read}
 444 %*                                                      *
 445 %*********************************************************
 446
 447 \begin{code}
 448 instance Read () where
 449   readPrec =
 450     parens
 451     ( paren
 452       ( return ()
 453       )
 454     )
 455
 456   readListPrec = readListPrecDefault
 457   readList     = readListDefault
 458
 459 instance (Read a, Read b) => Read (a,b) where
 460   readPrec =
 461     parens
 462     ( paren
 463       ( do x <- readPrec
 464            Single ',' <- lexP
 465            y <- readPrec
 466            return (x,y)
 467       )
 468     )
 469
 470   readListPrec = readListPrecDefault
 471   readList     = readListDefault
 472
 473
 474 instance (Read a, Read b, Read c) => Read (a, b, c) where
 475   readPrec =
 476     parens
 477     ( paren
 478       ( do x <- readPrec
 479            Single ',' <- lexP
 480            y <- readPrec
 481            Single ',' <- lexP
 482            z <- readPrec
 483            return (x,y,z)
 484       )
 485     )
 486
 487   readListPrec = readListPrecDefault
 488   readList     = readListDefault
 489
 490 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
 491   readPrec =
 492     parens
 493     ( paren
 494       ( do w <- readPrec
 495            Single ',' <- lexP
 496            x <- readPrec
 497            Single ',' <- lexP
 498            y <- readPrec
 499            Single ',' <- lexP
 500            z <- readPrec
 501            return (w,x,y,z)
 502       )
 503     )
 504
 505   readListPrec = readListPrecDefault
 506   readList     = readListDefault
 507
 508 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
 509   readPrec =
 510     parens
 511     ( paren
 512       ( do v <- readPrec
 513            Single ',' <- lexP
 514            w <- readPrec
 515            Single ',' <- lexP
 516            x <- readPrec
 517            Single ',' <- lexP
 518            y <- readPrec
 519            Single ',' <- lexP
 520            z <- readPrec
 521            return (v,w,x,y,z)
 522       )
 523     )
 524
 525   readListPrec = readListPrecDefault
 526   readList     = readListDefault
 527 \end{code}