Generating AST using Parsec

Hi All, I recently came across the paper titled "Monadic Parser Combinators" - After going through it a few times, I think I am beginning to understand monads. However, the parser developed in the paper does not generate an AST - I feel, I'd grasp the whole thing a lot better if I could go over a sample that generates an AST from a simple expression (or even a standard language such as C or Java) ... Can someone please point me to a sample that generates AST - preferably with the simple parser combinator given in the paper. Regards, Kashyap

Hi Kashyap
Algebraic data types in Haskell and other modern functional languages
are so convenient for describing syntax trees that you don't have need
for a 'tree builder' vis-a-vis Java Tree Builder or JJTree that you
might use in Java.
The original Parsec distribution has parsers and ASTs for Henk and
Andrew Appel's Tiger language and is available here:
http://legacy.cs.uu.nl/daan/parsec.html
Unfortunately the package on Hackage has removed the examples. Parsec
can be considered a progression of the ideas detailed in Hutton and
Meijer's "Monadic Parser Combinators".
Best wishes
Stephen
2009/12/27 CK Kashyap
However, the parser developed in the paper does not generate an AST - I feel, I'd grasp the whole thing a lot better if I could go over a sample that generates an AST from a simple expression (or even a standard language such as C or Java) ... Can someone please point me to a sample that generates AST - preferably with the simple parser combinator given in the paper.

This isn't quite what you're asking for, but by using the applicative
interface to parsers, you need do little more than spell out what your AST
looks like:
import Control.Applicative
import Control.Applicative.Infix
data Equation = String :=: Expression
data Expression = EApp fun arg | EInt Int | EId String
parseEquation :: Parser Equation
parseEquation = parseIdentifier <^(:=:)^> parseExpression
parseExpression :: Parser Expression
parseExpression =
(EApp <$> parseExpression <*> parseExpression)
<|> (EInt <$> parseInt)
<|> (EId <$> parseIdentifier)
parseIdentifier :: Parser String
parseIdentifier = parseLowercaseChar <^(:)^> parseString
etc
Bob
On Sun, Dec 27, 2009 at 10:18 AM, CK Kashyap
Hi All, I recently came across the paper titled "Monadic Parser Combinators" - After going through it a few times, I think I am beginning to understand monads. However, the parser developed in the paper does not generate an AST - I feel, I'd grasp the whole thing a lot better if I could go over a sample that generates an AST from a simple expression (or even a standard language such as C or Java) ... Can someone please point me to a sample that generates AST - preferably with the simple parser combinator given in the paper. Regards, Kashyap
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On Sun, 2009-12-27 at 02:18 -0800, CK Kashyap wrote:
Hi All, I recently came across the paper titled "Monadic Parser Combinators" - After going through it a few times, I think I am beginning to understand monads. However, the parser developed in the paper does not generate an AST - I feel, I'd grasp the whole thing a lot better if I could go over a sample that generates an AST from a simple expression (or even a standard language such as C or Java) ... Can someone please point me to a sample that generates AST - preferably with the simple parser combinator given in the paper. Regards, Kashyap
It parses something like "x+y+z*pi" import Control.Applicative import Text.ParserCombinators.Parsec hiding ((<|>)) data Expr = Variable String | Add Expr Expr | Mul Expr Expr deriving (Show) parseAST :: Parser Expr parseAST = parseAdd parseAdd :: Parser Expr parseAdd = parseMul >>= \e -> ((string "+" >> (Add e <$> parseAdd)) <|> (return e)) parseMul :: Parser Expr parseMul = parseBase >>= \e -> ((string "*" >> (Mul e <$> parseMul)) <|> (return e)) parseBase :: Parser Expr parseBase = (string "(" *> parseAST <* string ")") <|> (Variable <$> many1 letter) Regards
participants (4)
-
CK Kashyap
-
Maciej Piechotka
-
Stephen Tetley
-
Tom Davie