[Haskell-cafe] Parsec question

Tillmann Rendel rendel at rbg.informatik.tu-darmstadt.de
Thu Jun 21 10:03:35 EDT 2007


Levi Stephen wrote:
>> newtype Identifier = Identifier String
>> newtype Literal = StringLiteral String -- to be extended later
>> data Primary = PrimaryLiteral Literal | PrimaryIdentifier Identifier
>>
>> primary = do {
>>        i <- identifier;
>>        return $ PrimaryIdentifier i; }
>>    <|>   do {
>>        l <- stringLiteral;
>>        return $ PrimaryLiteral l; }
>>
> ||> identifier = do
>>    i <- many1 letter
>>    return $ Identifier i
>>
>> stringLiteral = do
>>    (char '\'')
>>    s <- manyTill anyChar (char '\'')
>>    return $ StringLiteral s
> 
> Is there a way through combining types/parsers that the double do block 
> in primary could be avoided?

I prefer using Control.Monad.ap:

   primary =     (return PrimaryIdentifier `ap` identifier)
             <|> (return PrimaryLiteral `ap` stringLiteral)

   identifier = return Identifier `ap` many1 letter

   stringLiteral = return StringLiteral
                   `ap` (quote >> manyTill anyChar quote)

   quote = char '\''

This scales easily to the case of multiple fields per constructor, 
provided that the order of the subterms in the abstract syntax is the 
same as in the concrete syntax:

   data FunctionCall = FunctionCall Identifier [Primary]

   functionCall = return FunctionCall
                  `ap` identifier
                  `ap` parens (primary `sepBy` comma)

   parens = between lparen rparen

   lparen = char '('
   rparen = char ')'
   comma = char ','



My self-defined monadic combinator of choice to use with parsec is

   a >>~ b = a >>= \x -> b >> return x

It works like (>>), but returns the result of the first instead of the 
result of the second computation. It is kind of an alternative for between:

   between lparen rparen p   ==   lparen >> p >>~ rparen

It can be usefull like this:

   data Term = TVar Identifier | TTerm Identifier [Term]

   term =     (return TTerm
               `ap` try (identififer >>~ lparen)
               `ap` (term `sepBy` comma >>~ rparen))

          <|> (return TVar
               `ap` identifier)

After accepting lparen, the second branch is discarded.

   Tillmann


More information about the Haskell-Cafe mailing list