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