[m-rev.] diff: fix I/O retry bug in 0.12

Ian MacLarty maclarty at cs.mu.OZ.AU
Thu Aug 4 15:40:28 AEST 2005


This bug was fixed in the main branch, but was not fixed in the release branch.
The diff has already been reviewed for the main branch.

Estimated hours taken: 1
Branches: 0.12

Allow retries over procedures which are called with an io.state type in one of
their polymorphic arguments.

tests/debugger/Mercury.options:
tests/debugger/Mmakefile:
tests/debugger/poly_io_retry.exp:
tests/debugger/poly_io_retry.inp:
tests/debugger/poly_io_retry.m:
        Test we can retry over a procedure with an io.state in it's
        polymorphic arguments.  Prevoiusly the retry would give an error
        message like "some inputs are missing".

trace/mercury_trace.c:
        Construct the type parameters for a call and pass these to
        MR_is_io_state so it can instantiate any polymorphic arguments before
        checking if they are io.state.

        Set has_io_state to true if we find an io.state argument, since this
        would not have been done previously if the argument was polymorphic.

Index: tests/debugger/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mercury.options,v
retrieving revision 1.10
diff -u -r1.10 Mercury.options
--- tests/debugger/Mercury.options	9 Dec 2004 01:03:19 -0000	1.10
+++ tests/debugger/Mercury.options	4 Aug 2005 05:13:20 -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/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.108.2.2
diff -u -r1.108.2.2 Mmakefile
--- tests/debugger/Mmakefile	10 Feb 2005 00:55:08 -0000	1.108.2.2
+++ tests/debugger/Mmakefile	3 Aug 2005 15:15:02 -0000
@@ -35,6 +35,7 @@
 	loopcheck			\
 	lval_desc_array			\
 	multi_parameter			\
+	poly_io_retry			\
 	polymorphic_output		\
 	print_goal			\
 	print_table			\
@@ -261,6 +262,10 @@
 deeply_nested_typeinfo.out: deeply_nested_typeinfo deeply_nested_typeinfo.inp
 	$(MDB_STD) ./deeply_nested_typeinfo < deeply_nested_typeinfo.inp \
 		> deeply_nested_typeinfo.out 2>&1
+
+poly_io_retry.out: poly_io_retry poly_io_retry.inp
+	$(MDB_STD) ./poly_io_retry < poly_io_retry.inp \
+		> poly_io_retry.out 2>&1

 # The exception_cmd, exception_vars, polymorphic_output and loopcheck tests
 # are supposed to return a non-zero exit status, since they exit by throwing
Index: tests/debugger/poly_io_retry.exp
===================================================================
RCS file: tests/debugger/poly_io_retry.exp
diff -N tests/debugger/poly_io_retry.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/poly_io_retry.exp	3 Aug 2005 15:13:45 -0000
@@ -0,0 +1,31 @@
+      E1:     C1 CALL pred poly_io_retry.main/2-0 (det) poly_io_retry.m:13
+mdb> mdb> Contexts will not be printed.
+mdb> echo on
+Command echo enabled.
+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
+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
+      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)
+mdb> retry
+Cannot perform retry because the values of some input arguments are missing.
+mdb> quit -y
Index: tests/debugger/poly_io_retry.inp
===================================================================
RCS file: tests/debugger/poly_io_retry.inp
diff -N tests/debugger/poly_io_retry.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/poly_io_retry.inp	3 Aug 2005 15:13:45 -0000
@@ -0,0 +1,15 @@
+register --quiet
+context none
+echo on
+table_io allow
+table_io start
+break polycall
+*
+c
+f
+retry -a
+f
+c
+f
+retry
+quit -y
Index: tests/debugger/poly_io_retry.m
===================================================================
RCS file: tests/debugger/poly_io_retry.m
diff -N tests/debugger/poly_io_retry.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/poly_io_retry.m	3 Aug 2005 15:13:45 -0000
@@ -0,0 +1,40 @@
+:- module poly_io_retry.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module array, list.
+
+main(!IO) :-
+	polycall(poly_io_retry.write_int(1), !IO),
+	A = array([0]),
+	polycall(array_update, A, B),
+	io.write(B, !IO),
+	nl(!IO).
+
+:- pred polycall(pred(T, T), T, T).
+:- mode polycall(in(pred(di, uo) is det), di, uo) is det.
+:- mode polycall(in(pred(array_di, array_uo) is det), array_di, array_uo)
+	is det.
+
+polycall(P, !S) :- P(!S).
+
+:- 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.78
diff -u -r1.78 mercury_trace.c
--- trace/mercury_trace.c	28 Jan 2005 06:42:54 -0000	1.78
+++ trace/mercury_trace.c	3 Aug 2005 15:12:56 -0000
@@ -75,7 +75,8 @@
                         MR_Unsigned depth);
 static  MR_bool     MR_in_traced_region(const MR_Proc_Layout *proc_layout,
                         MR_Word *base_sp, MR_Word *base_curfr);
-static  MR_bool     MR_is_io_state(MR_PseudoTypeInfo pti);
+static  MR_bool     MR_is_io_state(MR_TypeInfoParams type_params,
+                        MR_PseudoTypeInfo pti);
 static  MR_bool     MR_is_dummy_type(MR_PseudoTypeInfo pti);
 static  MR_bool     MR_find_saved_io_counter(const MR_Label_Layout *call_label,
                         MR_Word *base_sp, MR_Word *base_curfr,
@@ -529,6 +530,7 @@
     int                     arg_max;
     int                     arg_num;
     MR_Word                 arg_value;
+    MR_TypeInfoParams       type_params;
     int                     i;
     MR_bool                 succeeded;
     MR_Word                 *saved_regs;
@@ -612,16 +614,27 @@
         saved_io_action_counter = 0;
     }

+    type_params = MR_materialize_type_params_base(return_label_layout,
+        saved_regs, base_sp, base_curfr);
+
     for (i = 0; i < MR_all_desc_var_count(call_label); i++) {
         arg_value = MR_trace_find_input_arg(return_label_layout,
             saved_regs, base_sp, base_curfr,
             call_label->MR_sll_var_nums[i], &succeeded);

         if (! succeeded) {
-            if (! MR_is_io_state(MR_var_pti(call_label, i))) {
+            if (! MR_is_io_state(type_params, MR_var_pti(call_label, i))) {
                 *problem = "Cannot perform retry because the "
                     "values of some input arguments are missing.";
                 goto report_problem;
+            } else if (! has_io_state) {
+                /*
+                ** 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);
             }

             /*
@@ -928,17 +941,15 @@
 }

 static MR_bool
-MR_is_io_state(MR_PseudoTypeInfo pti)
+MR_is_io_state(MR_TypeInfoParams type_params, MR_PseudoTypeInfo pti)
 {
     MR_TypeCtorInfo type_ctor_info;
     MR_ConstString  module;
     MR_ConstString  type;
+    MR_TypeInfo     type_info;

-    if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pti)) {
-        return MR_FALSE;
-    }
-
-    type_ctor_info = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pti);
+    type_info = MR_create_type_info(type_params, pti);
+    type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
     module = MR_type_ctor_module_name(type_ctor_info);
     type = MR_type_ctor_name(type_ctor_info);


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



More information about the reviews mailing list