X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FRead.lhs;h=2610ec59ba4b5177a9d7cd1c9181567a4d0cd60f;hb=62b84e6edd594d35f3620926c72ad3febf990d43;hp=e24cbe5c00c52c4904015fcb941271b2e37ae52d;hpb=aaf764b3ad8b1816d68b5f27299eac125f08e1a5;p=ghc-base.git diff --git a/GHC/Read.lhs b/GHC/Read.lhs index e24cbe5..2610ec5 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -14,6 +14,7 @@ -- ----------------------------------------------------------------------------- +-- #hide module GHC.Read ( Read(..) -- class @@ -71,7 +72,6 @@ import {-# SOURCE #-} GHC.Unicode ( isDigit ) import GHC.Num import GHC.Real import GHC.Float -import GHC.List import GHC.Show import GHC.Base import GHC.Arr @@ -133,25 +133,45 @@ readParen b g = if b then mandatory else optional -- > infixr 5 :^: -- > data Tree a = Leaf a | Tree a :^: Tree a -- --- the derived instance of 'Read' is equivalent to +-- the derived instance of 'Read' in Haskell 98 is equivalent to -- -- > instance (Read a) => Read (Tree a) where -- > --- > readsPrec d r = readParen (d > up_prec) +-- > 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 -- > --- > ++ 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 +-- > 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 -- | attempts to parse a value from the front of the string, returning @@ -183,6 +203,8 @@ class Read a where 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 @@ -192,13 +214,14 @@ 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 ------------------------------------------------------------------------ @@ -291,7 +314,7 @@ paren p = do L.Punc "(" <- lexP 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 +-- and parses \"P0\" in precedence context zero parens p = optional where optional = p +++ mandatory @@ -532,7 +555,7 @@ instance (Integral a, Read a) => Read (Ratio a) where %********************************************************* %* * -\subsection{Tuple instances of Read} + Tuple instances of Read, up to size 15 %* * %********************************************************* @@ -549,71 +572,145 @@ 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}