1 {-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
4 -- Module : Text.ParserCombinators.ReadP
5 -- Copyright : (c) The University of Glasgow 2002
6 -- License : BSD-style (see the file libraries/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : provisional
10 -- Portability : non-portable (local universal quantification)
12 -- This is a library of parser combinators, originally written by Koen Claessen.
13 -- It parses all alternatives in parallel, so it never keeps hold of
14 -- the beginning of the input string, a common source of space leaks with
15 -- other parsers. The '(+++)' choice combinator is genuinely commutative;
16 -- it makes no difference which branch is \"shorter\".
18 -----------------------------------------------------------------------------
20 module Text.ParserCombinators.ReadP
23 ReadP, -- :: * -> *; instance Functor, Monad, MonadPlus
25 -- * Primitive operations
27 look, -- :: ReadP String
28 (+++), -- :: ReadP a -> ReadP a -> ReadP a
29 (<++), -- :: ReadP a -> ReadP a -> ReadP a
30 gather, -- :: ReadP a -> ReadP (String, a)
34 satisfy, -- :: (Char -> Bool) -> ReadP Char
35 char, -- :: Char -> ReadP Char
36 string, -- :: String -> ReadP String
37 munch, -- :: (Char -> Bool) -> ReadP String
38 munch1, -- :: (Char -> Bool) -> ReadP String
39 skipSpaces, -- :: ReadP ()
40 choice, -- :: [ReadP a] -> ReadP a
41 count, -- :: Int -> ReadP a -> ReadP [a]
42 between, -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a
43 option, -- :: a -> ReadP a -> ReadP a
44 optional, -- :: ReadP a -> ReadP ()
45 many, -- :: ReadP a -> ReadP [a]
46 many1, -- :: ReadP a -> ReadP [a]
47 skipMany, -- :: ReadP a -> ReadP ()
48 skipMany1, -- :: ReadP a -> ReadP ()
49 sepBy, -- :: ReadP a -> ReadP sep -> ReadP [a]
50 sepBy1, -- :: ReadP a -> ReadP sep -> ReadP [a]
51 endBy, -- :: ReadP a -> ReadP sep -> ReadP [a]
52 endBy1, -- :: ReadP a -> ReadP sep -> ReadP [a]
53 chainr, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
54 chainl, -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
55 chainl1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
56 chainr1, -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
57 manyTill, -- :: ReadP a -> ReadP end -> ReadP [a]
60 ReadS, -- :: *; = String -> [(a,String)]
61 readP_to_S, -- :: ReadP a -> ReadS a
62 readS_to_P, -- :: ReadS a -> ReadP a
69 import Control.Monad( MonadPlus(..), sequence, liftM2 )
71 #ifdef __GLASGOW_HASKELL__
73 import {-# SOURCE #-} GHC.Unicode ( isSpace )
75 import GHC.List ( replicate )
78 import Data.Char( isSpace )
83 #ifdef __GLASGOW_HASKELL__
84 ------------------------------------------------------------------------
87 -- | A parser for a type @a@, represented as a function that takes a
88 -- 'String' and returns a list of possible parses as @(a,'String')@ pairs.
90 -- Note that this kind of backtracking parser is very inefficient;
91 -- reading a large structure may be quite slow (cf 'ReadP').
92 type ReadS a = String -> [(a,String)]
95 -- ---------------------------------------------------------------------------
97 -- is representation type -- should be kept abstract
101 | Look (String -> P a)
104 | Final [(a,String)] -- invariant: list is non-empty!
108 instance Monad P where
109 return x = Result x Fail
111 (Get f) >>= k = Get (\c -> f c >>= k)
112 (Look f) >>= k = Look (\s -> f s >>= k)
114 (Result x p) >>= k = k x `mplus` (p >>= k)
115 (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
119 instance MonadPlus P where
122 -- most common case: two gets are combined
123 Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c)
125 -- results are delivered as soon as possible
126 Result x p `mplus` q = Result x (p `mplus` q)
127 p `mplus` Result x q = Result x (p `mplus` q)
133 -- two finals are combined
134 -- final + look becomes one look and one final (=optimization)
135 -- final + sthg else becomes one look and one final
136 Final r `mplus` Final t = Final (r ++ t)
137 Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s))
138 Final r `mplus` p = Look (\s -> Final (r ++ run p s))
139 Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r))
140 p `mplus` Final r = Look (\s -> Final (run p s ++ r))
142 -- two looks are combined (=optimization)
143 -- look + sthg else floats upwards
144 Look f `mplus` Look g = Look (\s -> f s `mplus` g s)
145 Look f `mplus` p = Look (\s -> f s `mplus` p)
146 p `mplus` Look f = Look (\s -> p `mplus` f s)
148 -- ---------------------------------------------------------------------------
151 newtype ReadP a = R (forall b . (a -> P b) -> P b)
153 -- Functor, Monad, MonadPlus
155 instance Functor ReadP where
156 fmap h (R f) = R (\k -> f (k . h))
158 instance Monad ReadP where
159 return x = R (\k -> k x)
160 fail _ = R (\_ -> Fail)
161 R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
163 instance MonadPlus ReadP where
167 -- ---------------------------------------------------------------------------
170 final :: [(a,String)] -> P a
171 -- Maintains invariant for Final constructor
175 run :: P a -> ReadS a
176 run (Get f) (c:s) = run (f c) s
177 run (Look f) s = run (f s) s
178 run (Result x p) s = (x,s) : run p s
182 -- ---------------------------------------------------------------------------
183 -- Operations over ReadP
186 -- ^ Consumes and returns the next character.
187 -- Fails if there is no input left.
191 -- ^ Look-ahead: returns the part of the input that is left, without
197 pfail = R (\_ -> Fail)
199 (+++) :: ReadP a -> ReadP a -> ReadP a
200 -- ^ Symmetric choice.
201 R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
203 (<++) :: ReadP a -> ReadP a -> ReadP a
204 -- ^ Local, exclusive, left-biased choice: If left parser
205 -- locally produces any result at all, then right parser is
207 #ifdef __GLASGOW_HASKELL__
210 probe (f return) s 0#
212 probe (Get f) (c:s) n = probe (f c) s (n+#1#)
213 probe (Look f) s n = probe (f s) s n
214 probe p@(Result _ _) _ n = discard n >> R (p >>=)
215 probe (Final r) _ _ = R (Final r >>=)
218 discard 0# = return ()
219 discard n = get >> discard (n-#1#)
225 probe (Get f) (c:s) n = probe (f c) s (n+1)
226 probe (Look f) s n = probe (f s) s n
227 probe p@(Result _ _) _ n = discard n >> R (p >>=)
228 probe (Final r) _ _ = R (Final r >>=)
231 discard 0 = return ()
232 discard n = get >> discard (n-1)
235 gather :: ReadP a -> ReadP (String, a)
236 -- ^ Transforms a parser into one that does the same, but
237 -- in addition returns the exact characters read.
238 -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
239 -- is built using any occurrences of readS_to_P.
241 R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))
243 gath l (Get f) = Get (\c -> gath (l.(c:)) (f c))
245 gath l (Look f) = Look (\s -> gath l (f s))
246 gath l (Result k p) = k (l []) `mplus` gath l p
247 gath l (Final r) = error "do not use readS_to_P in gather!"
249 -- ---------------------------------------------------------------------------
250 -- Derived operations
252 satisfy :: (Char -> Bool) -> ReadP Char
253 -- ^ Consumes and returns the next character, if it satisfies the
254 -- specified predicate.
255 satisfy p = do c <- get; if p c then return c else pfail
257 char :: Char -> ReadP Char
258 -- ^ Parses and returns the specified character.
259 char c = satisfy (c ==)
261 string :: String -> ReadP String
262 -- ^ Parses and returns the specified string.
263 string this = do s <- look; scan this s
265 scan [] _ = do return this
266 scan (x:xs) (y:ys) | x == y = do get; scan xs ys
269 munch :: (Char -> Bool) -> ReadP String
270 -- ^ Parses the first zero or more characters satisfying the predicate.
275 scan (c:cs) | p c = do get; s <- scan cs; return (c:s)
276 scan _ = do return ""
278 munch1 :: (Char -> Bool) -> ReadP String
279 -- ^ Parses the first one or more characters satisfying the predicate.
282 if p c then do s <- munch p; return (c:s) else pfail
284 choice :: [ReadP a] -> ReadP a
285 -- ^ Combines all parsers in the specified list.
288 choice (p:ps) = p +++ choice ps
290 skipSpaces :: ReadP ()
291 -- ^ Skips all whitespace.
296 skip (c:s) | isSpace c = do get; skip s
297 skip _ = do return ()
299 count :: Int -> ReadP a -> ReadP [a]
300 -- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of
301 -- results is returned.
302 count n p = sequence (replicate n p)
304 between :: ReadP open -> ReadP close -> ReadP a -> ReadP a
305 -- ^ @between open close p@ parses @open@, followed by @p@ and finally
306 -- @close@. Only the value of @p@ is returned.
307 between open close p = do open
312 option :: a -> ReadP a -> ReadP a
313 -- ^ @option x p@ will either parse @p@ or return @x@ without consuming
315 option x p = p +++ return x
317 optional :: ReadP a -> ReadP ()
318 -- ^ @optional p@ optionally parses @p@ and always returns @()@.
319 optional p = (p >> return ()) +++ return ()
321 many :: ReadP a -> ReadP [a]
322 -- ^ Parses zero or more occurrences of the given parser.
323 many p = return [] +++ many1 p
325 many1 :: ReadP a -> ReadP [a]
326 -- ^ Parses one or more occurrences of the given parser.
327 many1 p = liftM2 (:) p (many p)
329 skipMany :: ReadP a -> ReadP ()
330 -- ^ Like 'many', but discards the result.
331 skipMany p = many p >> return ()
333 skipMany1 :: ReadP a -> ReadP ()
334 -- ^ Like 'many1', but discards the result.
335 skipMany1 p = p >> skipMany p
337 sepBy :: ReadP a -> ReadP sep -> ReadP [a]
338 -- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
339 -- Returns a list of values returned by @p@.
340 sepBy p sep = sepBy1 p sep +++ return []
342 sepBy1 :: ReadP a -> ReadP sep -> ReadP [a]
343 -- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
344 -- Returns a list of values returned by @p@.
345 sepBy1 p sep = liftM2 (:) p (many (sep >> p))
347 endBy :: ReadP a -> ReadP sep -> ReadP [a]
348 -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
350 endBy p sep = many (do x <- p ; sep ; return x)
352 endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
353 -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
355 endBy1 p sep = many1 (do x <- p ; sep ; return x)
357 chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
358 -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
359 -- Returns a value produced by a /right/ associative application of all
360 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
362 chainr p op x = chainr1 p op +++ return x
364 chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
365 -- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
366 -- Returns a value produced by a /left/ associative application of all
367 -- functions returned by @op@. If there are no occurrences of @p@, @x@ is
369 chainl p op x = chainl1 p op +++ return x
371 chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
372 -- ^ Like 'chainr', but parses one or more occurrences of @p@.
374 where scan = p >>= rest
380 chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
381 -- ^ Like 'chainl', but parses one or more occurrences of @p@.
382 chainl1 p op = p >>= rest
383 where rest x = do f <- op
388 manyTill :: ReadP a -> ReadP end -> ReadP [a]
389 -- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
390 -- succeeds. Returns a list of values returned by @p@.
391 manyTill p end = scan
392 where scan = (end >> return []) <++ (liftM2 (:) p scan)
394 -- ---------------------------------------------------------------------------
395 -- Converting between ReadP and Read
397 readP_to_S :: ReadP a -> ReadS a
398 -- ^ Converts a parser into a Haskell ReadS-style function.
399 -- This is the main way in which you can \"run\" a 'ReadP' parser:
400 -- the expanded type is
401 -- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
402 readP_to_S (R f) = run (f return)
404 readS_to_P :: ReadS a -> ReadP a
405 -- ^ Converts a Haskell ReadS-style function into a parser.
406 -- Warning: This introduces local backtracking in the resulting
407 -- parser, and therefore a possible inefficiency.
409 R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
411 -- ---------------------------------------------------------------------------
412 -- QuickCheck properties that hold for the combinators
415 The following are QuickCheck specifications of what the combinators do.
416 These can be seen as formal specifications of the behavior of the
419 We use bags to give semantics to the combinators.
423 Equality on bags does not care about the order of elements.
425 > (=~) :: Ord a => Bag a -> Bag a -> Bool
426 > xs =~ ys = sort xs == sort ys
428 A special equality operator to avoid unresolved overloading
429 when testing the properties.
431 > (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool
434 Here follow the properties:
437 > readP_to_S get [] =~ []
439 > prop_Get_Cons c s =
440 > readP_to_S get (c:s) =~ [(c,s)]
443 > readP_to_S look s =~ [(s,s)]
446 > readP_to_S pfail s =~. []
449 > readP_to_S (return x) s =~. [(x,s)]
452 > readP_to_S (p >>= k) s =~.
454 > | (x,s') <- readP_to_S p s
455 > , ys'' <- readP_to_S (k (x::Int)) s'
459 > readP_to_S (p +++ q) s =~.
460 > (readP_to_S p s ++ readP_to_S q s)
462 > prop_LeftPlus p q s =
463 > readP_to_S (p <++ q) s =~.
464 > (readP_to_S p s +<+ readP_to_S q s)
470 > forAll readPWithoutReadS $ \p ->
471 > readP_to_S (gather p) s =~
472 > [ ((pre,x::Int),s')
473 > | (x,s') <- readP_to_S p s
474 > , let pre = take (length s - length s') s
477 > prop_String_Yes this s =
478 > readP_to_S (string this) (this ++ s) =~
481 > prop_String_Maybe this s =
482 > readP_to_S (string this) s =~
483 > [(this, drop (length this) s) | this `isPrefixOf` s]
486 > readP_to_S (munch p) s =~
487 > [(takeWhile p s, dropWhile p s)]
490 > readP_to_S (munch1 p) s =~
491 > [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
494 > readP_to_S (choice ps) s =~.
495 > readP_to_S (foldr (+++) pfail ps) s
498 > readP_to_S (readS_to_P r) s =~. r s