\begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving #-}
+{-# OPTIONS_HADDOCK hide #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Read
--
-----------------------------------------------------------------------------
-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
-- Temporary
, readParen
+
+ -- XXX Can this be removed?
+ , readp
)
where
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
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)
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
-- ^ 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}
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
%*********************************************************
-%* *
+%* *
\subsection{Structure instances of Read: Maybe, List etc}
-%* *
+%* *
%*********************************************************
For structured instances of Read we start using the precedences. The
return Nothing
+++
prec appPrec (
- do L.Ident "Just" <- lexP
+ do L.Ident "Just" <- lexP
x <- step readPrec
return (Just x))
)
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
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
%*********************************************************
-%* *
+%* *
\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
%*********************************************************
-%* *
-\subsection{Tuple instances of Read}
-%* *
+%* *
+ Tuple instances of Read, up to size 15
+%* *
%*********************************************************
\begin{code}
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
projects / ghc-base.git / blobdiff