[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