[m-rev.] diff: implement concat_string_list for .NET

[Fergus Henderson]

On 18-Feb-2003, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> I think the problem
> may perhaps be related to the fact that they occur at the start of the
> `then' part of an if-then-else, rather than before the `if'.

On further investigation, it looks like the loop invariant hoisting
optimization is not working even for much simpler cases.  It doesn't
work for this one, for example:

	:- pred loop1(int::in, int::in, int::out) is det.
	loop1(N, Acc0, Acc) :-
	    ( N =< 0 ->
		Acc = Acc0
	    ;
		p(X),
		Acc1 = Acc0 + X,
		loop1(N - 1, Acc1, Acc)
	    ).

	:- pred p(int::out) is det.

I've added some test cases to check that loop invariant hoisting works.
See the diff below.

Currently none of these test pass -- loop invariant hoisting is only
capable of optimizing one of the six loops in these tests.  Ralph, could
you please have a look and see if you can see why these tests are failing?

Branches: main
Estimated hours taken: 1

tests/hard_coded/Mmakefile:
tests/hard_coded/loop_inv_test0.m:
tests/hard_coded/loop_inv_test0.inp:
tests/hard_coded/loop_inv_test1.m:
tests/hard_coded/loop_inv_test1.inp:
tests/hard_coded/loop_inv_test2.m:
tests/hard_coded/loop_inv_test2.inp:
	Add some test cases to test that the loop invariant hoisting
	optimization gets applied.

Workspace: /home/ceres/fjh/mercury
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.187
diff -u -d -r1.187 Mmakefile
--- tests/hard_coded/Mmakefile	13 Feb 2003 01:36:46 -0000	1.187
+++ tests/hard_coded/Mmakefile	18 Feb 2003 03:30:32 -0000
@@ -189,6 +189,9 @@
 endif
 
 # We do not pass the following tests at all:
+# 
+# XXX loop_inv_test0, loop_inv_test1, loop_inv_test2:
+#     loop invariant optimization is not properly optimizing these cases.
 #
 # XXX var_not_found -- mode error in automatically generated unification
 #		predicate.  This test uses partially instantiated modes,
@@ -199,7 +202,7 @@
 # XXX needs_init doesn't work yet in profiling grades.
 #
 # XXX compare_rep_array doesn't work because MR_COMPARE_BY_RTTI is
-# not yet implemented for arrays.
+#     not yet implemented for arrays.
 
 # The following tests are passed only in some grades.
 
Index: tests/hard_coded/loop_inv_test0.inp
===================================================================
RCS file: tests/hard_coded/loop_inv_test0.inp
diff -N tests/hard_coded/loop_inv_test0.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/loop_inv_test0.inp	18 Feb 2003 03:29:29 -0000
@@ -0,0 +1,3 @@
+100
+33
+0
Index: tests/hard_coded/loop_inv_test0.m
===================================================================
RCS file: tests/hard_coded/loop_inv_test0.m
diff -N tests/hard_coded/loop_inv_test0.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/loop_inv_test0.m	18 Feb 2003 03:26:55 -0000
@@ -0,0 +1,124 @@
+%-----------------------------------------------------------------------------%
+% 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 do the basics of loop invariant hoisting.
+
+:- module loop_inv_test0.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module int, 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. */
+:- 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.
+
+%-----------------------------------------------------------------------------%
Index: tests/hard_coded/loop_inv_test1.inp
===================================================================
RCS file: tests/hard_coded/loop_inv_test1.inp
diff -N tests/hard_coded/loop_inv_test1.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/loop_inv_test1.inp	18 Feb 2003 03:03:10 -0000
@@ -0,0 +1,2 @@
+100
+33
Index: tests/hard_coded/loop_inv_test1.m
===================================================================
RCS file: tests/hard_coded/loop_inv_test1.m
diff -N tests/hard_coded/loop_inv_test1.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/loop_inv_test1.m	18 Feb 2003 03:27:25 -0000
@@ -0,0 +1,123 @@
+%-----------------------------------------------------------------------------%
+% 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 do loop invariant hoisting for
+% invariant goals which have no input arguments.
+
+:- module loop_inv_test1.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module int, string.
+
+main -->
+    io__print("enter two integers, one on each line\n"), io__flush_output,
+    io__read_line_as_string(Res1),
+    io__read_line_as_string(Res2),
+    ( { Res1 = ok(L1), Res2 = ok(L2) } ->
+	    { N1 = string__det_to_int(string__chomp(L1)) },
+	    { N2 = string__det_to_int(string__chomp(L2)) },
+	    { loop1(N1, N2, R1) },
+	    { loop2(N1, N2, 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::out) is det.
+loop1(N, Acc0, Acc) :-
+    ( N =< 0 ->
+        Acc = Acc0
+    ;
+        p(X),
+        Acc1 = Acc0 + X,
+        loop1(N - 1, 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. */
+:- pred loop2(int::in, int::in, int::out) is det.
+loop2(N, Acc0, Acc) :-
+    ( N =< 0 ->
+        Acc = Acc0
+    ;
+        ( r(N, 3) ->
+            q(X),
+            Acc1 = Acc0 * 2 + X + 1
+        ;
+            q(X),
+            Acc1 = Acc0 * 2 + X
+        ),
+        loop2(N - 1, Acc1, Acc)
+    ).
+
+% :- pragma no_inline(p/1).
+% :- pragma no_inline(q/1).
+
+:- pred p(int::out) is det.
+:- pragma foreign_proc("C", p(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 = 42;
+").
+:- pragma foreign_proc("C#", p(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 = 42;
+").
+
+:- pred q(int::out) is det.
+:- pragma foreign_proc("C", q(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 = 53;
+").
+:- pragma foreign_proc("C#", q(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 = 53;
+").
+
+:- pragma no_inline(r/2).
+:- pred r(int::in, int::in) is semidet.
+r(X, Y) :- X > Y.
+
+%-----------------------------------------------------------------------------%
Index: tests/hard_coded/loop_inv_test2.inp
===================================================================
RCS file: tests/hard_coded/loop_inv_test2.inp
diff -N tests/hard_coded/loop_inv_test2.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/loop_inv_test2.inp	18 Feb 2003 03:03:18 -0000
@@ -0,0 +1,2 @@
+100
+33
Index: tests/hard_coded/loop_inv_test2.m
===================================================================
RCS file: tests/hard_coded/loop_inv_test2.m
diff -N tests/hard_coded/loop_inv_test2.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/loop_inv_test2.m	18 Feb 2003 03:29:04 -0000
@@ -0,0 +1,120 @@
+%-----------------------------------------------------------------------------%
+% 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 do loop invariant hoisting for calls
+% that occur in the condition of an if-then-else in the loop body.
+
+:- module loop_inv_test2.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module int, string.
+
+main -->
+    io__print("enter two integers, one on each line\n"), io__flush_output,
+    io__read_line_as_string(Res1),
+    io__read_line_as_string(Res2),
+    ( { Res1 = ok(L1), Res2 = ok(L2) } ->
+	    { N1 = string__det_to_int(string__chomp(L1)) },
+	    { N2 = string__det_to_int(string__chomp(L2)) },
+	    { loop1(N1, N2, R1) },
+	    { loop2(N1, N2, R2) },
+	    io__print("R1 = "), io__print(R1), io__nl,
+	    io__print("R2 = "), io__print(R2), io__nl
+    ;
+        io__print("input error"), io__nl
+    ).
+
+:- pred loop1(int::in, int::in, int::out) is det.
+loop1(N, Acc0, Acc) :-
+    ( N =< 0 ->
+        Acc = Acc0
+    ;
+        ( p(X) ->
+            Acc1 = Acc0 + X
+        ;
+            Acc1 = Acc0 * 10
+        ),
+        loop1(N - 1, Acc1, Acc)
+    ).
+
+:- pred loop2(int::in, int::in, int::out) is det.
+loop2(N, Acc0, Acc) :-
+    ( N =< 0 ->
+        Acc = Acc0
+    ;
+        ( q(X), r(N, X) ->
+            Acc1 = Acc0 + X
+        ;
+            Acc1 = Acc0 * 10
+        ),
+        loop2(N - 1, Acc1, Acc)
+    ).
+
+:- pred p(int::out) is semidet.
+:- pragma foreign_proc("C", p(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(""loop_inv failed -- p/1 called twice"");
+    }
+
+    X = 42;
+    SUCCESS_INDICATOR = MR_TRUE;
+").
+:- pragma foreign_proc("C#", p(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(
+            ""loop_inv failed -- p/1 called twice"");
+    }
+
+    X = 42;
+    SUCCESS_INDICATOR = true;
+").
+
+:- pred q(int::out) is det.
+:- pragma foreign_proc("C", q(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(""loop_inv failed -- p/1 called twice"");
+    }
+
+    X = 42;
+").
+:- pragma foreign_proc("C#", q(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(
+            ""loop_inv failed -- q/1 called twice"");
+    }
+
+    X = 42;
+").
+
+:- pragma no_inline(r/2).
+:- pred r(int::in, int::in) is semidet.
+r(X, Y) :- X - 40 > Y.
+
+%-----------------------------------------------------------------------------%

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------