CloudFlare suffered a massive security issue affecting all of its customers, including Rosetta Code. All passwords not changed since February 19th 2017 have been expired, and session cookie longevity will be reduced until late March.--Michael Mol (talk) 05:15, 25 February 2017 (UTC)

Compiler/syntax analyzer

From Rosetta Code
Task
Compiler/syntax analyzer
You are encouraged to solve this task according to the task description, using any language you may know.
Syntax Analyzer

A Syntax analyzer transforms a token stream (from the Lexical analyzer) into a Syntax tree, based on a grammar.

Task[edit]

Take the output from the Lexical analyzer task, and convert it to an Abstract Syntax Tree (AST), based on the grammar below. The output should be in a flattened format.

The program should read input from a file and/or stdin, and write output to a file and/or stdout. If the language being used has a parser module/library/class, it would be great if two versions of the solution are provided: One without the parser module, and one with.

Grammar

The simple programming language to be analyzed is more or less a (very tiny) subset of C. The formal grammar in Extended Backus-Naur Form (EBNF):

 
stmt_list = {stmt} ;
 
stmt = ';'
| Identifier '=' expr ';'
| 'while' paren_expr stmt
| 'if' paren_expr stmt ['else' stmt]
| 'print' '(' prt_list ')' ';'
| 'putc' paren_expr ';'
| '{' stmt_list '}'
 ;
 
paren_expr = '(' expr ')' ;
 
prt_list = string | expr {',' String | expr} ;
 
expr = and_expr {'||' and_expr} ;
and_expr = equality_expr {'&&' equality_expr} ;
equality_expr = relational_expr [('==' | '!=') relational_expr] ;
relational_expr = addition_expr [('<' | '<=' | '>' | '>=') addition_expr] ;
addition_expr = multiplication_expr {('+' | '-') multiplication_expr} ;
multiplication_expr = primary {('*' | '/' | '%') primary } ;
primary = Identifier
| Integer
| '(' expr ')'
| ('+' | '-' | '!') primary
 ;

The resulting AST should be formulated as a Binary Tree.

Example - given the simple program (below), stored in a file called while.t, create the list of tokens, using one of the Lexical analyzer solutions
lex < while.t > while.lex
Run one of the Syntax analyzer solutions
parse < while.lex > while.ast
The following table shows the input to lex, lex output, and the AST produced by the parser
Input to lex Output from lex, input to parse Output from parse
count = 1;
while (count < 10) {
print("count is: ", count, "\n");
count = count + 1;
}
    1      1 Identifier      count
    1      7 Op_assign
    1      9 Integer             1
    1     10 Semicolon
    2      1 Keyword_while
    2      7 LeftParen
    2      8 Identifier      count
    2     14 Op_less
    2     16 Integer            10
    2     18 RightParen
    2     20 LeftBrace
    3      5 Keyword_print
    3     10 LeftParen
    3     11 String          "count is: "
    3     23 Comma
    3     25 Identifier      count
    3     30 Comma
    3     32 String          "\n"
    3     36 RightParen
    3     37 Semicolon
    4      5 Identifier      count
    4     11 Op_assign
    4     13 Identifier      count
    4     19 Op_add
    4     21 Integer             1
    4     22 Semicolon
    5      1 RightBrace
    6      1 End_of_input
Sequence
Sequence
;
Assign
Identifier    count
Integer       1
While
Less
Identifier    count
Integer       10
Sequence
Sequence
;
Sequence
Sequence
Sequence
;
Prts
String        "count is: "
;
Prti
Identifier    count
;
Prts
String        "\n"
;
Assign
Identifier    count
Add
Identifier    count
Integer       1
Specifications
List of node type names
Identifier String Integer Sequence If Prtc Prts Prti While Assign Negate Not Multiply Divide Mod
Add Subtract Less LessEqual Greater GreaterEqual Equal NotEqual And Or

In the text below, Null/Empty nodes are represented by ";".

Non-terminal (internal) nodes

For Operators, the following nodes should be created:

Multiply Divide Mod Add Subtract Less LessEqual Greater GreaterEqual Equal NotEqual And Or

For each of the above nodes, the left and right sub-nodes are the operands of the respective operation.

In pseudo S-Expression format:

(Operator expression expression)

Negate, Not

For these node types, the left node is the operand, and the right node is null.

(Operator expression ;)

Sequence - sub-nodes are either statements or Sequences.

If - left node is the expression, the right node is If node, with it's left node being the if-true statement part, and the right node being the if-false (else) statement part.

(If expression (If statement else-statement))

If there is not an else, the tree becomes:

(If expression (If statement ;))

Prtc

(Prtc (expression) ;)

Prts

(Prts (String "the string") ;)

Prti

(Prti (Integer 12345) ;)

While - left node is the expression, the right node is the statement.

(While expression statement)

Assign - left node is the left-hand side of the assignment, the right node is the right-hand side of the assignment.

(Assign Identifier expression)

Terminal (leaf) nodes:

Identifier: (Identifier ident_name)
Integer:    (Integer 12345)
String:     (String "Hello World!")
";":        Empty node
Some simple examples

Sequences denote a list node; they are used to represent a list. semicolon's represent a null node, e.g., the end of this path.

This simple program:

   a=11;

Produces the following AST, encoded as a binary tree:

Under each non-leaf node are two '|' lines. The first represents the left sub-node, the second represents the right sub-node:

   (1) Sequence
   (2)     |-- ;
   (3)     |-- Assign
   (4)         |-- Identifier: a
   (5)         |-- Integer: 11

In flattened form:

   (1) Sequence
   (2) ;
   (3) Assign
   (4) Identifier    a
   (5) Integer       11


This program:

   a=11;
   b=22;
   c=33;

Produces the following AST:

   ( 1) Sequence
   ( 2)     |-- Sequence
   ( 3)     |   |-- Sequence
   ( 4)     |   |   |-- ;
   ( 5)     |   |   |-- Assign
   ( 6)     |   |       |-- Identifier: a
   ( 7)     |   |       |-- Integer: 11
   ( 8)     |   |-- Assign
   ( 9)     |       |-- Identifier: b
   (10)     |       |-- Integer: 22
   (11)     |-- Assign
   (12)         |-- Identifier: c
   (13)         |-- Integer: 33

In flattened form:

   ( 1) Sequence
   ( 2) Sequence
   ( 3) Sequence
   ( 4) ;
   ( 5) Assign
   ( 6) Identifier    a
   ( 7) Integer       11
   ( 8) Assign
   ( 9) Identifier    b
   (10) Integer       22
   (11) Assign
   (12) Identifier    c
   (13) Integer       33
Pseudo-code for the parser.

Uses Precedence Climbing for expression parsing, and Recursive Descent for statement parsing. The AST is also built:

def expr(p)
if tok is "("
x = paren_expr()
elif tok in ["-", "+", "!"]
gettok()
y = expr(precedence of operator)
if operator was "+"
x = y
else
x = make_node(operator, y)
elif tok is an Identifier
x = make_leaf(Identifier, variable name)
gettok()
elif tok is an Integer constant
x = make_leaf(Integer, integer value)
gettok()
else
error()
 
while tok is a binary operator and precedence of tok >= p
save_tok = tok
gettok()
q = precedence of save_tok
if save_tok is not right associative
q += 1
x = make_node(Operator save_tok represents, x, expr(q))
 
return x
 
def paren_expr()
expect("(")
x = expr(0)
expect(")")
return x
 
def stmt()
t = NULL
if accept("if")
e = paren_expr()
s = stmt()
t = make_node(If, e, make_node(If, s, accept("else") ? stmt() : NULL))
elif accept("putc")
t = make_node(Prtc, paren_expr())
expect(";")
elif accept("print")
expect("(")
repeat
if tok is a string
e = make_node(Prts, make_leaf(String, the string))
gettok()
else
e = make_node(Prti, expr(0))
 
t = make_node(Sequence, t, e)
until not accept(",")
expect(")")
expect(";")
elif tok is ";"
gettok()
elif tok is an Identifier
v = make_leaf(Identifier, variable name)
gettok()
expect("=")
t = make_node(Assign, v, expr(0))
expect(";")
elif accept("while")
e = paren_expr()
t = make_node(While, e, stmt()
elif accept("{")
while tok not equal "}" and tok not equal end-of-file
t = make_node(Sequence, t, stmt())
expect("}")
elif tok is end-of-file
pass
else
error()
return t
 
def parse()
t = NULL
gettok()
repeat
t = make_node(Sequence, t, stmt())
until tok is end-of-file
return t
Once the AST is built, it should be output in a flattened format. This can be as simple as the following
def prt_ast(t)
if t == NULL
print(";\n")
else
print(t.node_type)
if t.node_type in [Identifier, Integer, String] # leaf node
print the value of the Ident, Integer or String, "\n"
else
print("\n")
prt_ast(t.left)
prt_ast(t.right)
If the AST is correctly built, loading it into a subsequent program should be as simple as
def load_ast()
line = readline()
# Each line has at least one token
line_list = tokenize the line, respecting double quotes
 
text = line_list[0] # first token is always the node type
 
if text == ";" # a terminal node
return NULL
 
node_type = text # could convert to internal form if desired
 
# A line with two tokens is a leaf node
# Leaf nodes are: Identifier, Integer, String
# The 2nd token is the value
if len(line_list) > 1
return make_leaf(node_type, line_list[1])
 
left = load_ast()
right = load_ast()
return make_node(node_type, left, right)

Finally, the AST can also be tested by running it against one of the AST Interpreter solutions.

Test program, assuming this is in a file called prime.t
lex <prime.t | parse
Input to lex Output from lex, input to parse Output from parse
/*
Simple prime number generator
*/

count = 1;
n = 1;
limit = 100;
while (n < limit) {
k=3;
p=1;
n=n+2;
while ((k*k<=n) && (p)) {
p=n/k*k!=n;
k=k+2;
}
if (p) {
print(n, " is prime\n");
count = count + 1;
}
}
print("Total primes found: ", count, "\n");
    4      1 Identifier      count
    4      7 Op_assign
    4      9 Integer             1
    4     10 Semicolon
    5      1 Identifier      n
    5      3 Op_assign
    5      5 Integer             1
    5      6 Semicolon
    6      1 Identifier      limit
    6      7 Op_assign
    6      9 Integer           100
    6     12 Semicolon
    7      1 Keyword_while
    7      7 LeftParen
    7      8 Identifier      n
    7     10 Op_less
    7     12 Identifier      limit
    7     17 RightParen
    7     19 LeftBrace
    8      5 Identifier      k
    8      6 Op_assign
    8      7 Integer             3
    8      8 Semicolon
    9      5 Identifier      p
    9      6 Op_assign
    9      7 Integer             1
    9      8 Semicolon
   10      5 Identifier      n
   10      6 Op_assign
   10      7 Identifier      n
   10      8 Op_add
   10      9 Integer             2
   10     10 Semicolon
   11      5 Keyword_while
   11     11 LeftParen
   11     12 LeftParen
   11     13 Identifier      k
   11     14 Op_multiply
   11     15 Identifier      k
   11     16 Op_lessequal
   11     18 Identifier      n
   11     19 RightParen
   11     21 Op_and
   11     24 LeftParen
   11     25 Identifier      p
   11     26 RightParen
   11     27 RightParen
   11     29 LeftBrace
   12      9 Identifier      p
   12     10 Op_assign
   12     11 Identifier      n
   12     12 Op_divide
   12     13 Identifier      k
   12     14 Op_multiply
   12     15 Identifier      k
   12     16 Op_notequal
   12     18 Identifier      n
   12     19 Semicolon
   13      9 Identifier      k
   13     10 Op_assign
   13     11 Identifier      k
   13     12 Op_add
   13     13 Integer             2
   13     14 Semicolon
   14      5 RightBrace
   15      5 Keyword_if
   15      8 LeftParen
   15      9 Identifier      p
   15     10 RightParen
   15     12 LeftBrace
   16      9 Keyword_print
   16     14 LeftParen
   16     15 Identifier      n
   16     16 Comma
   16     18 String          " is prime\n"
   16     31 RightParen
   16     32 Semicolon
   17      9 Identifier      count
   17     15 Op_assign
   17     17 Identifier      count
   17     23 Op_add
   17     25 Integer             1
   17     26 Semicolon
   18      5 RightBrace
   19      1 RightBrace
   20      1 Keyword_print
   20      6 LeftParen
   20      7 String          "Total primes found: "
   20     29 Comma
   20     31 Identifier      count
   20     36 Comma
   20     38 String          "\n"
   20     42 RightParen
   20     43 Semicolon
   21      1 End_of_input
Sequence
Sequence
Sequence
Sequence
Sequence
;
Assign
Identifier    count
Integer       1
Assign
Identifier    n
Integer       1
Assign
Identifier    limit
Integer       100
While
Less
Identifier    n
Identifier    limit
Sequence
Sequence
Sequence
Sequence
Sequence
;
Assign
Identifier    k
Integer       3
Assign
Identifier    p
Integer       1
Assign
Identifier    n
Add
Identifier    n
Integer       2
While
And
LessEqual
Multiply
Identifier    k
Identifier    k
Identifier    n
Identifier    p
Sequence
Sequence
;
Assign
Identifier    p
NotEqual
Multiply
Divide
Identifier    n
Identifier    k
Identifier    k
Identifier    n
Assign
Identifier    k
Add
Identifier    k
Integer       2
If
Identifier    p
If
Sequence
Sequence
;
Sequence
Sequence
;
Prti
Identifier    n
;
Prts
String        " is prime\n"
;
Assign
Identifier    count
Add
Identifier    count
Integer       1
;
Sequence
Sequence
Sequence
;
Prts
String        "Total primes found: "
;
Prti
Identifier    count
;
Prts
String        "\n"
;
Additional examples

Your solution should pass all the test cases above and the additional tests found Here.

Reference

The C and Python versions can be considered reference implementations.

Related Tasks

ALGOL W[edit]

begin % syntax analyser %
 % parse tree nodes %
record node( integer type
 ; reference(node) left, right
 ; integer iValue % nString/nIndentifier number or nInteger value %
);
integer nIdentifier, nString, nInteger, nSequence, nIf, nPrtc, nPrts
, nPrti, nWhile, nAssign, nNegate, nNot, nMultiply
, nDivide, nMod, nAdd, nSubtract, nLess, nLessEqual
, nGreater, nGreaterEqual, nEqual, nNotEqual, nAnd, nOr
 ;
string(14) array ndName ( 1 :: 25 );
 % tokens - names must match those output by the lexical analyser %
integer tkType, tkLine, tkColumn, tkLength, tkIntegerValue;
integer tOp_multiply , tOp_divide , tOp_mod , tOp_add
, tOp_subtract , tOp_negate , tOp_less , tOp_lessequal
, tOp_greater , tOp_greaterequal , tOp_equal , tOp_notequal
, tOp_not , tOp_assign , tOp_and , tOp_or
, tLeftParen , tRightParen , tLeftBrace , tRightBrace
, tSemicolon , tComma , tKeyword_if , tKeyword_else
, tKeyword_while , tKeyword_print , tKeyword_putc , tIdentifier
, tInteger , tString , tEnd_of_input
, MAX_TOKEN_TYPE, PRIMARY_PREC
 ;
string(16) array tkName ( 1 :: 31 );
integer array tkPrec, tkNode ( 1 :: 31 );
 % string literals and identifiers - uses a linked list - a hash table might be better... %
string(1) array text ( 0 :: 4095 );
integer textNext, TEXT_MAX;
record textElement ( integer start, length; reference(textElement) next );
reference(textElement) idList, stList;
 
 % returns a new node with left and right branches %
reference(node) procedure opNode ( integer value opType; reference(node) value opLeft, opRight ) ; begin
node( opType, opLeft, opRight, 0 )
end opNode ;
 
 % returns a new operand node %
reference(node) procedure operandNode ( integer value opType, opValue ) ; begin
node( opType, null, null, opValue )
end operandNode ;
 
 % reports an error %
procedure synError( integer value line, column; string(80) value message ); begin
integer errorPos;
write( i_w := 1, s_w := 0, "**** Error at(", line, ",", column, "): " );
errorPos := 0;
while errorPos < 80 and message( errorPos // 1 ) not = "." do begin
writeon( s_w := 0, message( errorPos // 1 ) );
errorPos := errorPos + 1
end while_not_at_end_of_message ;
writeon( s_w := 0, "." )
end synError ;
 
 % reports an error and stops %
procedure fatalError( integer value line, column; string(80) value message ); begin
synError( line, column, message );
assert( false )
end fatalError ;
 
 % prints a node and its sub-nodes %
procedure writeNode( reference(node) value n ) ; begin
 % prints an identifier or string from text %
procedure writeOnText( reference(textElement) value txHead; integer value txNumber ) ;
begin
reference(textElement) txPos;
integer count;
txPos := txHead;
count := 1;
while count < txNumber and txPos not = null do begin
txPos := next(txPos);
count := count + 1
end while_text_element_not_found ;
if txPos = null then fatalError( 0, txNumber, "INTERNAL ERROR: text not found." )
else for cPos := 0 until length(txPos) - 1 do writeon( text( start(txPos) + cPos ) );
if text( start(txPos) ) = """" then writeon( """" );
end writeOnText ;
 
if n = null then write( ";" )
else begin
write( ndName( type(n) ) );
if type(n) = nInteger then writeon( iValue(n) )
else if type(n) = nIdentifier then writeOnText( idList, iValue(n) )
else if type(n) = nString then writeOnText( stList, iValue(n) )
else begin
writeNode( left(n) );
writeNode( right(n) )
end
end
end writeNode ;
 
 % reads a token from standard input %
procedure readToken ; begin
 
 % parses a string from line and stores it in a string in the text array %
 % - if it is not already present in the specified textElement list.  %
 % returns the position of the string in the text array  %
integer procedure readString ( reference(textElement) value result txList; string(1) value terminator ) ; begin
string(256) str;
integer sLen, sPos, ePos;
logical found;
reference(textElement) txPos, txLastPos;
 % get the text of the string %
str  := " ";
sLen := 0;
str( sLen // 1 ) := line( lPos // 1 );
sLen := sLen + 1;
lPos := lPos + 1;
while lPos <= 255 and line( lPos // 1 ) not = terminator do begin
str( sLen // 1 ) := line( lPos // 1 );
sLen := sLen + 1;
lPos := lPos + 1
end while_more_string ;
if lPos > 255 then fatalError( tkLine, tkColumn, "Unterminated String in token file." );
 % attempt to find the text in the list of strings/identifiers %
txLastPos := txPos := txList;
found := false;
ePos := 0;
while not found and txPos not = null do begin
ePos  := ePos + 1;
found := ( length(txPos) = sLen );
sPos  := 0;
while found and sPos < sLen do begin
found := str( sPos // 1 ) = text( start(txPos) + sPos );
sPos  := sPos + 1
end while_not_found ;
txLastPos := txPos;
if not found then txPos := next(txPos)
end while_string_not_found ;
if not found then begin
 % the string/identifier is not in the list - add it %
ePos := ePos + 1;
if txList = null then txList := textElement( textNext, sLen, null )
else next(txLastPos) := textElement( textNext, sLen, null );
if textNext + sLen > TEXT_MAX then fatalError( tkLine, tkColumn, "Text space exhausted." )
else begin
for cPos := 0 until sLen - 1 do begin
text( textNext ) := str( cPos // 1 );
textNext := textNext + 1
end for_cPos
end
end if_not_found ;
ePos
end readString ;
 
 % gets an integer from the line - no checks for valid digits %
integer procedure readInteger ; begin
integer n;
while line( lPos // 1 ) = " " do lPos := lPos + 1;
n := 0;
while line( lPos // 1 ) not = " " do begin
n  := ( n * 10 ) + ( decode( line( lPos // 1 ) ) - decode( "0" ) );
lPos := lPos + 1
end while_not_end_of_integer ;
n
end readInteger ;
 
string(256) line;
string(16) name;
integer lPos, tPos;
tPos := lPos := 0;
readcard( line );
 % get the line and column numbers %
tkLine  := readInteger;
tkColumn := readInteger;
 % get the token name %
while line( lPos // 1 ) = " " do lPos := lPos + 1;
name := "";
while lPos < 256 and line( lPos // 1 ) not = " " do begin
name( tPos // 1 ) := line( lPos // 1 );
lPos := lPos + 1;
tPos := tPos + 1
end while_more_name ;
 % determine the token type %
tkType  := 1;
tkIntegerValue := 0;
while tkType <= MAX_TOKEN_TYPE and name not = tkName( tkType ) do tkType := tkType + 1;
if tkType > MAX_TOKEN_TYPE then fatalError( tkLine, tkColumn, "Malformed token" );
 % handle the additional parameter for identifier/string/integer %
if tkType = tInteger or tkType = tIdentifier or tkType = tString then begin
while line( lPos // 1 ) = " " do lPos := lPos + 1;
if tkType = tInteger then tkIntegerValue := readInteger
else if tkType = tIdentifier then tkIntegerValue := readString( idList, " " )
else  % tkType = tString  % tkIntegerValue := readString( stList, """" )
end if_token_with_additional_parameter ;
end readToken ;
 
 % parses a statement %
reference(node) procedure parseStatement ; begin
reference(node) stmtNode, stmtExpr;
 
 % skips the current token if it is expectedToken,  %
 % returns true if the token was expectedToken, false otherwise %
logical procedure have ( integer value expectedToken ) ; begin
logical haveExpectedToken;
haveExpectedToken := ( tkType = expectedToken );
if haveExpectedToken and tkType not = tEnd_of_input then readToken;
haveExpectedToken
end have ;
 
 % issues an error message and skips past the next semi-colon or to end of input %
procedure skipStatement ( string(80) value message ) ; begin
synError( tkLine, tkColumn, message );
while tkType not = tEnd_of_input and not have( tSemicolon ) do readToken
end skipStatement ;
 
 % checks we have a semicolon, issues an error and skips the statement if not %
procedure mustBeEndOfStatement ; begin
if not have( tSemicolon ) then skipStatement( """;"" expected." )
end mustBeEndOfStatement ;
 
 % skips the current token if it is "(" and issues an error if it isn't %
procedure mustBeLeftParen ; begin
if not have( tLeftParen ) then synError( tkLine, tkColumn, """("" expected." )
end % mustBeLeftParen % ;
 
 % skips the current token if it is ")" and issues an error if it isn't %
procedure mustBeRightParen ; begin
if not have( tRightParen ) then synError( tkLine, tkColumn, """)"" expected." )
end % mustBeRightParen % ;
 
 % gets the next token and parses an expression with the specified precedence %
reference(node) procedure nextAndparseExpr ( integer value precedence ) ; begin
readToken;
parseExpr( precedence )
end nextAndParseExpr ;
 
 % parses an expression with the specified precedence %
 % all operators are assumed to be left-associative %
reference(node) procedure parseExpr ( integer value precedence ) ; begin
 
 % handles a single token primary %
reference(node) procedure simplePrimary ( integer value primaryNodeType ) ; begin
reference(node) primaryNode;
primaryNode := operandNode( primaryNodeType, tkIntegerValue );
readToken;
primaryNode
end simplePrimary ;
 
reference(node) exprNode;
 
if precedence < PRIMARY_PREC then begin
exprNode := parseExpr( precedence + 1 );
while tkPrec( tkType ) = precedence do begin
integer op;
op := tkNode( tkType );
exprNode := opNode( op, exprNode, nextAndParseExpr( precedence + 1 ) )
end while_op_at_this_precedence_level
end
else if tkType = tIdentifier then exprNode := simplePrimary( nIdentifier )
else if tkType = tInteger then exprNode := simplePrimary( nInteger )
else if tkType = nString then begin
synError( tkLine, tkColumn, "Unexpected string literal." );
exprNode := simplePrimary( nInteger )
end
else if tkType = tLeftParen then exprNode := parseParenExpr
else if tkType = tOp_add then exprNode := nextAndParseExpr( precedence )
else if tkType = tOp_subtract then exprNode := opNode( nNegate, nextAndParseExpr( precedence ), null )
else if tkType = tOp_not then exprNode := opNode( nNot, nextAndParseExpr( precedence ), null )
else begin
synError( tkLine, tkColumn, "Syntax error in expression." );
exprNode := simplePrimary( nInteger )
end;
exprNode
end parseExpr ;
 
 % parses a preenthesised expression %
reference(node) procedure parseParenExpr ; begin
reference(node) exprNode;
mustBeLeftParen;
exprNode := parseExpr( 0 );
mustBeRightParen;
exprNode
end parseParenExpr ;
 
 % parse statement depending on it's first token %
if tkType = tIdentifier then begin % assignment statement %
stmtExpr := operandNode( nIdentifier, tkIntegerValue );
 % skip the identifier and check for "=" %
readToken;
if not have( tOp_Assign ) then synError( tkLine, tkColumn, "Expected ""="" in assignment statement." );
stmtNode := opNode( nAssign, stmtExpr, parseExpr( 0 ) );
mustBeEndOfStatement
end
else if have( tKeyword_while ) then begin
stmtExpr := parseParenExpr;
stmtNode := opNode( nWhile, stmtExpr, parseStatement )
end
else if have( tkeyword_if ) then begin
stmtExpr := parseParenExpr;
stmtNode := opNode( nIf, stmtExpr, opNode( nIf, parseStatement, null ) );
if have( tKeyword_else ) then % have an "else" part % right(right(stmtNode)) := parseStatement
end
else if have( tKeyword_Print ) then begin
mustBeLeftParen;
stmtNode := null;
while begin
if tkType = tString then begin
stmtNode  := opNode( nSequence, stmtNode, opNode( nPrts, operandNode( nString, tkIntegerValue ), null ) );
readToken
end
else stmtNode := opNode( nSequence, stmtNode, opNode( nPrti, parseExpr( 0 ), null ) );
have( tComma )
end do begin end;
mustBeRightparen;
mustBeEndOfStatement;
end
else if have( tKeyword_Putc ) then begin
stmtNode := opNode( nPrtc, parseParenExpr, null );
mustBeEndOfStatement
end
else if have( tLeftBrace ) then begin % block %
stmtNode := parseStatementList( tRightBrace );
if not have( tRightBrace ) then synError( tkLine, tkColumn, "Expected ""}""." );
end
else if have( tSemicolon ) then stmtNode := null
else begin % unrecognised statement %
skipStatement( "Unrecognised statement." );
stmtNode := null
end if_various_tokens ;
stmtNode
end parseStatement ;
 
 % parses a statement list ending with the specified terminator %
reference(node) procedure parseStatementList ( integer value terminator ) ; begin
reference(node) listNode;
listNode := null;
while tkType not = terminator and tkType not = tEnd_of_input do listNode := opNode( nSequence, listNode, parseStatement );
listNode
end parseStatementList ;
 
nIdentifier  := 1; ndName( nIdentifier ) := "Identifier"; nString  := 2; ndName( nString ) := "String";
nInteger  := 3; ndName( nInteger ) := "Integer"; nSequence  := 4; ndName( nSequence ) := "Sequence";
nIf  := 5; ndName( nIf ) := "If"; nPrtc  := 6; ndName( nPrtc ) := "Prtc";
nPrts  := 7; ndName( nPrts ) := "Prts"; nPrti  := 8; ndName( nPrti ) := "Prti";
nWhile  := 9; ndName( nWhile ) := "While"; nAssign  := 10; ndName( nAssign ) := "Assign";
nNegate  := 11; ndName( nNegate ) := "Negate"; nNot  := 12; ndName( nNot ) := "Not";
nMultiply  := 13; ndName( nMultiply ) := "Multiply"; nDivide  := 14; ndName( nDivide ) := "Divide";
nMod  := 15; ndName( nMod ) := "Mod"; nAdd  := 16; ndName( nAdd ) := "Add";
nSubtract  := 17; ndName( nSubtract ) := "Subtract"; nLess  := 18; ndName( nLess ) := "Less";
nLessEqual  := 19; ndName( nLessEqual ) := "LessEqual"  ; nGreater  := 20; ndName( nGreater ) := "Greater";
nGreaterEqual  := 21; ndName( nGreaterEqual ) := "GreaterEqual"; nEqual  := 22; ndName( nEqual ) := "Equal";
nNotEqual  := 23; ndName( nNotEqual ) := "NotEqual"; nAnd  := 24; ndName( nAnd ) := "And";
nOr  := 25; ndName( nOr ) := "Or";
tOp_multiply  := 1; tkName( tOp_multiply ) := "Op_multiply"; tkPrec( tOp_multiply ) := 5;
tOp_divide  := 2; tkName( tOp_divide ) := "Op_divide"; tkPrec( tOp_divide ) := 5;
tOp_mod  := 3; tkName( tOp_mod ) := "Op_mod"; tkPrec( tOp_mod ) := 5;
tOp_add  := 4; tkName( tOp_add ) := "Op_add"; tkPrec( tOp_add ) := 4;
tOp_subtract  := 5; tkName( tOp_subtract ) := "Op_subtract"; tkPrec( tOp_subtract ) := 4;
tOp_negate  := 6; tkName( tOp_negate ) := "Op_negate"; tkPrec( tOp_negate ) := -1;
tOp_less  := 7; tkName( tOp_less ) := "Op_less"; tkPrec( tOp_less ) := 3;
tOp_lessequal  := 8; tkName( tOp_lessequal ) := "Op_lessequal"; tkPrec( tOp_lessequal ) := 3;
tOp_greater  := 9; tkName( tOp_greater ) := "Op_greater"; tkPrec( tOp_greater ) := 3;
tOp_greaterequal := 10; tkName( tOp_greaterequal ) := "Op_greaterequal"; tkPrec( tOp_greaterequal ) := 3;
tOp_equal  := 11; tkName( tOp_equal ) := "Op_equal"; tkPrec( tOp_equal ) := 2;
tOp_notequal  := 12; tkName( tOp_notequal ) := "Op_notequal"; tkPrec( tOp_notequal ) := 2;
tOp_not  := 13; tkName( tOp_not ) := "Op_not"; tkPrec( tOp_not ) := -1;
tOp_assign  := 14; tkName( tOp_assign ) := "Op_assign"; tkPrec( tOp_assign ) := -1;
tOp_and  := 15; tkName( tOp_and ) := "Op_and"; tkPrec( tOp_and ) := 1;
tOp_or  := 16; tkName( tOp_or ) := "Op_or"; tkPrec( tOp_or ) := 0;
tLeftParen  := 17; tkName( tLeftParen ) := "LeftParen"; tkPrec( tLeftParen ) := -1;
tRightParen  := 18; tkName( tRightParen ) := "RightParen"; tkPrec( tRightParen ) := -1;
tLeftBrace  := 19; tkName( tLeftBrace ) := "LeftBrace"; tkPrec( tLeftBrace ) := -1;
tRightBrace  := 20; tkName( tRightBrace ) := "RightBrace"; tkPrec( tRightBrace ) := -1;
tSemicolon  := 21; tkName( tSemicolon ) := "Semicolon"; tkPrec( tSemicolon ) := -1;
tComma  := 22; tkName( tComma ) := "Comma"; tkPrec( tComma ) := -1;
tKeyword_if  := 23; tkName( tKeyword_if ) := "Keyword_if"; tkPrec( tKeyword_if ) := -1;
tKeyword_else  := 24; tkName( tKeyword_else ) := "Keyword_else"; tkPrec( tKeyword_else ) := -1;
tKeyword_while  := 25; tkName( tKeyword_while ) := "Keyword_while"; tkPrec( tKeyword_while ) := -1;
tKeyword_print  := 26; tkName( tKeyword_print ) := "Keyword_print"; tkPrec( tKeyword_print ) := -1;
tKeyword_putc  := 27; tkName( tKeyword_putc ) := "Keyword_putc"; tkPrec( tKeyword_putc ) := -1;
tIdentifier  := 28; tkName( tIdentifier ) := "Identifier"; tkPrec( tIdentifier ) := -1;
tInteger  := 29; tkName( tInteger ) := "Integer"; tkPrec( tInteger ) := -1;
tString  := 30; tkName( tString ) := "String"; tkPrec( tString ) := -1;
tEnd_of_input  := 31; tkName( tEnd_of_input ) := "End_of_input"; tkPrec( tEnd_of_input ) := -1;
MAX_TOKEN_TYPE  := 31; TEXT_MAX := 4095; textNext := 0; PRIMARY_PREC := 6;
for tkPos := 1 until MAX_TOKEN_TYPE do tkNode( tkPos ) := - tkPos;
tkNode( tOp_multiply ) := nMultiply; tkNode( tOp_divide ) := nDivide; tkNode( tOp_mod ) := nMod;
tkNode( tOp_add ) := nAdd; tkNode( tOp_subtract ) := nSubtract; tkNode( tOp_less ) := nLess;
tkNode( tOp_lessequal ) := nLessEqual; tkNode( tOp_greater ) := nGreater; tkNode( tOp_greaterequal ) := nGreaterEqual;
tkNode( tOp_equal ) := nEqual; tkNode( tOp_notequal ) := nNotEqual; tkNode( tOp_not ) := nNot;
tkNode( tOp_and ) := nAnd; tkNode( tOp_or ) := nOr;
stList := idList := null;
 
 % parse the output from the lexical analyser and output the linearised parse tree %
readToken;
writeNode( parseStatementList( tEnd_of_input ) )
end.
Output:

Output from parsing the Prime Numbers example program.

Sequence      
Sequence      
Sequence      
Sequence      
Sequence      
;
Assign        
Identifier    count
Integer                    1  
Assign        
Identifier    n
Integer                    1  
Assign        
Identifier    limit
Integer                  100  
While         
Less          
Identifier    n
Identifier    limit
Sequence      
Sequence      
Sequence      
Sequence      
Sequence      
;
Assign        
Identifier    k
Integer                    3  
Assign        
Identifier    p
Integer                    1  
Assign        
Identifier    n
Add           
Identifier    n
Integer                    2  
While         
And           
LessEqual     
Multiply      
Identifier    k
Identifier    k
Identifier    n
Identifier    p
Sequence      
Sequence      
;
Assign        
Identifier    p
NotEqual      
Multiply      
Divide        
Identifier    n
Identifier    k
Identifier    k
Identifier    n
Assign        
Identifier    k
Add           
Identifier    k
Integer                    2  
If            
Identifier    p
If            
Sequence      
Sequence      
;
Sequence      
Sequence      
;
Prti          
Identifier    n
;
Prts          
String        " is prime\n"
;
Assign        
Identifier    count
Add           
Identifier    count
Integer                    1  
;
Sequence      
Sequence      
Sequence      
;
Prts          
String        "Total primes found: "
;
Prti          
Identifier    count
;
Prts          
String        "\n"
;

AWK[edit]

Tested with gawk 4.1.1 and mawk 1.3.4.

 
function Token_assign(tk, attr, attr_array, n, i) {
n=split(attr, attr_array)
for(i=1; i<=n; i++)
Tokens[tk,i-1] = attr_array[i]
}
 
#*** show error and exit
function error(msg) {
printf("(%s, %s) %s\n", err_line, err_col, msg)
exit(1)
}
 
function gettok( line, n, i) {
getline line
if (line == "")
error("empty line")
n=split(line, line_list)
# line col Ident var_name
# 1 2 3 4
err_line = line_list[1]
err_col = line_list[2]
tok_text = line_list[3]
tok = all_syms[tok_text]
for (i=5; i<=n; i++)
line_list[4] = line_list[4] " " line_list[i]
if (tok == "")
error("Unknown token " tok_text)
tok_other = ""
if (tok == "tk_Integer" || tok == "tk_Ident" || tok =="tk_String")
tok_other = line_list[4]
}
 
function make_node(oper, left, right, value) {
node_type [next_free_node_index] = oper
node_left [next_free_node_index] = left
node_right[next_free_node_index] = right
node_value[next_free_node_index] = value
return next_free_node_index ++
}
 
function make_leaf(oper, n) {
return make_node(oper, 0, 0, n)
}
 
function expect(msg, s) {
if (tok == s) {
gettok()
return
}
error(msg ": Expecting '" Tokens[s,TK_NAME] "', found '" Tokens[tok,TK_NAME] "'")
}
 
function expr(p, x, op, node) {
x = 0
if (tok == "tk_Lparen") {
x = paren_expr()
} else if (tok == "tk_Sub" || tok == "tk_Add") {
if (tok == "tk_Sub")
op = "tk_Negate"
else
op = "tk_Add"
gettok()
node = expr(Tokens["tk_Negate",TK_PRECEDENCE]+0)
if (op == "tk_Negate")
x = make_node("nd_Negate", node)
else
x = node
} else if (tok == "tk_Not") {
gettok()
x = make_node("nd_Not", expr(Tokens["tk_Not",TK_PRECEDENCE]+0))
} else if (tok == "tk_Ident") {
x = make_leaf("nd_Ident", tok_other)
gettok()
} else if (tok == "tk_Integer") {
x = make_leaf("nd_Integer", tok_other)
gettok()
} else {
error("Expecting a primary, found: " Tokens[tok,TK_NAME])
}
while (((Tokens[tok,TK_IS_BINARY]+0) > 0) && ((Tokens[tok,TK_PRECEDENCE]+0) >= p)) {
op = tok
gettok()
q = Tokens[op,TK_PRECEDENCE]+0
if (! (Tokens[op,TK_RIGHT_ASSOC]+0 > 0))
q += 1
node = expr(q)
x = make_node(Tokens[op,TK_NODE], x, node)
}
return x
}
 
function paren_expr( node) {
expect("paren_expr", "tk_Lparen")
node = expr(0)
expect("paren_expr", "tk_Rparen")
return node
}
 
function stmt( t, e, s, s2, v) {
t = 0
if (tok == "tk_If") {
gettok()
e = paren_expr()
s = stmt()
s2 = 0
if (tok == "tk_Else") {
gettok()
s2 = stmt()
}
t = make_node("nd_If", e, make_node("nd_If", s, s2))
} else if (tok == "tk_Putc") {
gettok()
e = paren_expr()
t = make_node("nd_Prtc", e)
expect("Putc", "tk_Semi")
} else if (tok == "tk_Print") {
gettok()
expect("Print", "tk_Lparen")
while (1) {
if (tok == "tk_String") {
e = make_node("nd_Prts", make_leaf("nd_String", tok_other))
gettok()
} else {
e = make_node("nd_Prti", expr(0))
}
t = make_node("nd_Sequence", t, e)
if (tok != "tk_Comma")
break
gettok()
}
expect("Print", "tk_Rparen")
expect("Print", "tk_Semi")
} else if (tok == "tk_Semi") {
gettok()
} else if (tok == "tk_Ident") {
v = make_leaf("nd_Ident", tok_other)
gettok()
expect("assign", "tk_Assign")
e = expr(0)
t = make_node("nd_Assign", v, e)
expect("assign", "tk_Semi")
} else if (tok == "tk_While") {
gettok()
e = paren_expr()
s = stmt()
t = make_node("nd_While", e, s)
} else if (tok == "tk_Lbrace") {
gettok()
while (tok != "tk_Rbrace" && tok != "tk_EOI")
t = make_node("nd_Sequence", t, stmt())
expect("Lbrace", "tk_Rbrace")
} else if (tok == "tk_EOI") {
} else {
error("Expecting start of statement, found: " Tokens[tok,TK_NAME])
}
return t
}
 
function parse( t) {
t = 0 # None
gettok()
while (1) {
t = make_node("nd_Sequence", t, stmt())
if (tok == "tk_EOI" || t == 0)
break
}
return t
}
 
function prt_ast(t) {
if (t == 0) {
print(";")
} else {
printf("%-14s", Display_nodes[node_type[t]])
if ((node_type[t] == "nd_Ident") || (node_type[t] == "nd_Integer"))
printf("%s\n", node_value[t])
else if (node_type[t] == "nd_String") {
printf("%s\n", node_value[t])
} else {
print("")
prt_ast(node_left[t])
prt_ast(node_right[t])
}
}
}
 
BEGIN {
all_syms["End_of_input" ] = "tk_EOI"
all_syms["Op_multiply" ] = "tk_Mul"
all_syms["Op_divide" ] = "tk_Div"
all_syms["Op_mod" ] = "tk_Mod"
all_syms["Op_add" ] = "tk_Add"
all_syms["Op_subtract" ] = "tk_Sub"
all_syms["Op_negate" ] = "tk_Negate"
all_syms["Op_not" ] = "tk_Not"
all_syms["Op_less" ] = "tk_Lss"
all_syms["Op_lessequal" ] = "tk_Leq"
all_syms["Op_greater" ] = "tk_Gtr"
all_syms["Op_greaterequal" ] = "tk_Geq"
all_syms["Op_equal" ] = "tk_Eq"
all_syms["Op_notequal" ] = "tk_Neq"
all_syms["Op_assign" ] = "tk_Assign"
all_syms["Op_and" ] = "tk_And"
all_syms["Op_or" ] = "tk_Or"
all_syms["Keyword_if" ] = "tk_If"
all_syms["Keyword_else" ] = "tk_Else"
all_syms["Keyword_while" ] = "tk_While"
all_syms["Keyword_print" ] = "tk_Print"
all_syms["Keyword_putc" ] = "tk_Putc"
all_syms["LeftParen" ] = "tk_Lparen"
all_syms["RightParen" ] = "tk_Rparen"
all_syms["LeftBrace" ] = "tk_Lbrace"
all_syms["RightBrace" ] = "tk_Rbrace"
all_syms["Semicolon" ] = "tk_Semi"
all_syms["Comma" ] = "tk_Comma"
all_syms["Identifier" ] = "tk_Ident"
all_syms["Integer" ] = "tk_Integer"
all_syms["String" ] = "tk_String"
 
Display_nodes["nd_Ident" ] = "Identifier"
Display_nodes["nd_String" ] = "String"
Display_nodes["nd_Integer" ] = "Integer"
Display_nodes["nd_Sequence"] = "Sequence"
Display_nodes["nd_If" ] = "If"
Display_nodes["nd_Prtc" ] = "Prtc"
Display_nodes["nd_Prts" ] = "Prts"
Display_nodes["nd_Prti" ] = "Prti"
Display_nodes["nd_While" ] = "While"
Display_nodes["nd_Assign" ] = "Assign"
Display_nodes["nd_Negate" ] = "Negate"
Display_nodes["nd_Not" ] = "Not"
Display_nodes["nd_Mul" ] = "Multiply"
Display_nodes["nd_Div" ] = "Divide"
Display_nodes["nd_Mod" ] = "Mod"
Display_nodes["nd_Add" ] = "Add"
Display_nodes["nd_Sub" ] = "Subtract"
Display_nodes["nd_Lss" ] = "Less"
Display_nodes["nd_Leq" ] = "LessEqual"
Display_nodes["nd_Gtr" ] = "Greater"
Display_nodes["nd_Geq" ] = "GreaterEqual"
Display_nodes["nd_Eql" ] = "Equal"
Display_nodes["nd_Neq" ] = "NotEqual"
Display_nodes["nd_And" ] = "And"
Display_nodes["nd_Or" ] = "Or"
 
TK_NAME = 0
TK_RIGHT_ASSOC = 1
TK_IS_BINARY = 2
TK_IS_UNARY = 3
TK_PRECEDENCE = 4
TK_NODE = 5
Token_assign("tk_EOI" , "EOI 0 0 0 -1 -1 ")
Token_assign("tk_Mul" , "* 0 1 0 13 nd_Mul ")
Token_assign("tk_Div" , "/ 0 1 0 13 nd_Div ")
Token_assign("tk_Mod" , "% 0 1 0 13 nd_Mod ")
Token_assign("tk_Add" , "+ 0 1 0 12 nd_Add ")
Token_assign("tk_Sub" , "- 0 1 0 12 nd_Sub ")
Token_assign("tk_Negate" , "- 0 0 1 14 nd_Negate ")
Token_assign("tk_Not" , "! 0 0 1 14 nd_Not ")
Token_assign("tk_Lss" , "< 0 1 0 10 nd_Lss ")
Token_assign("tk_Leq" , "<= 0 1 0 10 nd_Leq ")
Token_assign("tk_Gtr" , "> 0 1 0 10 nd_Gtr ")
Token_assign("tk_Geq" , ">= 0 1 0 10 nd_Geq ")
Token_assign("tk_Eql" , "== 0 1 0 9 nd_Eql ")
Token_assign("tk_Neq" , "!= 0 1 0 9 nd_Neq ")
Token_assign("tk_Assign" , "= 0 0 0 -1 nd_Assign ")
Token_assign("tk_And" , "&& 0 1 0 5 nd_And ")
Token_assign("tk_Or" , "|| 0 1 0 4 nd_Or ")
Token_assign("tk_If" , "if 0 0 0 -1 nd_If ")
Token_assign("tk_Else" , "else 0 0 0 -1 -1 ")
Token_assign("tk_While" , "while 0 0 0 -1 nd_While ")
Token_assign("tk_Print" , "print 0 0 0 -1 -1 ")
Token_assign("tk_Putc" , "putc 0 0 0 -1 -1 ")
Token_assign("tk_Lparen" , "( 0 0 0 -1 -1 ")
Token_assign("tk_Rparen" , ") 0 0 0 -1 -1 ")
Token_assign("tk_Lbrace" , "{ 0 0 0 -1 -1 ")
Token_assign("tk_Rbrace" , "} 0 0 0 -1 -1 ")
Token_assign("tk_Semi" , "; 0 0 0 -1 -1 ")
Token_assign("tk_Comma" , ", 0 0 0 -1 -1 ")
Token_assign("tk_Ident" , "Ident 0 0 0 -1 nd_Ident ")
Token_assign("tk_Integer", "Integer 0 0 0 -1 nd_Integer")
Token_assign("tk_String" , "String 0 0 0 -1 nd_String ")
 
input_file = "-"
err_line = 0
err_col = 0
tok = ""
tok_text = ""
next_free_node_index = 1
 
if (ARGC > 1)
input_file = ARGV[1]
t = parse()
prt_ast(t)
}
 
Output  —  count:

Sequence      
Sequence      
;
Assign        
Identifier    count
Integer       1
While         
Less          
Identifier    count
Integer       10
Sequence      
Sequence      
;
Sequence      
Sequence      
Sequence      
;
Prts          
String        "count is: "
;
Prti          
Identifier    count
;
Prts          
String        "\n"
;
Assign        
Identifier    count
Add           
Identifier    count
Integer       1

C[edit]

Tested with gcc 4.81 and later, compiles warning free with -Wall -Wextra

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdarg.h>
#include <stdbool.h>
#include <ctype.h>
 
#define NELEMS(arr) (sizeof(arr) / sizeof(arr[0]))
 
typedef enum {
tk_EOI, tk_Mul, tk_Div, tk_Mod, tk_Add, tk_Sub, tk_Negate, tk_Not, tk_Lss, tk_Leq, tk_Gtr,
tk_Geq, tk_Eql, tk_Neq, tk_Assign, tk_And, tk_Or, tk_If, tk_Else, tk_While, tk_Print,
tk_Putc, tk_Lparen, tk_Rparen, tk_Lbrace, tk_Rbrace, tk_Semi, tk_Comma, tk_Ident,
tk_Integer, tk_String
} TokenType;
 
typedef enum {
nd_Ident, nd_String, nd_Integer, nd_Sequence, nd_If, nd_Prtc, nd_Prts, nd_Prti, nd_While,
nd_Assign, nd_Negate, nd_Not, nd_Mul, nd_Div, nd_Mod, nd_Add, nd_Sub, nd_Lss, nd_Leq,
nd_Gtr, nd_Geq, nd_Eql, nd_Neq, nd_And, nd_Or
} NodeType;
 
typedef struct {
TokenType tok;
int err_ln;
int err_col;
char *text; /* ident or string literal or integer value */
} tok_s;
 
typedef struct Tree {
NodeType node_type;
struct Tree *left;
struct Tree *right;
char *value;
} Tree;
 
// dependency: Ordered by tok, must remain in same order as TokenType enum
struct {
char *text, *enum_text;
TokenType tok;
bool right_associative, is_binary, is_unary;
int precedence;
NodeType node_type;
} atr[] = {
{"EOI", "End_of_input" , tk_EOI, false, false, false, -1, -1 },
{"*", "Op_multiply" , tk_Mul, false, true, false, 13, nd_Mul },
{"/", "Op_divide" , tk_Div, false, true, false, 13, nd_Div },
{"%", "Op_mod" , tk_Mod, false, true, false, 13, nd_Mod },
{"+", "Op_add" , tk_Add, false, true, false, 12, nd_Add },
{"-", "Op_subtract" , tk_Sub, false, true, false, 12, nd_Sub },
{"-", "Op_negate" , tk_Negate, false, false, true, 14, nd_Negate },
{"!", "Op_not" , tk_Not, false, false, true, 14, nd_Not },
{"<", "Op_less" , tk_Lss, false, true, false, 10, nd_Lss },
{"<=", "Op_lessequal" , tk_Leq, false, true, false, 10, nd_Leq },
{">", "Op_greater" , tk_Gtr, false, true, false, 10, nd_Gtr },
{">=", "Op_greaterequal", tk_Geq, false, true, false, 10, nd_Geq },
{"==", "Op_equal" , tk_Eql, false, true, false, 9, nd_Eql },
{"!=", "Op_notequal" , tk_Neq, false, true, false, 9, nd_Neq },
{"=", "Op_assign" , tk_Assign, false, false, false, -1, nd_Assign },
{"&&", "Op_and" , tk_And, false, true, false, 5, nd_And },
{"||", "Op_or" , tk_Or, false, true, false, 4, nd_Or },
{"if", "Keyword_if" , tk_If, false, false, false, -1, nd_If },
{"else", "Keyword_else" , tk_Else, false, false, false, -1, -1 },
{"while", "Keyword_while" , tk_While, false, false, false, -1, nd_While },
{"print", "Keyword_print" , tk_Print, false, false, false, -1, -1 },
{"putc", "Keyword_putc" , tk_Putc, false, false, false, -1, -1 },
{"(", "LeftParen" , tk_Lparen, false, false, false, -1, -1 },
{")", "RightParen" , tk_Rparen, false, false, false, -1, -1 },
{"{", "LeftBrace" , tk_Lbrace, false, false, false, -1, -1 },
{"}", "RightBrace" , tk_Rbrace, false, false, false, -1, -1 },
{";", "Semicolon" , tk_Semi, false, false, false, -1, -1 },
{",", "Comma" , tk_Comma, false, false, false, -1, -1 },
{"Ident", "Identifier" , tk_Ident, false, false, false, -1, nd_Ident },
{"Integer literal", "Integer" , tk_Integer, false, false, false, -1, nd_Integer},
{"String literal", "String" , tk_String, false, false, false, -1, nd_String },
};
 
char *Display_nodes[] = {"Identifier", "String", "Integer", "Sequence", "If", "Prtc",
"Prts", "Prti", "While", "Assign", "Negate", "Not", "Multiply", "Divide", "Mod",
"Add", "Subtract", "Less", "LessEqual", "Greater", "GreaterEqual", "Equal",
"NotEqual", "And", "Or"};
 
static tok_s tok;
static FILE *source_fp, *dest_fp;
 
Tree *paren_expr();
 
void error(int err_line, int err_col, const char *fmt, ... ) {
va_list ap;
char buf[1000];
 
va_start(ap, fmt);
vsprintf(buf, fmt, ap);
va_end(ap);
printf("(%d, %d) error: %s\n", err_line, err_col, buf);
exit(1);
}
 
char *read_line(int *len) {
static char *text = NULL;
static int textmax = 0;
 
for (*len = 0; ; (*len)++) {
int ch = fgetc(source_fp);
if (ch == EOF || ch == '\n') {
if (*len == 0)
return NULL;
break;
}
if (*len + 1 >= textmax) {
textmax = (textmax == 0 ? 128 : textmax * 2);
text = realloc(text, textmax);
}
text[*len] = ch;
}
text[*len] = '\0';
return text;
}
 
char *rtrim(char *text, int *len) { // remove trailing spaces
for (; *len > 0 && isspace(text[*len - 1]); --(*len))
;
 
text[*len] = '\0';
return text;
}
 
TokenType get_enum(const char *name) { // return internal version of name
for (size_t i = 0; i < NELEMS(atr); i++) {
if (strcmp(atr[i].enum_text, name) == 0)
return atr[i].tok;
}
error(0, 0, "Unknown token %s\n", name);
return 0;
}
 
tok_s gettok() {
int len;
tok_s tok;
char *yytext = read_line(&len);
yytext = rtrim(yytext, &len);
 
// [ ]*{lineno}[ ]+{colno}[ ]+token[ ]+optional
 
// get line and column
tok.err_ln = atoi(strtok(yytext, " "));
tok.err_col = atoi(strtok(NULL, " "));
 
// get the token name
char *name = strtok(NULL, " ");
tok.tok = get_enum(name);
 
// if there is extra data, get it
char *p = name + strlen(name);
if (p != &yytext[len]) {
for (++p; isspace(*p); ++p)
;
tok.text = strdup(p);
}
return tok;
}
 
Tree *make_node(NodeType node_type, Tree *left, Tree *right) {
Tree *t = calloc(sizeof(Tree), 1);
t->node_type = node_type;
t->left = left;
t->right = right;
return t;
}
 
Tree *make_leaf(NodeType node_type, char *value) {
Tree *t = calloc(sizeof(Tree), 1);
t->node_type = node_type;
t->value = strdup(value);
return t;
}
 
void expect(const char msg[], TokenType s) {
if (tok.tok == s) {
tok = gettok();
return;
}
error(tok.err_ln, tok.err_col, "%s: Expecting '%s', found '%s'\n", msg, atr[s].text, atr[tok.tok].text);
}
 
Tree *expr(int p) {
Tree *x = NULL, *node;
TokenType op;
 
switch (tok.tok) {
case tk_Lparen:
x = paren_expr();
break;
case tk_Sub: case tk_Add:
op = tok.tok;
tok = gettok();
node = expr(atr[tk_Negate].precedence);
x = (op == tk_Sub) ? make_node(nd_Negate, node, NULL) : node;
break;
case tk_Not:
tok = gettok();
x = make_node(nd_Not, expr(atr[tk_Not].precedence), NULL);
break;
case tk_Ident:
x = make_leaf(nd_Ident, tok.text);
tok = gettok();
break;
case tk_Integer:
x = make_leaf(nd_Integer, tok.text);
tok = gettok();
break;
default:
error(tok.err_ln, tok.err_col, "Expecting a primary, found: %s\n", atr[tok.tok].text);
}
 
while (atr[tok.tok].is_binary && atr[tok.tok].precedence >= p) {
TokenType op = tok.tok;
 
tok = gettok();
 
int q = atr[op].precedence;
if (!atr[op].right_associative)
q++;
 
node = expr(q);
x = make_node(atr[op].node_type, x, node);
}
return x;
}
 
Tree *paren_expr() {
expect("paren_expr", tk_Lparen);
Tree *t = expr(0);
expect("paren_expr", tk_Rparen);
return t;
}
 
Tree *stmt() {
Tree *t = NULL, *v, *e, *s, *s2;
 
switch (tok.tok) {
case tk_If:
tok = gettok();
e = paren_expr();
s = stmt();
s2 = NULL;
if (tok.tok == tk_Else) {
tok = gettok();
s2 = stmt();
}
t = make_node(nd_If, e, make_node(nd_If, s, s2));
break;
case tk_Putc:
tok = gettok();
e = paren_expr();
t = make_node(nd_Prtc, e, NULL);
expect("Putc", tk_Semi);
break;
case tk_Print: /* print '(' expr {',' expr} ')' */
tok = gettok();
for (expect("Print", tk_Lparen); ; expect("Print", tk_Comma)) {
if (tok.tok == tk_String) {
e = make_node(nd_Prts, make_leaf(nd_String, tok.text), NULL);
tok = gettok();
} else
e = make_node(nd_Prti, expr(0), NULL);
 
t = make_node(nd_Sequence, t, e);
 
if (tok.tok != tk_Comma)
break;
}
expect("Print", tk_Rparen);
expect("Print", tk_Semi);
break;
case tk_Semi:
tok = gettok();
break;
case tk_Ident:
v = make_leaf(nd_Ident, tok.text);
tok = gettok();
expect("assign", tk_Assign);
e = expr(0);
t = make_node(nd_Assign, v, e);
expect("assign", tk_Semi);
break;
case tk_While:
tok = gettok();
e = paren_expr();
s = stmt();
t = make_node(nd_While, e, s);
break;
case tk_Lbrace: /* {stmt} */
for (expect("Lbrace", tk_Lbrace); tok.tok != tk_Rbrace && tok.tok != tk_EOI;)
t = make_node(nd_Sequence, t, stmt());
expect("Lbrace", tk_Rbrace);
break;
case tk_EOI:
break;
default: error(tok.err_ln, tok.err_col, "expecting start of statement, found '%s'\n", atr[tok.tok].text);
}
return t;
}
 
Tree *parse() {
Tree *t = NULL;
 
tok = gettok();
do {
t = make_node(nd_Sequence, t, stmt());
} while (t != NULL && tok.tok != tk_EOI);
return t;
}
 
void prt_ast(Tree *t) {
if (t == NULL)
printf(";\n");
else {
printf("%-14s ", Display_nodes[t->node_type]);
if (t->node_type == nd_Ident || t->node_type == nd_Integer || t->node_type == nd_String) {
printf("%s\n", t->value);
} else {
printf("\n");
prt_ast(t->left);
prt_ast(t->right);
}
}
}
 
void init_io(FILE **fp, FILE *std, const char mode[], const char fn[]) {
if (fn[0] == '\0')
*fp = std;
else if ((*fp = fopen(fn, mode)) == NULL)
error(0, 0, "Can't open %s\n", fn);
}
 
int main(int argc, char *argv[]) {
init_io(&source_fp, stdin, "r", argc > 1 ? argv[1] : "");
init_io(&dest_fp, stdout, "wb", argc > 2 ? argv[2] : "");
prt_ast(parse());
}
Output  —  prime numbers AST:

Sequence
Sequence
Sequence
Sequence
Sequence
;
Assign
Identifier     count
Integer        1
Assign
Identifier     n
Integer        1
Assign
Identifier     limit
Integer        100
While
Less
Identifier     n
Identifier     limit
Sequence
Sequence
Sequence
Sequence
Sequence
;
Assign
Identifier     k
Integer        3
Assign
Identifier     p
Integer        1
Assign
Identifier     n
Add
Identifier     n
Integer        2
While
And
LessEqual
Multiply
Identifier     k
Identifier     k
Identifier     n
Identifier     p
Sequence
Sequence
;
Assign
Identifier     p
NotEqual
Multiply
Divide
Identifier     n
Identifier     k
Identifier     k
Identifier     n
Assign
Identifier     k
Add
Identifier     k
Integer        2
If
Identifier     p
If
Sequence
Sequence
;
Sequence
Sequence
;
Prti
Identifier     n
;
Prts
String         " is prime\n"
;
Assign
Identifier     count
Add
Identifier     count
Integer        1
;
Sequence
Sequence
Sequence
;
Prts
String         "Total primes found: "
;
Prti
Identifier     count
;
Prts
String         "\n"
;

Phix[edit]

Reusing lex.e (and core.e) from the Lexical Analyzer task, and again written as a reusable module.

--
-- demo\\rosetta\\Compiler\\parse.e
-- ================================
--
-- The reusable part of parse.exw
--
 
include lex.e
 
sequence tok
 
procedure errd(sequence msg, sequence args={})
{tok_line,tok_col} = tok
error(msg,args)
end procedure
 
global sequence toks
integer next_tok = 1
 
function get_tok()
sequence tok = toks[next_tok]
next_tok += 1
return tok
end function
 
procedure expect(string msg, integer s)
integer tk = tok[3]
if tk!=s then
errd("%s: Expecting '%s', found '%s'\n", {msg, tkNames[s], tkNames[tk]})
end if
tok = get_tok()
end procedure
 
function expr(integer p)
object x = NULL, node
integer op = tok[3]
 
switch op do
case tk_LeftParen:
tok = get_tok()
x = expr(0)
expect("expr",tk_RightParen)
case tk_sub:
case tk_add:
tok = get_tok()
node = expr(precedences[tk_neg]);
x = iff(op==tk_sub?{tk_neg, node, NULL}:node)
case tk_not:
tok = get_tok();
x = {tk_not, expr(precedences[tk_not]), NULL}
case tk_Identifier:
x = {tk_Identifier, tok[4]}
tok = get_tok();
case tk_Integer:
x = {tk_Integer, tok[4]}
tok = get_tok();
default:
errd("Expecting a primary, found: %s\n", tkNames[op])
end switch
 
op = tok[3]
while narys[op]=BINARY
and precedences[op]>=p do
tok = get_tok()
x = {op, x, expr(precedences[op]+1)}
op = tok[3]
end while
return x;
end function
 
function paren_expr(string msg)
expect(msg, tk_LeftParen);
object t = expr(0)
expect(msg, tk_RightParen);
return t
end function
 
function stmt()
object t = NULL, e, s
 
switch tok[3] do
case tk_if:
tok = get_tok();
object condition = paren_expr("If-cond");
object ifblock = stmt();
object elseblock = NULL;
if tok[3] == tk_else then
tok = get_tok();
elseblock = stmt();
end if
t = {tk_if, condition, {tk_if, ifblock, elseblock}}
case tk_putc:
tok = get_tok();
e = paren_expr("Prtc")
t = {tk_putc, e, NULL}
expect("Putc", tk_Semicolon);
case tk_print:
tok = get_tok();
expect("Print",tk_LeftParen)
while 1 do
if tok[3] == tk_String then
e = {tk_Prints, {tk_String, tok[4]}, NULL}
tok = get_tok();
else
e = {tk_Printi, expr(0), NULL}
end if
t = {tk_Sequence, t, e}
if tok[3]!=tk_Comma then exit end if
expect("Print", tk_Comma)
end while
expect("Print", tk_RightParen);
expect("Print", tk_Semicolon);
case tk_Semicolon:
tok = get_tok();
case tk_Identifier:
object v
v = {tk_Identifier, tok[4]}
tok = get_tok();
expect("assign", tk_assign);
e = expr(0);
t = {tk_assign, v, e}
expect("assign", tk_Semicolon);
case tk_while:
tok = get_tok();
e = paren_expr("while");
s = stmt();
t = {tk_while, e, s}
case tk_LeftBrace: /* {stmt} */
expect("LeftBrace", tk_LeftBrace)
while not find(tok[3],{tk_RightBrace,tk_EOI}) do
t = {tk_Sequence, t, stmt()}
end while
expect("LeftBrace", tk_RightBrace);
break;
case tk_EOI:
break;
default:
errd("expecting start of statement, found '%s'\n", tkNames[tok[3]]);
end switch
return t
end function
 
global function parse()
object t = NULL
tok = get_tok()
while 1 do
object s = stmt()
if s=NULL then exit end if
t = {tk_Sequence, t, s}
end while
return t
end function

And a simple test driver for the specific task:

--
-- demo\\rosetta\\Compiler\\parse.exw
-- ==================================
--
include parse.e
 
procedure print_ast(object t)
if t == NULL then
printf(output_file,";\n")
else
integer ttype = t[1]
printf(output_file,tkNames[ttype])
if ttype=tk_Identifier then
printf(output_file," %s\n",t[2])
elsif ttype=tk_Integer then
printf(output_file," %d\n",t[2])
elsif ttype=tk_String then
printf(output_file," %s\n",enquote(t[2]))
else
printf(output_file,"\n")
print_ast(t[2])
print_ast(t[3])
end if
end if
end procedure
 
procedure main(sequence cl)
open_files(cl)
toks = lex()
object t = parse()
print_ast(t)
close_files()
end procedure
 
--main(command_line())
main({0,0,"test3.c"}) -- not parseable!
--main({0,0,"primes.c"}) -- as Algol, C, Python (apart from spacing)
--main({0,0,"count.c"}) -- as AWK ( "" )
Output:
Line 5 column 40:
Print: Expecting 'LeftParen', found 'Op_subtract'

Python[edit]

Tested with Python 2.7 and 3.x

from __future__ import print_function
import sys, shlex, operator
 
tk_EOI, tk_Mul, tk_Div, tk_Mod, tk_Add, tk_Sub, tk_Negate, tk_Not, tk_Lss, tk_Leq, tk_Gtr, \
tk_Geq, tk_Eql, tk_Neq, tk_Assign, tk_And, tk_Or, tk_If, tk_Else, tk_While, tk_Print, \
tk_Putc, tk_Lparen, tk_Rparen, tk_Lbrace, tk_Rbrace, tk_Semi, tk_Comma, tk_Ident, \
tk_Integer, tk_String = range(31)
 
nd_Ident, nd_String, nd_Integer, nd_Sequence, nd_If, nd_Prtc, nd_Prts, nd_Prti, nd_While, \
nd_Assign, nd_Negate, nd_Not, nd_Mul, nd_Div, nd_Mod, nd_Add, nd_Sub, nd_Lss, nd_Leq, \
nd_Gtr, nd_Geq, nd_Eql, nd_Neq, nd_And, nd_Or = range(25)
 
# must have same order as above
Tokens = [
["EOI" , False, False, False, -1, -1 ],
["*" , False, True, False, 13, nd_Mul ],
["/" , False, True, False, 13, nd_Div ],
["%" , False, True, False, 13, nd_Mod ],
["+" , False, True, False, 12, nd_Add ],
["-" , False, True, False, 12, nd_Sub ],
["-" , False, False, True, 14, nd_Negate ],
["!" , False, False, True, 14, nd_Not ],
["<" , False, True, False, 10, nd_Lss ],
["<=" , False, True, False, 10, nd_Leq ],
[">" , False, True, False, 10, nd_Gtr ],
[">=" , False, True, False, 10, nd_Geq ],
["==" , False, True, False, 9, nd_Eql ],
["!=" , False, True, False, 9, nd_Neq ],
["=" , False, False, False, -1, nd_Assign ],
["&&" , False, True, False, 5, nd_And ],
["||" , False, True, False, 4, nd_Or ],
["if" , False, False, False, -1, nd_If ],
["else" , False, False, False, -1, -1 ],
["while" , False, False, False, -1, nd_While ],
["print" , False, False, False, -1, -1 ],
["putc" , False, False, False, -1, -1 ],
["(" , False, False, False, -1, -1 ],
[")" , False, False, False, -1, -1 ],
["{" , False, False, False, -1, -1 ],
["}" , False, False, False, -1, -1 ],
[";" , False, False, False, -1, -1 ],
["," , False, False, False, -1, -1 ],
["Ident" , False, False, False, -1, nd_Ident ],
["Integer literal" , False, False, False, -1, nd_Integer],
["String literal" , False, False, False, -1, nd_String ]
]
 
all_syms = {"End_of_input"  : tk_EOI, "Op_multiply"  : tk_Mul,
"Op_divide"  : tk_Div, "Op_mod"  : tk_Mod,
"Op_add"  : tk_Add, "Op_subtract"  : tk_Sub,
"Op_negate"  : tk_Negate, "Op_not"  : tk_Not,
"Op_less"  : tk_Lss, "Op_lessequal"  : tk_Leq,
"Op_greater"  : tk_Gtr, "Op_greaterequal": tk_Geq,
"Op_equal"  : tk_Eql, "Op_notequal"  : tk_Neq,
"Op_assign"  : tk_Assign, "Op_and"  : tk_And,
"Op_or"  : tk_Or, "Keyword_if"  : tk_If,
"Keyword_else"  : tk_Else, "Keyword_while"  : tk_While,
"Keyword_print"  : tk_Print, "Keyword_putc"  : tk_Putc,
"LeftParen"  : tk_Lparen, "RightParen"  : tk_Rparen,
"LeftBrace"  : tk_Lbrace, "RightBrace"  : tk_Rbrace,
"Semicolon"  : tk_Semi, "Comma"  : tk_Comma,
"Identifier"  : tk_Ident, "Integer"  : tk_Integer,
"String"  : tk_String}
 
Display_nodes = ["Identifier", "String", "Integer", "Sequence", "If", "Prtc", "Prts",
"Prti", "While", "Assign", "Negate", "Not", "Multiply", "Divide", "Mod", "Add",
"Subtract", "Less", "LessEqual", "Greater", "GreaterEqual", "Equal", "NotEqual",
"And", "Or"]
 
TK_NAME = 0
TK_RIGHT_ASSOC = 1
TK_IS_BINARY = 2
TK_IS_UNARY = 3
TK_PRECEDENCE = 4
TK_NODE = 5
 
input_file = None
err_line = None
err_col = None
tok = None
tok_text = None
 
#*** show error and exit
def error(msg):
print("(%d, %d) %s" % (int(err_line), int(err_col), msg))
exit(1)
 
#***
def gettok():
global err_line, err_col, tok, tok_text, tok_other
line = input_file.readline()
if len(line) == 0:
error("empty line")
 
line_list = shlex.split(line, False, False)
# line col Ident var_name
# 0 1 2 3
 
err_line = line_list[0]
err_col = line_list[1]
tok_text = line_list[2]
 
tok = all_syms.get(tok_text)
if tok == None:
error("Unknown token %s" % (tok_text))
 
tok_other = None
if tok in [tk_Integer, tk_Ident, tk_String]:
tok_other = line_list[3]
 
class Node:
def __init__(self, node_type, left = None, right = None, value = None):
self.node_type = node_type
self.left = left
self.right = right
self.value = value
 
#***
def make_node(oper, left, right = None):
return Node(oper, left, right)
 
#***
def make_leaf(oper, n):
return Node(oper, value = n)
 
#***
def expect(msg, s):
if tok == s:
gettok()
return
error("%s: Expecting '%s', found '%s'" % (msg, Tokens[s][TK_NAME], Tokens[tok][TK_NAME]))
 
#***
def expr(p):
x = None
 
if tok == tk_Lparen:
x = paren_expr()
elif tok in [tk_Sub, tk_Add]:
op = (tk_Negate if tok == tk_Sub else tk_Add)
gettok()
node = expr(Tokens[tk_Negate][TK_PRECEDENCE])
x = (make_node(nd_Negate, node) if op == tk_Negate else node)
elif tok == tk_Not:
gettok()
x = make_node(nd_Not, expr(Tokens[tk_Not][TK_PRECEDENCE]))
elif tok == tk_Ident:
x = make_leaf(nd_Ident, tok_other)
gettok()
elif tok == tk_Integer:
x = make_leaf(nd_Integer, tok_other)
gettok()
else:
error("Expecting a primary, found: %s" % (Tokens[tok][TK_NAME]))
 
while Tokens[tok][TK_IS_BINARY] and Tokens[tok][TK_PRECEDENCE] >= p:
op = tok
gettok()
q = Tokens[op][TK_PRECEDENCE]
if not Tokens[op][TK_RIGHT_ASSOC]:
q += 1
 
node = expr(q)
x = make_node(Tokens[op][TK_NODE], x, node)
 
return x
 
#***
def paren_expr():
expect("paren_expr", tk_Lparen)
node = expr(0)
expect("paren_expr", tk_Rparen)
return node
 
#***
def stmt():
t = None
 
if tok == tk_If:
gettok()
e = paren_expr()
s = stmt()
s2 = None
if tok == tk_Else:
gettok()
s2 = stmt()
t = make_node(nd_If, e, make_node(nd_If, s, s2))
elif tok == tk_Putc:
gettok()
e = paren_expr()
t = make_node(nd_Prtc, e)
expect("Putc", tk_Semi)
elif tok == tk_Print:
gettok()
expect("Print", tk_Lparen)
while True:
if tok == tk_String:
e = make_node(nd_Prts, make_leaf(nd_String, tok_other))
gettok()
else:
e = make_node(nd_Prti, expr(0))
 
t = make_node(nd_Sequence, t, e)
if tok != tk_Comma:
break
gettok()
expect("Print", tk_Rparen)
expect("Print", tk_Semi)
elif tok == tk_Semi:
gettok()
elif tok == tk_Ident:
v = make_leaf(nd_Ident, tok_other)
gettok()
expect("assign", tk_Assign)
e = expr(0)
t = make_node(nd_Assign, v, e)
expect("assign", tk_Semi)
elif tok == tk_While:
gettok()
e = paren_expr()
s = stmt()
t = make_node(nd_While, e, s)
elif tok == tk_Lbrace:
gettok()
while tok != tk_Rbrace and tok != tk_EOI:
t = make_node(nd_Sequence, t, stmt())
expect("Lbrace", tk_Rbrace)
elif tok == tk_EOI:
pass
else:
error("Expecting start of statement, found: %s" % (Tokens[tok][TK_NAME]))
 
return t
 
#***
def parse():
t = None
gettok()
while True:
t = make_node(nd_Sequence, t, stmt())
if tok == tk_EOI or t == None:
break
return t
 
def prt_ast(t):
if t == None:
print(";")
else:
print("%-14s" % (Display_nodes[t.node_type]), end='')
if t.node_type in [nd_Ident, nd_Integer]:
print("%s" % (t.value))
elif t.node_type == nd_String:
print("%s" %(t.value))
else:
print("")
prt_ast(t.left)
prt_ast(t.right)
 
#*** main driver
input_file = sys.stdin
if len(sys.argv) > 1:
try:
input_file = open(sys.argv[1], "r", 4096)
except IOError as e:
error(0, 0, "Can't open %s" % sys.argv[1])
t = parse()
prt_ast(t)
Output  —  prime numbers AST:

Sequence
Sequence
Sequence
Sequence
Sequence
;
Assign
Identifier    count
Integer       1
Assign
Identifier    n
Integer       1
Assign
Identifier    limit
Integer       100
While
Less
Identifier    n
Identifier    limit
Sequence
Sequence
Sequence
Sequence
Sequence
;
Assign
Identifier    k
Integer       3
Assign
Identifier    p
Integer       1
Assign
Identifier    n
Add
Identifier    n
Integer       2
While
And
LessEqual
Multiply
Identifier    k
Identifier    k
Identifier    n
Identifier    p
Sequence
Sequence
;
Assign
Identifier    p
NotEqual
Multiply
Divide
Identifier    n
Identifier    k
Identifier    k
Identifier    n
Assign
Identifier    k
Add
Identifier    k
Integer       2
If
Identifier    p
If
Sequence
Sequence
;
Sequence
Sequence
;
Prti
Identifier    n
;
Prts
String        " is prime\n"
;
Assign
Identifier    count
Add
Identifier    count
Integer       1
;
Sequence
Sequence
Sequence
;
Prts
String        "Total primes found: "
;
Prti
Identifier    count
;
Prts
String        "\n"
;

Scheme[edit]

Code implements a recursive descent parser based on the given grammar. Tested against all programs in Compiler/Sample programs.

 
(import (scheme base)
(scheme process-context)
(scheme write))
 
(define *names* (list (cons 'Op_add 'Add)
(cons 'Op_subtract 'Subtract)
(cons 'Op_multiply 'Multiply)
(cons 'Op_divide 'Divide)
(cons 'Op_mod 'Mod)
(cons 'Op_not 'Not)
(cons 'Op_equal 'Equal)
(cons 'Op_notequal 'NotEqual)
(cons 'Op_or 'Or)
(cons 'Op_and 'And)
(cons 'Op_less 'Less)
(cons 'Op_lessequal 'LessEqual)
(cons 'Op_greater 'Greater)
(cons 'Op_greaterequal 'GreaterEqual)))
 
(define (retrieve-name type)
(let ((res (assq type *names*)))
(if res
(cdr res)
(error "Unknown type name"))))
 
;; takes a vector of tokens
(define (parse tokens) ; read statements, until hit end of tokens
(define posn 0)
(define (peek-token)
(vector-ref tokens posn))
(define (get-token)
(set! posn (+ 1 posn))
(vector-ref tokens (- posn 1)))
(define (match type)
(if (eq? (car (vector-ref tokens posn)) type)
(set! posn (+ 1 posn))
(error "Could not match token type" type)))
; make it easier to read token parts
(define type car)
(define value cadr)
;
;; left associative read of one or more items with given separators
(define (read-one-or-more reader separators)
(let loop ((lft (reader)))
(let ((next (peek-token)))
(if (memq (type next) separators)
(begin (match (type next))
(loop (list (retrieve-name (type next)) lft (reader))))
lft))))
;
;; read one or two items with given separator
(define (read-one-or-two reader separators)
(let* ((lft (reader))
(next (peek-token)))
(if (memq (type next) separators)
(begin (match (type next))
(list (retrieve-name (type next)) lft (reader)))
lft)))
;
(define (read-primary)
(let ((next (get-token)))
(case (type next)
((Identifier Integer)
next)
((LeftParen)
(let ((v (read-expr)))
(match 'RightParen)
v))
((Op_add) ; + sign is ignored
(read-primary))
((Op_not)
(list 'Not (read-primary) '()))
((Op_subtract)
(list 'Negate (read-primary) '()))
(else
(error "Unknown primary type")))))
;
(define (read-multiplication-expr) ; *
(read-one-or-more read-primary '(Op_multiply Op_divide Op_mod)))
;
(define (read-addition-expr) ; *
(read-one-or-more read-multiplication-expr '(Op_add Op_subtract)))
;
(define (read-relational-expr) ; ?
(read-one-or-two read-addition-expr
'(Op_less Op_lessequal Op_greater Op_greaterequal)))
;
(define (read-equality-expr) ; ?
(read-one-or-two read-relational-expr '(Op_equal Op_notequal)))
;
(define (read-and-expr) ; *
(read-one-or-more read-equality-expr '(Op_and)))
;
(define (read-expr) ; *
(read-one-or-more read-and-expr '(Op_or)))
;
(define (read-prt-list)
(define (read-print-part)
(if (eq? (type (peek-token)) 'String)
(list 'Prts (get-token) '())
(list 'Prti (read-expr) '())))
;
(do ((tok (read-print-part) (read-print-part))
(rec '() (list 'Sequence rec tok)))
((not (eq? (type (peek-token)) 'Comma))
(list 'Sequence rec tok))
(match 'Comma)))
;
(define (read-paren-expr)
(match 'LeftParen)
(let ((v (read-expr)))
(match 'RightParen)
v))
;
(define (read-stmt)
(case (type (peek-token))
((SemiColon)
'())
((Identifier)
(let ((id (get-token)))
(match 'Op_assign)
(let ((ex (read-expr)))
(match 'Semicolon)
(list 'Assign id ex))))
((Keyword_while)
(match 'Keyword_while)
(let* ((expr (read-paren-expr))
(stmt (read-stmt)))
(list 'While expr stmt)))
((Keyword_if)
(match 'Keyword_if)
(let* ((expr (read-paren-expr))
(then-part (read-stmt))
(else-part (if (eq? (type (peek-token)) 'Keyword_else)
(begin (match 'Keyword_else)
(read-stmt))
'())))
(list 'If expr (list 'If then-part else-part))))
((Keyword_print)
(match 'Keyword_print)
(match 'LeftParen)
(let ((v (read-prt-list)))
(match 'RightParen)
(match 'Semicolon)
v))
((Keyword_putc)
(match 'Keyword_putc)
(let ((v (read-paren-expr)))
(match 'Semicolon)
(list 'Putc v '())))
((LeftBrace)
(match 'LeftBrace)
(let ((v (read-stmts)))
(match 'RightBrace)
v))
(else
(error "Unknown token type for statement" (type (peek-token))))))
;
(define (read-stmts)
(do ((sequence (list 'Sequence '() (read-stmt))
(list 'Sequence sequence (read-stmt))))
((memq (type (peek-token)) '(End_of_input RightBrace))
sequence)))
;
(let ((res (read-stmts)))
(match 'End_of_input)
res))
 
;; reads tokens from file, parses and returns the AST
(define (parse-file filename)
(define (tokenise line)
(let ((port (open-input-string line)))
(read port) ; discard line
(read port) ; discard col
(let* ((type (read port)) ; read type as symbol
(val (read port))) ; check for optional value
(if (eof-object? val)
(list type)
(list type val)))))
;
(with-input-from-file
filename
(lambda ()
(do ((line (read-line) (read-line))
(toks '() (cons (tokenise line) toks)))
((eof-object? line)
(parse (list->vector (reverse toks))))))))
 
;; Output the AST in flattened format
(define (display-ast ast)
(cond ((null? ast)
(display ";\n"))
((= 2 (length ast))
(display (car ast))
(display #\tab)
(write (cadr ast)) ; use write to preserve " " on String
(newline))
(else
(display (car ast)) (newline)
(display-ast (cadr ast))
(display-ast (cadr (cdr ast))))))
 
;; read from filename passed on command line
(if (= 2 (length (command-line)))
(display-ast (parse-file (cadr (command-line))))
(display "Error: provide program filename\n"))