X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FRead.lhs;h=6305276cdd2bb352807d73cb966a883ecb446e82;hb=HEAD;hp=cc3c541ac06abaf7b35c3b0fb2e4633d55d8632b;hpb=833c0251f3de7eafbc42b4ce67360e84afd071f4;p=ghc-base.git diff --git a/GHC/Read.lhs b/GHC/Read.lhs index cc3c541..6305276 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -1,5 +1,7 @@ \begin{code} -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving #-} +{-# OPTIONS_HADDOCK hide #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Read @@ -14,24 +16,19 @@ -- ----------------------------------------------------------------------------- -module GHC.Read +-- #hide +module GHC.Read ( Read(..) -- class - + -- ReadS type , ReadS -- :: *; = String -> [(a,String)] - - -- utility functions - , reads -- :: Read a => ReadS a - , readp -- :: Read a => ReadP a - , readEither -- :: Read a => String -> Either String a - , read -- :: Read a => String -> a -- H98 compatibility - , lex -- :: ReadS String - , lexLitChar -- :: ReadS String - , readLitChar -- :: ReadS Char - , lexDigits -- :: ReadS String - + , lex -- :: ReadS String + , lexLitChar -- :: ReadS String + , readLitChar -- :: ReadS Char + , lexDigits -- :: ReadS String + -- defining readers , lexP -- :: ReadPrec Lexeme , paren -- :: ReadPrec a -> ReadPrec a @@ -42,6 +39,9 @@ module GHC.Read -- Temporary , readParen + + -- XXX Can this be removed? + , readp ) where @@ -62,51 +62,148 @@ import qualified Text.Read.Lex as L import Text.ParserCombinators.ReadPrec import Data.Maybe -import Data.Either -import {-# SOURCE #-} GHC.Err ( error ) #ifndef __HADDOCK__ -import {-# SOURCE #-} GHC.Unicode ( isDigit ) +import {-# SOURCE #-} GHC.Unicode ( isDigit ) #endif import GHC.Num import GHC.Real -import GHC.Float -import GHC.List +import GHC.Float () import GHC.Show import GHC.Base import GHC.Arr +-- For defining instances for the generic deriving mechanism +import GHC.Generics (Arity(..), Associativity(..), Fixity(..)) \end{code} \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 - ("(",s) <- lex r - (x,t) <- optional s - (")",u) <- lex t - return (x,u) + ("(",s) <- lex r + (x,t) <- optional s + (")",u) <- lex t + return (x,u) \end{code} %********************************************************* -%* * +%* * \subsection{The @Read@ class} -%* * +%* * %********************************************************* \begin{code} ------------------------------------------------------------------------ -- 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' in Haskell 98 is equivalent to +-- +-- > instance (Read a) => Read (Tree a) where +-- > +-- > readsPrec d r = readParen (d > app_prec) +-- > (\r -> [(Leaf m,t) | +-- > ("Leaf",s) <- lex r, +-- > (m,t) <- readsPrec (app_prec+1) s]) 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 +-- > +-- > where app_prec = 10 +-- > up_prec = 5 +-- +-- Note that right-associativity of @:^:@ is unused. +-- +-- The derived instance in GHC is equivalent to +-- +-- > instance (Read a) => Read (Tree a) where +-- > +-- > readPrec = parens $ (prec app_prec $ do +-- > Ident "Leaf" <- lexP +-- > m <- step readPrec +-- > return (Leaf m)) +-- > +-- > +++ (prec up_prec $ do +-- > u <- step readPrec +-- > Symbol ":^:" <- lexP +-- > v <- step readPrec +-- > return (u :^: v)) +-- > +-- > where app_prec = 10 +-- > up_prec = 5 +-- > +-- > readListPrec = readListPrecDefault + 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). + -- The default definition uses 'readList'. Instances that define 'readPrec' + -- should also define 'readListPrec' as 'readListPrecDefault'. readListPrec :: ReadPrec [a] -- default definitions @@ -116,54 +213,58 @@ 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). +-- ^ A possible replacement definition for the 'readList' method (GHC only). +-- This is only needed for GHC, and even then only for 'Read' instances +-- where 'readListPrec' isn't defined as 'readListPrecDefault'. 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). +-- ^ A possible replacement definition for the 'readListPrec' method, +-- defined using 'readPrec' (GHC only). readListPrecDefault = list readPrec ------------------------------------------------------------------------ --- utility functions - -reads :: Read a => ReadS a -reads = readsPrec minPrec - -readp :: Read a => ReadP a -readp = readPrec_to_P readPrec minPrec - -readEither :: Read a => String -> Either String a -readEither s = - case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of - [x] -> Right x - [] -> Left "Prelude.read: no parse" - _ -> Left "Prelude.read: ambiguous parse" - where - read' = - do x <- readPrec - lift P.skipSpaces - return x - -read :: Read a => String -> a -read s = either error id (readEither s) - ------------------------------------------------------------------------- -- H98 compatibility -lex :: ReadS String -- As defined by H98 +-- | 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 s = readP_to_S L.hsLex s -lexLitChar :: ReadS String -- As defined by H98 +-- | 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 { (s, _) <- P.gather L.lexChar ; - return s }) - -- There was a skipSpaces before the P.gather L.lexChar, - -- but that seems inconsistent with readLitChar + return s }) + -- There was a skipSpaces before the P.gather L.lexChar, + -- but that seems inconsistent with readLitChar -readLitChar :: ReadS Char -- As defined by H98 +-- | 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 L.lexChar +-- | Reads a non-empty string of decimal digits. lexDigits :: ReadS String lexDigits = readP_to_S (P.munch1 isDigit) @@ -176,16 +277,16 @@ lexP = lift L.lex paren :: ReadPrec a -> ReadPrec a -- ^ @(paren p)@ parses \"(P0)\" --- where @p@ parses \"P0\" in precedence context zero +-- where @p@ parses \"P0\" in precedence context zero paren p = do L.Punc "(" <- lexP - x <- reset p - L.Punc ")" <- lexP - return x + 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 +-- where @p@ parses \"P\" in the current precedence context +-- and parses \"P0\" in precedence context zero parens p = optional where optional = p +++ mandatory @@ -216,17 +317,22 @@ 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)]@ +-- We match both Ident and Symbol because the constructor +-- might be an operator eg (:=:) choose sps = foldr ((+++) . try_one) pfail sps - where - try_one (s,p) = do { L.Ident s' <- lexP ; - if s == s' then p else pfail } + where + try_one (s,p) = do { token <- lexP ; + case token of + L.Ident s' | s==s' -> p + L.Symbol s' | s==s' -> p + _other -> pfail } \end{code} %********************************************************* -%* * +%* * \subsection{Simple instances of Read} -%* * +%* * %********************************************************* \begin{code} @@ -239,11 +345,11 @@ instance Read Char where readListPrec = parens - ( do L.String s <- lexP -- Looks for "foo" + ( do L.String s <- lexP -- Looks for "foo" return s +++ - readListPrecDefault -- Looks for ['f','o','o'] - ) -- (more generous than H98 spec) + readListPrecDefault -- Looks for ['f','o','o'] + ) -- (more generous than H98 spec) readList = readListDefault @@ -277,9 +383,9 @@ instance Read Ordering where %********************************************************* -%* * +%* * \subsection{Structure instances of Read: Maybe, List etc} -%* * +%* * %********************************************************* For structured instances of Read we start using the precedences. The @@ -311,7 +417,7 @@ instance Read a => Read (Maybe a) where return Nothing +++ prec appPrec ( - do L.Ident "Just" <- lexP + do L.Ident "Just" <- lexP x <- step readPrec return (Just x)) ) @@ -319,23 +425,6 @@ instance Read a => Read (Maybe a) where readListPrec = readListPrecDefault readList = readListDefault -instance (Read a, Read b) => Read (Either a b) where - readPrec = - parens - ( prec appPrec - ( do L.Ident "Left" <- lexP - x <- step readPrec - return (Left x) - +++ - do L.Ident "Right" <- lexP - y <- step readPrec - return (Right y) - ) - ) - - readListPrec = readListPrecDefault - readList = readListDefault - instance Read a => Read [a] where readPrec = readListPrec readListPrec = readListPrecDefault @@ -343,10 +432,10 @@ instance Read a => Read [a] 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) + do L.Ident "array" <- lexP + theBounds <- step readPrec + vals <- step readPrec + return (array theBounds vals) readListPrec = readListPrecDefault readList = readListDefault @@ -359,34 +448,34 @@ instance Read L.Lexeme where %********************************************************* -%* * +%* * \subsection{Numeric instances of Read} -%* * +%* * %********************************************************* \begin{code} -readNumber :: Num a => (L.Lexeme -> Maybe a) -> ReadPrec a +readNumber :: Num a => (L.Lexeme -> ReadPrec a) -> ReadPrec a -- Read a signed number readNumber convert = parens ( do x <- lexP case x of - L.Symbol "-" -> do n <- readNumber convert + L.Symbol "-" -> do y <- lexP + n <- convert y return (negate n) - - _ -> case convert x of - Just n -> return n - Nothing -> pfail + + _ -> convert x ) -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 +convertInt :: Num a => L.Lexeme -> ReadPrec a +convertInt (L.Int i) = return (fromInteger i) +convertInt _ = pfail + +convertFrac :: Fractional a => L.Lexeme -> ReadPrec a +convertFrac (L.Int i) = return (fromInteger i) +convertFrac (L.Rat r) = return (fromRational r) +convertFrac _ = pfail instance Read Int where readPrec = readNumber convertInt @@ -425,9 +514,9 @@ instance (Integral a, Read a) => Read (Ratio a) where %********************************************************* -%* * -\subsection{Tuple instances of Read} -%* * +%* * + Tuple instances of Read, up to size 15 +%* * %********************************************************* \begin{code} @@ -443,71 +532,160 @@ instance Read () where readList = readListDefault instance (Read a, Read b) => Read (a,b) where - readPrec = - parens - ( paren - ( do x <- readPrec - L.Punc "," <- lexP - y <- readPrec - return (x,y) - ) - ) - + readPrec = wrap_tup read_tup2 readListPrec = readListPrecDefault readList = readListDefault +wrap_tup :: ReadPrec a -> ReadPrec a +wrap_tup p = parens (paren p) -instance (Read a, Read b, Read c) => Read (a, b, c) where - readPrec = - parens - ( paren - ( do x <- readPrec - L.Punc "," <- lexP - y <- readPrec - L.Punc "," <- lexP - z <- readPrec - return (x,y,z) - ) - ) +read_comma :: ReadPrec () +read_comma = do { L.Punc "," <- lexP; return () } + +read_tup2 :: (Read a, Read b) => ReadPrec (a,b) +-- Reads "a , b" no parens! +read_tup2 = do x <- readPrec + read_comma + y <- readPrec + return (x,y) + +read_tup4 :: (Read a, Read b, Read c, Read d) => ReadPrec (a,b,c,d) +read_tup4 = do (a,b) <- read_tup2 + read_comma + (c,d) <- read_tup2 + return (a,b,c,d) + + +read_tup8 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) + => ReadPrec (a,b,c,d,e,f,g,h) +read_tup8 = do (a,b,c,d) <- read_tup4 + read_comma + (e,f,g,h) <- read_tup4 + return (a,b,c,d,e,f,g,h) + +instance (Read a, Read b, Read c) => Read (a, b, c) where + readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma + ; c <- readPrec + ; return (a,b,c) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where - readPrec = - parens - ( paren - ( do w <- readPrec - L.Punc "," <- lexP - x <- readPrec - L.Punc "," <- lexP - y <- readPrec - L.Punc "," <- lexP - z <- readPrec - return (w,x,y,z) - ) - ) - + readPrec = wrap_tup read_tup4 readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where - readPrec = - parens - ( paren - ( do v <- readPrec - L.Punc "," <- lexP - w <- readPrec - L.Punc "," <- lexP - x <- readPrec - L.Punc "," <- lexP - y <- readPrec - L.Punc "," <- lexP - z <- readPrec - return (v,w,x,y,z) - ) - ) + readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma + ; e <- readPrec + ; return (a,b,c,d,e) }) + readListPrec = readListPrecDefault + readList = readListDefault +instance (Read a, Read b, Read c, Read d, Read e, Read f) + => Read (a, b, c, d, e, f) where + readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma + ; (e,f) <- read_tup2 + ; return (a,b,c,d,e,f) }) readListPrec = readListPrecDefault readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) + => Read (a, b, c, d, e, f, g) where + readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma + ; (e,f) <- read_tup2; read_comma + ; g <- readPrec + ; return (a,b,c,d,e,f,g) }) + readListPrec = readListPrecDefault + readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) + => Read (a, b, c, d, e, f, g, h) where + readPrec = wrap_tup read_tup8 + readListPrec = readListPrecDefault + readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, + Read i) + => Read (a, b, c, d, e, f, g, h, i) where + readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma + ; i <- readPrec + ; return (a,b,c,d,e,f,g,h,i) }) + readListPrec = readListPrecDefault + readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, + Read i, Read j) + => Read (a, b, c, d, e, f, g, h, i, j) where + readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma + ; (i,j) <- read_tup2 + ; return (a,b,c,d,e,f,g,h,i,j) }) + readListPrec = readListPrecDefault + readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, + Read i, Read j, Read k) + => Read (a, b, c, d, e, f, g, h, i, j, k) where + readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma + ; (i,j) <- read_tup2; read_comma + ; k <- readPrec + ; return (a,b,c,d,e,f,g,h,i,j,k) }) + readListPrec = readListPrecDefault + readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, + Read i, Read j, Read k, Read l) + => Read (a, b, c, d, e, f, g, h, i, j, k, l) where + readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma + ; (i,j,k,l) <- read_tup4 + ; return (a,b,c,d,e,f,g,h,i,j,k,l) }) + readListPrec = readListPrecDefault + readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, + Read i, Read j, Read k, Read l, Read m) + => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where + readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma + ; (i,j,k,l) <- read_tup4; read_comma + ; m <- readPrec + ; return (a,b,c,d,e,f,g,h,i,j,k,l,m) }) + readListPrec = readListPrecDefault + readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, + Read i, Read j, Read k, Read l, Read m, Read n) + => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where + readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma + ; (i,j,k,l) <- read_tup4; read_comma + ; (m,n) <- read_tup2 + ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n) }) + readListPrec = readListPrecDefault + readList = readListDefault + +instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, + Read i, Read j, Read k, Read l, Read m, Read n, Read o) + => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where + readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma + ; (i,j,k,l) <- read_tup4; read_comma + ; (m,n) <- read_tup2; read_comma + ; o <- readPrec + ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) }) + readListPrec = readListPrecDefault + readList = readListDefault +\end{code} + +\begin{code} +-- XXX Can this be removed? + +readp :: Read a => ReadP a +readp = readPrec_to_P readPrec minPrec \end{code} + +Instances for types of the generic deriving mechanism. + +\begin{code} +deriving instance Read Arity +deriving instance Read Associativity +deriving instance Read Fixity +\end{code} \ No newline at end of file