Files
mercury/tests/hard_coded/loop_inv_test0.m
Zoltan Somogyi 33eb3028f5 Clean up the tests in half the test directories.
tests/accumulator/*.m:
tests/analysis_*/*.m:
tests/benchmarks*/*.m:
tests/debugger*/*.{m,exp,inp}:
tests/declarative_debugger*/*.{m,exp,inp}:
tests/dppd*/*.m:
tests/exceptions*/*.m:
tests/general*/*.m:
tests/grade_subdirs*/*.m:
tests/hard_coded*/*.m:
    Make these tests use four-space indentation, and ensure that
    each module is imported on its own line. (I intend to use the latter
    to figure out which subdirectories' tests can be executed in parallel.)

    These changes usually move code to different lines. For the debugger tests,
    specify the new line numbers in .inp files and expect them in .exp files.
2015-02-14 20:14:03 +11:00

144 lines
4.0 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%---------------------------------------------------------------------------%
% This module tests the loop invariant hoisting optimization.
% It does so using foreign_procs which abort if called twice.
% If loop invariant hoisting works, these procedures will only
% be called once, but if loop invariant hoisting doesn't work,
% these procedures will abort.
% This test checks that we can do loop invariant hoisting for calls
% which occur in different branches of an if-then-else.
% XXX we do not yet pass this test case (see XXX comment below).
% Should be easy to fix??
:- module loop_inv_test0.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module int.
:- import_module string.
main -->
io__print("enter three integers, one on each line\n"), io__flush_output,
io__read_line_as_string(Res1),
io__read_line_as_string(Res2),
io__read_line_as_string(Res3),
( { Res1 = ok(L1), Res2 = ok(L2), Res3 = ok(L3) } ->
{ N1 = string__det_to_int(string__chomp(L1)) },
{ N2 = string__det_to_int(string__chomp(L2)) },
{ N3 = string__det_to_int(string__chomp(L3)) },
{ loop1(N1, N2, N3, R1) },
{ loop2(N1, N2, N3, R2) },
io__print("R1 = "), io__print(R1), io__nl,
io__print("R2 = "), io__print(R2), io__nl
;
io__print("input error"), io__nl
).
% Test that we can do ordinary loop hoisting:
% p/1 will abort if called twice.
%
:- pred loop1(int::in, int::in, int::in, int::out) is det.
loop1(N, Inv, Acc0, Acc) :-
( N =< 0 ->
Acc = Acc0
;
p(Inv, X),
Acc1 = Acc0 + X,
loop1(N - 1, Inv, Acc1, Acc)
).
% Test that we can do loop hoisting for calls which occur in
% different branches of an if-then-else: q/1 will abort if called twice.
% XXX currently loop invariant hoisting does NOT optimize this case,
% because the variable `X' gets renamed to two different variables
% for the two different scopes in which it occurs, and then loop
% invariant hoisting is not smart enough to notice that the two calls
% are the same.
%
:- pred loop2(int::in, int::in, int::in, int::out) is det.
loop2(N, Inv, Acc0, Acc) :-
( N =< 0 ->
Acc = Acc0
;
( r(N, 3) ->
q(Inv, X),
Acc1 = Acc0 * 2 + X + 1
;
q(Inv, X),
Acc1 = Acc0 * 2 + X
),
loop2(N - 1, Inv, Acc1, Acc)
).
:- pragma no_inline(p/2).
:- pragma no_inline(q/2).
:- pred p(int::in, int::out) is det.
:- pragma foreign_proc("C",
p(Inv::in, X::out),
[will_not_call_mercury, promise_pure],
"
/* Test that p/1 only gets called once. */
static int num_calls = 0;
if (num_calls++) {
MR_fatal_error(""p/1 called more than once"");
abort();
}
X = Inv + 42;
").
:- pragma foreign_proc("C#",
p(Inv::in, X::out),
[will_not_call_mercury, promise_pure],
"
/* Test that p/1 only gets called once. */
static int num_calls = 0;
if (num_calls++) {
mercury.runtime.Errors.fatal_error(""p/1 called more than once"");
}
X = Inv + 42;
").
:- pred q(int::in, int::out) is det.
:- pragma foreign_proc("C",
q(Inv::in, X::out),
[will_not_call_mercury, promise_pure],
"
/* Test that q/1 only gets called once. */
static int num_calls = 0;
if (num_calls++) {
MR_fatal_error(""q/1 called more than once"");
}
X = Inv + 53;
").
:- pragma foreign_proc("C#",
q(Inv::in, X::out),
[will_not_call_mercury, promise_pure],
"
/* Test that q/1 only gets called once. */
static int num_calls = 0;
if (num_calls++) {
mercury.runtime.Errors.fatal_error(""q/1 called more than once"");
}
X = Inv + 53;
").
:- pragma no_inline(r/2).
:- pred r(int::in, int::in) is semidet.
r(X, Y) :-
X > Y.
%---------------------------------------------------------------------------%