[m-dev.] for review: add `do_while/4' to std_util.m
Fergus Henderson
fjh at cs.mu.OZ.AU
Tue Oct 19 16:40:35 AEST 1999
Estimated hours taken: 2
library/std_util.m:
Implement `do_while/4'.
samples/README:
samples/all_solutions.m:
samples/committed_choice.m:
samples/solutions/all_solutions.m:
samples/solutions/one_solution.m:
samples/solutions/some_solutions.m:
Move the all_solutions.m and committed_choice.m samples
into a new subdirectory `solutions', renaming committed_choice.m
as `one_solution.m', and add a new file `some_solutions.m'
illustrating the use of `do_while/4'.
(Also fix some documentation rot in samples/README.)
NEWS:
Mention the new predicate std_util__do_while/4.
Workspace: /d-drive/home/hg/fjh/mercury
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.148
diff -u -d -r1.148 NEWS
--- NEWS 1999/10/12 00:11:11 1.148
+++ NEWS 1999/10/19 06:33:35
@@ -63,7 +63,8 @@
* We've added some new predicates to the Mercury standard library:
array__map/3,
- bag__count_value/3.
+ bag__count_value/3,
+ std_util__do_while/4.
* The following predicates have been replaced by functions with
the same names, and will be removed in a future release.
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.166
diff -u -d -r1.166 std_util.m
--- library/std_util.m 1999/10/19 04:45:09 1.166
+++ library/std_util.m 1999/10/19 05:40:28
@@ -21,7 +21,7 @@
:- interface.
-:- import_module list, set.
+:- import_module list, set, bool.
%-----------------------------------------------------------------------------%
@@ -182,6 +182,37 @@
:- mode unsorted_aggregate(pred(muo) is nondet, pred(mdi, di, uo) is det,
di, uo) is cc_multi.
+ % 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 }
+ % ).
+ %
+ % Operationally, however, do_while/4 will call the Filter
+ % predicate for each solution as it is obtained, rather than
+ % first building a list of all the solutions.
+ %
+:- pred do_while(pred(T), pred(T, bool, T2, T2), T2, T2).
+:- mode do_while(pred(out) is multi, pred(in, out, in, out) is det, in, out)
+ is cc_multi.
+:- mode do_while(pred(out) is nondet, pred(in, out, in, out) is det, in, out)
+ is cc_multi.
+:- mode do_while(pred(out) is multi, pred(in, out, di, uo) is det, di, uo)
+ is cc_multi.
+:- mode do_while(pred(out) is nondet, pred(in, out, di, uo) is det, di, uo)
+ is cc_multi.
+
%-----------------------------------------------------------------------------%
% maybe_pred(Pred, X, Y) takes a closure Pred which transforms an
@@ -541,7 +572,7 @@
** while the collector pred is executing, and by the time the nested do_ is
** completed, the 'real' heap pointer will have been reset.
**
-** If the collector predicate throws an exception while they are swapped.
+** If the collector predicate throws an exception while they are swapped,
** then the code for builtin_throw/1 will unswap the heaps.
** So we don't need to create our own exception handlers to here to
** cover that case.
@@ -550,38 +581,28 @@
** and copying operations are no-ops, so we get a "zero-copy" solution.
*/
-:- pragma promise_pure(builtin_aggregate/4).
+% Note that the code for builtin_aggregate is very similar to the code
+% for do_while (below).
+:- pragma promise_pure(builtin_aggregate/4).
builtin_aggregate(GeneratorPred, CollectorPred, Accumulator0, Accumulator) :-
- %
% Save some of the Mercury virtual machine registers
- %
impure get_registers(HeapPtr, SolutionsHeapPtr, TrailPtr),
- %
% Initialize the accumulator
- %
- % Mutvar := Accumulator0
- %
+ % /* Mutvar := Accumulator0 */
impure new_mutvar(Accumulator0, Mutvar),
(
- %
% Get a solution
- %
GeneratorPred(Answer0),
- %
% Check that the generator didn't leave any
% delayed goals outstanding
- %
impure check_for_floundering(TrailPtr),
- %
% Update the accumulator
- %
- % MutVar := CollectorPred(MutVar)
- %
+ % /* MutVar := CollectorPred(MutVar) */
impure swap_heap_and_solutions_heap,
impure partial_deep_copy(HeapPtr, Answer0, Answer),
impure get_mutvar(Mutvar, Acc0),
@@ -589,27 +610,57 @@
impure set_mutvar(Mutvar, Acc1),
impure swap_heap_and_solutions_heap,
- %
% Force backtracking, so that we get the next solution.
% This will automatically reset the heap and trail.
- %
fail
;
- %
% There are no more solutions.
% So now we just need to copy the final value
% of the accumulator from the solutions heap
% back onto the ordinary heap, and then we can
% reset the solutions heap pointer.
- %
- % Accumulator := MutVar
- %
+ % /* Accumulator := MutVar */
impure get_mutvar(Mutvar, Accumulator1),
impure partial_deep_copy(SolutionsHeapPtr, Accumulator1,
Accumulator),
impure reset_solutions_heap(SolutionsHeapPtr)
).
+% The code for do_while/4 is essentially the same as the code for
+% builtin_aggregate (above). See the detailed comments above.
+%
+% XXX It would be nice to avoid the code duplication here,
+% but it is a bit tricky -- we can't just use a lambda expression,
+% because we'd need to specify the mode, but we want it to work
+% for multiple modes. An alternative would be to use a typeclass,
+% but typeclasses still don't work in `jump' or `fast' grades.
+
+:- pragma promise_pure(do_while/4).
+do_while(GeneratorPred, CollectorPred, Accumulator0, Accumulator) :-
+ impure get_registers(HeapPtr, SolutionsHeapPtr, TrailPtr),
+ impure new_mutvar(Accumulator0, Mutvar),
+ (
+ GeneratorPred(Answer0),
+
+ impure check_for_floundering(TrailPtr),
+
+ impure swap_heap_and_solutions_heap,
+ impure partial_deep_copy(HeapPtr, Answer0, Answer),
+ impure get_mutvar(Mutvar, Acc0),
+ CollectorPred(Answer, More, Acc0, Acc1),
+ impure set_mutvar(Mutvar, Acc1),
+ impure swap_heap_and_solutions_heap,
+
+ % if More = yes, then backtrack for the next solution.
+ % if More = no, then we're done.
+ More = no
+ ;
+ true
+ ),
+ impure get_mutvar(Mutvar, Accumulator1),
+ impure partial_deep_copy(SolutionsHeapPtr, Accumulator1, Accumulator),
+ impure reset_solutions_heap(SolutionsHeapPtr).
+
:- type heap_ptr ---> heap_ptr(c_pointer).
:- type trail_ptr ---> trail_ptr(c_pointer).
@@ -2736,18 +2787,6 @@
get_type_info_for_type_info(TypeInfo) :-
Type = type_of(1),
TypeInfo = type_of(Type).
-
-%-----------------------------------------------------------------------------%
-
-% This is a generalization of unsorted_aggregate which allows the
-% iteration to stop before all solutions have been found.
-% NOT YET IMPLEMENTED
-%
-% :- pred do_while(pred(T), pred(T,T2,T2,bool), T2, T2).
-% :- mode do_while(pred(out) is multi, pred(in,in,out,out) is det, in, out) is
-% cc_multi.
-% :- mode do_while(pred(out) is nondet, pred(in,in,out,out) is det, in, out) is
-% cc_multi.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: samples/README
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/README,v
retrieving revision 1.5
diff -u -d -r1.5 README
--- samples/README 1998/11/19 06:16:56 1.5
+++ samples/README 1999/10/19 06:29:02
@@ -32,11 +32,18 @@
choose. It illustrates one way to achieve
lazy evaluation in Mercury.
-Mmake The file used by `mmake', the Mercury Make program,
+Mmakefile The file used by `mmake', the Mercury Make program,
to build the programs in this directory.
+The `solutions' sub-directory contains some examples of the use of
+nondeterminism, showing how a Mercury program can compute
+ - one solution,
+ - all solutions, or
+ - some solutions (determined by a user-specified criteria)
+for a query which has more than one logically correct answer.
+
There are also some sub-directories which contain examples of multi-module
-Mercury programs.
+Mercury programs:
diff This directory contains an implementation of a
simple version of the standard UNIX utility
@@ -49,3 +56,5 @@
rot13 This directory contains a few implementations of
rot-13 encoding.
+muz This directory contains a syntax checker / type checker
+ for the specification language Z.
cvs diff: samples/all_solutions.m was removed, no comparison available
cvs diff: samples/committed_choice.m was removed, no comparison available
cvs diff: samples/solutions/all_solutions.m is a new entry, no comparison available
cvs diff: samples/solutions/one_solution.m is a new entry, no comparison available
cvs diff: samples/solutions/some_solutions.m is a new entry, no comparison available
-------------------------------------------------------
samples/solutions/some_solutions.m
-------------------------------------------------------
% An example program to illustrate the use of the `do_while'
% predicate in Mercury. This program calls a nondeterministic
% predicate hello/1, prints the first solution it finds, and
% then asks the user if they want any more solutions;
% if they do, it finds another solution, prompts the user again,
% and so on. It stops when there are no more solutions or
% when the user says no to the "More?" prompt.
%
% Note that in the standard "commutative" semantics, the order of
% solutions is unspecified. If you want to force the order of
% evaluation, then you would need to use the "strict sequential semantics"
% (enabled by the `--strict-sequential' option to the Mercury compiler).
% This source file is hereby placed in the public domain. -fjh (the author).
:- module some_solutions.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is cc_multi.
:- implementation.
:- import_module std_util, char, bool, list.
main -->
do_while(hello, get_next),
io__write_string("No (more) solutions\n").
:- pred hello(string::out) is multi.
hello("Hello, world\n").
hello("Good day, world\n").
hello("Greetings, world\n").
:- pred get_next(string::in, bool::out, io__state::di, io__state::uo) is det.
get_next(String, More) -->
% print the first answer
io__write_string(String),
% see if the user wants more answers
io__write_string("More? "),
io__read_line(Line),
{ if Line = ok([FirstChar|_]),
char__to_upper(FirstChar, 'Y')
then More = yes
else More = no
}.
% This source file is hereby placed in the public domain. -fjh (the author).
:- module committed_choice.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is cc_multi.
:- implementation.
main --> io__write_string("Hello, world\n").
main --> io__write_string("Goodbye, world\n").
-------------------------------------------------------
diff -u samples/committed_choice.m samples/solutions/one_solution.m
-------------------------------------------------------
--- samples/committed_choice.m Tue Oct 19 16:39:14 1999
+++ samples/solutions/one_solution.m Tue Oct 19 16:37:09 1999
@@ -1,4 +1,6 @@
% An example module to illustrate committed choice nondeterminism in Mercury.
+% There is more than one answer which is logically correct,
+% but the program will only compute one of them.
% In the standard "commutative" semantics, this program should print out
% _either_
%
@@ -13,7 +15,7 @@
% This source file is hereby placed in the public domain. -fjh (the author).
-:- module committed_choice.
+:- module one_solution.
:- interface.
:- import_module io.
--
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
--------------------------------------------------------------------------
More information about the developers
mailing list