mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-20 20:03:44 +00:00
ecb5e4a9e6
tests/declarative_debugger/*.m:
tests/exceptions/*.m:
tests/general/*.m:
tests/grade_subdirs/*.m:
tests/purity/*.m:
tests/submodules/*.m:
tests/typeclasses/*.m:
Update programming style.
tests/declarative_debugger/*.inp:
Update line numbers in breakpoint commands.
tests/declarative_debugger/*.exp:
Update expected line numbers.
tests/exceptions/Mercury.options:
tests/general/Mercury.options:
Disable some warnings that are irrelevant to the test.
577 lines
20 KiB
Mathematica
577 lines
20 KiB
Mathematica
%---------------------------------------------------------------------------%
|
||
% vim: ts=4 sw=4 et ft=mercury
|
||
%---------------------------------------------------------------------------%
|
||
% test_parsing_utils.m
|
||
% Ralph Becket <rafe@csse.unimelb.edu.au>
|
||
% Tue Jan 27 13:44:59 EST 2009
|
||
%
|
||
% The .exp file is for backends that use UTF-8 encoded strings.
|
||
% The .exp2 file is for backends that use UTF-16 encoded strings.
|
||
%
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- module test_parsing_utils.
|
||
|
||
:- interface.
|
||
|
||
:- import_module io.
|
||
|
||
:- pred main(io::di, io::uo) is cc_multi.
|
||
|
||
%---------------------------------------------------------------------------%
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- implementation.
|
||
|
||
:- import_module int.
|
||
:- import_module list.
|
||
:- import_module maybe.
|
||
:- import_module parsing_utils.
|
||
:- import_module solutions.
|
||
:- import_module string.
|
||
:- import_module unit.
|
||
|
||
%---------------------------------------------------------------------------%
|
||
|
||
main(!IO) :-
|
||
unsorted_aggregate(run_test, io.write_string, !IO),
|
||
io.write_string("--\n", !IO),
|
||
test_pos("123456789\n123456789\n", 14, !IO),
|
||
test_pos("\n123456789\n123456789\n\n\n\n\n\n", 3, !IO),
|
||
test_pos("\n1234\n12\n\n\nfewefwef\nwwfwe\n\n", 20, !IO),
|
||
test_pos("123456789\n123456789\n\n1234567890", 22, !IO),
|
||
test_pos("123456789\n123456789\n\n1234567890", 20, !IO),
|
||
test_pos("123456789", 2, !IO),
|
||
test_pos("123456789", 0, !IO),
|
||
test_pos("123456789\n123456789\n\n", 19, !IO),
|
||
test_pos("123456789\n123456789\n\n", 20, !IO),
|
||
test_pos("", 0, !IO),
|
||
io.write_string("--\n", !IO),
|
||
test_pos("ábc\n☿\n\n", 0, !IO),
|
||
test_pos("ábc\n☿\n\n", 1, !IO),
|
||
test_pos("ábc\n☿\n\n", 2, !IO),
|
||
test_pos("ábc\n☿\n\n", 3, !IO),
|
||
test_pos("ábc\n☿\n\n", 4, !IO),
|
||
test_pos("ábc\n☿\n\n", 5, !IO),
|
||
test_pos("ábc\n☿\n\n", 6, !IO),
|
||
test_pos("ábc\n☿\n\n", 7, !IO),
|
||
test_pos("ábc\n☿\n\n", 8, !IO),
|
||
test_pos("ábc\n☿\n\n", 9, !IO),
|
||
io.write_string("--\n", !IO),
|
||
test_err("12 + x-pow(x + 3; y)", expr_top, !IO),
|
||
test_err("abs(x ++ 3)", expr_top, !IO),
|
||
test_err("abs (x))", expr_top, !IO),
|
||
test_err("1 + 3 MoD 2 + f(3 + x)", expr_top, !IO),
|
||
test_err("1 + /* comment */ 3 mody 2 + f(3 + x)", expr_top, !IO),
|
||
test_err("1 + 1x", expr_top, !IO),
|
||
test_err("1 + 2 /* blah blah ...", expr_top, !IO),
|
||
true.
|
||
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- pred run_test(string::out) is multi.
|
||
|
||
run_test(Result) :-
|
||
test_case(ParserName, Parser, TestString, ExpectedOutput),
|
||
new_src_and_ps(TestString, Src, PS0),
|
||
( if Parser(Src, ActualOutput0, PS0, PS) then
|
||
ActualOutput = yes(ActualOutput0),
|
||
current_offset(Src, CurrentOffset0, PS, _),
|
||
CurrentOffset = yes(CurrentOffset0)
|
||
else
|
||
ActualOutput = no,
|
||
CurrentOffset = no
|
||
),
|
||
(
|
||
ExpectedOutput = no,
|
||
ActualOutput = no,
|
||
Outcome = "failed as expected",
|
||
PassFail = "pass"
|
||
;
|
||
ExpectedOutput = no,
|
||
ActualOutput = yes(ActualOutputString),
|
||
Outcome = "should have failed, but returned \"" ++
|
||
ActualOutputString ++ "\"",
|
||
PassFail = "fail"
|
||
;
|
||
ExpectedOutput = yes(ExpectedOutputString),
|
||
ActualOutput = no,
|
||
Outcome = "failed, but should have returned \"" ++
|
||
ExpectedOutputString ++ "\"",
|
||
PassFail = "fail"
|
||
;
|
||
ExpectedOutput = yes(ExpectedOutputString),
|
||
ActualOutput = yes(ActualOutputString),
|
||
Outcome0 = "returned " ++ ActualOutputString,
|
||
( if ActualOutputString = ExpectedOutputString then
|
||
Outcome = Outcome0 ++ " as expected",
|
||
PassFail = "pass"
|
||
else
|
||
Outcome = Outcome0 ++ ", but should have returned " ++
|
||
ExpectedOutputString,
|
||
PassFail = "fail"
|
||
)
|
||
),
|
||
(
|
||
CurrentOffset = yes(CO),
|
||
input_substring(Src, 0, CO, Substring)
|
||
->
|
||
NumCodePoints = string.count_codepoints(Substring),
|
||
NumCodeUnits = string.count_code_units(Substring),
|
||
( NumCodeUnits = NumCodePoints ->
|
||
What = "chars"
|
||
;
|
||
What = "code points"
|
||
),
|
||
Consumed = string.format("\n\t[%d %s consumed]",
|
||
[i(NumCodePoints), s(What)])
|
||
;
|
||
Consumed = ""
|
||
),
|
||
Result = PassFail ++ ": " ++
|
||
ParserName ++ " on \"" ++ TestString ++ "\"\n\t" ++
|
||
Outcome ++ Consumed ++ "\n".
|
||
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- pred test_case(string::out,
|
||
pred(src, string, ps, ps)::out(pred(in, out, in, out) is semidet),
|
||
string::out, maybe(string)::out) is multi.
|
||
|
||
test_case("next_char", stringify(next_char),
|
||
"", no).
|
||
test_case("next_char", stringify(next_char),
|
||
"123", yes("'1'")).
|
||
|
||
test_case("char_in_class(\"123\")", stringify(char_in_class("123")),
|
||
"", no).
|
||
test_case("char_in_class(\"123\")", stringify(char_in_class("123")),
|
||
"abc", no).
|
||
test_case("char_in_class(\"123\")", stringify(char_in_class("123")),
|
||
"123", yes("'1'")).
|
||
|
||
test_case("punct(\"!\")", stringify(punct("!")),
|
||
"", no).
|
||
test_case("punct(\"!\")", stringify(punct("!")),
|
||
"abc", no).
|
||
test_case("punct(\"!\")", stringify(punct("!")),
|
||
"*", no).
|
||
test_case("punct(\"!\")", stringify(punct("!")),
|
||
"!", yes("unit")).
|
||
|
||
test_case("keyword(\"ABC\", \"ABC\")", stringify(keyword("ABC", "ABC")),
|
||
"", no).
|
||
test_case("keyword(\"ABC\", \"ABC\")", stringify(keyword("ABC", "ABC")),
|
||
"123", no).
|
||
test_case("keyword(\"ABC\", \"ABC\")", stringify(keyword("ABC", "ABC")),
|
||
"ABCA", no).
|
||
test_case("keyword(\"ABC\", \"ABC\")", stringify(keyword("ABC", "ABC")),
|
||
"ABC 123", yes("unit")).
|
||
|
||
test_case("keyword(\"αβγ\", \"αβγ\")", stringify(keyword("αβγ", "αβγ")),
|
||
"", no).
|
||
test_case("keyword(\"αβγ\", \"αβγ\")", stringify(keyword("αβγ", "αβγ")),
|
||
"123", no).
|
||
test_case("keyword(\"αβγ\", \"αβγ\")", stringify(keyword("αβγ", "αβγ")),
|
||
"αβγα", no).
|
||
test_case("keyword(\"αβγ\", \"αβγ\")", stringify(keyword("αβγ", "αβγ")),
|
||
"αβγ 123", yes("unit")).
|
||
|
||
test_case("keyword(\"ABC\", \"ABC\")", stringify(ikeyword("ABC", "ABC")),
|
||
"abc 123", yes("unit")).
|
||
test_case("ikeyword(\"αβγ\", \"αβγ\")", stringify(ikeyword("αβγ", "αβγ")),
|
||
"αβγ 123", yes("unit")).
|
||
|
||
test_case("identifier(\"ABC\", \"ABCabc_\")", stringify(identifier("ABC", "ABCabc_")),
|
||
"", no).
|
||
test_case("identifier(\"ABC\", \"ABCabc_\")", stringify(identifier("ABC", "ABCabc_")),
|
||
"abc", no).
|
||
test_case("identifier(\"ABC\", \"ABCabc_\")", stringify(identifier("ABC", "ABCabc_")),
|
||
"_", no).
|
||
test_case("identifier(\"ABC\", \"ABCabc_\")", stringify(identifier("ABC", "ABCabc_")),
|
||
"A", yes("\"A\"")).
|
||
test_case("identifier(\"ABC\", \"ABCabc_\")", stringify(identifier("ABC", "ABCabc_")),
|
||
"Ab_c", yes("\"Ab_c\"")).
|
||
test_case("identifier(\"ABC\", \"ABCabc_\")", stringify(identifier("ABC", "ABCabc_")),
|
||
"*", no).
|
||
test_case("identifier(\"ABC\", \"ABCabc_\")", stringify(identifier("ABC", "ABCabc_")),
|
||
"Abc !", yes("\"Abc\"")).
|
||
|
||
test_case("identifier(\"αβγ\", \"αβγ_\")", stringify(identifier("αβγ", "αβγ_")),
|
||
"", no).
|
||
test_case("identifier(\"αβγ\", \"αβγ_\")", stringify(identifier("αβγ", "αβγ_")),
|
||
"abc", no).
|
||
test_case("identifier(\"αβγ\", \"αβγ_\")", stringify(identifier("αβγ", "αβγ_")),
|
||
"_", no).
|
||
test_case("identifier(\"αβγ\", \"αβγ_\")", stringify(identifier("αβγ", "αβγ_")),
|
||
"α", yes("\"α\"")).
|
||
test_case("identifier(\"αβγ\", \"αβγ_\")", stringify(identifier("αβγ", "αβγ_")),
|
||
"αβ_γ", yes("\"αβ_γ\"")).
|
||
|
||
test_case("whitespace", stringify(whitespace),
|
||
"", yes("unit")).
|
||
test_case("whitespace", stringify(whitespace),
|
||
"123", yes("unit")).
|
||
test_case("whitespace", stringify(whitespace),
|
||
" ", yes("unit")).
|
||
test_case("whitespace", stringify(whitespace),
|
||
" 123", yes("unit")).
|
||
|
||
test_case("skip_to_eol", stringify(skip_to_eol),
|
||
"", no).
|
||
test_case("skip_to_eol", stringify(skip_to_eol),
|
||
"blah blah\n", yes("unit")).
|
||
test_case("skip_to_eol", stringify(skip_to_eol),
|
||
"blah blah\n123", yes("unit")).
|
||
|
||
test_case("eof", stringify(eof),
|
||
"123", no).
|
||
test_case("eof", stringify(eof),
|
||
"", yes("unit")).
|
||
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"", no).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"abc", no).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"123", no).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"123.0 abc", yes("\"123.0\"")).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"123.0e1 abc", yes("\"123.0e1\"")).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"-123.0 abc", yes("\"-123.0\"")).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"-123.0e1 abc", yes("\"-123.0e1\"")).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"-123.0e-1 abc", yes("\"-123.0e-1\"")).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"-123.0e+1 abc", yes("\"-123.0e+1\"")).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"-123.0E1 abc", yes("\"-123.0E1\"")).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"-123.0E-1 abc", yes("\"-123.0E-1\"")).
|
||
test_case("float_literal_as_string", stringify(float_literal_as_string),
|
||
"-123.0E+1 abc", yes("\"-123.0E+1\"")).
|
||
|
||
test_case("float_literal", stringify(float_literal),
|
||
"", no).
|
||
test_case("float_literal", stringify(float_literal),
|
||
"abc", no).
|
||
test_case("float_literal", stringify(float_literal),
|
||
"123", no).
|
||
test_case("float_literal", stringify(float_literal),
|
||
"123.0 abc", yes("123.0")).
|
||
test_case("float_literal", stringify(float_literal),
|
||
"123.0e1 abc", yes("1230.0")).
|
||
test_case("float_literal", stringify(float_literal),
|
||
"-123.0 abc", yes("-123.0")).
|
||
test_case("float_literal", stringify(float_literal),
|
||
"-123.0e1 abc", yes("-1230.0")).
|
||
test_case("float_literal", stringify(float_literal),
|
||
"-123.0e+1 abc", yes("-1230.0")).
|
||
test_case("float_literal", stringify(float_literal),
|
||
"-123.0E-1 abc", yes("-12.3")).
|
||
|
||
test_case("int_literal_as_string", stringify(int_literal_as_string),
|
||
"", no).
|
||
test_case("int_literal_as_string", stringify(int_literal_as_string),
|
||
"abc", no).
|
||
test_case("int_literal_as_string", stringify(int_literal_as_string),
|
||
"123.0", no).
|
||
test_case("int_literal_as_string", stringify(int_literal_as_string),
|
||
"123 abc", yes("\"123\"")).
|
||
test_case("int_literal_as_string", stringify(int_literal_as_string),
|
||
"-123 abc", yes("\"-123\"")).
|
||
test_case("int_literal_as_string", stringify(int_literal_as_string),
|
||
"999999999999999999999 abc", yes("\"999999999999999999999\"")).
|
||
|
||
test_case("int_literal", stringify(int_literal),
|
||
"", no).
|
||
test_case("int_literal", stringify(int_literal),
|
||
"abc", no).
|
||
test_case("int_literal", stringify(int_literal),
|
||
"123.0", no).
|
||
test_case("int_literal", stringify(int_literal),
|
||
"123 abc", yes("123")).
|
||
test_case("int_literal", stringify(int_literal),
|
||
"-123 abc", yes("-123")).
|
||
test_case("int_literal", stringify(int_literal),
|
||
"999999999999999999999 abc", no).
|
||
|
||
test_case("string_literal('\\\"')", stringify(string_literal('\"')),
|
||
"", no).
|
||
test_case("string_literal('\\\"')", stringify(string_literal('\"')),
|
||
"\"123\" abc", yes("\"123\"")).
|
||
test_case("string_literal('\\\"')", stringify(string_literal('\"')),
|
||
"\"1\\\"2\\\"3\" abc", yes("\"1\\\\\\\"2\\\\\\\"3\"")).
|
||
test_case("string_literal('\\\'')", stringify(string_literal('\'')),
|
||
"", no).
|
||
test_case("string_literal('\\\'')", stringify(string_literal('\'')),
|
||
"\'123\' abc", yes("\"123\"")).
|
||
test_case("string_literal('\\\'')", stringify(string_literal('\'')),
|
||
"\'1\\\'2\\\'3\' abc", yes("\"1\\\\\\\'2\\\\\\\'3\"")).
|
||
|
||
test_case("string_literal('‖')", stringify(string_literal('‖')),
|
||
"", no).
|
||
test_case("string_literal('‖')", stringify(string_literal('‖')),
|
||
"‖123‖ abc", yes("\"123\"")).
|
||
test_case("string_literal('‖')", stringify(string_literal('‖')),
|
||
"‖αβγ‖ abc", yes("\"αβγ\"")).
|
||
|
||
test_case("optional(punct(\"!\"))", stringify(optional(punct("!"))),
|
||
"", yes("no")).
|
||
test_case("optional(punct(\"!\"))", stringify(optional(punct("!"))),
|
||
"abc", yes("no")).
|
||
test_case("optional(punct(\"!\"))", stringify(optional(punct("!"))),
|
||
"! ", yes("yes(unit)")).
|
||
|
||
test_case("zero_or_more(punct(\"!\"))", stringify(zero_or_more(punct("!"))),
|
||
"", yes("[]")).
|
||
test_case("zero_or_more(punct(\"!\"))", stringify(zero_or_more(punct("!"))),
|
||
"abc", yes("[]")).
|
||
test_case("zero_or_more(punct(\"!\"))", stringify(zero_or_more(punct("!"))),
|
||
"!!! abc", yes("[unit, unit, unit]")).
|
||
|
||
test_case("one_or_more(punct(\"!\"))", stringify(one_or_more(punct("!"))),
|
||
"", no).
|
||
test_case("one_or_more(punct(\"!\"))", stringify(one_or_more(punct("!"))),
|
||
"abc", no).
|
||
test_case("one_or_more(punct(\"!\"))", stringify(one_or_more(punct("!"))),
|
||
"!!! abc", yes("[unit, unit, unit]")).
|
||
|
||
test_case("brackets(\"(\", \")\", punct(\"!\"))",
|
||
stringify(brackets("(", ")", punct("!"))),
|
||
"", no).
|
||
test_case("brackets(\"(\", \")\", punct(\"!\"))",
|
||
stringify(brackets("(", ")", punct("!"))),
|
||
"abc", no).
|
||
test_case("brackets(\"(\", \")\", punct(\"!\"))",
|
||
stringify(brackets("(", ")", punct("!"))),
|
||
"(abc)", no).
|
||
test_case("brackets(\"(\", \")\", punct(\"!\"))",
|
||
stringify(brackets("(", ")", punct("!"))),
|
||
"(!) abc", yes("unit")).
|
||
|
||
test_case("separated_list(\"+\", punct(\"!\"))",
|
||
stringify(separated_list("+", punct("!"))),
|
||
"", yes("[]")).
|
||
test_case("separated_list(\"+\", punct(\"!\"))",
|
||
stringify(separated_list("+", punct("!"))),
|
||
"abc", yes("[]")).
|
||
test_case("separated_list(\"+\", punct(\"!\"))",
|
||
stringify(separated_list("+", punct("!"))),
|
||
"! abc", yes("[unit]")).
|
||
test_case("separated_list(\"+\", punct(\"!\"))",
|
||
stringify(separated_list("+", punct("!"))),
|
||
"!+ ! + ! abc", yes("[unit, unit, unit]")).
|
||
|
||
test_case("comma_separated_list(punct(\"!\"))",
|
||
stringify(comma_separated_list(punct("!"))),
|
||
"", yes("[]")).
|
||
test_case("comma_separated_list(punct(\"!\"))",
|
||
stringify(comma_separated_list(punct("!"))),
|
||
"abc", yes("[]")).
|
||
test_case("comma_separated_list(punct(\"!\"))",
|
||
stringify(comma_separated_list(punct("!"))),
|
||
"! abc", yes("[unit]")).
|
||
test_case("comma_separated_list(punct(\"!\"))",
|
||
stringify(comma_separated_list(punct("!"))),
|
||
"!, ! , ! abc", yes("[unit, unit, unit]")).
|
||
|
||
test_case("optional(int_with_state)",
|
||
stringify_state(optional(int_with_state)),
|
||
"abc", yes("[]")).
|
||
|
||
test_case("optional(int_with_state)",
|
||
stringify_state(optional(int_with_state)),
|
||
"1", yes("[1]")).
|
||
|
||
test_case("zero_or_more(int_with_state)",
|
||
stringify_state(zero_or_more(int_with_state)),
|
||
"abc", yes("[]")).
|
||
|
||
test_case("zero_or_more(int_with_state)",
|
||
stringify_state(zero_or_more(int_with_state)),
|
||
"1 2 3", yes("[3, 2, 1]")).
|
||
|
||
test_case("one_or_more(int_with_state)",
|
||
stringify_state(one_or_more(int_with_state)),
|
||
"abc", no).
|
||
|
||
test_case("one_or_more(int_with_state)",
|
||
stringify_state(one_or_more(int_with_state)),
|
||
"1 2 3", yes("[3, 2, 1]")).
|
||
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- pred int_with_state(src::in, int::out, list(int)::in, list(int)::out,
|
||
ps::in, ps::out) is semidet.
|
||
|
||
int_with_state(Src, X, Xs, [X | Xs], !PS) :-
|
||
int_literal(Src, X, !PS).
|
||
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- pred stringify(pred(src, T, ps, ps)::in(pred(in, out, in, out) is semidet),
|
||
src::in, string::out, ps::in, ps::out) is semidet.
|
||
|
||
stringify(P, Src, String, !PS) :-
|
||
P(Src, X, !PS),
|
||
String = string.string(X).
|
||
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- pred test_pos(string::in, int::in, io::di, io::uo) is det.
|
||
|
||
test_pos(Str, OS, !IO) :-
|
||
new_src_and_ps(Str, Src, _),
|
||
offset_to_line_number_and_position(src_to_line_numbers(Src), OS, Line,
|
||
Pos),
|
||
io.format("Line = %d, Pos = %d\n", [i(Line), i(Pos)], !IO).
|
||
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- pred stringify_state(
|
||
pred(src, T, list(S), list(S), ps, ps)::
|
||
in(pred(in, out, in, out, in, out) is semidet),
|
||
src::in, string::out, ps::in, ps::out) is semidet.
|
||
|
||
stringify_state(P, Src, String, !PS) :-
|
||
P(Src, _, [], State, !PS),
|
||
String = string.string(State).
|
||
|
||
%---------------------------------------------------------------------------%
|
||
|
||
:- pred test_err(string::in, parser(expr)::in(parser), io::di, io::uo)
|
||
is cc_multi.
|
||
|
||
test_err(Input, Parser, !IO) :-
|
||
parse(Input, skip_ws, Parser, Result),
|
||
(
|
||
Result = ok(Expr),
|
||
io.write(Expr, !IO),
|
||
io.nl(!IO)
|
||
;
|
||
Result = error(MaybeMsg, LineNo, Col),
|
||
Lines = string.words_separator(unify('\n'), Input),
|
||
Line= list.det_index1(Lines, LineNo),
|
||
Spaces = string.from_char_list(list.duplicate(Col - 1, ' ')),
|
||
(
|
||
MaybeMsg = yes(Msg),
|
||
io.write_string(Msg ++ "\n", !IO)
|
||
;
|
||
MaybeMsg = no,
|
||
io.write_string("syntax error\n", !IO)
|
||
),
|
||
io.write_string(Line ++ "\n", !IO),
|
||
io.write_string(Spaces ++ "^\n", !IO)
|
||
).
|
||
|
||
:- pred skip_ws(src::in, unit::out, ps::in, ps::out) is semidet.
|
||
|
||
skip_ws(Src, unit) -->
|
||
whitespace(Src, _),
|
||
( if next_char(Src, ('/')), next_char(Src, ('*')) then
|
||
find_close_comment(Src),
|
||
skip_ws(Src, _)
|
||
else
|
||
{ true }
|
||
).
|
||
|
||
:- pred find_close_comment(src::in, ps::in, ps::out) is semidet.
|
||
|
||
find_close_comment(Src) -->
|
||
( if next_char(Src, C) then
|
||
( if { C = ('*') } then
|
||
( if next_char(Src, ('/')) then
|
||
{ true }
|
||
else
|
||
find_close_comment(Src)
|
||
)
|
||
else
|
||
find_close_comment(Src)
|
||
)
|
||
else
|
||
fail_with_message("unterminated comment", Src, _:unit)
|
||
).
|
||
|
||
:- type expr
|
||
---> op(op, expr, expr)
|
||
; function_application(string, list(expr))
|
||
; integer(int)
|
||
; variable(string).
|
||
|
||
:- type op
|
||
---> plus
|
||
; minus
|
||
; modulo.
|
||
|
||
:- pred expr_top(src::in, expr::out, ps::in, ps::out) is semidet.
|
||
|
||
expr_top(Src, Expr) -->
|
||
expr(Src, Expr),
|
||
eof(Src, _).
|
||
|
||
:- pred expr(src::in, expr::out, ps::in, ps::out) is semidet.
|
||
|
||
expr(Src, Expr) -->
|
||
term(Src, Term1),
|
||
( if op(Src, Op) then
|
||
expr(Src, Expr2),
|
||
{ Expr = op(Op, Term1, Expr2) }
|
||
else
|
||
{ Expr = Term1 }
|
||
).
|
||
|
||
:- pred term(src::in, expr::out, ps::in, ps::out) is semidet.
|
||
|
||
term(Src, Term) -->
|
||
current_offset(Src, Start),
|
||
( if int_literal(Src, Int) then
|
||
{ Term = integer(Int) }
|
||
else if id(Src, Id) then
|
||
( if punct("(", Src, _) then
|
||
( if { known_function(Id) } then
|
||
comma_separated_list(expr, Src, Args),
|
||
punct(")", Src, _),
|
||
{ Term = function_application(Id, Args) }
|
||
else
|
||
fail_with_message("unknown function: " ++ Id, Start, Src, Term)
|
||
)
|
||
else
|
||
{ Term = variable(Id) }
|
||
)
|
||
else
|
||
{ fail }
|
||
).
|
||
|
||
:- pred known_function(string::in) is semidet.
|
||
|
||
known_function("abs").
|
||
known_function("pow").
|
||
|
||
:- pred op(src::in, op::out, ps::in, ps::out) is semidet.
|
||
|
||
op(Src, Op) -->
|
||
( if punct("+", Src, _) then
|
||
{ Op = plus }
|
||
else if punct("-", Src, _) then
|
||
{ Op = minus }
|
||
else if ikeyword(id_chars, "mod", Src, _) then
|
||
{ Op = modulo }
|
||
else
|
||
fail_with_message("expecting an operator", Src, Op)
|
||
).
|
||
|
||
:- pred id(src::in, string::out, ps::in, ps::out) is semidet.
|
||
|
||
id(Src, Id) -->
|
||
identifier(id_chars, id_chars ++ "0123456789", Src, Id).
|
||
|
||
:- func id_chars = string.
|
||
|
||
id_chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_".
|
||
|
||
%---------------------------------------------------------------------------%
|