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