projects
/
ghc-base.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add tests from testsuite/tests/h98
[ghc-base.git]
/
Text
/
ParserCombinators
/
ReadP.hs
diff --git
a/Text/ParserCombinators/ReadP.hs
b/Text/ParserCombinators/ReadP.hs
index
d0743e7
..
27bba54
100644
(file)
--- a/
Text/ParserCombinators/ReadP.hs
+++ b/
Text/ParserCombinators/ReadP.hs
@@
-1,4
+1,11
@@
-{-# OPTIONS_GHC -fglasgow-exts -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+#ifndef __NHC__
+{-# LANGUAGE Rank2Types #-}
+#endif
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE MagicHash #-}
+#endif
+
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.ReadP
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.ReadP
@@
-35,6
+42,7
@@
module Text.ParserCombinators.ReadP
-- * Other operations
pfail, -- :: ReadP a
-- * Other operations
pfail, -- :: ReadP a
+ eof, -- :: ReadP ()
satisfy, -- :: (Char -> Bool) -> ReadP Char
char, -- :: Char -> ReadP Char
string, -- :: String -> ReadP String
satisfy, -- :: (Char -> Bool) -> ReadP Char
char, -- :: Char -> ReadP Char
string, -- :: String -> ReadP String
@@
-76,7
+84,7
@@
import Control.Monad( MonadPlus(..), sequence, liftM2 )
#ifndef __HADDOCK__
import {-# SOURCE #-} GHC.Unicode ( isSpace )
#endif
#ifndef __HADDOCK__
import {-# SOURCE #-} GHC.Unicode ( isSpace )
#endif
-import GHC.List ( replicate )
+import GHC.List ( replicate, null )
import GHC.Base
#else
import Data.Char( isSpace )
import GHC.Base
#else
import Data.Char( isSpace )
@@
-114,7
+122,7
@@
instance Monad P where
(Get f) >>= k = Get (\c -> f c >>= k)
(Look f) >>= k = Look (\s -> f s >>= k)
(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]
(Result x p) >>= k = k x `mplus` (p >>= k)
(Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
@@
-218,9
+226,9
@@
R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
-- locally produces any result at all, then right parser is
-- not used.
#ifdef __GLASGOW_HASKELL__
-- locally produces any result at all, then right parser is
-- not used.
#ifdef __GLASGOW_HASKELL__
-R f <++ q =
+R f0 <++ q =
do s <- look
do s <- look
- probe (f return) s 0#
+ probe (f0 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
where
probe (Get f) (c:s) n = probe (f c) s (n+#1#)
probe (Look f) s n = probe (f s) s n
@@
-254,14
+262,15
@@
gather :: ReadP a -> ReadP (String, a)
-- in addition returns the exact characters read.
-- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
-- is built using any occurrences of readS_to_P.
-- in addition returns the exact characters read.
-- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
-- is built using any occurrences of readS_to_P.
-gather (R m) =
- R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
+gather (R m)
+ = R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
where
where
+ gath :: (String -> String) -> P (String -> P b) -> P b
gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
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 (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
-- ---------------------------------------------------------------------------
-- Derived operations
@@
-275,28
+284,39
@@
char :: Char -> ReadP Char
-- ^ Parses and returns the specified character.
char c = satisfy (c ==)
-- ^ Parses and returns the specified character.
char c = satisfy (c ==)
+eof :: ReadP ()
+-- ^ Succeeds iff we are at the end of input
+eof = do { s <- look
+ ; if null s then return ()
+ else pfail }
+
string :: String -> ReadP String
-- ^ Parses and returns the specified string.
string this = do s <- look; scan this s
where
scan [] _ = do return this
string :: String -> ReadP String
-- ^ Parses and returns the specified string.
string this = do s <- look; scan this s
where
scan [] _ = do return this
- scan (x:xs) (y:ys) | x == y = do get; scan xs ys
+ scan (x:xs) (y:ys) | x == y = do _ <- get; scan xs ys
scan _ _ = do pfail
munch :: (Char -> Bool) -> ReadP String
-- ^ Parses the first zero or more characters satisfying the predicate.
scan _ _ = do pfail
munch :: (Char -> Bool) -> ReadP String
-- ^ Parses the first zero or more characters satisfying the predicate.
+-- Always succeds, exactly once having consumed all the characters
+-- Hence NOT the same as (many (satisfy p))
munch p =
do s <- look
scan s
where
munch p =
do s <- look
scan s
where
- scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
+ scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)
scan _ = do return ""
munch1 :: (Char -> Bool) -> ReadP String
-- ^ Parses the first one or more characters satisfying the predicate.
scan _ = do return ""
munch1 :: (Char -> Bool) -> ReadP String
-- ^ Parses the first one or more characters satisfying the predicate.
+-- Fails if none, else succeeds exactly once having consumed all the characters
+-- Hence NOT the same as (many1 (satisfy p))
munch1 p =
do c <- get
munch1 p =
do c <- get
- if p c then do s <- munch p; return (c:s) else pfail
+ if p c then do s <- munch p; return (c:s)
+ else pfail
choice :: [ReadP a] -> ReadP a
-- ^ Combines all parsers in the specified list.
choice :: [ReadP a] -> ReadP a
-- ^ Combines all parsers in the specified list.
@@
-310,7
+330,7
@@
skipSpaces =
do s <- look
skip s
where
do s <- look
skip s
where
- skip (c:s) | isSpace c = do get; skip s
+ skip (c:s) | isSpace c = do _ <- get; skip s
skip _ = do return ()
count :: Int -> ReadP a -> ReadP [a]
skip _ = do return ()
count :: Int -> ReadP a -> ReadP [a]
@@
-321,9
+341,9
@@
count n p = sequence (replicate n p)
between :: ReadP open -> ReadP close -> ReadP a -> ReadP a
-- ^ @between open close p@ parses @open@, followed by @p@ and finally
-- @close@. Only the value of @p@ is returned.
between :: ReadP open -> ReadP close -> ReadP a -> ReadP 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
+between open close p = do _ <- open
x <- p
x <- p
- close
+ _ <- close
return x
option :: a -> ReadP a -> ReadP a
return x
option :: a -> ReadP a -> ReadP a
@@
-364,12
+384,12
@@
sepBy1 p sep = liftM2 (:) p (many (sep >> p))
endBy :: ReadP a -> ReadP sep -> ReadP [a]
-- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
-- by @sep@.
endBy :: ReadP a -> ReadP sep -> ReadP [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)
+endBy p sep = many (do x <- p ; _ <- sep ; return x)
endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
-- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
-- by @sep@.
endBy1 :: ReadP a -> ReadP sep -> ReadP [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)
+endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x)
chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.