Commit f7d0f9c1 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Use the same ReadP for all compilers, remove CPP hacks

If we're bundling a whole copy of ReadP then why bother trying to use
the version from the base package, especially when that requires hacks
to use the H98 version with some compilers and the non-H98 version in
base. It just makes testing harder because we're using different versions
with different compilers.
As a bonus, hugs should no longer need the -98 flag to use Cabal.
Added all the type signatures back in and fixed some warnings.
parent 70b4d9ae
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -cpp #-}
{-# OPTIONS_NHC98 -cpp #-}
{-# OPTIONS_JHC -fcpp #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Compat.ReadP
......@@ -70,22 +66,11 @@ module Distribution.Compat.ReadP
readP_to_S, -- :: ReadP a -> ReadS a
readS_to_P -- :: ReadS a -> ReadP a
#ifdef __NHC__
-- * Properties
-- $properties
#endif
)
where
#ifndef __NHC__
import Text.ParserCombinators.ReadP hiding (ReadP)
import qualified Text.ParserCombinators.ReadP as ReadP
type ReadP r a = ReadP.ReadP a
#else
import Control.Monad( MonadPlus(..), liftM2 )
import Data.Char (isSpace)
......@@ -109,7 +94,7 @@ instance Monad (P s) where
(Get f) >>= k = Get (\c -> f c >>= k)
(Look f) >>= k = Look (\s -> f s >>= k)
Fail >>= k = Fail
Fail >>= _ = Fail
(Result x p) >>= k = k x `mplus` (p >>= k)
(Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
......@@ -160,9 +145,9 @@ instance Monad (Parser r s) where
fail _ = R (\_ -> Fail)
R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
instance MonadPlus (Parser r s) where
mzero = pfail
mplus = (+++)
--instance MonadPlus (Parser r s) where
-- mzero = pfail
-- mplus = (+++)
-- ---------------------------------------------------------------------------
-- Operations over P
......@@ -172,7 +157,7 @@ final :: [(a,[s])] -> P s a
final [] = Fail
final r = Final r
--run :: P s a -> ReadS a
run :: P c a -> ([c] -> [(a, [c])])
run (Get f) (c:s) = run (f c) s
run (Look f) s = run (f s) s
run (Result x p) s = (x,s) : run p s
......@@ -182,25 +167,25 @@ run _ _ = []
-- ---------------------------------------------------------------------------
-- Operations over ReadP
--get :: ReadP Char
get :: ReadP r Char
-- ^ Consumes and returns the next character.
-- Fails if there is no input left.
get = R Get
--look :: ReadP String
look :: ReadP r String
-- ^ Look-ahead: returns the part of the input that is left, without
-- consuming it.
look = R Look
--pfail :: ReadP a
pfail :: ReadP r a
-- ^ Always fails.
pfail = R (\_ -> Fail)
--(+++) :: ReadP r a -> ReadP r a -> ReadP r a
(+++) :: ReadP r a -> ReadP r a -> ReadP r a
-- ^ Symmetric choice.
R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
--(<++) :: ReadP a -> ReadP a -> ReadP a
(<++) :: ReadP a a -> ReadP r a -> ReadP r a
-- ^ Local, exclusive, left-biased choice: If left parser
-- locally produces any result at all, then right parser is
-- not used.
......@@ -208,16 +193,16 @@ R f <++ q =
do s <- look
probe (f return) s 0
where
probe (Get f) (c:s) n = probe (f c) s (n+1)
probe (Look f) s n = probe (f s) s n
probe (Get f') (c:s) n = probe (f' c) s (n+1 :: Int)
probe (Look f') s n = probe (f' s) s n
probe p@(Result _ _) _ n = discard n >> R (p >>=)
probe (Final r) _ _ = R (Final r >>=)
probe _ _ _ = q
discard 0 = return ()
discard n = get >> discard (n-1)
discard n = get >> discard (n-1 :: Int)
--gather :: ReadP a -> ReadP (String, a)
gather :: ReadP (String -> P Char r) a -> ReadP r (String, a)
-- ^ Transforms a parser into one that does the same, but
-- in addition returns the exact characters read.
-- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
......@@ -226,24 +211,24 @@ gather (R m) =
R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
where
gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
gath l Fail = Fail
gath _ Fail = Fail
gath l (Look f) = Look (\s -> gath l (f s))
gath l (Result k p) = k (l []) `mplus` gath l p
gath l (Final r) = error "do not use readS_to_P in gather!"
gath _ (Final _) = error "do not use readS_to_P in gather!"
-- ---------------------------------------------------------------------------
-- Derived operations
--satisfy :: (Char -> Bool) -> ReadP Char
satisfy :: (Char -> Bool) -> ReadP r Char
-- ^ Consumes and returns the next character, if it satisfies the
-- specified predicate.
satisfy p = do c <- get; if p c then return c else pfail
--char :: Char -> ReadP Char
char :: Char -> ReadP r Char
-- ^ Parses and returns the specified character.
char c = satisfy (c ==)
--string :: String -> ReadP String
string :: String -> ReadP r String
-- ^ Parses and returns the specified string.
string this = do s <- look; scan this s
where
......@@ -251,7 +236,7 @@ string this = do s <- look; scan this s
scan (x:xs) (y:ys) | x == y = do get; scan xs ys
scan _ _ = do pfail
--munch :: (Char -> Bool) -> ReadP String
munch :: (Char -> Bool) -> ReadP r String
-- ^ Parses the first zero or more characters satisfying the predicate.
munch p =
do s <- look
......@@ -260,19 +245,19 @@ munch p =
scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
scan _ = do return ""
--munch1 :: (Char -> Bool) -> ReadP String
munch1 :: (Char -> Bool) -> ReadP r String
-- ^ Parses the first one or more characters satisfying the predicate.
munch1 p =
do c <- get
if p c then do s <- munch p; return (c:s) else pfail
--choice :: [ReadP a] -> ReadP a
choice :: [ReadP r a] -> ReadP r a
-- ^ Combines all parsers in the specified list.
choice [] = pfail
choice [p] = p
choice (p:ps) = p +++ choice ps
--skipSpaces :: ReadP ()
skipSpaces :: ReadP r ()
-- ^ Skips all whitespace.
skipSpaces =
do s <- look
......@@ -281,12 +266,12 @@ skipSpaces =
skip (c:s) | isSpace c = do get; skip s
skip _ = do return ()
--count :: Int -> ReadP a -> ReadP [a]
count :: Int -> ReadP r a -> ReadP r [a]
-- ^ @ count n p @ parses @n@ occurrences of @p@ in sequence. A list of
-- results is returned.
count n p = sequence (replicate n p)
--between :: ReadP open -> ReadP close -> ReadP a -> ReadP a
between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r a
-- ^ @ between open close p @ parses @open@, followed by @p@ and finally
-- @close@. Only the value of @p@ is returned.
between open close p = do open
......@@ -294,66 +279,66 @@ between open close p = do open
close
return x
--option :: a -> ReadP a -> ReadP a
option :: a -> ReadP r a -> ReadP r a
-- ^ @option x p@ will either parse @p@ or return @x@ without consuming
-- any input.
option x p = p +++ return x
--optional :: ReadP a -> ReadP ()
optional :: ReadP r a -> ReadP r ()
-- ^ @optional p@ optionally parses @p@ and always returns @()@.
optional p = (p >> return ()) +++ return ()
--many :: ReadP a -> ReadP [a]
many :: ReadP r a -> ReadP r [a]
-- ^ Parses zero or more occurrences of the given parser.
many p = return [] +++ many1 p
--many1 :: ReadP a -> ReadP [a]
many1 :: ReadP r a -> ReadP r [a]
-- ^ Parses one or more occurrences of the given parser.
many1 p = liftM2 (:) p (many p)
--skipMany :: ReadP a -> ReadP ()
skipMany :: ReadP r a -> ReadP r ()
-- ^ Like 'many', but discards the result.
skipMany p = many p >> return ()
--skipMany1 :: ReadP a -> ReadP ()
skipMany1 :: ReadP r a -> ReadP r ()
-- ^ Like 'many1', but discards the result.
skipMany1 p = p >> skipMany p
--sepBy :: ReadP a -> ReadP sep -> ReadP [a]
sepBy :: ReadP r a -> ReadP r sep -> ReadP r [a]
-- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
-- Returns a list of values returned by @p@.
sepBy p sep = sepBy1 p sep +++ return []
--sepBy1 :: ReadP a -> ReadP sep -> ReadP [a]
sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]
-- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
-- Returns a list of values returned by @p@.
sepBy1 p sep = liftM2 (:) p (many (sep >> p))
--endBy :: ReadP a -> ReadP sep -> ReadP [a]
endBy :: ReadP r a -> ReadP r sep -> ReadP r [a]
-- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
-- by @sep@.
endBy p sep = many (do x <- p ; sep ; return x)
--endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
endBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]
-- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
-- by @sep@.
endBy1 p sep = many1 (do x <- p ; sep ; return x)
--chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
chainr :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a
-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
-- Returns a value produced by a /right/ associative application of all
-- functions returned by @op@. If there are no occurrences of @p@, @x@ is
-- returned.
chainr p op x = chainr1 p op +++ return x
--chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
chainl :: ReadP r a -> ReadP r (a -> a -> a) -> a -> ReadP r a
-- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
-- Returns a value produced by a /left/ associative application of all
-- functions returned by @op@. If there are no occurrences of @p@, @x@ is
-- returned.
chainl p op x = chainl1 p op +++ return x
--chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
chainr1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
-- ^ Like 'chainr', but parses one or more occurrences of @p@.
chainr1 p op = scan
where scan = p >>= rest
......@@ -362,7 +347,7 @@ chainr1 p op = scan
return (f x y)
+++ return x
--chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
chainl1 :: ReadP r a -> ReadP r (a -> a -> a) -> ReadP r a
-- ^ Like 'chainl', but parses one or more occurrences of @p@.
chainl1 p op = p >>= rest
where rest x = do f <- op
......@@ -370,7 +355,7 @@ chainl1 p op = p >>= rest
rest (f x y)
+++ return x
--manyTill :: ReadP a -> ReadP end -> ReadP [a]
manyTill :: ReadP r a -> ReadP [a] end -> ReadP r [a]
-- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
-- succeeds. Returns a list of values returned by @p@.
manyTill p end = scan
......@@ -379,14 +364,14 @@ manyTill p end = scan
-- ---------------------------------------------------------------------------
-- Converting between ReadP and Read
--readP_to_S :: ReadP a -> ReadS a
readP_to_S :: ReadP a a -> ReadS a
-- ^ Converts a parser into a Haskell ReadS-style function.
-- This is the main way in which you can \"run\" a 'ReadP' parser:
-- the expanded type is
-- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
readP_to_S (R f) = run (f return)
--readS_to_P :: ReadS a -> ReadP a
readS_to_P :: ReadS a -> ReadP r a
-- ^ Converts a Haskell ReadS-style function into a parser.
-- Warning: This introduces local backtracking in the resulting
-- parser, and therefore a possible inefficiency.
......@@ -483,4 +468,3 @@ Here follow the properties:
> readP_to_S (readS_to_P r) s =~. r s
-}
#endif
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment