Compiler/syntax analyzer: Difference between revisions

Line 4,931:

=={{header|Phix}}==

Reusing lex.e (and core.e) from the [[Compiler/lexical_analyzer#Phix|Lexical Analyzer task]], and again written as a reusable module.

<lang Phix>--

--

-- demo\\rosetta\\Compiler\\parse.e

-- demo\rosetta\Compiler\parse.e

-- ================================

-- =============================

--

-- The reusable part of parse.exw

--

--

with javascript_semantics

include lex.e

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

sequence tok

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

procedure errd(sequence msg, sequence args={})

switch tok[3] do

{tok_line,tok_col} = tok

case tk_if:

error(msg,args)

tok = get_tok();

end procedure

object condition = paren_expr("If-cond");

object ifblock = stmt();

global sequence toks

object elseblock = NULL;

integer next_tok = 1

if tok[3] == tk_else then

tok = get_tok();

function get_tok()

elseblock = stmt();

sequence tok = toks[next_tok]

end if

next_tok += 1

t = {tk_if, condition, {tk_if, ifblock, elseblock}}

return tok

case tk_putc:

end function

tok = get_tok();

e = paren_expr("Prtc")

procedure expect(string msg, integer s)

t = {tk_putc, e, NULL}

integer tk = tok[3]

expect("Putc", tk_Semicolon);

if tk!=s then

case tk_print:

errd("%s: Expecting '%s', found '%s'\n", {msg, tkNames[s], tkNames[tk]})

tok = get_tok();

end if

expect("Print",tk_LeftParen)

tok = get_tok()

while 1 do

end procedure

if tok[3] == tk_String then

e = {tk_Prints, {tk_String, tok[4]}, NULL}

function expr(integer p)

tok = get_tok();

object x = NULL, node

else

integer op = tok[3]

e = {tk_Printi, expr(0), NULL}

end if

switch op do

t = {tk_Sequence, t, e}

case tk_LeftParen:

if tok[3]!=tk_Comma then exit end if

tok = get_tok()

expect("Print", tk_Comma)

x = expr(0)

end while

expect("expr",tk_RightParen)

expect("Print", tk_RightParen);

case tk_sub:

expect("Print", tk_Semicolon);

case tk_add:

case tk_Semicolon:

tok = get_tok()

tok = get_tok();

node = expr(precedences[tk_neg]);

case tk_Identifier:

x = iff(op==tk_sub?{tk_neg, node, NULL}:node)

object v

case tk_not:

v = {tk_Identifier, tok[4]}

tok = get_tok();

tok = get_tok();

x = {tk_not, expr(precedences[tk_not]), NULL}

expect("assign", tk_assign);

case tk_Identifier:

e = expr(0);

x = {tk_Identifier, tok[4]}

t = {tk_assign, v, e}

tok = get_tok();

expect("assign", tk_Semicolon);

case tk_Integer:

case tk_while:

x = {tk_Integer, tok[4]}

tok = get_tok();

tok = get_tok();

e = paren_expr("while");

default:

s = stmt();

errd("Expecting a primary, found: %s\n", tkNames[op])

t = {tk_while, e, s}

end switch

case tk_LeftBrace: /* {stmt} */

expect("LeftBrace", tk_LeftBrace)

op = tok[3]

while not find(tok[3],{tk_RightBrace,tk_EOI}) do

while narys[op]=BINARY

t = {tk_Sequence, t, stmt()}

and precedences[op]>=p do

end while

tok = get_tok()

expect("LeftBrace", tk_RightBrace);

x = {op, x, expr(precedences[op]+1)}

break;

op = tok[3]

case tk_EOI:

end while

break;

return x;

default:

end function

errd("expecting start of statement, found '%s'\n", tkNames[tok[3]]);

end switch

function paren_expr(string msg)

return t

expect(msg, tk_LeftParen);

end function

object t = expr(0)

expect(msg, tk_RightParen);

global function parse()

return t

object t = NULL

end function

tok = get_tok()

while 1 do

function stmt()

object s = stmt()

object t = NULL, e, s

if s=NULL then exit end if

t = {tk_Sequence, t, s}

switch tok[3] do

end while

case tk_if:

return t

tok = get_tok();

end function</lang>

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:

<lang Phix>--

--

-- demo\\rosetta\\Compiler\\parse.exw

-- demo\rosetta\Compiler\parse.exw

-- ==================================

-- ===============================

--

--

include parse.e

with javascript_semantics

include parse.e

procedure print_ast(object t)

if t == NULL then

procedure print_ast(object t)

printf(output_file,";\n")

if t == NULL then

else

printf(output_file,";\n")

integer ttype = t[1]

else

printf(output_file,tkNames[ttype])

integer ttype = t[1]

if ttype=tk_Identifier then

printf(output_file,tkNames[ttype])

printf(output_file," %s\n",t[2])

if ttype=tk_Identifier then

elsif ttype=tk_Integer then

printf(output_file," %s\n",t[2])

printf(output_file," %d\n",t[2])

elsif ttype=tk_Integer then

elsif ttype=tk_String then

printf(output_file," %d\n",t[2])

printf(output_file," %s\n",enquote(t[2]))

elsif ttype=tk_String then

else

printf(output_file," %s\n",enquote(t[2]))

printf(output_file,"\n")

~~print_ast(t[2])~~

else

printf(output_file,"\n")

print_ast(t[3])

print_ast(t[2])

end if

print_ast(t[3])

end if

end if

end procedure

end if

end procedure

procedure main(sequence cl)

open_files(cl)

function ptree(object t)

toks = lex()

if sequence(t) then

object t = parse()

integer t1 = t[1]

print_ast(t)

t = deep_copy(t)

close_files()

t[1] = tkNames[t1]

end procedure

if not find(t1,{tk_Identifier,tk_String}) then

for i=2 to length(t) do

--main(command_line())

if t1=tk_Sequence and t[i]=NULL then

main({0,0,"test3.c"}) -- not parseable!

t[i] = "NULL"

--main({0,0,"primes.c"}) -- as Algol, C, Python (apart from spacing)

~~--main({0,0,"count.c"})~~ -- as ~~AWK~~ ( "~~" )~~</~~lang~~>

else

t[i] = ptree(t[i])

end if

end for

end if

return t

end function

procedure main(sequence cl)

open_files(cl)

toks = lex()

object t = parse()

print_ast(t)

pp(ptree(t),{pp_Nest,10,pp_Pause,0,pp_IntCh,false})

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 ( "" )

<pre>