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