\begin{code}
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- 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
-- Temporary
, readParen
+
+ -- XXX Can this be removed?
+ , readp
)
where
import Text.ParserCombinators.ReadPrec
import Data.Maybe
-import Data.Either
#ifndef __HADDOCK__
import {-# SOURCE #-} GHC.Unicode ( isDigit )
#endif
import GHC.Num
import GHC.Real
-import GHC.Float
+import GHC.Float ()
import GHC.Show
import GHC.Base
import GHC.Arr
readListPrecDefault = list readPrec
------------------------------------------------------------------------
--- utility functions
-
--- | equivalent to 'readsPrec' with a precedence of 0.
-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
-
--- | The 'read' function reads input from a string, which must be
--- completely consumed by the input process.
-read :: Read a => String -> a
-read s = either error id (readEither s)
-
-------------------------------------------------------------------------
-- H98 compatibility
-- | The 'lex' function reads a single lexeme from the input, discarding
-- ^ 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 }
+ 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}
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
+ theBounds <- step readPrec
vals <- step readPrec
- return (array bounds vals)
+ return (array theBounds vals)
readListPrec = readListPrecDefault
readList = readListDefault
%*********************************************************
\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
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}
+