[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