GHC/Read.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: Read.lhs,v 1.4 2002/04/11 12:03:44 simonpj 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 instance Read Int where
 388   readPrec     = readNumber numberToInt
 389   readListPrec = readListPrecDefault
 390   readList     = readListDefault
 391
 392 instance Read Integer where
 393   readPrec     = readNumber numberToInteger
 394   readListPrec = readListPrecDefault
 395   readList     = readListDefault
 396
 397 instance Read Float where
 398   readPrec     = readNumber numberToFloat
 399   readListPrec = readListPrecDefault
 400   readList     = readListDefault
 401
 402 instance Read Double where
 403   readPrec     = readNumber numberToDouble
 404   readListPrec = readListPrecDefault
 405   readList     = readListDefault
 406
 407 instance (Integral a, Read a) => Read (Ratio a) where
 408   readPrec =
 409     parens
 410     ( prec ratioPrec
 411       ( do x          <- step readPrec
 412            Symbol "%" <- lexP
 413            y          <- step readPrec
 414            return (x % y)
 415       )
 416     )
 417
 418   readListPrec = readListPrecDefault
 419   readList     = readListDefault
 420 \end{code}
 421
 422
 423 %*********************************************************
 424 %*                                                      *
 425 \subsection{Tuple instances of Read}
 426 %*                                                      *
 427 %*********************************************************
 428
 429 \begin{code}
 430 instance Read () where
 431   readPrec =
 432     parens
 433     ( paren
 434       ( return ()
 435       )
 436     )
 437
 438   readListPrec = readListPrecDefault
 439   readList     = readListDefault
 440
 441 instance (Read a, Read b) => Read (a,b) where
 442   readPrec =
 443     parens
 444     ( paren
 445       ( do x <- readPrec
 446            Single ',' <- lexP
 447            y <- readPrec
 448            return (x,y)
 449       )
 450     )
 451
 452   readListPrec = readListPrecDefault
 453   readList     = readListDefault
 454
 455
 456 instance (Read a, Read b, Read c) => Read (a, b, c) where
 457   readPrec =
 458     parens
 459     ( paren
 460       ( do x <- readPrec
 461            Single ',' <- lexP
 462            y <- readPrec
 463            Single ',' <- lexP
 464            z <- readPrec
 465            return (x,y,z)
 466       )
 467     )
 468
 469   readListPrec = readListPrecDefault
 470   readList     = readListDefault
 471
 472 instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
 473   readPrec =
 474     parens
 475     ( paren
 476       ( do w <- readPrec
 477            Single ',' <- lexP
 478            x <- readPrec
 479            Single ',' <- lexP
 480            y <- readPrec
 481            Single ',' <- lexP
 482            z <- readPrec
 483            return (w,x,y,z)
 484       )
 485     )
 486
 487   readListPrec = readListPrecDefault
 488   readList     = readListDefault
 489
 490 instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
 491   readPrec =
 492     parens
 493     ( paren
 494       ( do v <- readPrec
 495            Single ',' <- lexP
 496            w <- readPrec
 497            Single ',' <- lexP
 498            x <- readPrec
 499            Single ',' <- lexP
 500            y <- readPrec
 501            Single ',' <- lexP
 502            z <- readPrec
 503            return (v,w,x,y,z)
 504       )
 505     )
 506
 507   readListPrec = readListPrecDefault
 508   readList     = readListDefault
 509 \end{code}