[Haskell-cafe] Re: Optimizing Parsec 3 -- was: Wiki software?

Stephen Tetley stephen.tetley at gmail.com
Wed Dec 16 04:14:54 EST 2009


2009/12/16 Jason Dusek <jason.dusek at gmail.com>:
>  What is the relationship between the "Parsec API", Applicative
>  and Alternative? Is the only point of overlap `<|>`?


Hello everyone,

Lots of functions in Text.ParserCombinators.Parsec.Combinator can be
defined with only with an obligation on Applicative and no need to
access the token stream, parser state. etc. No surprise of course, as
the equivalents were available in UU parsing.

Here are some if the ones form
Text.ParserCombinators.Parsec.Combinator defined just with Applicative
obligations that I did for a two continuation parser monad a while
ago. I was a bit surprised no-one had put something similar up on
Hackage, maybe they have but its not yet indexed by Hayoo. The code is
a bit old and might be some way off optimal, though the combinators do
show the utility of applicative cons (<:>).

Parsec's character parsers (Text.ParserCombinators.Parsec.Char) need
access to the input. My attempts to define similar ones with only type
class obligations rather than some concrete character type were dismal
failures.


Best wishes

Stephen

-- Applicative cons
(<:>) :: Applicative f => f a -> f [a] -> f [a]
(<:>) p1 p2 = (:) <$> p1 <*> p2


choice :: Alternative f => [f a] -> f a
choice = foldr (<|>) empty

count :: Applicative f => Int -> f a -> f [a]
count i p | i <= 0    = pure []
          | otherwise = p <:> count (i-1) p

between :: Applicative f => f open -> f close -> f a -> f a
between o c a = o *> a <* c


option :: Alternative f => a -> f a -> f a
option x p          = p <|> pure x

optionMaybe :: Alternative f => f a -> f (Maybe a)
optionMaybe = optional

-- aka Parsecs /optional/
optionUnit :: Alternative f => f a -> f ()
optionUnit p = () <$ p <|> pure ()

skipMany1 :: Alternative f => f a -> f ()
skipMany1 p = p *> skipMany p

skipMany :: Alternative f => f a -> f ()
skipMany p = many_p
  where many_p = some_p <|> pure ()
        some_p = p       *> many_p

-- | @many1@ an alias for @some at .
many1 :: Alternative f => f a -> f [a]
many1 = some

sepBy :: Alternative f => f a -> f b -> f [a]
sepBy p sep = sepBy1 p sep <|> pure []

sepBy1 :: Alternative f => f a -> f b -> f [a]
sepBy1 p sep = p <:> step where
    step = (sep *> p) <:> step <|> pure []

sepEndBy :: Alternative f => f a -> f b -> f [a]
sepEndBy p sep = sepEndBy1 p sep <|> pure []

sepEndBy1 :: Alternative f => f a -> f b -> f [a]
sepEndBy1 p sep = (p <* sep) <:> step where
    step = (p <* sep) <:> step <|> pure []

manyTill :: Alternative f => f a -> f b -> f [a]
manyTill p end = step <|> pure [] where
    step = p <:> (step <|> (pure [] <$> end))


More information about the Haskell-Cafe mailing list