X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=GHC%2FRead.lhs;h=1e213b5cde36d0bb9c9fb335a73c5cc624ebb65d;hb=3868c8ecba9479ffb24063cb3972cea960a7d1e4;hp=8296da5e712d758bf9fa2c630d56d4a2e639fe36;hpb=854c0d47341b2804aa90c432b14b223cb51ec0a1;p=ghc-base.git diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 8296da5..1e213b5 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : GHC.Read --- Copyright : (c) The FFI Task Force, 1994-2002 +-- Copyright : (c) The University of Glasgow, 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org @@ -41,7 +41,6 @@ module GHC.Read , readListDefault, readListPrecDefault -- Temporary - , readList__ , readParen ) where @@ -50,8 +49,8 @@ import qualified Text.ParserCombinators.ReadP as P import Text.ParserCombinators.ReadP ( ReadP + , ReadS , readP_to_S - , readS_to_P ) import qualified Text.Read.Lex as L @@ -66,22 +65,22 @@ import Data.Maybe import Data.Either import {-# SOURCE #-} GHC.Err ( error ) +#ifndef __HADDOCK__ +import {-# SOURCE #-} GHC.Unicode ( isDigit ) +#endif import GHC.Num import GHC.Real import GHC.Float import GHC.List -import GHC.Show -- isAlpha etc +import GHC.Show import GHC.Base import GHC.Arr - -ratioPrec = 7 -- Precedence of ':%' constructor -appPrec = 10 -- Precedence of applictaion \end{code} -------------------------------------------------------- - TEMPORARY UNTIL I DO DERIVED READ + \begin{code} readParen :: Bool -> ReadS a -> ReadS a +-- A Haskell 98 function readParen b g = if b then mandatory else optional where optional r = g r ++ mandatory r mandatory r = do @@ -89,45 +88,25 @@ readParen b g = if b then mandatory else optional (x,t) <- optional s (")",u) <- lex t return (x,u) - - -readList__ :: ReadS a -> ReadS [a] - -readList__ readx - = readParen False (\r -> do - ("[",s) <- lex r - readl s) - where readl s = - (do { ("]",t) <- lex s ; return ([],t) }) ++ - (do { (x,t) <- readx s ; (xs,u) <- readl2 t ; return (x:xs,u) }) - - readl2 s = - (do { ("]",t) <- lex s ; return ([],t) }) ++ - (do { (",",t) <- lex s ; (x,u) <- readx t ; (xs,v) <- readl2 u ; return (x:xs,v) }) \end{code} %********************************************************* %* * -\subsection{The @Read@ class and @ReadS@ type} +\subsection{The @Read@ class} %* * %********************************************************* \begin{code} ------------------------------------------------------------------------ --- ReadS - --- | A parser for a type @a@, represented as a function that takes a --- 'String' and returns a list of possible parses @(a,'String')@ pairs. -type ReadS a = String -> [(a,String)] - ------------------------------------------------------------------------- -- class Read class Read a where readsPrec :: Int -> ReadS a readList :: ReadS [a] + -- | Proposed replacement for 'readsPrec' using new-style parsers (GHC only). readPrec :: ReadPrec a + -- | Proposed replacement for 'readList' using new-style parsers (GHC only). readListPrec :: ReadPrec [a] -- default definitions @@ -137,13 +116,13 @@ class Read a where readListPrec = readS_to_Prec (\_ -> readList) readListDefault :: Read a => ReadS [a] --- ^ Use this to define the 'readList' method, if you --- don't want a special case +-- ^ Use this to define the 'readList' method, if you don't want a special +-- case (GHC only; for other systems the default suffices). readListDefault = readPrec_to_S readListPrec 0 readListPrecDefault :: Read a => ReadPrec [a] -- ^ Use this to define the 'readListPrec' method, if you --- don't want a special case +-- don't want a special case (GHC only). readListPrecDefault = list readPrec ------------------------------------------------------------------------ @@ -176,15 +155,27 @@ read s = either error id (readEither s) lex :: ReadS String -- As defined by H98 lex s = readP_to_S L.hsLex s +-- | Read a string representation of a character, using Haskell +-- source-language escape conventions. For example: +-- +-- > lexLitChar "\\nHello" = [("\\n", "Hello")] +-- lexLitChar :: ReadS String -- As defined by H98 -lexLitChar = readP_to_S (do { P.skipSpaces ; - (s, L.Char _) <- P.gather L.lex ; +lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ; return s }) + -- There was a skipSpaces before the P.gather L.lexChar, + -- but that seems inconsistent with readLitChar +-- | Read a string representation of a character, using Haskell +-- source-language escape conventions, and convert it to the character +-- that it encodes. For example: +-- +-- > readLitChar "\\nHello" = [('\n', "Hello")] +-- readLitChar :: ReadS Char -- As defined by H98 -readLitChar = readP_to_S (do { L.Char c <- L.lex ; - return c }) +readLitChar = readP_to_S L.lexChar +-- | Reads a non-empty string of decimal digits. lexDigits :: ReadS String lexDigits = readP_to_S (P.munch1 isDigit) @@ -196,17 +187,17 @@ lexP :: ReadPrec L.Lexeme lexP = lift L.lex paren :: ReadPrec a -> ReadPrec a --- ^ @(paren p)@ parses "(P0)" --- where @p@ parses "P0" in precedence context zero +-- ^ @(paren p)@ parses \"(P0)\" +-- where @p@ parses \"P0\" in precedence context zero paren p = do L.Punc "(" <- lexP x <- reset p L.Punc ")" <- lexP return x parens :: ReadPrec a -> ReadPrec a --- ^ @(parens p)@ parses "P", "(P0)", "((P0))", etc, --- where @p@ parses "P" in the current precedence context --- parses "P0" in precedence context zero +-- ^ @(parens p)@ parses \"P\", \"(P0)\", \"((P0))\", etc, +-- where @p@ parses \"P\" in the current precedence context +-- parses \"P0\" in precedence context zero parens p = optional where optional = p +++ mandatory @@ -236,7 +227,7 @@ list readx = choose :: [(String, ReadPrec a)] -> ReadPrec a -- ^ Parse the specified lexeme and continue as specified. -- Esp useful for nullary constructors; e.g. --- @choose [("A", return A), ("B", return B)]@ +-- @choose [(\"A\", return A), (\"B\", return B)]@ choose sps = foldr ((+++) . try_one) pfail sps where try_one (s,p) = do { L.Ident s' <- lexP ; @@ -309,10 +300,10 @@ to parse it in a context with a higher precedence level than k. But if there is one parenthesis parsed, then the required precedence level drops to 0 again, and parsing inside p may succeed. -'appPrec' is just the precedence level of function application (maybe -it should be called 'appPrec' instead). So, if we are parsing -function application, we'd better require the precedence level to be -at least 'appPrec'. Otherwise, we have to put parentheses around it. +'appPrec' is just the precedence level of function application. So, +if we are parsing function application, we'd better require the +precedence level to be at least 'appPrec'. Otherwise, we have to put +parentheses around it. 'step' is used to increase the precedence levels inside a parser, and can be used to express left- or right- associativity. For @@ -328,14 +319,13 @@ parenthesis-like objects such as (...) and [...] can be an argument to instance Read a => Read (Maybe a) where readPrec = parens - ( prec appPrec - ( do L.Ident "Nothing" <- lexP - return Nothing - +++ - do L.Ident "Just" <- lexP - x <- step readPrec - return (Just x) - ) + (do L.Ident "Nothing" <- lexP + return Nothing + +++ + prec appPrec ( + do L.Ident "Just" <- lexP + x <- step readPrec + return (Just x)) ) readListPrec = readListPrecDefault