[m-rev.] diff: library improvements for g12

Zoltan Somogyi zs at csse.unimelb.edu.au
Mon Dec 13 14:12:47 AEDT 2010


library/Mmakefile:
	Make a module list easier to modify.

library/array.m:
library/int.m:
	Add predicates needed by g12.

NEWS:
	Mention the new predicates.

	Remove announcements of new modes for predicates which are themselves
	new.

Zoltan.

cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.549
diff -u -b -r1.549 NEWS
--- NEWS	7 Dec 2010 03:09:13 -0000	1.549
+++ NEWS	9 Dec 2010 06:26:06 -0000
@@ -6,8 +6,8 @@
 
 Changes to the Mercury standard library:
 
-* We have added semidet modes for array.foldl/4, array.foldl2/6,
-  hash_table.fold/4, version_array.foldl/4, and version_hash_table.fold/4.
+* We have added semidet modes for hash_table.fold/4 and
+  version_hash_table.fold/4.
 
 * We have added new predicates and functions added to the assoc_list module.
   The predicates map_keys_only/3 map_values_only/3 and map_values/3 complement
@@ -60,9 +60,10 @@
 * We have made the following changes to the array module of the standard
   library:
 
-  + The function array.unsafe_elem2/ has been added.
+  + We have added the functions unsafe_elem/2 and append/2.
 
-  + The predicates array.foldr/4 and array.foldr2/6 have been added.
+  + We have added the predicates svset/4, unsafe_svset/4, foldl2/4, foldl2/6,
+    foldr/4, foldr2/6, map_foldl/5, map_corresponding_foldl/6, and member/2.
 
 * We have added the predicates version_array.foldl2/6, version_array.foldr/4,
   and version_array.foldr2/6 to the standard library.
@@ -127,7 +128,8 @@
 
 Changes to the Mercury standard library:
 * We have added cc_multi modes for map.foldl2/6 and tree234.foldl2/6.
-* We have improved the performance of cords, hash tables and version hash tables.
+* We have improved the performance of cords, hash tables and
+version hash tables.
 
 
 NEWS for Mercury 10.04
@@ -213,7 +215,10 @@
   and just plain foldl* in which the higher order argument does not take
   the key as an argument.
 
-* The following functions have been added to the integer module:
+* We have added the following predicate to the int module:
+	int.nondet_int_in_range/2.
+
+* We have added the following functions to the integer module:
 	integer.from_base_string/2
 	integer.det_from_base_string/2
 
@@ -221,13 +226,13 @@
   can be useful when manipulating polymorphic values that have inst any.
 
 * Predicates and functions which create strings from lists of characters
-  now fail, throw an exception or return an error value if a null character
-  is found.  Unexpected null characters in strings are a potential source of
-  security vulnerabilities.
-
-  Predicates string.semidet_from_char_list/2 and
-  string.semidet_from_rev_char_list/2 have been added.  These fail rather
-  than throwing an exception if a null character is found.
+  now fail, throw an exception or return an error value if they find
+  a null character. Unexpected null characters in strings are a potential
+  source of security vulnerabilities.
+
+  We have added the predicates string.semidet_from_char_list/2 and
+  string.semidet_from_rev_char_list/2. These fail rather than throwing
+  an exception if they find a null character.
 
 * We have added string.remove_suffix_det, a version of string.remove_suffix
   that throws an exception if the suffix is not there.
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
Index: boehm_gc/libatomic_ops/tests/test_atomic_include.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/boehm_gc/libatomic_ops/tests/test_atomic_include.h,v
retrieving revision 1.1.1.1
diff -u -b -r1.1.1.1 test_atomic_include.h
--- boehm_gc/libatomic_ops/tests/test_atomic_include.h	23 Feb 2010 06:28:40 -0000	1.1.1.1
+++ boehm_gc/libatomic_ops/tests/test_atomic_include.h	9 Dec 2010 09:42:15 -0000
@@ -5,15 +5,6 @@
  * see doc/COPYING for details.
  */
 
-void test_atomic(void);
-void test_atomic_release(void);
-void test_atomic_acquire(void);
-void test_atomic_read(void);
-void test_atomic_write(void);
-void test_atomic_full(void);
-void test_atomic_release_write(void);
-void test_atomic_acquire_read(void);
-
 /* Some basic sanity tests.  These do not test the barrier semantics. */
 
 #undef TA_assert
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.173
diff -u -b -r1.173 Mmakefile
--- library/Mmakefile	9 Nov 2010 03:46:32 -0000	1.173
+++ library/Mmakefile	8 Dec 2010 05:55:28 -0000
@@ -343,9 +343,24 @@
 mercury_dotnet.dll: ../runtime/mercury_dotnet.dll
 	cp ../runtime/mercury_dotnet.dll .
 
-CSHARP_MODULES = array builtin char construct dir exception float int io \
-		library math private_builtin rtti_implementation std_util \
-		string time type_desc
+CSHARP_MODULES = \
+	array \
+	builtin \
+	char \
+	construct \
+	dir \
+	exception \
+	float \
+	int \
+	io \
+	library \
+	math \
+	private_builtin \
+	rtti_implementation \
+	std_util \
+	string \
+	time \
+	type_desc
 
 CSHARP_DLLS = $(CSHARP_MODULES:%=%__csharp_code.dll)
 
Index: library/array.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.178
diff -u -b -r1.178 array.m
--- library/array.m	18 Nov 2010 04:12:11 -0000	1.178
+++ library/array.m	9 Dec 2010 06:19:11 -0000
@@ -31,13 +31,12 @@
 %
 % WARNING!
 %
-% Arrays are currently not unique objects - until this situation is
-% resolved it is up to the programmer to ensure that arrays are used
-% in such a way as to preserve correctness.  In the absence of mode
-% reordering, one should therefore assume that evaluation will take
-% place in left-to-right order.  For example, the following code will
-% probably not work as expected (f is a function, A an array, I an
-% index, and X an appropriate value):
+% Arrays are currently not unique objects. until this situation is resolved,
+% it is up to the programmer to ensure that arrays are used in ways that
+% preserve correctness. In the absence of mode reordering, one should therefore
+% assume that evaluation will take place in left-to-right order. For example,
+% the following code will probably not work as expected (f is a function,
+% A an array, I an index, and X an appropriate value):
 %
 %       Y = f(A ^ elem(I) := X, A ^ elem(I))
 %
@@ -47,9 +46,8 @@
 %       V1 = A ^ elem(I),
 %       Y  = f(V0, V1)
 %
-% and will be unaware that the first line should be ordered
-% *after* the second.  The safest thing to do is write things out
-% by hand in the form
+% and will be unaware that the first line should be ordered *after* the second.
+% The safest thing to do is write things out by hand in the form
 %
 %       A0I = A0 ^ elem(I),
 %       A1  = A0 ^ elem(I) := X,
@@ -214,6 +212,12 @@
 :- pred array.set(array(T), int, T, array(T)).
 :- mode array.set(array_di, in, in, array_uo) is det.
 
+    % The same as array.set, except the arguments are in an order
+    % that allows the use of state variables.
+    %
+:- pred array.svset(int, T, array(T), array(T)).
+:- mode array.svset(in, in, array_di, array_uo) is det.
+
 :- func array.set(array(T), int, T) = array(T).
 :- mode array.set(array_di, in, in) = array_uo is det.
 
@@ -229,6 +233,12 @@
 :- pred array.unsafe_set(array(T), int, T, array(T)).
 :- mode array.unsafe_set(array_di, in, in, array_uo) is det.
 
+    % The same as array.unsafe_set, except the arguments are in an order
+    % that allows the use of state variables.
+    %
+:- pred array.unsafe_svset(int, T, array(T), array(T)).
+:- mode array.unsafe_svset(in, in, array_di, array_uo) is det.
+
     % array.slow_set sets the nth element of an array, and returns the
     % resulting array. The initial array is not required to be unique,
     % so the implementation may not be able to use destructive update.
@@ -270,6 +280,10 @@
 :- func 'elem :='(int, array(T), T) = array(T).
 :- mode 'elem :='(in, array_di, in) = array_uo is det.
 
+    % Returns every element of the array, one by one.
+    %
+:- pred array.member(array(T)::in, T::out) is nondet.
+
 %-----------------------------------------------------------------------------%
 
     % array.copy(Array0, Array):
@@ -481,13 +495,47 @@
 :- mode array.foldr2(pred(in, in, out, di, uo) is semidet, in,
     in, out, di, uo) is semidet.
 
+    % array.map_foldl(P, A, B, !Acc):
+    % Invoke P(Aelt, Belt, !Acc) on each element of the A array,
+    % and construct array B from the resulting values of Belt.
+    %
+:- pred map_foldl(pred(T1, T2, T3, T3), array(T1), array(T2), T3, T3).
+:- mode map_foldl(in(pred(in, out, in, out) is det),
+    in, array_uo, in, out) is det.
+:- mode map_foldl(in(pred(in, out, in, out) is semidet),
+    in, array_uo, in, out) is semidet.
+
+    % array.map_corresponding_foldl(P, A, B, C, !Acc):
+    %
+    % Given two arrays A and B, invoke P(Aelt, Belt, Celt, !Acc) on
+    % each corresponding pair of elements Aelt and Belt. Build up the array C
+    % from the result Celt values. Return C and the final value of the
+    % accumulator.
+    %
+    % C will have as many elements as A does. In most uses, B will also have
+    % this many elements, but may have more; it may NOT have fewer.
+    %
+:- pred array.map_corresponding_foldl(pred(T1, T2, T3, T4, T4),
+    array(T1), array(T2), array(T3), T4, T4).
+:- mode array.map_corresponding_foldl(
+    in(pred(in, in, out, in, out) is det),
+    in, in, array_uo, in, out) is det.
+:- mode array.map_corresponding_foldl(
+    in(pred(in, in, out, in, out) is semidet),
+    in, in, array_uo, in, out) is semidet.
+
+    % array.append(A, B) = C:
+    %
+    % Make C a concatenation of the arrays A and B.
+    %
+:- func array.append(array(T)::in, array(T)::in) = (array(T)::array_uo) is det.
+
     % array.random_permutation(A0, A, RS0, RS) permutes the elements in
     % A0 given random seed RS0 and returns the permuted array in A
     % and the next random seed in RS.
     %
-:- pred array.random_permutation(array(T), array(T),
-    random.supply, random.supply).
-:- mode array.random_permutation(array_di, array_uo, mdi, muo) is det.
+:- pred array.random_permutation(array(T)::array_di, array(T)::array_uo,
+    random.supply::mdi, random.supply::muo) is det.
 
     % Convert an array to a pretty_printer.doc for formatting.
     %
@@ -1198,6 +1246,13 @@
         array.unsafe_set(Array0, Index, Item, Array)
     ).
 
+array.svset(Index, Item, Array0, Array) :-
+    ( bounds_checks, \+ array.in_bounds(Array0, Index) ->
+        out_of_bounds_error(Array0, Index, "array.set")
+    ;
+        array.unsafe_svset(Index, Item, Array0, Array)
+    ).
+
 :- pragma foreign_proc("C",
     array.unsafe_set(Array0::array_di, Index::in, Item::in, Array::array_uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
@@ -1212,6 +1267,20 @@
     Array = Array0;
 ").
 
+:- pragma foreign_proc("C",
+    array.unsafe_svset(Index::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        sharing(yes(array(T), int, T, array(T)), [
+            cel(Array0, []) - cel(Array, []),
+            cel(Item, [])   - cel(Array, [T])
+        ])
+    ],
+"
+    Array0->elements[Index] = Item; /* destructive update! */
+    Array = Array0;
+").
+
 :- pragma foreign_proc("C#",
     array.unsafe_set(Array0::array_di, Index::in, Item::in, Array::array_uo),
     [will_not_call_mercury, promise_pure, thread_safe],
@@ -1220,6 +1289,14 @@
     Array = Array0;
 }").
 
+:- pragma foreign_proc("C#",
+    array.unsafe_svset(Index::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"{
+    Array0.SetValue(Item, Index);   /* destructive update! */
+    Array = Array0;
+}").
+
 :- pragma foreign_proc("Erlang",
     array.unsafe_set(Array0::array_di, Index::in, Item::in, Array::array_uo),
     [will_not_call_mercury, promise_pure, thread_safe],
@@ -1227,6 +1304,13 @@
     Array = setelement(Index + 1, Array0, Item)
 ").
 
+:- pragma foreign_proc("Erlang",
+    array.unsafe_svset(Index::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = setelement(Index + 1, Array0, Item)
+").
+
 :- pragma foreign_proc("Java",
     array.unsafe_set(Array0::array_di, Index::in, Item::in, Array::array_uo),
     [will_not_call_mercury, promise_pure, thread_safe],
@@ -1245,6 +1329,24 @@
     Array = Array0;         /* destructive update! */
 ").
 
+:- pragma foreign_proc("Java",
+    array.unsafe_svset(Index::in, Item::in, Array0::array_di, Array::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    if (Array0 instanceof int[]) {
+        ((int[]) Array0)[Index] = (Integer) Item;
+    } else if (Array0 instanceof double[]) {
+        ((double[]) Array0)[Index] = (Double) Item;
+    } else if (Array0 instanceof char[]) {
+        ((char[]) Array0)[Index] = (Character) Item;
+    } else if (Array0 instanceof boolean[]) {
+        ((boolean[]) Array0)[Index] = (Boolean) Item;
+    } else {
+        ((Object[]) Array0)[Index] = Item;
+    }
+    Array = Array0;         /* destructive update! */
+").
+
 %-----------------------------------------------------------------------------%
 
 % lower bounds other than zero are not supported
@@ -1457,8 +1559,9 @@
 ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array)
 {
     /*
-    ** Any changes to this function will probably also require
-    ** changes to deepcopy() in runtime/deep_copy.c.
+    ** Any changes to this function will probably also require changes to
+    ** - array.append below, and
+    ** - MR_deep_copy() in runtime/mercury_deep_copy.[ch].
     */
 
     MR_Integer i;
@@ -1702,6 +1805,10 @@
 
 'elem :='(Index, Array, Value) = array.set(Array, Index, Value).
 
+member(A, X) :-
+    nondet_int_in_range(0, array.size(A) - 1, I0),
+    X = A ^ elem(I0).
+
 % ---------------------------------------------------------------------------- %
 
     % array.sort/1 has type specialised versions for arrays of
@@ -1733,8 +1840,8 @@
     Hi = array.size(A) - 1,
     approx_binary_search_2(Cmp, A, X, Lo, Hi, I).
 
-:- pred approx_binary_search_2(comparison_func(T), array(T), T, int, int, int).
-:- mode approx_binary_search_2(in, array_ui, in, in, in, out) is semidet.
+:- pred approx_binary_search_2(comparison_func(T)::in, array(T)::array_ui,
+    T::in, int::in, int::in, int::out) is semidet.
 
 approx_binary_search_2(Cmp, A, X, Lo, Hi, I) :-
     Lo =< Hi,
@@ -1757,15 +1864,66 @@
 
 %-----------------------------------------------------------------------------%
 
+array.append(A, B) = C :-
+    SizeA = array.size(A),
+    SizeB = array.size(B),
+    SizeC = SizeA + SizeB,
+    ( if
+        ( if SizeA > 0 then
+            InitElem = A ^ elem(0)
+          else if SizeB > 0 then
+            InitElem = B ^ elem(0)
+          else
+            fail
+        )
+      then
+        C0 = array.init(SizeC, InitElem),
+        copy_subarray(A, 0, SizeA - 1, 0, C0, C1),
+        copy_subarray(B, 0, SizeB - 1, SizeA, C1, C)
+      else
+        C = array.make_empty_array
+    ).
+
+:- pragma foreign_proc("C",
+    array.append(ArrayA::in, ArrayB::in) = (ArrayC::array_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+        does_not_affect_liveness,
+        % XXX zs: I am not sure about the sharing annotation.
+        sharing(yes(array(T), array(T)), [
+            cel(ArrayA, [T]) - cel(ArrayC, [T]),
+            cel(ArrayB, [T]) - cel(ArrayC, [T])
+        ])
+    ],
+"
+    MR_Integer sizeC;
+    MR_Integer i;
+    MR_Integer offset;
+
+    sizeC = ArrayA->size + ArrayB->size;
+    ML_alloc_array(ArrayC, sizeC + 1, MR_PROC_LABEL);
+
+    ArrayC->size = sizeC;
+    for (i = 0; i < ArrayA->size; i++) {
+        ArrayC->elements[i] = ArrayA->elements[i];
+    }
+
+    offset = ArrayA->size;
+    for (i = 0; i < ArrayB->size; i++) {
+        ArrayC->elements[offset + i] = ArrayB->elements[i];
+    }
+").
+
+%-----------------------------------------------------------------------------%
+
 array.random_permutation(A0, A, RS0, RS) :-
     Lo = array.min(A0),
     Hi = array.max(A0),
     Sz = array.size(A0),
     permutation_2(Lo, Lo, Hi, Sz, A0, A, RS0, RS).
 
-:- pred permutation_2(int, int, int, int, array(T), array(T),
-        random.supply, random.supply).
-:- mode permutation_2(in, in, in, in, array_di, array_uo, mdi, muo) is det.
+:- pred permutation_2(int::in, int::in, int::in, int::in,
+    array(T)::array_di, array(T)::array_uo,
+    random.supply::mdi, random.supply::muo) is det.
 
 permutation_2(I, Lo, Hi, Sz, A0, A, RS0, RS) :-
     ( I > Hi ->
@@ -1906,30 +2064,90 @@
 
 %-----------------------------------------------------------------------------%
 
-array.foldr2(P, A, !Acc1, !Acc2) :-
-    do_foldr2(P, array.min(A), array.max(A), A, !Acc1, !Acc2).
+foldr2(P, A, !Acc1, !Acc2) :-
+    do_foldr_2(P, array.min(A), array.max(A), A, !Acc1, !Acc2).
 
-:- pred do_foldr2(pred(T1, T2, T2, T3, T3), int, int, array(T1), T2, T2,
+:- pred do_foldr_2(pred(T1, T2, T2, T3, T3), int, int, array(T1), T2, T2,
     T3, T3).
-:- mode do_foldr2(pred(in, in, out, in, out) is det, in, in, in, in, out,
+:- mode do_foldr_2(pred(in, in, out, in, out) is det, in, in, in, in, out,
     in, out) is det.
-:- mode do_foldr2(pred(in, in, out, mdi, muo) is det, in, in, in, in, out,
+:- mode do_foldr_2(pred(in, in, out, mdi, muo) is det, in, in, in, in, out,
     mdi, muo) is det.
-:- mode do_foldr2(pred(in, in, out, di, uo) is det, in, in, in, in, out,
+:- mode do_foldr_2(pred(in, in, out, di, uo) is det, in, in, in, in, out,
     di, uo) is det.
-:- mode do_foldr2(pred(in, in, out, in, out) is semidet, in, in, in, in, out,
+:- mode do_foldr_2(pred(in, in, out, in, out) is semidet, in, in, in, in, out,
     in, out) is semidet.
-:- mode do_foldr2(pred(in, in, out, mdi, muo) is semidet, in, in, in, in, out,
+:- mode do_foldr_2(pred(in, in, out, mdi, muo) is semidet, in, in, in, in, out,
     mdi, muo) is semidet.
-:- mode do_foldr2(pred(in, in, out, di, uo) is semidet, in, in, in, in, out,
+:- mode do_foldr_2(pred(in, in, out, di, uo) is semidet, in, in, in, in, out,
     di, uo) is semidet.
 
-do_foldr2(P, Min, I, A, !Acc1, !Acc2) :-
+do_foldr_2(P, Min, I, A, !Acc1, !Acc2) :-
     ( I < Min ->
         true
     ;
         P(A ^ unsafe_elem(I), !Acc1, !Acc2),
-        do_foldr2(P, Min, I - 1, A, !Acc1, !Acc2)
+        do_foldr_2(P, Min, I - 1, A, !Acc1, !Acc2)
+    ).
+
+map_foldl(P, A, B, !C) :-
+    N = array.size(A),
+    ( if N =< 0 then
+        B = array.make_empty_array
+      else
+        X = A ^ elem(0),
+        P(X, Y, !.C, _),
+        B0 = array.init(N, Y),
+        map_foldl_2(P, 0, A, B0, B, !C)
+    ).
+
+:- pred map_foldl_2(pred(T1, T2, T3, T3),
+    int, array(T1), array(T2), array(T2), T3, T3).
+:- mode map_foldl_2(in(pred(in, out, in, out) is det),
+    in, in, array_di, array_uo, in, out) is det.
+:- mode map_foldl_2(in(pred(in, out, in, out) is semidet),
+    in, in, array_di, array_uo, in, out) is semidet.
+
+map_foldl_2(P, I, A, B0, B, !C) :-
+    ( if I < array.size(A) then
+        X = A ^ elem(I),
+        P(X, Y, !C),
+        B1 = B0 ^ elem(I) := Y,
+        map_foldl_2(P, I + 1, A, B1, B, !C)
+      else
+        B = B0
+    ).
+
+array.map_corresponding_foldl(P, A, B, C, !D) :-
+    N = array.size(A),
+    ( if N =< 0 then
+        C = array.make_empty_array
+      else
+        X = A ^ elem(0),
+        Y = B ^ elem(0),
+        P(X, Y, Z, !.D, _),
+        C0 = array.init(N, Z),
+        array.map_corresponding_foldl_2(P, 1, N, A, B, C0, C, !D)
+    ).
+
+:- pred array.map_corresponding_foldl_2(pred(T1, T2, T3, T4, T4),
+    int, int, array(T1), array(T2), array(T3), array(T3), T4, T4).
+:- mode array.map_corresponding_foldl_2(
+    in(pred(in, in, out, in, out) is det),
+    in, in, in, in, array_di, array_uo, in, out) is det.
+:- mode array.map_corresponding_foldl_2(
+    in(pred(in, in, out, in, out) is semidet),
+    in, in, in, in, array_di, array_uo, in, out) is semidet.
+
+array.map_corresponding_foldl_2(P, I, N, A, B, C0, C, !D) :-
+    ( if I < N then
+        X = A ^ elem(I),
+        Y = B ^ elem(I),
+        P(X, Y, Z, !D),
+        C1 = C0 ^ elem(I) := Z,
+        array.map_corresponding_foldl_2(P, I + 1, N, A, B, C1, C, !D)
+      else
+        C = C0
     ).
 
 %-----------------------------------------------------------------------------%
@@ -1972,7 +2190,7 @@
         samsort_down(N - 1, B0, B1, A0, A1, I, Hi, J),
         % A1 is sorted from I .. J - 1.
         % A1 and B1 are identical from J .. Hi.
-        B2 = merge_subarrays(A1, B1, Lo, I - 1, I, J - 1, Lo),
+        merge_subarrays(A1, Lo, I - 1, I, J - 1, Lo, B1, B2),
         A2 = A1,
         % B2 is sorted from Lo .. J - 1.
         samsort_up(N + 1, B2, B, A2, A, Lo, Hi, J)
@@ -2007,7 +2225,7 @@
         % A2 is sorted from Lo .. J - 1.
         % A2 is sorted from J  .. I - 1.
         A = A2,
-        B = merge_subarrays(A2, B2, Lo, J - 1, J, I - 1, Lo)
+        merge_subarrays(A2, Lo, J - 1, J, I - 1, Lo, B2, B)
         % B is sorted from Lo .. I - 1.
     ;
         A = A0,
@@ -2029,10 +2247,10 @@
         compare((>), A ^ elem(Lo), A ^ elem(Lo + 1))
     ->
         I = search_until((<), A, Lo, Hi),
-        B = copy_subarray_reverse(A, B0, Lo, I - 1, I - 1)
+        copy_subarray_reverse(A, Lo, I - 1, I - 1, B0, B)
     ;
         I = search_until((>), A, Lo, Hi),
-        B = copy_subarray(A, B0, Lo, I - 1, Lo)
+        copy_subarray(A, Lo, I - 1, Lo, B0, B)
     ).
 
 %------------------------------------------------------------------------------%
@@ -2055,33 +2273,40 @@
 
 %------------------------------------------------------------------------------%
 
-:- func copy_subarray(array(T)::array_ui, array(T)::array_di, int::in, int::in,
-    int::in) = (array(T)::array_uo) is det.
+    % Assigns the subarray A[Lo..Hi] to B[InitI..Final], where InitI
+    % is the initial value of I, and FinalI = InitI + (Ho - Lo + 1).
+    % In this version, I is ascending, so B[InitI] gets A[Lo]
+    %
+:- pred copy_subarray(array(T)::array_ui, int::in, int::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
 
-:- pragma type_spec(copy_subarray/5, T = int).
-:- pragma type_spec(copy_subarray/5, T = string).
+:- pragma type_spec(copy_subarray/6, T = int).
+:- pragma type_spec(copy_subarray/6, T = string).
 
-copy_subarray(A, B, Lo, Hi, I) =
+copy_subarray(A, Lo, Hi, I, B0, B) :-
     ( Lo =< Hi ->
-        copy_subarray(A, B ^ elem(I) := A ^ elem(Lo), Lo + 1, Hi, I + 1)
+        B1 = B0 ^ elem(I) := A ^ elem(Lo),
+        copy_subarray(A, Lo + 1, Hi, I + 1, B1, B)
     ;
-        B
+        B = B0
     ).
 
-%------------------------------------------------------------------------------%
-
-:- func copy_subarray_reverse(array(T)::array_ui, array(T)::array_di,
-    int::in, int::in, int::in) = (array(T)::array_uo) is det.
+    % Assigns the subarray A[Lo..Hi] to B[InitI..Final], where InitI
+    % is the initial value of I, and FinalI = InitI - (Ho - Lo + 1).
+    % In this version, I is descending, so B[InitI] gets A[Hi].
+    %
+:- pred copy_subarray_reverse(array(T)::array_ui, int::in, int::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
 
-:- pragma type_spec(copy_subarray_reverse/5, T = int).
-:- pragma type_spec(copy_subarray_reverse/5, T = string).
+:- pragma type_spec(copy_subarray_reverse/6, T = int).
+:- pragma type_spec(copy_subarray_reverse/6, T = string).
 
-copy_subarray_reverse(A, B, Lo, Hi, I) =
+copy_subarray_reverse(A, Lo, Hi, I, B0, B) :-
     ( Lo =< Hi ->
-        copy_subarray_reverse(A, B ^ elem(I) := A ^ elem(Lo),
-            Lo + 1, Hi, I - 1)
+        B1 = B0 ^ elem(I) := A ^ elem(Lo),
+        copy_subarray_reverse(A, Lo + 1, Hi, I - 1, B1, B)
     ;
-        B
+        B = B0
     ).
 
 %------------------------------------------------------------------------------%
@@ -2089,33 +2314,34 @@
     % merges the two sorted consecutive subarrays Lo1 .. Hi1 and
     % Lo2 .. Hi2 from A into the subarray starting at I in B.
     %
-:- func merge_subarrays(array(T)::array_ui, array(T)::array_di,
-    int::in, int::in, int::in, int::in, int::in) = (array(T)::array_uo) is det.
+:- pred merge_subarrays(array(T)::array_ui,
+    int::in, int::in, int::in, int::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
 
-:- pragma type_spec(merge_subarrays/7, T = int).
-:- pragma type_spec(merge_subarrays/7, T = string).
+:- pragma type_spec(merge_subarrays/8, T = int).
+:- pragma type_spec(merge_subarrays/8, T = string).
 
-merge_subarrays(A, B0, Lo1, Hi1, Lo2, Hi2, I) = B :-
+merge_subarrays(A, Lo1, Hi1, Lo2, Hi2, I, B0, B) :-
     ( Lo1 > Hi1 ->
-        B = copy_subarray(A, B0, Lo2, Hi2, I)
+        copy_subarray(A, Lo2, Hi2, I, B0, B)
     ; Lo2 > Hi2 ->
-        B = copy_subarray(A, B0, Lo1, Hi1, I)
+        copy_subarray(A, Lo1, Hi1, I, B0, B)
     ;
         X1 = A ^ elem(Lo1),
         X2 = A ^ elem(Lo2),
         compare(R, X1, X2),
         (
             R = (<),
-            B = merge_subarrays(A, B0 ^ elem(I) := X1,
-                Lo1 + 1, Hi1, Lo2, Hi2, I + 1)
+            array.svset(I, X1, B0, B1),
+            merge_subarrays(A, Lo1 + 1, Hi1, Lo2, Hi2, I + 1, B1, B)
         ;
             R = (=),
-            B = merge_subarrays(A, B0 ^ elem(I) := X1,
-                Lo1 + 1, Hi1, Lo2, Hi2, I + 1)
+            array.svset(I, X1, B0, B1),
+            merge_subarrays(A, Lo1 + 1, Hi1, Lo2, Hi2, I + 1, B1, B)
         ;
             R = (>),
-            B = merge_subarrays(A, B0 ^ elem(I) := X2,
-                Lo1, Hi1, Lo2 + 1, Hi2, I + 1)
+            array.svset(I, X2, B0, B1),
+            merge_subarrays(A, Lo1, Hi1, Lo2 + 1, Hi2, I + 1, B1, B)
         )
     ).
 
Index: library/int.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/int.m,v
retrieving revision 1.126
diff -u -b -r1.126 int.m
--- library/int.m	7 May 2010 03:12:25 -0000	1.126
+++ library/int.m	7 Dec 2010 22:54:33 -0000
@@ -346,6 +346,12 @@
 :- mode int.fold_down2(pred(in, in, out, mdi, muo) is nondet, in, in,
     in, out, mdi, muo) is nondet.
 
+    % nondet_int_in_range(Lo, Hi, I):
+    %
+    % On successive successes, set I to every integer from Lo to Hi.
+    %
+:- pred nondet_int_in_range(int::in, int::in, int::out) is nondet.
+
     % Convert an int to a pretty_printer.doc for formatting.
     %
 :- func int.int_to_doc(int) = pretty_printer.doc.
@@ -835,6 +841,20 @@
       else  true
     ).
 
+nondet_int_in_range(Lo, Hi, I) :-
+    % Leave a choice point only if there is at least one solution
+    % to find on backtracking.
+    ( Lo < Hi ->
+        (
+            I = Lo
+        ;
+            nondet_int_in_range(Lo + 1, Hi, I)
+        )
+    ;
+        Lo = Hi,
+        I = Lo
+    ).
+
 %-----------------------------------------------------------------------------%
 
 int.int_to_doc(X) = str(string.int_to_string(X)).
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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