[m-dev.] for review: add `do_while/4' to std_util.m

[Fergus Henderson]

On 19-Oct-1999, Tyson Dowd <trd at cs.mu.OZ.AU> wrote:
> On 19-Oct-1999, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > Estimated hours taken: 2
> > 
> > library/std_util.m:
> > 	Implement `do_while/4'.
> 
> Just one comment.
> 
> > +	% This is a generalization of unsorted_aggregate which allows the
> > +	% iteration to stop before all solutions have been found.
> > +	% Declaratively, the specification is as follows:
> > +	%
> > +	%	do_while(Generator, Filter) -->
> > +	%		{ solutions(Generator, Solutions) },
> > +	%		do_while_2(Solutions, Filter).
> > +	%
> > +	%	do_while_2([], _) --> [].
> > +	%	do_while_2([X|Xs], Filter) :-
> > +	%		Filter(X, More),
> > +	%		(if { More = yes } then
> > +	%			do_while_2(Xs, Filter)
> > +	%		else
> > +	%			{ true }
> > +	%		).
> 
> I was about to write complaining that I don't think declarative
> semantics should be defined using DCG notation (because it looks a
> little sloppy and confusing) but then I realized that
> you have a bug in your specification anyway because of the use of :-
> instead of -->.
> 
> So I think at least fix the bug, and maybe remove the DCG notation.

I fixed the bug, but left the DCG notation in.  There was another bug
in the specification: `solutions' should have been `unsorted_solutions'.
I fixed that too.  I've also added a test case.

I will commit all this now.

----------

tests/general/Mmakefile:
tests/general/do_while.m:
tests/general/do_while.exp:
	A test case for the new feature.

Index: tests/general/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/general/Mmakefile,v
retrieving revision 1.26
diff -u -d -r1.26 Mmakefile
--- tests/general/Mmakefile	1999/07/14 17:03:00	1.26
+++ tests/general/Mmakefile	1999/10/19 07:39:24
@@ -24,6 +24,7 @@
 		det_complicated_unify \
 		determinism_inlining \
 		disj_disj \
+		do_while \
 		double_error \
 		double_error2 \
 		duplicate_label \
cvs diff: tests/general/do_while.exp is a new entry, no comparison available
cvs diff: tests/general/do_while.m is a new entry, no comparison available

-------------------------------------------------------
tests/general/do_while.m
-------------------------------------------------------
% tests/general/do_while.m:
%	A test case for std_util__do_while/4.
%
% Adapted from tests/general/nondet_ite.m.

:- module do_while.
:- interface.
:- import_module io.

:- pred main(io__state::di, io__state::uo) is cc_multi.

:- implementation.
:- import_module list, int, std_util, bool.

main -->
	do_while(r(100), write_answer("foo")),
	{ do_while(r(100), collect_answer(201), [], L) },
	print(L), nl,
	{ do_while(r(100), collect_answer(555), [], L2) },
	print(L2), nl.

:- pred write_answer(string::in, int::in, bool::out,
	io__state::di, io__state::uo) is det.

write_answer(S, R, More) -->
	print(S), nl,
	print(R), nl,
	{ More = (if R = 200 then no else yes) }.

:- pred collect_answer(int, int, bool, list(int), list(int)).
:- mode collect_answer(in, in, out, in, out) is det.

collect_answer(Limit, R, More, Rs0, [R|Rs0]) :-
	More = (if R = Limit then no else yes).

:- pred r(int::in, int::out) is nondet.

r(Mult, Z) :-
	q(X, Y),
	Z is X * Mult + Y.

:- pred q(int::out, int::out) is nondet.

q(X, Y) :-
	p(X),
	(if some [Y1] p(Y1) then
		Y = Y1
	else
		Y = 42
	).

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

p(0).
p(1).
p(2).

-------------------------------------------------------
tests/general/do_while.exp
-------------------------------------------------------
foo
0
foo
1
foo
2
foo
100
foo
101
foo
102
foo
200
[201, 200, 102, 101, 100, 2, 1, 0]
[202, 201, 200, 102, 101, 100, 2, 1, 0]
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------