GHC/Read.lhs

   1 \begin{code}
   2 {-# OPTIONS -fno-implicit-prelude #-}
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  GHC.Read
   6 -- Copyright   :  (c) The University of Glasgow, 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   , readParen
  45   )
  46  where
  47
  48 import qualified Text.ParserCombinators.ReadP as P
  49
  50 import Text.ParserCombinators.ReadP
  51   ( ReadP
  52   , ReadS
  53   , readP_to_S
  54   )
  55
  56 import qualified Text.Read.Lex as L
  57 -- Lex exports 'lex', which is also defined here,
  58 -- hence the qualified import.
  59 -- We can't import *anything* unqualified, because that
  60 -- confuses Haddock.
  61
  62 import Text.ParserCombinators.ReadPrec
  63
  64 import Data.Maybe
  65 import Data.Either
  66
  67 import {-# SOURCE #-} GHC.Err           ( error )
  68 #ifndef __HADDOCK__
  69 import {-# SOURCE #-} GHC.Unicode       ( isDigit )
  70 #endif
  71 import GHC.Num
  72 import GHC.Real
  73 import GHC.Float
  74 import GHC.List
  75 import GHC.Show
  76 import GHC.Base
  77 import GHC.Arr
  78 \end{code}
  79
  80
  81 \begin{code}
  82 readParen       :: Bool -> ReadS a -> ReadS a
  83 -- A Haskell 98 function
  84 readParen b g   =  if b then mandatory else optional
  85                    where optional r  = g r ++ mandatory r
  86                          mandatory r = do
  87                                 ("(",s) <- lex r
  88                                 (x,t)   <- optional s
  89                                 (")",u) <- lex t
  90                                 return (x,u)
  91 \end{code}
  92
  93
  94 %*********************************************************
  95 %*                                                      *
  96 \subsection{The @Read@ class}
  97 %*                                                      *
  98 %*********************************************************
  99
 100 \begin{code}
 101 ------------------------------------------------------------------------
 102 -- class Read
 103
 104 class Read a where
 105   readsPrec    :: Int -> ReadS a
 106   readList     :: ReadS [a]
 107   -- | Proposed replacement for 'readsPrec' using new-style parsers (GHC only).
 108   readPrec     :: ReadPrec a
 109   -- | Proposed replacement for 'readList' using new-style parsers (GHC only).
 110   readListPrec :: ReadPrec [a]
 111
 112   -- default definitions
 113   readsPrec    = readPrec_to_S readPrec
 114   readList     = readPrec_to_S (list readPrec) 0
 115   readPrec     = readS_to_Prec readsPrec
 116   readListPrec = readS_to_Prec (\_ -> readList)
 117
 118 readListDefault :: Read a => ReadS [a]
 119 -- ^ Use this to define the 'readList' method, if you don't want a special
 120 --   case (GHC only; for other systems the default suffices).
 121 readListDefault = readPrec_to_S readListPrec 0
 122
 123 readListPrecDefault :: Read a => ReadPrec [a]
 124 -- ^ Use this to define the 'readListPrec' method, if you
 125 --   don't want a special case (GHC only).
 126 readListPrecDefault = list readPrec
 127
 128 ------------------------------------------------------------------------
 129 -- utility functions
 130
 131 reads :: Read a => ReadS a
 132 reads = readsPrec minPrec
 133
 134 readp :: Read a => ReadP a
 135 readp = readPrec_to_P readPrec minPrec
 136
 137 readEither :: Read a => String -> Either String a
 138 readEither s =
 139   case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
 140     [x] -> Right x
 141     []  -> Left "Prelude.read: no parse"
 142     _   -> Left "Prelude.read: ambiguous parse"
 143  where
 144   read' =
 145     do x <- readPrec
 146        lift P.skipSpaces
 147        return x
 148
 149 read :: Read a => String -> a
 150 read s = either error id (readEither s)
 151
 152 ------------------------------------------------------------------------
 153 -- H98 compatibility
 154
 155 lex :: ReadS String             -- As defined by H98
 156 lex s  = readP_to_S L.hsLex s
 157
 158 lexLitChar :: ReadS String      -- As defined by H98
 159 lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ;
 160                               return s })
 161         -- There was a skipSpaces before the P.gather L.lexChar,
 162         -- but that seems inconsistent with readLitChar
 163
 164 readLitChar :: ReadS Char       -- As defined by H98
 165 readLitChar = readP_to_S L.lexChar
 166
 167 lexDigits :: ReadS String
 168 lexDigits = readP_to_S (P.munch1 isDigit)
 169
 170 ------------------------------------------------------------------------
 171 -- utility parsers
 172
 173 lexP :: ReadPrec L.Lexeme
 174 -- ^ Parse a single lexeme
 175 lexP = lift L.lex
 176
 177 paren :: ReadPrec a -> ReadPrec a
 178 -- ^ @(paren p)@ parses \"(P0)\"
 179 --      where @p@ parses \"P0\" in precedence context zero
 180 paren p = do L.Punc "(" <- lexP
 181              x          <- reset p
 182              L.Punc ")" <- lexP
 183              return x
 184
 185 parens :: ReadPrec a -> ReadPrec a
 186 -- ^ @(parens p)@ parses \"P\", \"(P0)\", \"((P0))\", etc,
 187 --      where @p@ parses \"P\"  in the current precedence context
 188 --              parses \"P0\" in precedence context zero
 189 parens p = optional
 190  where
 191   optional  = p +++ mandatory
 192   mandatory = paren optional
 193
 194 list :: ReadPrec a -> ReadPrec [a]
 195 -- ^ @(list p)@ parses a list of things parsed by @p@,
 196 -- using the usual square-bracket syntax.
 197 list readx =
 198   parens
 199   ( do L.Punc "[" <- lexP
 200        (listRest False +++ listNext)
 201   )
 202  where
 203   listRest started =
 204     do L.Punc c <- lexP
 205        case c of
 206          "]"           -> return []
 207          "," | started -> listNext
 208          _             -> pfail
 209
 210   listNext =
 211     do x  <- reset readx
 212        xs <- listRest True
 213        return (x:xs)
 214
 215 choose :: [(String, ReadPrec a)] -> ReadPrec a
 216 -- ^ Parse the specified lexeme and continue as specified.
 217 -- Esp useful for nullary constructors; e.g.
 218 --    @choose [(\"A\", return A), (\"B\", return B)]@
 219 choose sps = foldr ((+++) . try_one) pfail sps
 220            where
 221              try_one (s,p) = do { L.Ident s' <- lexP ;
 222                                   if s == s' then p else pfail }
 223 \end{code}
 224
 225
 226 %*********************************************************
 227 %*                                                      *
 228 \subsection{Simple instances of Read}
 229 %*                                                      *
 230 %*********************************************************
 231
 232 \begin{code}
 233 instance Read Char where
 234   readPrec =
 235     parens
 236     ( do L.Char c <- lexP
 237          return c
 238     )
 239
 240   readListPrec =
 241     parens
 242     ( do L.String s <- lexP     -- Looks for "foo"
 243          return s
 244      +++
 245       readListPrecDefault       -- Looks for ['f','o','o']
 246     )                           -- (more generous than H98 spec)
 247
 248   readList = readListDefault
 249
 250 instance Read Bool where
 251   readPrec =
 252     parens
 253     ( do L.Ident s <- lexP
 254          case s of
 255            "True"  -> return True
 256            "False" -> return False
 257            _       -> pfail
 258     )
 259
 260   readListPrec = readListPrecDefault
 261   readList     = readListDefault
 262
 263 instance Read Ordering where
 264   readPrec =
 265     parens
 266     ( do L.Ident s <- lexP
 267          case s of
 268            "LT" -> return LT
 269            "EQ" -> return EQ
 270            "GT" -> return GT
 271            _    -> pfail
 272     )
 273
 274   readListPrec = readListPrecDefault
 275   readList     = readListDefault
 276 \end{code}
 277
 278
 279 %*********************************************************
 280 %*                                                      *
 281 \subsection{Structure instances of Read: Maybe, List etc}
 282 %*                                                      *
 283 %*********************************************************
 284
 285 For structured instances of Read we start using the precedences.  The
 286 idea is then that 'parens (prec k p)' will fail immediately when trying
 287 to parse it in a context with a higher precedence level than k. But if
 288 there is one parenthesis parsed, then the required precedence level
 289 drops to 0 again, and parsing inside p may succeed.
 290
 291 'appPrec' is just the precedence level of function application.  So,
 292 if we are parsing function application, we'd better require the
 293 precedence level to be at least 'appPrec'. Otherwise, we have to put
 294 parentheses around it.
 295
 296 'step' is used to increase the precedence levels inside a
 297 parser, and can be used to express left- or right- associativity. For
 298 example, % is defined to be left associative, so we only increase
 299 precedence on the right hand side.
 300
 301 Note how step is used in for example the Maybe parser to increase the
 302 precedence beyond appPrec, so that basically only literals and
 303 parenthesis-like objects such as (...) and [...] can be an argument to
 304 'Just'.
 305
 306 \begin{code}
 307 instance Read a => Read (Maybe a) where
 308   readPrec =
 309     parens
 310     (do L.Ident "Nothing" <- lexP
 311         return Nothing
 312      +++
 313      prec appPrec (
 314         do L.Ident "Just" <- lexP
 315            x              <- step readPrec
 316            return (Just x))
 317     )
 318
 319   readListPrec = readListPrecDefault
 320   readList     = readListDefault
 321
 322 instance (Read a, Read b) => Read (Either a b) where
 323   readPrec =
 324     parens
 325     ( prec appPrec
 326       ( do L.Ident "Left" <- lexP
 327            x            <- step readPrec
 328            return (Left x)
 329        +++
 330         do L.Ident "Right" <- lexP
 331            y             <- step readPrec
 332            return (Right y)
 333       )
 334     )
 335
 336   readListPrec = readListPrecDefault
 337   readList     = readListDefault
 338
 339 instance Read a => Read [a] where
 340   readPrec     = readListPrec
 341   readListPrec = readListPrecDefault
 342   readList     = readListDefault
 343
 344 instance  (Ix a, Read a, Read b) => Read (Array a b)  where
 345     readPrec = parens $ prec appPrec $
 346                do L.Ident "array" <- lexP
 347                   bounds <- step readPrec
 348                   vals   <- step readPrec
 349                   return (array bounds vals)
 350
 351     readListPrec = readListPrecDefault
 352     readList     = readListDefault
 353
 354 instance Read L.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 => (L.Lexeme -> Maybe a) -> ReadPrec a
 369 -- Read a signed number
 370 readNumber convert =
 371   parens
 372   ( do x <- lexP
 373        case x of
 374          L.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 => L.Lexeme -> Maybe a
 383 convertInt (L.Int i) = Just (fromInteger i)
 384 convertInt _         = Nothing
 385
 386 convertFrac :: Fractional a => L.Lexeme -> Maybe a
 387 convertFrac (L.Int i) = Just (fromInteger i)
 388 convertFrac (L.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            L.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            L.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            L.Punc "," <- lexP
 466            y <- readPrec
 467            L.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            L.Punc "," <- lexP
 482            x <- readPrec
 483            L.Punc "," <- lexP
 484            y <- readPrec
 485            L.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            L.Punc "," <- lexP
 500            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 (v,w,x,y,z)
 508       )
 509     )
 510
 511   readListPrec = readListPrecDefault
 512   readList     = readListDefault
 513 \end{code}