[m-rev.] diff: add unsorrted_aggregate2/6 to ths standard library
Julien Fischer
juliensf at csse.unimelb.edu.au
Tue Dec 7 01:03:29 AEDT 2010
Branches: main
Add the predicate unsorted_aggregate2/6 to the solutions module of the
standard library.
library/solutions.m:
Add the new predicate.
browser/declarative_tree.m:
Handle builtin_aggregate2/6 like builtin_aggregate/4.
NEWS:
Announce the new predicate.
tests/hard_coded/Mmakefile:
tests/hard_coded/unsorted_agg2.{m,exp}:
A simple test of the new predicate.
Julien.
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.548
diff -u -r1.548 NEWS
--- NEWS 30 Nov 2010 02:41:53 -0000 1.548
+++ NEWS 6 Dec 2010 13:55:51 -0000
@@ -78,6 +78,9 @@
list.map_corresponding3_foldl/7
map.foldl3/8
+* We have added the predicate unsorted_aggregate2/6 to the solutions module
+ of the standard library.
+
Changes to the Mercury compiler:
* We have added a new backend that generates C#.
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.61
diff -u -r1.61 declarative_tree.m
--- browser/declarative_tree.m 2 Oct 2008 05:22:37 -0000 1.61
+++ browser/declarative_tree.m 6 Dec 2010 13:55:51 -0000
@@ -454,8 +454,13 @@
missing_answer_special_case(Atom) :-
ProcLabel = get_proc_label_from_layout(Atom ^ proc_layout),
- ProcLabel = ordinary_proc_label(StdUtilModule1, pf_predicate,
- StdUtilModule2, "builtin_aggregate", 4, _),
+ (
+ ProcLabel = ordinary_proc_label(StdUtilModule1, pf_predicate,
+ StdUtilModule2, "builtin_aggregate", 4, _)
+ ;
+ ProcLabel = ordinary_proc_label(StdUtilModule1, pf_predicate,
+ StdUtilModule2, "builtin_aggregate2", 6, _)
+ ),
possible_sym_library_module_name("solutions", StdUtilModule1),
possible_sym_library_module_name("solutions", StdUtilModule2).
Index: library/solutions.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/solutions.m,v
retrieving revision 1.9
diff -u -r1.9 solutions.m
--- library/solutions.m 3 Dec 2010 03:31:23 -0000 1.9
+++ library/solutions.m 6 Dec 2010 13:55:52 -0000
@@ -126,6 +126,36 @@
:- mode unsorted_aggregate(pred(muo) is nondet, pred(mdi, di, uo) is det,
di, uo) is cc_multi.
+ % unsorted_aggregate2/6 generates all the solutions to a predicate
+ % and applies an accumulator predicate to each solution in turn.
+ % Declaratively, the specification is as follows:
+ %
+ % unsorted_aggregate2(Generator, Accumulator, !Acc1, !Acc2) <=>
+ % unsorted_solutions(Generator, Solutions),
+ % list.foldl2(Accumulator, Solutions, !Acc1, !Acc2).
+ %
+ % Operationally, however, unsorted_aggregate2/6 will call the
+ % Accumulator for each solution as it is obtained, rather than
+ % first building a list of all the solutions.
+ %
+:- pred unsorted_aggregate2(pred(T), pred(T, U, U, V, V), U, U, V, V).
+:- mode unsorted_aggregate2(pred(out) is multi,
+ pred(in, in, out, in, out) is det, in, out, in, out) is cc_multi.
+:- mode unsorted_aggregate2(pred(out) is multi,
+ pred(in, in, out, in, out) is cc_multi, in, out, in, out) is cc_multi.
+:- mode unsorted_aggregate2(pred(out) is multi,
+ pred(in, in, out, di, uo) is det, in, out, di, uo) is cc_multi.
+:- mode unsorted_aggregate2(pred(out) is multi,
+ pred(in, in, out, di, uo) is cc_multi, in, out, di, uo) is cc_multi.
+:- mode unsorted_aggregate2(pred(out) is nondet,
+ pred(in, in, out, in, out) is det, in, out, in, out) is cc_multi.
+:- mode unsorted_aggregate2(pred(out) is nondet,
+ pred(in, in, out, in, out) is cc_multi, in, out, in, out) is cc_multi.
+:- mode unsorted_aggregate2(pred(out) is nondet,
+ pred(in, in, out, di, uo) is det, in, out, di, uo) is cc_multi.
+:- mode unsorted_aggregate2(pred(out) is nondet,
+ pred(in, in, out, di, uo) is cc_multi, in, out, 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:
@@ -210,6 +240,11 @@
builtin_aggregate(Generator, Accumulator, !Acc),
cc_multi_equal(!Acc).
+unsorted_aggregate2(Generator, Accumulator, !Acc1, !Acc2) :-
+ builtin_aggregate2(Generator, Accumulator, !Acc1, !Acc2),
+ cc_multi_equal(!Acc1),
+ cc_multi_equal(!Acc2).
+
%-----------------------------------------------------------------------------%
:- pred builtin_solutions(pred(T), list(T)).
@@ -345,6 +380,83 @@
%-----------------------------------------------------------------------------%
+:- pragma promise_pure(builtin_aggregate2/6).
+
+:- pred builtin_aggregate2(pred(T), pred(T, U, U, V, V), U, U, V, V).
+:- mode builtin_aggregate2(pred(out) is multi,
+ pred(in, in, out, in, out) is det,
+ in, out, in, out) is det. % really cc_multi
+:- mode builtin_aggregate2(pred(out) is multi,
+ pred(in, in, out, in, out) is cc_multi,
+ in, out, in, out) is det. % really cc_multi
+:- mode builtin_aggregate2(pred(out) is multi,
+ pred(in, in, out, di, uo) is det,
+ in, out, di, uo) is det. % really cc_multi
+:- mode builtin_aggregate2(pred(out) is multi,
+ pred(in, in, out, di, uo) is cc_multi,
+ in, out, di, uo) is det. % really cc_multi
+:- mode builtin_aggregate2(pred(out) is nondet,
+ pred(in, in, out, in, out) is det,
+ in, out, in, out) is det. % really cc_multi
+:- mode builtin_aggregate2(pred(out) is nondet,
+ pred(in, in, out, in, out) is cc_multi,
+ in, out, in, out) is det. % really cc_multi
+:- mode builtin_aggregate2(pred(out) is nondet,
+ pred(in, in, out, di, uo) is det,
+ in, out, di, uo) is det. % really cc_multi
+:- mode builtin_aggregate2(pred(out) is nondet,
+ pred(in, in, out, di, uo) is cc_multi,
+ in, out, di, uo) is det. % really cc_multi
+
+builtin_aggregate2(GeneratorPred, CollectorPred, !Accumulator1, !Accumulator2) :-
+ % Save some of the Mercury virtual machine registers
+ impure get_registers(HeapPtr, SolutionsHeapPtr, TrailPtr),
+ impure start_all_soln_neg_context,
+
+ % Initialize the accumulator
+ impure new_mutvar(!.Accumulator1, Mutvar1),
+ impure new_mutvar(!.Accumulator2, Mutvar2),
+
+ (
+ % Get a solution.
+ GeneratorPred(Answer0),
+
+ % Check that the generator didn't leave any delayed goals outstanding.
+ impure check_for_floundering(TrailPtr),
+
+ % Update the accumulators.
+ impure swap_heap_and_solutions_heap,
+ impure partial_deep_copy(HeapPtr, Answer0, Answer),
+ some [!Acc1, !Acc2] (
+ impure get_mutvar(Mutvar1, !:Acc1),
+ impure get_mutvar(Mutvar2, !:Acc2),
+ impure non_cc_call(CollectorPred, Answer, !Acc1, !Acc2),
+ impure set_mutvar(Mutvar1, !.Acc1),
+ impure set_mutvar(Mutvar2, !.Acc2)
+ ),
+ 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.
+ impure end_all_soln_neg_context_no_more,
+
+ % So now we just need to copy the final value of the accumulators
+ % from the solutions heap back onto the ordinary heap, and then we can
+ % reset the solutions heap pointer. We also need to discard the trail
+ % ticket created by get_registers/3.
+ impure get_mutvar(Mutvar1, !:Accumulator1),
+ impure get_mutvar(Mutvar2, !:Accumulator2),
+ impure partial_deep_copy(SolutionsHeapPtr, !Accumulator1),
+ impure partial_deep_copy(SolutionsHeapPtr, !Accumulator2),
+ impure reset_solutions_heap(SolutionsHeapPtr),
+ impure discard_trail_ticket
+ ).
+
+%-----------------------------------------------------------------------------%
+
% The code for do_while/4 is essentially the same as the code for
% builtin_aggregate (above). See the detailed comments above.
%
@@ -430,6 +542,32 @@
impure impure_true
).
+:- impure pred non_cc_call(pred(T1, Acc1, Acc1, Acc2, Acc2), T1,
+ Acc1, Acc1, Acc2, Acc2).
+:- mode non_cc_call(pred(in, in, out, in, out) is det, in, in, out, in, out) is det.
+:- mode non_cc_call(pred(in, in, out, in, out) is cc_multi, in, in, out, in, out) is det.
+:- mode non_cc_call(pred(in, in, out, di, uo) is det, in, in, out, di, uo) is det.
+:- mode non_cc_call(pred(in, in, out, di, uo) is cc_multi, in, in, out, di, uo) is det.
+
+non_cc_call(P::pred(in, in, out, in, out) is det, X::in,
+ !.Acc1::in, !:Acc1::out, !.Acc2::in, !:Acc2::out) :-
+ P(X, !Acc1, !Acc2).
+non_cc_call(P::pred(in, in, out, in, out) is cc_multi, X::in,
+ !.Acc1::in, !:Acc1::out, !.Acc2::in, !:Acc2::out) :-
+ promise_equivalent_solutions [!:Acc1, !:Acc2] (
+ P(X, !Acc1, !Acc2),
+ impure impure_true
+ ).
+non_cc_call(P::pred(in, in, out, di, uo) is det, X::in,
+ !.Acc1::in, !:Acc1::out, !.Acc2::di, !:Acc2::uo) :-
+ P(X, !Acc1, !Acc2).
+non_cc_call(P::pred(in, in, out, di, uo) is cc_multi, X::in,
+ !.Acc1::in, !:Acc1::out, !.Acc2::di, !:Acc2::uo) :-
+ promise_equivalent_solutions [!:Acc1, !:Acc2] (
+ P(X, !Acc1, !Acc2),
+ impure impure_true
+ ).
+
:- type heap_ptr == private_builtin.heap_pointer.
:- type trail_ptr ---> trail_ptr(c_pointer).
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.394
diff -u -r1.394 Mmakefile
--- tests/hard_coded/Mmakefile 30 Nov 2010 04:06:59 -0000 1.394
+++ tests/hard_coded/Mmakefile 6 Dec 2010 13:55:52 -0000
@@ -286,6 +286,7 @@
unify_expression \
unify_typeinfo_bug \
uniq_duplicate_call \
+ unsorted_agg2 \
unused_float_box_test \
unusual_name_mutable \
uo_regression1 \
Index: tests/hard_coded/unsorted_agg2.exp
===================================================================
RCS file: tests/hard_coded/unsorted_agg2.exp
diff -N tests/hard_coded/unsorted_agg2.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/unsorted_agg2.exp 6 Dec 2010 13:55:52 -0000
@@ -0,0 +1,4 @@
+Collecting 3 ...
+Collecting 4 ...
+Collecting 5 ...
+[10, 8, 6]
Index: tests/hard_coded/unsorted_agg2.m
===================================================================
RCS file: tests/hard_coded/unsorted_agg2.m
diff -N tests/hard_coded/unsorted_agg2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/unsorted_agg2.m 6 Dec 2010 13:55:52 -0000
@@ -0,0 +1,34 @@
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+% A simple test of solutions.unsorted_aggregate2/6.
+
+:- module unsorted_agg2.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module solutions.
+:- import_module string.
+
+main(!IO) :-
+ unsorted_aggregate2(q, collect_q, [], DoubleQs, !IO),
+ io.write(DoubleQs, !IO),
+ io.nl(!IO).
+
+:- pred collect_q(int::in, list(int)::in, list(int)::out,
+ io::di, io::uo) is det.
+
+collect_q(I, !DoubleQs, !IO) :-
+ io.format("Collecting %d ... \n", [i(I)], !IO),
+ !:DoubleQs = [ 2 * I | !.DoubleQs].
+
+:- pred q(int::out) is multi.
+
+q(3).
+q(4).
+q(5).
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list