[m-rev.] for review: Fix array.sort.
Peter Wang
novalazy at gmail.com
Fri Oct 10 16:11:36 AEDT 2014
Branches: master, 14.01
array.sort was broken since 2001 when the implementation was changed
from merge sort to SAM sort.
library/array.m:
Fix the confusion as to which output argument of samsort_up is
sorted.
Add optional runtime checks of the pre- and post-conditions
of samsort_up and samsort_down when built with a trace flag.
Add array.sort_fix_2014.
tests/hard_coded/Mmakefile:
tests/hard_coded/array_sort.exp:
tests/hard_coded/array_sort.m:
Add test program.
NEWS:
Announce the fix.
diff --git a/NEWS b/NEWS
index 9079523..4c02c07 100644
--- a/NEWS
+++ b/NEWS
@@ -1,12 +1,14 @@
NEWS for Mercury 14.01.2
------------------------
This is a bug-fix release.
-+ Fix the handling of nondet code by the auto-parallelisation analysis in
+* Fix array.sort, which has been buggy since 2001. You may wish to
+ reference array.sort_fix_2014 to ensure that you using the fixed version.
+* Fix the handling of nondet code by the auto-parallelisation analysis in
mdprof_create_feedback. (Bug #364)
NEWS for Mercury 14.01.1
------------------------
This is a bug-fix release.
diff --git a/library/array.m b/library/array.m
index 05bf118..50c6dc5 100644
--- a/library/array.m
+++ b/library/array.m
@@ -429,12 +429,17 @@
% primarily only an issue with types with user-defined equivalence for
% which `equivalent' objects are otherwise distinguishable.
%
:- func array.sort(array(T)) = array(T).
:- mode array.sort(array_di) = array_uo is det.
+ % array.sort was previously buggy. This symbol provides a way to ensure
+ % that you are using the fixed version.
+ %
+:- pred array.sort_fix_2014 is det.
+
% array.foldl(Fn, Array, X) is equivalent to
% list.foldl(Fn, array.to_list(Array), X)
% but more efficient.
%
:- func array.foldl(func(T1, T2) = T2, array(T1), T2) = T2.
%:- mode array.foldl(func(in, in) = out is det, array_ui, in) = out is det.
@@ -2117,12 +2122,16 @@ array.member(A, X) :-
%
:- pragma type_spec(array.sort/1, T = int).
:- pragma type_spec(array.sort/1, T = string).
array.sort(A) = samsort_subarray(A, array.min(A), array.max(A)).
+:- pragma no_inline(array.sort_fix_2014/0).
+
+array.sort_fix_2014.
+
%------------------------------------------------------------------------------%
array.binary_search(A, X, I) :-
array.binary_search(ordering, A, X, I).
array.binary_search(Cmp, A, X, I) :-
@@ -2687,44 +2696,68 @@ do_all_false(Pred, I, UB, Array) :-
(array(T)::array_uo) is det.
:- pragma type_spec(samsort_subarray/3, T = int).
:- pragma type_spec(samsort_subarray/3, T = string).
samsort_subarray(A0, Lo, Hi) = A :-
- samsort_up(0, A0, _, array.copy(A0), A, Lo, Hi, Lo).
+ samsort_up(0, array.copy(A0), A, A0, _, Lo, Hi, Lo).
:- pred samsort_up(int::in, array(T)::array_di, array(T)::array_uo,
array(T)::array_di, array(T)::array_uo, int::in, int::in, int::in) is det.
:- pragma type_spec(samsort_up/8, T = int).
:- pragma type_spec(samsort_up/8, T = string).
% Precondition:
% We are N levels from the bottom (leaf nodes) of the tree.
% A0 is sorted from Lo .. I - 1.
% A0 and B0 are identical from I .. Hi.
% Postcondition:
- % B is sorted from Lo .. Hi.
+ % A is sorted from Lo .. Hi.
%
samsort_up(N, A0, A, B0, B, Lo, Hi, I) :-
+ trace [compile_time(flag("array_sort"))] (
+ verify_sorted(A0, Lo, I - 1),
+ verify_identical(A0, B0, I, Hi)
+ ),
( I > Hi ->
A = A0,
B = B0
+ % A is sorted from Lo .. Hi.
; N > 0 ->
+ % B0 and A0 are identical from I .. Hi.
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.
+ % B1 and A1 are identical from J .. Hi.
+
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)
+ % B2 and A2 are identical from J .. Hi.
+ samsort_up(N + 1, B2, B3, A2, A3, Lo, Hi, J),
+ % B3 is sorted from Lo .. Hi.
+
+ A = B3,
+ B = A3
+ % A is sorted from Lo .. Hi.
;
% N = 0, I = Lo
copy_run_ascending(A0, B0, B1, Lo, Hi, J),
+
% B1 is sorted from Lo .. J - 1.
- samsort_up(N + 1, B1, B, A0, A, Lo, Hi, J)
+ % B1 and A0 are identical from J .. Hi.
+ samsort_up(N + 1, B1, B2, A0, A2, Lo, Hi, J),
+ % B2 is sorted from Lo .. Hi.
+
+ A = B2,
+ B = A2
+ % A is sorted from Lo .. Hi.
+ ),
+ trace [compile_time(flag("array_sort"))] (
+ verify_sorted(A, Lo, Hi)
).
:- pred samsort_down(int::in, array(T)::array_di, array(T)::array_uo,
array(T)::array_di, array(T)::array_uo, int::in, int::in, int::out) is det.
:- pragma type_spec(samsort_down/8, T = int).
@@ -2735,28 +2768,59 @@ samsort_up(N, A0, A, B0, B, Lo, Hi, I) :-
% A0 and B0 are identical from Lo .. Hi.
% Postcondition:
% B is sorted from Lo .. I - 1.
% A and B are identical from I .. Hi.
%
samsort_down(N, A0, A, B0, B, Lo, Hi, I) :-
+ trace [compile_time(flag("array_sort"))] (
+ verify_identical(A0, B0, Lo, Hi)
+ ),
( Lo > Hi ->
A = A0,
B = B0,
I = Lo
+ % B is sorted from Lo .. I - 1.
; N > 0 ->
samsort_down(N - 1, B0, B1, A0, A1, Lo, Hi, J),
samsort_down(N - 1, B1, B2, A1, A2, J, Hi, I),
% A2 is sorted from Lo .. J - 1.
% A2 is sorted from J .. I - 1.
A = A2,
merge_subarrays(A2, Lo, J - 1, J, I - 1, Lo, B2, B)
% B is sorted from Lo .. I - 1.
;
A = A0,
copy_run_ascending(A0, B0, B, Lo, Hi, I)
% B is sorted from Lo .. I - 1.
+ ),
+ trace [compile_time(flag("array_sort"))] (
+ verify_sorted(B, Lo, I - 1),
+ verify_identical(A, B, I, Hi)
+ ).
+
+:- pred verify_sorted(array(T)::array_ui, int::in, int::in) is det.
+
+verify_sorted(A, Lo, Hi) :-
+ ( Lo >= Hi ->
+ true
+ ; compare((<), A ^ elem(Lo + 1), A ^ elem(Lo)) ->
+ unexpected($module, $pred, "array range not sorted")
+ ;
+ verify_sorted(A, Lo + 1, Hi)
+ ).
+
+:- pred verify_identical(array(T)::array_ui, array(T)::array_ui,
+ int::in, int::in) is det.
+
+verify_identical(A, B, Lo, Hi) :-
+ ( Lo > Hi ->
+ true
+ ; A ^ elem(Lo) = B ^ elem(Lo) ->
+ verify_identical(A, B, Lo + 1, Hi)
+ ;
+ unexpected($module, $pred, "array ranges not identical")
).
%------------------------------------------------------------------------------%
:- pred copy_run_ascending(array(T)::array_ui,
array(T)::array_di, array(T)::array_uo, int::in, int::in, int::out) is det.
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 4403c7b..b67f4f4 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -8,12 +8,13 @@ THIS_DIR = hard_coded
ORDINARY_PROGS= \
abstract_eqv \
address_of_builtins \
agg \
array_gen \
+ array_sort \
array_test \
array_test2 \
array_all_tf \
backquoted_qualified_ops \
bag_various \
bidirectional \
diff --git a/tests/hard_coded/array_sort.exp b/tests/hard_coded/array_sort.exp
new file mode 100644
index 0000000..70ff8e5
--- /dev/null
+++ b/tests/hard_coded/array_sort.exp
@@ -0,0 +1 @@
+done.
diff --git a/tests/hard_coded/array_sort.m b/tests/hard_coded/array_sort.m
new file mode 100644
index 0000000..5f936b4
--- /dev/null
+++ b/tests/hard_coded/array_sort.m
@@ -0,0 +1,61 @@
+%-----------------------------------------------------------------------------%
+
+:- module array_sort.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array.
+:- import_module int.
+:- import_module list.
+:- import_module solutions.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ array.sort_fix_2014,
+ unsorted_aggregate(generate, test, !IO),
+ io.write_string("done.\n", !IO).
+
+:- pred generate(list(int)::out) is multi.
+
+generate(L) :-
+ L0 = [0, 0, 1, 1, 2, 2, 3, 3],
+ sub(L0, L1),
+ list.perm(L1, L).
+
+:- pred sub(list(T)::in, list(T)::out) is multi.
+
+sub([], []).
+sub([_ | T], L) :-
+ sub(T, L).
+sub([H | T], [H | L]) :-
+ sub(T, L).
+
+:- pred test(list(int)::in, io::di, io::uo) is det.
+
+test(L, !IO) :-
+ list.sort(L, LS),
+ AS = to_list(array.sort(from_list(L))),
+ ( LS = AS ->
+ % io.write_string("ok: ", !IO),
+ % io.write(L, !IO),
+ % io.nl(!IO)
+ true
+ ;
+ io.write_string("failed: ", !IO),
+ io.write(L, !IO),
+ io.write_string(" -> ", !IO),
+ io.write(AS, !IO),
+ io.nl(!IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
--
1.8.4
More information about the reviews
mailing list