[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