Compiler/syntax analyzer: Difference between revisions
→{{header|J}}
m (→{{header|ATS}}) |
|||
Line 5,983:
;
</pre>
=={{header|Icon}}==
{{works with|Icon|9.5.20i}}
I use co-expressions in a way that could easily be done differently, but I prefer to use the co-expressions. (These can be sluggish or fast, depending on what sort of Icon you are running. In this case, the speed differences are of little concern.)
<lang Icon>#
# The Rosetta Code Tiny-Language Parser, in Icon.
#
# This implementation is based closely on the pseudocode and the C
# reference implementation.
#
# ximage from the IPL is useful for debugging. Use "xdump(x)" to
# pretty-print x.
#link ximage
record token_record (line_no, column_no, tok, tokval)
record token_getter (nxt, curr)
procedure main (args)
local inpf_name, outf_name
local inpf, outf
local nexttok, currtok, current_token, gettok
local ast
inpf_name := "-"
outf_name := "-"
if 1 <= *args then inpf_name := args[1]
if 2 <= *args then outf_name := args[2]
inpf :=
if inpf_name == "-" then
&input
else
(open(inpf_name, "r") |
stop("failed to open \"" || inpf_name || "\" for input"))
outf :=
if outf_name == "-" then
&output
else
(open(outf_name, "w") |
stop("failed to open \"" || outf_name || "\" for output"))
current_token := [&null]
nexttok := create generate_tokens(inpf, current_token)
currtok := create get_current_token (current_token)
gettok := token_getter(nexttok, currtok)
ast := parse(gettok)
prt_ast(outf, ast)
close(inpf)
close(outf)
end
procedure prt_ast (outf, ast)
if *ast = 0 then {
write(outf, ";")
} else {
writes(outf, ast[1])
if ast[1] == ("Identifier" | "Integer" | "String") then {
write(outf, " ", ast[2])
} else {
write(outf)
prt_ast(outf, ast[2])
prt_ast(outf, ast[3])
}
}
end
procedure generate_tokens (inpf, current_token)
local s
while s := read(inpf) do {
if trim(s) ~== "" then {
current_token[1] := string_to_token_record(s)
suspend current_token[1]
}
}
end
procedure get_current_token (current_token)
repeat (suspend current_token[1])
end
procedure string_to_token_record (s)
local line_no, column_no, tok, tokval
static spaces
initial {
spaces := ' \t\f\v\r\n'
}
trim(s) ? {
tab(many(spaces))
line_no := integer(tab(many(&digits)))
tab(many(spaces))
column_no := integer(tab(many(&digits)))
tab(many(spaces))
tok := tab(many(&letters ++ '_'))
tab(many(spaces))
tokval := tab(0)
}
return token_record(line_no, column_no, tok, tokval)
end
procedure parse (gettok)
local tok
local t
t := []
@gettok.nxt
tok := "Not End_of_input"
while tok ~== "End_of_input" do {
t := ["Sequence", t, stmt(gettok)]
tok := (@gettok.curr).tok
}
return t
end
procedure stmt (gettok)
local e, s, t, v
local tok
local done
t := []
if accept(gettok, "Keyword_if") then {
e := paren_expr(gettok)
s := stmt(gettok)
t := ["If", e, ["If", s,
if accept(gettok, "Keyword_else")
then stmt(gettok) else []]]
} else if accept(gettok, "Keyword_putc") then {
t := ["Prtc", paren_expr(gettok), []]
expect(gettok, "Putc", "Semicolon")
} else if accept(gettok, "Keyword_print") then {
expect(gettok, "Print", "LeftParen")
done := 0
while done = 0 do {
tok := @gettok.curr
if tok.tok == "String" then {
e := ["Prts", ["String", tok.tokval], []]
@gettok.nxt
} else {
e := ["Prti", expr(gettok, 0), []]
}
t := ["Sequence", t, e]
accept(gettok, "Comma") | (done := 1)
}
expect(gettok, "Print", "RightParen")
expect(gettok, "Print", "Semicolon")
} else if (@gettok.curr).tok == "Semicolon" then {
@gettok.nxt
} else if (@gettok.curr).tok == "Identifier" then {
v := ["Identifier", (@gettok.curr).tokval]
@gettok.nxt
expect(gettok, "assign", "Op_assign")
t := ["Assign", v, expr(gettok, 0)]
expect(gettok, "assign", "Semicolon")
} else if accept(gettok, "Keyword_while") then {
e := paren_expr(gettok)
t := ["While", e, stmt(gettok)]
} else if accept(gettok, "LeftBrace") then {
until (@gettok.curr).tok == ("RightBrace" | "End_of_input") do {
t := ["Sequence", t, stmt(gettok)]
}
expect(gettok, "Lbrace", "RightBrace")
} else if (@gettok.curr).tok ~== "End_of_input" then {
tok := @gettok.curr
error(tok, ("expecting start of statement, found '" ||
text(tok.tok) || "'"))
}
return t
end
procedure paren_expr (gettok)
local x
expect(gettok, "paren_expr", "LeftParen");
x := expr(gettok, 0);
expect(gettok, "paren_expr", "RightParen");
return x
end
procedure expr (gettok, p)
local tok, save_tok
local x, y
local q
tok := @gettok.curr
case tok.tok of {
"LeftParen" : {
x := paren_expr(gettok)
}
"Op_subtract" : {
@gettok.nxt
y := expr(gettok, precedence("Op_negate"))
x := ["Negate", y, []]
}
"Op_add" : {
@gettok.nxt
x := expr(gettok, precedence("Op_negate"))
}
"Op_not" : {
@gettok.nxt
y := expr(gettok, precedence("Op_not"))
x := ["Not", y, []]
}
"Identifier" : {
x := ["Identifier", tok.tokval]
@gettok.nxt
}
"Integer" : {
x := ["Integer", tok.tokval]
@gettok.nxt
}
default : {
error(tok, "Expecting a primary, found: " || text(tok.tok))
}
}
while (tok := @gettok.curr &
is_binary(tok.tok) &
p <= precedence(tok.tok)) do
{
save_tok := tok
@gettok.nxt
q := precedence(save_tok.tok)
if not is_right_associative(save_tok.tok) then q +:= 1
x := [operator(save_tok.tok), x, expr(gettok, q)]
}
return x
end
procedure accept (gettok, tok)
local nxt
if (@gettok.curr).tok == tok then nxt := @gettok.nxt else fail
return nxt
end
procedure expect (gettok, msg, tok)
if (@gettok.curr).tok ~== tok then {
error(@gettok.curr,
msg || ": Expecting '" || tok || "', found '" ||
(@gettok.curr).tok || "'")
}
return @gettok.nxt
end
procedure error (token, msg)
write("(", token.line_no, ", ", token.column_no, ") error: ", msg)
exit(1)
end
procedure precedence (tok)
local p
case tok of {
"Op_multiply" : p := 13
"Op_divide" : p := 13
"Op_mod" : p := 13
"Op_add" : p := 12
"Op_subtract" : p := 12
"Op_negate" : p := 14
"Op_not" : p := 14
"Op_less" : p := 10
"Op_lessequal" : p := 10
"Op_greater" : p := 10
"Op_greaterequal" : p := 10
"Op_equal" : p := 9
"Op_notequal" : p := 9
"Op_and" : p := 5
"Op_or" : p := 4
default : p := -1
}
return p
end
procedure is_binary (tok)
return ("Op_add" |
"Op_subtract" |
"Op_multiply" |
"Op_divide" |
"Op_mod" |
"Op_less" |
"Op_lessequal" |
"Op_greater" |
"Op_greaterequal" |
"Op_equal" |
"Op_notequal" |
"Op_and" |
"Op_or") == tok
fail
end
procedure is_right_associative (tok)
# None of the current operators is right associative.
fail
end
procedure operator (tok)
local s
case tok of {
"Op_multiply" : s := "Multiply"
"Op_divide" : s := "Divide"
"Op_mod" : s := "Mod"
"Op_add" : s := "Add"
"Op_subtract" : s := "Subtract"
"Op_negate" : s := "Negate"
"Op_not" : s := "Not"
"Op_less" : s := "Less"
"Op_lessequal" : s := "LessEqual"
"Op_greater" : s := "Greater"
"Op_greaterequal" : s := "GreaterEqual"
"Op_equal" : s := "Equal"
"Op_notequal" : s := "NotEqual"
"Op_and" : s := "And"
"Op_or" : s := "Or"
}
return s
end
procedure text (tok)
local s
case tok of {
"Keyword_else" : s := "else"
"Keyword_if" : s := "if"
"Keyword_print" : s := "print"
"Keyword_putc" : s := "putc"
"Keyword_while" : s := "while"
"Op_multiply" : s := "*"
"Op_divide" : s := "/"
"Op_mod" : s := "%"
"Op_add" : s := "+"
"Op_subtract" : s := "-"
"Op_negate" : s := "-"
"Op_less" : s := "<"
"Op_lessequal" : s := "<="
"Op_greater" : s := ">"
"Op_greaterequal" : s := ">="
"Op_equal" : s := "=="
"Op_notequal" : s := "!="
"Op_not" : s := "!"
"Op_assign" : s := "="
"Op_and" : s := "&&"
"Op_or" : s := "||"
"LeftParen" : s := "("
"RightParen" : s := ")"
"LeftBrace" : s := "{"
"RightBrace" : s := "}"
"Semicolon" : s := ";"
"Comma" : s := ","
"Identifier" : s := "Ident"
"Integer" : s := "Integer literal"
"String" : s := "String literal"
"End_of_input" : s := "EOI"
}
return s
end</lang>
{{out}}
<pre>$ icont -s -u parse.icn && ./parse compiler-tests/primes.lex
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"
;</pre>
=={{header|J}}==
| |||