-----------------------------------------------------------------------------
-- |
-- Module : GHC.Read
--- Copyright : (c) The FFI Task Force, 1994-2002
+-- Copyright : (c) The University of Glasgow, 1994-2002
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
, parens -- :: ReadPrec a -> ReadPrec a
, list -- :: ReadPrec a -> ReadPrec [a]
, choose -- :: [(String, ReadPrec a)] -> ReadPrec a
+ , readListDefault, readListPrecDefault
-- Temporary
- , readList__
, readParen
)
where
import Text.ParserCombinators.ReadP
( ReadP
+ , ReadS
, readP_to_S
- , readS_to_P
)
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
import Data.Either
import {-# SOURCE #-} GHC.Err ( error )
+#ifndef __HADDOCK__
+import {-# SOURCE #-} GHC.Unicode ( isDigit )
+#endif
import GHC.Num
import GHC.Real
import GHC.Float
import GHC.List
-import GHC.Show -- isAlpha etc
+import GHC.Show
import GHC.Base
-
-ratioPrec = 7 -- Precedence of ':%' constructor
-appPrec = 10 -- Precedence of applictaion
+import GHC.Arr
\end{code}
--------------------------------------------------------
- TEMPORARY UNTIL I DO DERIVED READ
+
\begin{code}
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
(x,t) <- optional s
(")",u) <- lex t
return (x,u)
-
-
-readList__ :: ReadS a -> ReadS [a]
-
-readList__ readx
- = readParen False (\r -> do
- ("[",s) <- lex r
- readl s)
- where readl s =
- (do { ("]",t) <- lex s ; return ([],t) }) ++
- (do { (x,t) <- readx s ; (xs,u) <- readl2 t ; return (x:xs,u) })
-
- readl2 s =
- (do { ("]",t) <- lex s ; return ([],t) }) ++
- (do { (",",t) <- lex s ; (x,u) <- readx t ; (xs,v) <- readl2 u ; return (x:xs,v) })
\end{code}
%*********************************************************
%* *
-\subsection{The @Read@ class and @ReadS@ type}
+\subsection{The @Read@ class}
%* *
%*********************************************************
\begin{code}
------------------------------------------------------------------------
--- ReadS
-
-type ReadS a = String -> [(a,String)]
-
-------------------------------------------------------------------------
-- class Read
class Read a where
readsPrec :: Int -> ReadS a
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).
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).
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).
readListPrecDefault = list readPrec
------------------------------------------------------------------------
-- H98 compatibility
lex :: ReadS String -- As defined by H98
-lex "" = [("","")] -- ugly hack
-lex s = readP_to_S (do { lexeme <- L.lex ;
- return (show lexeme) }) s
+lex s = readP_to_S L.hsLex s
+-- | 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 { lexeme <- L.lexLitChar ;
- return (show lexeme) })
-
+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
+
+-- | 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 (do { Char c <- L.lexLitChar ;
- return c })
+readLitChar = readP_to_S L.lexChar
lexDigits :: ReadS String
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 =
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}
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']
instance Read Bool where
readPrec =
parens
- ( do Ident s <- lexP
+ ( do L.Ident s <- lexP
case s of
"True" -> return True
"False" -> return False
instance Read Ordering where
readPrec =
parens
- ( do Ident s <- lexP
+ ( do L.Ident s <- lexP
case s of
"LT" -> return LT
"EQ" -> return EQ
there is one parenthesis parsed, then the required precedence level
drops to 0 again, and parsing inside p may succeed.
-'appPrec' is just the precedence level of function application (maybe
-it should be called 'appPrec' instead). So, if we are parsing
-function application, we'd better require the precedence level to be
-at least 'appPrec'. Otherwise, we have to put parentheses around it.
+'appPrec' is just the precedence level of function application. So,
+if we are parsing function application, we'd better require the
+precedence level to be at least 'appPrec'. Otherwise, we have to put
+parentheses around it.
'step' is used to increase the precedence levels inside a
parser, and can be used to express left- or right- associativity. For
instance Read a => Read (Maybe a) where
readPrec =
parens
- ( prec appPrec
- ( do Ident "Nothing" <- lexP
- return Nothing
- +++
- do Ident "Just" <- lexP
- x <- step readPrec
- return (Just x)
- )
+ (do L.Ident "Nothing" <- lexP
+ return Nothing
+ +++
+ prec appPrec (
+ do L.Ident "Just" <- lexP
+ x <- step readPrec
+ return (Just x))
)
readListPrec = readListPrecDefault
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)
)
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
%*********************************************************
\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
)
-readIEEENumber :: (RealFloat a) => (Number -> Maybe a) -> ReadPrec a
--- Read a Float/Double.
-readIEEENumber convert =
- parens
- ( do x <- lexP
- case x of
- Ident "NaN" -> return (0/0)
- Ident "Infinity" -> return (1/0)
- Symbol "-" -> do n <- readIEEENumber convert
- return (negate n)
-
- Number y -> case convert y of
- Just n -> return n
- Nothing -> pfail
-
- _ -> 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 = readIEEENumber numberToFloat
+ readPrec = readNumber convertFrac
readListPrec = readListPrecDefault
readList = readListDefault
instance Read Double where
- readPrec = readIEEENumber numberToDouble
+ readPrec = readNumber convertFrac
readListPrec = readListPrecDefault
readList = readListDefault
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)
)
)
parens
( paren
( do x <- readPrec
- Single ',' <- lexP
+ L.Punc "," <- lexP
y <- readPrec
return (x,y)
)
parens
( paren
( do x <- readPrec
- Single ',' <- lexP
+ L.Punc "," <- lexP
y <- readPrec
- Single ',' <- lexP
+ L.Punc "," <- lexP
z <- readPrec
return (x,y,z)
)
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)
)
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)
)
projects / ghc-base.git / blobdiff