[m-rev.] for review: allow retries over polymorphic procs with IO
Ian MacLarty
maclarty at cs.mu.OZ.AU
Wed May 11 16:53:00 AEST 2005
For review by anyone.
Estimated hours taken: 3
Branches: main
Allow retries over procedures which are called with an io.state type in one of
their polymorphic arguments.
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/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.113
diff -u -r1.113 Mmakefile
--- tests/debugger/Mmakefile 24 Mar 2005 01:58:10 -0000 1.113
+++ tests/debugger/Mmakefile 11 May 2005 05:07:05 -0000
@@ -37,6 +37,7 @@
loopcheck \
lval_desc_array \
multi_parameter \
+ poly_io_retry \
polymorphic_output \
print_goal \
print_table \
@@ -263,6 +264,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 11 May 2005 05:08:12 -0000
@@ -0,0 +1,15 @@
+ E1: C1 CALL pred poly_io_retry.main/2-0 (det) poly_io_retry.m:11
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break polycall
+ 0: + stop interface pred poly_io_retry.polycall/3-0 (det)
+mdb> c
+ E2: C2 CALL pred poly_io_retry.polycall/3-0 (det) poly_io_retry.m:17 (poly_io_retry.m:12)
+mdb> f
+hello E3: C2 EXIT pred poly_io_retry.polycall/3-0 (det) poly_io_retry.m:17 (poly_io_retry.m:12)
+mdb> retry
+Retry across I/O operations is not always safe.
+Are you sure you want to do it? y
+ E2: C2 CALL pred poly_io_retry.polycall/3-0 (det) poly_io_retry.m:17 (poly_io_retry.m:12)
+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 11 May 2005 05:06:02 -0000
@@ -0,0 +1,8 @@
+echo on
+register --quiet
+break polycall
+c
+f
+retry
+y
+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 11 May 2005 04:07:34 -0000
@@ -0,0 +1,17 @@
+:- module poly_io_retry.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+main(!IO) :-
+ polycall(io.write_string("hello"), !IO),
+ nl(!IO).
+
+:- pred polycall(pred(T, T)::in(pred(di, uo) is det), T::di, T::uo) is det.
+
+polycall(P, !S) :- P(!S).
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.79
diff -u -r1.79 mercury_trace.c
--- trace/mercury_trace.c 6 Apr 2005 01:11:32 -0000 1.79
+++ trace/mercury_trace.c 11 May 2005 05:05:33 -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,
@@ -530,6 +531,7 @@
int arg_max;
int arg_num;
MR_Word arg_value;
+ MR_TypeInfoParams type_params;
int i;
MR_bool succeeded;
MR_Word *saved_regs;
@@ -613,16 +615,25 @@
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 {
+ /*
+ ** This would not have been set earlier if the
+ ** argument is polymorphic.
+ */
+ has_io_state = MR_TRUE;
}
/*
@@ -933,17 +944,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