[m-rev.] diff: fix bug when retrying over polymorphic procs with io.state.

[Ian MacLarty]

Estimated hours taken: 2
Branches: main

Fix a bug in my recent diff to allow retrys over predicates which are
passed an io.state in their polymorphic arguments.

The IO action number was not being reset if a retry was done over
a predicate with an io.state in one of its polymorphic arguments.

tests/debugger/Mercury.options:
	Enable io tabling on poly_io_retry.

tests/debugger/poly_io_retry.exp:
tests/debugger/poly_io_retry.inp:
tests/debugger/poly_io_retry.m:
	Test the bug fix.
	Previously reexecuting the first call to polycall/3 would result
	in another "1" being displayed.

trace/mercury_trace.c:
	Find the IO action number of the call being retried to if a
	polymorphic argument with an io.state value is found.

Index: tests/debugger/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mercury.options,v
retrieving revision 1.11
diff -u -r1.11 Mercury.options
--- tests/debugger/Mercury.options	7 Mar 2005 05:00:35 -0000	1.11
+++ tests/debugger/Mercury.options	13 May 2005 03:57:25 -0000
@@ -11,6 +11,7 @@
 MCFLAGS-label_layout = --opt-space

 MCFLAGS-no_inline_builtins = --no-inline-builtins
+MCFLAGS-poly_io_retry = --trace-table-io-all
 MCFLAGS-queens_rep = --trace rep
 MCFLAGS-shallow = --trace shallow
 MCFLAGS-tabled_read = --trace-table-io-all
Index: tests/debugger/poly_io_retry.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/poly_io_retry.exp,v
retrieving revision 1.1
diff -u -r1.1 poly_io_retry.exp
--- tests/debugger/poly_io_retry.exp	11 May 2005 09:39:21 -0000	1.1
+++ tests/debugger/poly_io_retry.exp	13 May 2005 04:00:33 -0000
@@ -2,17 +2,27 @@
 mdb> mdb> Contexts will not be printed.
 mdb> echo on
 Command echo enabled.
-mdb>
+mdb> table_io allow
+mdb> table_io start
+I/O tabling started.
+mdb> break polycall
+Ambiguous procedure specification. The matches are:
+0: pred poly_io_retry.polycall/3-1 (det)
+1: pred poly_io_retry.polycall/3-0 (det)
+
+Which do you want to put a breakpoint on (0-1 or *)? *
+ 0: + stop  interface pred poly_io_retry.polycall/3-1 (det)
+ 1: + stop  interface pred poly_io_retry.polycall/3-0 (det)
+mdb> c
       E2:     C2 CALL pred poly_io_retry.polycall/3-0 (det)
 mdb> f
-hello      E3:     C2 EXIT pred poly_io_retry.polycall/3-0 (det)
-mdb> retry
-Retry across I/O operations is not always safe.
-Are you sure you want to do it? y
+1
+      E3:     C2 EXIT pred poly_io_retry.polycall/3-0 (det)
+mdb> retry -a
       E2:     C2 CALL pred poly_io_retry.polycall/3-0 (det)
 mdb> f
-hello      E3:     C2 EXIT pred poly_io_retry.polycall/3-0 (det)
-mdb>
+      E3:     C2 EXIT pred poly_io_retry.polycall/3-0 (det)
+mdb> c
       E4:     C3 CALL pred poly_io_retry.polycall/3-1 (det)
 mdb> f
       E5:     C3 EXIT pred poly_io_retry.polycall/3-1 (det)
Index: tests/debugger/poly_io_retry.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/poly_io_retry.inp,v
retrieving revision 1.1
diff -u -r1.1 poly_io_retry.inp
--- tests/debugger/poly_io_retry.inp	11 May 2005 09:39:22 -0000	1.1
+++ tests/debugger/poly_io_retry.inp	13 May 2005 03:48:21 -0000
@@ -1,12 +1,15 @@
 register --quiet
 context none
 echo on
-
+table_io allow
+table_io start
+break polycall
+*
+c
 f
-retry
-y
+retry -a
 f
-
+c
 f
 retry
 quit -y
Index: tests/debugger/poly_io_retry.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/poly_io_retry.m,v
retrieving revision 1.1
diff -u -r1.1 poly_io_retry.m
--- tests/debugger/poly_io_retry.m	11 May 2005 09:39:22 -0000	1.1
+++ tests/debugger/poly_io_retry.m	13 May 2005 03:49:13 -0000
@@ -11,7 +11,7 @@
 :- import_module array, list.

 main(!IO) :-
-	polycall(io.write_string("hello"), !IO),
+	polycall(poly_io_retry.write_int(1), !IO),
 	A = array([0]),
 	polycall(array_update, A, B),
 	io.write(B, !IO),
@@ -27,3 +27,14 @@
 :- pred array_update(array(int)::array_di, array(int)::array_uo) is det.

 array_update(!A) :- !:A = !.A ^ elem(0) := 1.
+
+:- pred poly_io_retry.write_int(int::in, io__state::di, io__state::uo)
+	is det.
+
+:- pragma foreign_proc("C",
+	poly_io_retry.write_int(N::in, IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure, tabled_for_io],
+"{
+	printf(""%d\\n"", (int) N);
+	IO = IO0;
+}").
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.80
diff -u -r1.80 mercury_trace.c
--- trace/mercury_trace.c	11 May 2005 09:39:22 -0000	1.80
+++ trace/mercury_trace.c	13 May 2005 04:36:22 -0000
@@ -628,12 +628,14 @@
                 *problem = "Cannot perform retry because the "
                     "values of some input arguments are missing.";
                 goto report_problem;
-            } else {
+            } else if (! has_io_state) {
                 /*
-                ** This would not have been set earlier if the
+                ** has_io_state would not have been set to true earlier if the
                 ** argument is polymorphic.
                 */
                 has_io_state = MR_TRUE;
+                found_io_action_counter = MR_find_saved_io_counter(
+                    call_label, base_sp, base_curfr, &saved_io_action_counter);
             }

             /*

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------