-{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fglasgow-exts -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.ReadP
--
-- Maintainer : libraries@haskell.org
-- Stability : provisional
--- Portability : portable
+-- Portability : non-portable (local universal quantification)
--
-- This is a library of parser combinators, originally written by Koen Claessen.
-- It parses all alternatives in parallel, so it never keeps hold of
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
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
)
where
-import Control.Monad( MonadPlus(..) )
-import GHC.Show( isSpace )
+import Control.Monad( MonadPlus(..), sequence, liftM2 )
+
+#ifdef __GLASGOW_HASKELL__
+#ifndef __HADDOCK__
+import {-# SOURCE #-} GHC.Unicode ( isSpace )
+#endif
+import GHC.List ( replicate )
import GHC.Base
+#else
+import Data.Char( isSpace )
+#endif
infixr 5 +++, <++
--- We define a local version of ReadS here,
--- because its "real" definition site is in GHC.Read
+#ifdef __GLASGOW_HASKELL__
+------------------------------------------------------------------------
+-- 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
-- ---------------------------------------------------------------------------
-- The P type
-- ---------------------------------------------------------------------------
-- 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
-- ^ 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.
+#ifdef __GLASGOW_HASKELL__
R f <++ q =
do s <- look
probe (f return) s 0#
discard 0# = return ()
discard n = get >> discard (n-#1#)
+#else
+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 p@(Result _ _) _ n = discard n >> R (p >>=)
+ probe (Final r) _ _ = R (Final r >>=)
+ probe _ _ _ = q
+
+ discard 0 = return ()
+ 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
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
--- @ readP_to_S :: ReadP a -> String -> [(String,String)] @
+-- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
readP_to_S (R f) = run (f return)
readS_to_P :: ReadS a -> ReadP a