X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FRead.lhs;h=68d05213ccfdf7ebe061bc6e3cdcb8564793c8aa;hb=6bbd4780e49f69a08ae373b5a07bd15b037013f7;hp=949ec591086ec564b0faa8098af052b68eba116a;hpb=05e43a9bd25232efced01ce45d00b3b3ba12af51;p=ghc-base.git diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 949ec59..68d0521 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -1,15 +1,18 @@ -% ------------------------------------------------------------------------------ -% $Id: Read.lhs,v 1.4 2002/04/11 12:03:44 simonpj 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 #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Read +-- Copyright : (c) The FFI Task Force, 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,6 +38,7 @@ module GHC.Read , parens -- :: ReadPrec a -> ReadPrec a , list -- :: ReadPrec a -> ReadPrec [a] , choose -- :: [(String, ReadPrec a)] -> ReadPrec a + , readListDefault, readListPrecDefault -- Temporary , readList__ @@ -51,15 +55,10 @@ import Text.ParserCombinators.ReadP ) 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 @@ -73,10 +72,9 @@ import GHC.Float import GHC.List import GHC.Show -- isAlpha etc import GHC.Base - -ratioPrec = 7 -- Precedence of ':%' constructor -appPrec = 10 -- Precedence of applictaion +import GHC.Arr \end{code} + ------------------------------------------------------- TEMPORARY UNTIL I DO DERIVED READ @@ -117,6 +115,8 @@ readList__ readx ------------------------------------------------------------------------ -- 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)] ------------------------------------------------------------------------ @@ -135,9 +135,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 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 readListPrecDefault = list readPrec ------------------------------------------------------------------------ @@ -168,15 +172,15 @@ read s = either error id (readEither s) -- H98 compatibility 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 lexLitChar :: ReadS String -- As defined by H98 -lexLitChar = readP_to_S (do { lexeme <- L.lexLitChar ; - return (show lexeme) }) +lexLitChar = readP_to_S (do { P.skipSpaces ; + (s, L.Char _) <- P.gather L.lex ; + return s }) readLitChar :: ReadS Char -- As defined by H98 -readLitChar = readP_to_S (do { Char c <- L.lexLitChar ; +readLitChar = readP_to_S (do { L.Char c <- L.lex ; return c }) lexDigits :: ReadS String @@ -185,39 +189,41 @@ 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 +232,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 +252,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 +269,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 +282,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 @@ -320,10 +327,10 @@ instance Read a => Read (Maybe a) where readPrec = parens ( prec appPrec - ( do Ident "Nothing" <- lexP + ( do L.Ident "Nothing" <- lexP return Nothing +++ - do Ident "Just" <- lexP + do L.Ident "Just" <- lexP x <- step readPrec return (Just x) ) @@ -336,11 +343,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 +361,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,39 +385,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 ) +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 = readNumber numberToFloat + readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault instance Read Double where - readPrec = readNumber numberToDouble + readPrec = readNumber convertFrac readListPrec = readListPrecDefault readList = readListDefault @@ -408,9 +432,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) ) ) @@ -443,7 +467,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) ) @@ -458,9 +482,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) ) @@ -474,11 +498,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) ) @@ -492,13 +516,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) )