X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Text%2FParserCombinators%2FReadP.hs;h=5835d9a45e072437edd47356dbae29d43d199e38;hb=1c12fc7d08d35015f32679738cf24f0924933449;hp=654eda096faf3869e7e7e4ee44a3de3d0b8ca0c3;hpb=4a7c209cf03afe756e37efa1aed737e1e56ff735;p=ghc-base.git diff --git a/Text/ParserCombinators/ReadP.hs b/Text/ParserCombinators/ReadP.hs index 654eda0..5835d9a 100644 --- a/Text/ParserCombinators/ReadP.hs +++ b/Text/ParserCombinators/ReadP.hs @@ -20,7 +20,11 @@ module Text.ParserCombinators.ReadP ( -- * The 'ReadP' type +#ifndef __NHC__ ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus +#else + ReadPN, -- :: * -> * -> *; instance Functor, Monad, MonadPlus +#endif -- * Primitive operations get, -- :: ReadP Char @@ -38,8 +42,26 @@ module Text.ParserCombinators.ReadP munch1, -- :: (Char -> Bool) -> ReadP String skipSpaces, -- :: ReadP () choice, -- :: [ReadP a] -> ReadP a + count, -- :: Int -> ReadP a -> ReadP [a] + between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a + option, -- :: a -> ReadP a -> ReadP a + optional, -- :: ReadP a -> ReadP () + many, -- :: ReadP a -> ReadP [a] + many1, -- :: ReadP a -> ReadP [a] + skipMany, -- :: ReadP a -> ReadP () + skipMany1, -- :: ReadP a -> ReadP () + sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a] + sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] + endBy, -- :: ReadP a -> ReadP sep -> ReadP [a] + endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a] + chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a + chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a + chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a + chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a + manyTill, -- :: ReadP a -> ReadP end -> ReadP [a] -- * Running a parser + ReadS, -- :: *; = String -> [(a,String)] readP_to_S, -- :: ReadP a -> ReadS a readS_to_P, -- :: ReadS a -> ReadP a @@ -48,9 +70,13 @@ module Text.ParserCombinators.ReadP ) where -import Control.Monad( MonadPlus(..) ) +import Control.Monad( MonadPlus(..), sequence, liftM2 ) + #ifdef __GLASGOW_HASKELL__ -import GHC.Show( isSpace ) +#ifndef __HADDOCK__ +import {-# SOURCE #-} GHC.Unicode ( isSpace ) +#endif +import GHC.List ( replicate ) import GHC.Base #else import Data.Char( isSpace ) @@ -59,8 +85,14 @@ import Data.Char( isSpace ) infixr 5 +++, <++ #ifdef __GLASGOW_HASKELL__ --- We define a local version of ReadS here, --- because its "real" definition site is in GHC.Read +------------------------------------------------------------------------ +-- ReadS + +-- | A parser for a type @a@, represented as a function that takes a +-- 'String' and returns a list of possible parses as @(a,'String')@ pairs. +-- +-- Note that this kind of backtracking parser is very inefficient; +-- reading a large structure may be quite slow (cf 'ReadP'). type ReadS a = String -> [(a,String)] #endif @@ -120,7 +152,12 @@ instance MonadPlus P where -- --------------------------------------------------------------------------- -- The ReadP type +#ifndef __NHC__ newtype ReadP a = R (forall b . (a -> P b) -> P b) +#else +#define ReadP (ReadPN b) +newtype ReadPN b a = R ((a -> P b) -> P b) +#endif -- Functor, Monad, MonadPlus @@ -172,7 +209,11 @@ pfail = R (\_ -> Fail) -- ^ Symmetric choice. R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k) +#ifndef __NHC__ (<++) :: ReadP a -> ReadP a -> ReadP a +#else +(<++) :: ReadPN a a -> ReadPN a a -> ReadPN a a +#endif -- ^ Local, exclusive, left-biased choice: If left parser -- locally produces any result at all, then right parser is -- not used. @@ -204,7 +245,11 @@ R f <++ q = discard n = get >> discard (n-1) #endif +#ifndef __NHC__ gather :: ReadP a -> ReadP (String, a) +#else +-- gather :: ReadPN (String->P b) a -> ReadPN (String->P b) (String, a) +#endif -- ^ 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 @@ -268,10 +313,113 @@ skipSpaces = skip (c:s) | isSpace c = do get; skip s skip _ = do return () +count :: Int -> ReadP a -> ReadP [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 open close p@ parses @open@, followed by @p@ and finally +-- @close@. Only the value of @p@ is returned. +between open close p = do open + x <- p + close + return x + +option :: a -> ReadP a -> ReadP 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 p@ optionally parses @p@ and always returns @()@. +optional p = (p >> return ()) +++ return () + +many :: ReadP a -> ReadP [a] +-- ^ Parses zero or more occurrences of the given parser. +many p = return [] +++ many1 p + +many1 :: ReadP a -> ReadP [a] +-- ^ Parses one or more occurrences of the given parser. +many1 p = liftM2 (:) p (many p) + +skipMany :: ReadP a -> ReadP () +-- ^ Like 'many', but discards the result. +skipMany p = many p >> return () + +skipMany1 :: ReadP a -> ReadP () +-- ^ Like 'many1', but discards the result. +skipMany1 p = p >> skipMany p + +sepBy :: ReadP a -> ReadP sep -> ReadP [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 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 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] +-- ^ @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 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 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 +-- ^ Like 'chainr', but parses one or more occurrences of @p@. +chainr1 p op = scan + where scan = p >>= rest + rest x = do f <- op + y <- scan + return (f x y) + +++ return x + +chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a +-- ^ Like 'chainl', but parses one or more occurrences of @p@. +chainl1 p op = p >>= rest + where rest x = do f <- op + y <- p + rest (f x y) + +++ return x + +#ifndef __NHC__ +manyTill :: ReadP a -> ReadP end -> ReadP [a] +#else +manyTill :: ReadPN [a] a -> ReadPN [a] end -> ReadPN [a] [a] +#endif +-- ^ @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 + where scan = (end >> return []) <++ (liftM2 (:) p scan) + -- --------------------------------------------------------------------------- -- Converting between ReadP and Read +#ifndef __NHC__ readP_to_S :: ReadP a -> ReadS a +#else +readP_to_S :: ReadPN a a -> ReadS a +#endif -- ^ 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