add Data.Function
[haskell-directory.git] / GHC / Read.lhs
index f8174cb..2610ec5 100644 (file)
@@ -1,5 +1,5 @@
 \begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Read
@@ -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}