[project @ 2005-01-11 13:44:39 by malcolm]
[ghc-base.git] / Text / ParserCombinators / ReadP.hs
index f478230..5835d9a 100644 (file)
 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,12 +152,12 @@ instance MonadPlus P where
 -- ---------------------------------------------------------------------------
 -- The ReadP type
 
--- newtype temporarily turned into data
--- until compiler bug as found on 26 July 2003 is fixed;
--- contact SPJ or ralf@cwi.nl
---
-data ReadP a = R (forall b . (a -> P b) -> P b)
--- newtype ReadP a = R (forall b . (a -> P b) -> P b)
+#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
 
@@ -177,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.
@@ -209,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
@@ -273,14 +313,117 @@ 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
--- @ 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