X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FRead.lhs;h=e24cbe5c00c52c4904015fcb941271b2e37ae52d;hb=49283ebbb8870082ed2da7f2f564ab890a248e5f;hp=a8240c60f11456c32240de5c4460207451ffd403;hpb=faa2f4ea42a9c81f9cb902ea815068c1041fe3c1;p=ghc-base.git diff --git a/GHC/Read.lhs b/GHC/Read.lhs index a8240c6..e24cbe5 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -1,15 +1,18 @@ -% ------------------------------------------------------------------------------ -% $Id: Read.lhs,v 1.5 2002/04/13 05:08:55 sof Exp $ -% -% (c) The University of Glasgow, 1994-2000 -% - -\section[GHC.Read]{Module @GHC.Read@} - -Instances of the Read class. - \begin{code} -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Read +-- Copyright : (c) The University of Glasgow, 1994-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- The 'Read' class and instances for basic data types. +-- +----------------------------------------------------------------------------- module GHC.Read ( Read(..) -- class @@ -35,9 +38,9 @@ module GHC.Read , parens -- :: ReadPrec a -> ReadPrec a , list -- :: ReadPrec a -> ReadPrec [a] , choose -- :: [(String, ReadPrec a)] -> ReadPrec a + , readListDefault, readListPrecDefault -- Temporary - , readList__ , readParen ) where @@ -46,20 +49,15 @@ 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 - -import Text.Read.Lex - ( Lexeme(..) - , Number(..) - , numberToInt - , numberToInteger - , numberToFloat - , numberToDouble - ) +-- Lex exports 'lex', which is also defined here, +-- hence the qualified import. +-- We can't import *anything* unqualified, because that +-- confuses Haddock. import Text.ParserCombinators.ReadPrec @@ -67,21 +65,27 @@ 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 - -ratioPrec = 7 -- Precedence of ':%' constructor -appPrec = 10 -- Precedence of applictaion +import GHC.Arr \end{code} -------------------------------------------------------- - TEMPORARY UNTIL I DO DERIVED READ + \begin{code} +-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with +-- parentheses. +-- +-- @'readParen' 'False' p@ parses what @p@ parses, but optionally +-- surrounded with parentheses. 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,43 +93,96 @@ 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 - -type ReadS a = String -> [(a,String)] - ------------------------------------------------------------------------- -- class Read +-- | Parsing of 'String's, producing values. +-- +-- Minimal complete definition: 'readsPrec' (or, for GHC only, 'readPrec') +-- +-- Derived instances of 'Read' make the following assumptions, which +-- derived instances of 'Text.Show.Show' obey: +-- +-- * If the constructor is defined to be an infix operator, then the +-- derived 'Read' instance will parse only infix applications of +-- the constructor (not the prefix form). +-- +-- * Associativity is not used to reduce the occurrence of parentheses, +-- although precedence may be. +-- +-- * If the constructor is defined using record syntax, the derived 'Read' +-- will parse only the record-syntax form, and furthermore, the fields +-- must be given in the same order as the original declaration. +-- +-- * The derived 'Read' instance allows arbitrary Haskell whitespace +-- between tokens of the input string. Extra parentheses are also +-- allowed. +-- +-- For example, given the declarations +-- +-- > infixr 5 :^: +-- > data Tree a = Leaf a | Tree a :^: Tree a +-- +-- the derived instance of 'Read' is equivalent to +-- +-- > instance (Read a) => Read (Tree a) where +-- > +-- > readsPrec d r = readParen (d > up_prec) +-- > (\r -> [(u:^:v,w) | +-- > (u,s) <- readsPrec (up_prec+1) r, +-- > (":^:",t) <- lex s, +-- > (v,w) <- readsPrec (up_prec+1) t]) r +-- > +-- > ++ readParen (d > app_prec) +-- > (\r -> [(Leaf m,t) | +-- > ("Leaf",s) <- lex r, +-- > (m,t) <- readsPrec (app_prec+1) s]) r +-- > +-- > where up_prec = 5 +-- > app_prec = 10 +-- +-- Note that right-associativity of @:^:@ is unused. + class Read a where - readsPrec :: Int -> ReadS a + -- | attempts to parse a value from the front of the string, returning + -- a list of (parsed value, remaining string) pairs. If there is no + -- successful parse, the returned list is empty. + -- + -- Derived instances of 'Read' and 'Text.Show.Show' satisfy the following: + -- + -- * @(x,\"\")@ is an element of + -- @('readsPrec' d ('Text.Show.showsPrec' d x \"\"))@. + -- + -- That is, 'readsPrec' parses the string produced by + -- 'Text.Show.showsPrec', and delivers the value that + -- 'Text.Show.showsPrec' started with. + + readsPrec :: Int -- ^ the operator precedence of the enclosing + -- context (a number from @0@ to @11@). + -- Function application has precedence @10@. + -> ReadS a + + -- | The method 'readList' is provided to allow the programmer to + -- give a specialised way of parsing lists of values. + -- For example, this is used by the predefined 'Read' instance of + -- the 'Char' type, where values of type 'String' should be are + -- expected to use double quotes, rather than square brackets. 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 @@ -135,14 +192,19 @@ 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 (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 (GHC only). readListPrecDefault = list readPrec ------------------------------------------------------------------------ -- utility functions +-- | equivalent to 'readsPrec' with a precedence of 0. reads :: Read a => ReadS a reads = readsPrec minPrec @@ -161,63 +223,94 @@ readEither s = lift P.skipSpaces return x +-- | The 'read' function reads input from a string, which must be +-- completely consumed by the input process. read :: Read a => String -> a read s = either error id (readEither s) ------------------------------------------------------------------------ -- H98 compatibility +-- | The 'lex' function reads a single lexeme from the input, discarding +-- initial white space, and returning the characters that constitute the +-- lexeme. If the input string contains only white space, 'lex' returns a +-- single successful \`lexeme\' consisting of the empty string. (Thus +-- @'lex' \"\" = [(\"\",\"\")]@.) If there is no legal lexeme at the +-- beginning of the input string, 'lex' fails (i.e. returns @[]@). +-- +-- This lexer is not completely faithful to the Haskell lexical syntax +-- in the following respects: +-- +-- * Qualified names are not handled properly +-- +-- * Octal and hexadecimal numerics are not recognized as a single token +-- +-- * Comments are not treated properly lex :: ReadS String -- As defined by H98 -lex = readP_to_S (do { lexeme <- L.lex ; - return (show lexeme) }) +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 { lexeme <- L.lexLitChar ; - return (show lexeme) }) - +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 { Char c <- L.lexLitChar ; - 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) ------------------------------------------------------------------------ -- utility parsers -lexP :: ReadPrec Lexeme +lexP :: ReadPrec L.Lexeme +-- ^ Parse a single lexeme lexP = lift L.lex paren :: ReadPrec a -> ReadPrec a --- (paren p) parses (P0) --- where p parses P0 in precedence context zero -paren p = - do Single '(' <- lexP - x <- reset p - Single ')' <- lexP - return x +-- ^ @(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 mandatory = paren optional list :: ReadPrec a -> ReadPrec [a] +-- ^ @(list p)@ parses a list of things parsed by @p@, +-- using the usual square-bracket syntax. list readx = parens - ( do Single '[' <- lexP + ( do L.Punc "[" <- lexP (listRest False +++ listNext) ) where listRest started = - do Single c <- lexP + do L.Punc c <- lexP case c of - ']' -> return [] - ',' | started -> listNext + "]" -> return [] + "," | started -> listNext _ -> pfail listNext = @@ -226,11 +319,12 @@ list readx = return (x:xs) choose :: [(String, ReadPrec a)] -> ReadPrec a --- Parse the specified lexeme and continue as specified --- Esp useful for nullary constructors +-- ^ Parse the specified lexeme and continue as specified. +-- Esp useful for nullary constructors; e.g. +-- @choose [(\"A\", return A), (\"B\", return B)]@ choose sps = foldr ((+++) . try_one) pfail sps where - try_one (s,p) = do { Ident s' <- lexP ; + try_one (s,p) = do { L.Ident s' <- lexP ; if s == s' then p else pfail } \end{code} @@ -245,13 +339,13 @@ choose sps = foldr ((+++) . try_one) pfail sps instance Read Char where readPrec = parens - ( do Char c <- lexP + ( do L.Char c <- lexP return c ) readListPrec = parens - ( do String s <- lexP -- Looks for "foo" + ( do L.String s <- lexP -- Looks for "foo" return s +++ readListPrecDefault -- Looks for ['f','o','o'] @@ -262,7 +356,7 @@ instance Read Char where instance Read Bool where readPrec = parens - ( do Ident s <- lexP + ( do L.Ident s <- lexP case s of "True" -> return True "False" -> return False @@ -275,7 +369,7 @@ instance Read Bool where instance Read Ordering where readPrec = parens - ( do Ident s <- lexP + ( do L.Ident s <- lexP case s of "LT" -> return LT "EQ" -> return EQ @@ -300,10 +394,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 @@ -319,14 +413,13 @@ parenthesis-like objects such as (...) and [...] can be an argument to instance Read a => Read (Maybe a) where readPrec = parens - ( prec appPrec - ( do Ident "Nothing" <- lexP - return Nothing - +++ - do 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 @@ -336,11 +429,11 @@ instance (Read a, Read b) => Read (Either a b) where readPrec = parens ( prec appPrec - ( do Ident "Left" <- lexP + ( do L.Ident "Left" <- lexP x <- step readPrec return (Left x) +++ - do Ident "Right" <- lexP + do L.Ident "Right" <- lexP y <- step readPrec return (Right y) ) @@ -354,7 +447,17 @@ instance Read a => Read [a] where readListPrec = readListPrecDefault readList = readListDefault -instance Read Lexeme where +instance (Ix a, Read a, Read b) => Read (Array a b) where + readPrec = parens $ prec appPrec $ + do L.Ident "array" <- lexP + bounds <- step readPrec + vals <- step readPrec + return (array bounds vals) + + readListPrec = readListPrecDefault + readList = readListDefault + +instance Read L.Lexeme where readPrec = lexP readListPrec = readListPrecDefault readList = readListDefault @@ -368,57 +471,46 @@ instance Read Lexeme where %********************************************************* \begin{code} -readNumber :: Num a => (Number -> Maybe a) -> ReadPrec a +readNumber :: Num a => (L.Lexeme -> Maybe a) -> ReadPrec a -- Read a signed number readNumber convert = parens ( do x <- lexP case x of - Symbol "-" -> do n <- readNumber convert - return (negate n) + L.Symbol "-" -> do n <- readNumber convert + return (negate n) - Number y -> case convert y of - Just n -> return n - Nothing -> pfail - - _ -> pfail + _ -> case convert x of + Just n -> return n + Nothing -> pfail ) -readIEEENumber :: (RealFloat a) => (Number -> Maybe a) -> ReadPrec a --- Read a Float/Double. -readIEEENumber convert = - parens - ( do x <- lexP - case x of - Ident "NaN" -> return (0/0) - Ident "Infinity" -> return (1/0) - Symbol "-" -> do n <- readIEEENumber convert - return (negate n) - - Number y -> case convert y of - Just n -> return n - Nothing -> pfail - - _ -> pfail - ) +convertInt :: Num a => L.Lexeme -> Maybe a +convertInt (L.Int i) = Just (fromInteger i) +convertInt _ = Nothing + +convertFrac :: Fractional a => L.Lexeme -> Maybe a +convertFrac (L.Int i) = Just (fromInteger i) +convertFrac (L.Rat r) = Just (fromRational r) +convertFrac _ = Nothing instance Read Int where - readPrec = readNumber numberToInt + readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault instance Read Integer where - readPrec = readNumber numberToInteger + readPrec = readNumber convertInt readListPrec = readListPrecDefault readList = readListDefault instance Read Float where - readPrec = readIEEENumber numberToFloat + readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault instance Read Double where - readPrec = readIEEENumber numberToDouble + readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault @@ -426,9 +518,9 @@ instance (Integral a, Read a) => Read (Ratio a) where readPrec = parens ( prec ratioPrec - ( do x <- step readPrec - Symbol "%" <- lexP - y <- step readPrec + ( do x <- step readPrec + L.Symbol "%" <- lexP + y <- step readPrec return (x % y) ) ) @@ -461,7 +553,7 @@ instance (Read a, Read b) => Read (a,b) where parens ( paren ( do x <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP y <- readPrec return (x,y) ) @@ -476,9 +568,9 @@ instance (Read a, Read b, Read c) => Read (a, b, c) where parens ( paren ( do x <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP y <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP z <- readPrec return (x,y,z) ) @@ -492,11 +584,11 @@ instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where parens ( paren ( do w <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP x <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP y <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP z <- readPrec return (w,x,y,z) ) @@ -510,13 +602,13 @@ instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where parens ( paren ( do v <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP w <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP x <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP y <- readPrec - Single ',' <- lexP + L.Punc "," <- lexP z <- readPrec return (v,w,x,y,z) )