[m-rev.] for review: comparison preds/funcs

Mark Brown dougl at cs.mu.OZ.AU
Fri Sep 13 01:42:55 AEST 2002


Hi,

This change is in response to the discussion that arose in the recent thread
on list__sort_and_remove_equivs, and a discussion that was had in person in
the Mercury office.  The purpose of the change is to clarify what we expect
of user supplied comparison, and what we mean by "duplicates" in the standard
library.

After this change, if the user supplies a comparison predicate to a
"remove_dups" predicate then that is used rather than builtin equality to
determine whether elements are duplicates.  Previously,
list__sort_and_remove_dups would do the sorting using the user supplied
comparison, but the removing of duplicates using builtin equality.

With the relaxed assumption, our implementation of sort_and_remove_dups
(which uses list__remove_adjacent_dups) wouldn't work because duplicates
will no longer necessarily be adjacent in the sorted list.  If there is any
great need for a predicate and/or function with the previous semantics of
list__sort_and_remove_dups, then it can be added later in a separate change.

Cheers,
Mark.

Estimated hours taken: 3
Branches: main

Remove the assumption on user supplied comparison predicates that
C(X, Y, =) implies X = Y (similarly for comparison functions).  Our code
shouldn't need to assume this, and sometimes more general orderings are
useful (for example, when you only want to compare the key of a key-value
pair).  The existing assumptions were not documented anywhere, so we now
document the remaining assumptions in builtin.m.

With this assumption gone the issue of the stability of library sorting
predicates that allow a user supplied ordering arises, since elements may
be equivalent according to the ordering even though they are not equal.
Therefore modify the documentation of standard library predicates to make
clear what we do with equivalent elements, and make minor modifications to
the code to ensure that it does as we claim.

Although the builtin comparison predicates are guaranteed to satisfy the
assumption, we nevertheless remove it from the implementation of predicates
in list.m that use builtin comparison.  The rationale for this is that we
don't need the assumption, and it may not be robust if in future we ever
decide to allow user defined comparison.

NEWS:
	Mention the changed assumptions about user supplied comparison
	predicates and functions.

	Mention the new predicate exported from list.m.

library/builtin.m:
	Add types comparison_pred/1 and comparison_func/1, and corresponding
	insts.  Document the assumptions we make about comparison predicates
	and functions.

library/list.m:
	Modify sort/3, sort_and_remove_dups/3, merge/4 and
	merge_and_remove_dups/4, as well as any functional versions, to use
	the new types.  Document the stability of sorting, and modify the
	code to ensure that we conform to this.

	Add remove_adjacent_dups/3, which takes a user supplied comparison
	predicate and determines whether elements are duplicates based on
	this, rather than the usual equality.

	Modify the implementation of some predicates that use compare, to
	avoid the unnecessary assumption.

	Fix some spelling and grammatical errors.

library/array.m:
library/bt_array.m:
	Modify the interface of {,bt_}array__bsearch to use the new types
	and insts.  Update the documentation.

tests/hard_coded/Mmakefile:
tests/hard_coded/stable_sort.exp:
tests/hard_coded/stable_sort.m:
	A test case that checks the stability of list__sort.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.266
diff -u -r1.266 NEWS
--- NEWS	12 Aug 2002 08:02:41 -0000	1.266
+++ NEWS	12 Sep 2002 14:11:43 -0000
@@ -117,6 +117,10 @@
 
 Changes to the Mercury standard library:
 
+* The assumptions that we make about user supplied comparison predicates and
+  functions have been relaxed to allow more general orderings.  The new
+  assumptions are documented in builtin.m.
+
 * The builtin predicates !/0 and !/2 from Mercury's Prolog heritage have been
   removed (`!' is now a prefix operator used in the state variable syntax).
 
@@ -166,6 +170,7 @@
   return `[|]' rather than `.' for lists, and calls to std_util__construct
   which construct lists may need to be updated.
 * We've added the predicate list__is_empty/1 and list__is_not_empty/1.
+* We've added the predicate list__remove_adjacent_dups/3.
 
 * We've added a function version of error/1, called func_error/1, to require.m.
 
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.113
diff -u -r1.113 array.m
--- library/array.m	21 Aug 2002 11:27:31 -0000	1.113
+++ library/array.m	12 Sep 2002 11:22:10 -0000
@@ -293,20 +293,19 @@
 :- mode array__fetch_items(array_ui, in, in) = out is det.
 :- mode array__fetch_items(in, in, in) = out is det.
 
-	% array__bsearch takes an array, an element to be found
+	% array__bsearch takes an array, an element to be matched
 	% and a comparison predicate and returns the position of
-	% the element in the array.  Assumes the array is in sorted
-	% order.  Fails if the element is not present.  If the
-	% element to be found appears multiple times, the index of
-	% the first occurrence is returned.
-:- pred array__bsearch(array(T), T, pred(T, T, comparison_result),
-			maybe(int)).
-:- mode array__bsearch(array_ui, in, pred(in, in, out) is det, out) is det.
-:- mode array__bsearch(in, in, pred(in, in, out) is det, out) is det.
+	% the first occurrence in the array of an element which is
+	% equivalent to the given one in the ordering provided.
+	% Assumes the array is sorted according to this ordering.
+	% Fails if the element is not present.
+:- pred array__bsearch(array(T), T, comparison_pred(T), maybe(int)).
+:- mode array__bsearch(array_ui, in, in(comparison_pred), out) is det.
+:- mode array__bsearch(in, in, in(comparison_pred), out) is det.
 
-:- func array__bsearch(array(T), T, func(T,T) = comparison_result) = maybe(int).
-:- mode array__bsearch(array_ui, in, func(in,in) = out is det) = out is det.
-:- mode array__bsearch(in, in, func(in,in) = out is det) = out is det.
+:- func array__bsearch(array(T), T, comparison_func(T)) = maybe(int).
+:- mode array__bsearch(array_ui, in, in(comparison_func)) = out is det.
+:- mode array__bsearch(in, in, in(comparison_func)) = out is det.
 
 	% array__map(Closure, OldArray, NewArray) applys `Closure' to
 	% each of the elements of `OldArray' to create `NewArray'.
Index: library/bt_array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bt_array.m,v
retrieving revision 1.9
diff -u -r1.9 bt_array.m
--- library/bt_array.m	13 Dec 2000 00:00:39 -0000	1.9
+++ library/bt_array.m	12 Sep 2002 11:23:50 -0000
@@ -164,14 +164,14 @@
 
 :- func bt_array__fetch_items(bt_array(T), int, int) = list(T).
 
-	% bt_array__bsearch takes a bt_array, an element to be found
+	% bt_array__bsearch takes a bt_array, an element to be matched
 	% and a comparison predicate and returns the position of
-	% the element in the bt_array.  Assumes the bt_array is in sorted
-	% order.  Fails if the element is not present.  If the
-	% element to be found appears multiple times, the index of
-	% the first occurrence is returned.
-:- pred bt_array__bsearch(bt_array(T), T, pred(T, T, comparison_result), int).
-:- mode bt_array__bsearch(in, in, pred(in, in, out) is det, out) is semidet.
+	% the first occurrence in the bt_array of an element which is
+	% equivalent to the given one in the ordering provided.
+	% Assumes the bt_array is sorted according to this ordering.
+	% Fails if the element is not present.
+:- pred bt_array__bsearch(bt_array(T), T, comparison_pred(T), int).
+:- mode bt_array__bsearch(in, in, in(comparison_pred), out) is semidet.
 
 	% Field selection for arrays.
 	% Array ^ elem(Index) = bt_array__lookup(Array, Index).
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.78
diff -u -r1.78 builtin.m
--- library/builtin.m	9 Aug 2002 05:26:41 -0000	1.78
+++ library/builtin.m	12 Sep 2002 06:43:08 -0000
@@ -191,6 +191,31 @@
 :- mode compare(uo, ui, in) is det.
 :- mode compare(uo, in, ui) is det.
 
+	% Values of types comparison_pred/1 and comparison_func/1 are used
+	% by predicates and functions which depend on an ordering on a given
+	% type, where this ordering is not necessarily the standard ordering.
+	% In addition to the type, mode and determinism constraints, a
+	% comparison predicate C is expected to obey two other laws.  For
+	% all X, Y and Z of the appropriate type, and for all
+	% comparison_results R:
+	%	1) C(X, Y, (>)) if and only if C(Y, X, (<))
+	%	2) C(X, Y, R) and C(Y, Z, R) implies C(X, Z, R).
+	% Comparison functions are expected to obey analogous laws.
+	%
+	% Note that binary relations <, > and = can be defined from a
+	% comparison predicate or function in an obvious way.  The following
+	% facts about these relations are entailed by the above constraints:
+	% = is an equivalence relation (not necessarily the usual equality),
+	% and the equivalence classes of this relation are totally ordered
+	% with respect to < and >.
+:- type comparison_pred(T) == pred(T, T, comparison_result).
+:- inst comparison_pred(I) == (pred(in(I), in(I), out) is det).
+:- inst comparison_pred == comparison_pred(ground).
+
+:- type comparison_func(T) == (func(T, T) = comparison_result).
+:- inst comparison_func(I) == (func(in(I), in(I)) = out is det).
+:- inst comparison_func == comparison_func(ground).
+
 % In addition, the following predicate-like constructs are builtin:
 %
 %	:- pred (T = T).
Index: library/list.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/list.m,v
retrieving revision 1.107
diff -u -r1.107 list.m
--- library/list.m	18 Aug 2002 09:41:37 -0000	1.107
+++ library/list.m	12 Sep 2002 13:45:49 -0000
@@ -130,7 +130,7 @@
 
 	% list__remove_dups(L0, L) :
 	%	L is the result of deleting the second and subsequent
-	%	occurrences of every element that occurs twice in L.
+	%	occurrences of every element that occurs twice in L0.
 :- pred list__remove_dups(list(T), list(T)).
 :- mode list__remove_dups(in, out) is det.
 
@@ -230,20 +230,20 @@
 :- func list__delete_all(list(T), T) = list(T).
 
 	% list__delete_first(List0, Elem, List) is true iff Elem occurs in List0
-	% and List is List0 with the first occurence of Elem removed
+	% and List is List0 with the first occurrence of Elem removed.
 	%
 :- pred list__delete_first(list(T), T, list(T)).
 :- mode list__delete_first(in, in, out) is semidet.
 
 	% list__delete_all(List0, Elem, List) is true iff List is List0 with
-	% all occurences of Elem removed
+	% all occurrences of Elem removed.
 	%
 :- pred list__delete_all(list(T), T, list(T)).
 :- mode list__delete_all(di, in, uo) is det.
 :- mode list__delete_all(in, in, out) is det.
 
 	% list__delete_elems(List0, Elems, List) is true iff List is List0 with
-	% all occurences of all elements of Elems removed
+	% all occurrences of all elements of Elems removed.
 	%
 :- pred list__delete_elems(list(T), list(T), list(T)).
 :- mode list__delete_elems(in, in, out) is det.
@@ -251,20 +251,20 @@
 :- func list__delete_elems(list(T), list(T)) = list(T).
 
 	% list__replace(List0, D, R, List) is true iff List is List0
-	% with an occurence of D replaced with R.
+	% with an occurrence of D replaced with R.
 	%
 :- pred list__replace(list(T), T, T, list(T)).
 :- mode list__replace(in, in, in, in) is semidet.
 :- mode list__replace(in, in, in, out) is nondet.
 
 	% list__replace_first(List0, D, R, List) is true iff List is List0
-	% with the first occurence of D replaced with R.
+	% with the first occurrence of D replaced with R.
 	%
 :- pred list__replace_first(list(T), T, T, list(T)).
 :- mode list__replace_first(in, in, in, out) is semidet.
 
 	% list__replace_all(List0, D, R, List) is true iff List is List0
-	% with all occurences of D replaced with R.
+	% with all occurrences of D replaced with R.
 	%
 :- pred list__replace_all(list(T), T, T, list(T)).
 :- mode list__replace_all(in, in, in, out) is det.
@@ -290,7 +290,8 @@
 :- func list__replace_nth_det(list(T), int, T) = list(T).
 
 	% list__sort_and_remove_dups(List0, List):
-	%	List is List0 sorted with duplicates removed.
+	%	List is List0 sorted with the second and subsequent
+	%	occurrence of any duplicates removed.
 	%
 :- pred list__sort_and_remove_dups(list(T), list(T)).
 :- mode list__sort_and_remove_dups(in, out) is det.
@@ -636,41 +637,56 @@
 
 	% list__sort(Compare, Unsorted, Sorted) is true iff Sorted is a
 	% list containing the same elements as Unsorted, where Sorted is
-	% a sorted list, with respect to the ordering defined by the predicate
-	% term Compare.
-:- pred list__sort(pred(X, X, comparison_result), list(X), list(X)).
-:- mode list__sort(pred(in, in, out) is det, in, out) is det.
+	% sorted with respect to the ordering defined by the predicate
+	% term Compare, and the elements that are equivalent in this ordering
+	% appear in the same sequence in Sorted as they do in Unsorted
+	% (that is, the sort is stable).
+:- pred list__sort(comparison_pred(X), list(X), list(X)).
+:- mode list__sort(in(comparison_pred), in, out) is det.
 
-:- func list__sort(func(X, X) = comparison_result, list(X)) = list(X).
+:- func list__sort(comparison_func(X), list(X)) = list(X).
 
 	% list__sort_and_remove_dups(Compare, Unsorted, Sorted) is true iff
-	% Sorted is a list containing the same elements as Unsorted, but with
-	% any duplicates removed. Where Sorted is a sorted list, with respect
-	% to the ordering defined by the predicate term Compare.
-:- pred list__sort_and_remove_dups(pred(X, X, comparison_result), list(X),
+	% Sorted is a list containing the same elements as Unsorted, where
+	% Sorted is sorted with respect to the ordering defined by the
+	% predicate term Compare, except that if two elements in Unsorted
+	% are equivalent with respect to this ordering only the one which
+	% occurs first will be in Sorted.
+:- pred list__sort_and_remove_dups(comparison_pred(X), list(X), list(X)).
+:- mode list__sort_and_remove_dups(in(comparison_pred), in, out) is det.
+
+	% list__remove_adjacent_dups(P, L0, L) is true iff L is the result
+	% of replacing every sequence of elements in L0 which are equivalent
+	% with respect to the ordering, with the first occurrence in L0 of
+	% such an element.
+:- pred list__remove_adjacent_dups(comparison_pred(X), list(X), list(X)).
+:- mode list__remove_adjacent_dups(in(comparison_pred), in, out) is det.
+
+	% list__merge(Compare, As, Bs, Sorted) is true iff, assuming As and
+	% Bs are sorted with respect to the ordering defined by Compare,
+	% Sorted is a list containing the elements of As and Bs which is
+	% also sorted.  For elements which are equivalent in the ordering,
+	% if they come from the same list then they appear in the same
+	% sequence in Sorted as they do in that list, otherwise the elements
+	% from As appear before the elements from Bs.
+:- pred list__merge(comparison_pred(X), list(X), list(X), list(X)).
+:- mode list__merge(in(comparison_pred), in, in, out) is det.
+
+:- func list__merge(comparison_func(X), list(X), list(X)) = list(X).
+
+	% list__merge_and_remove_dups(P, As, Bs, Sorted) is true iff, assuming
+	% As and Bs are sorted with respect to the ordering defined by
+	% Compare and neither contains any duplicates, Sorted is a list
+	% containing the elements of As and Bs which is also sorted and
+	% contains no duplicates.  If an element from As is duplicated in
+	% Bs (that is, they are equivalent in the ordering), then the element
+	% from As is the one that appears in Sorted.
+:- pred list__merge_and_remove_dups(comparison_pred(X), list(X), list(X),
 	list(X)).
-:- mode list__sort_and_remove_dups(pred(in, in, out) is det, in, out) is det.
+:- mode list__merge_and_remove_dups(in(comparison_pred), in, in, out) is det.
 
-	% list__merge(Compare, As, Bs, Sorted) is true iff Sorted is a
-	% list containing the elements of As and Bs in the order implied
-	% by their sorted merge. The ordering of elements is defined by
-	% the higher order comparison predicate Compare.
-:- pred list__merge(pred(X, X, comparison_result), list(X), list(X), list(X)).
-:- mode list__merge(pred(in, in, out) is det, in, in, out) is det.
-
-:- func list__merge(func(X, X) = comparison_result, list(X), list(X)) = list(X).
-
-	% list__merge_and_remove_dups(P, As, Bs, Sorted) is true if and only if
-	% Sorted is a list containing the elements of As and Bs in the order
-	% implied by their sorted merge. The ordering of elements is defined by
-	% the higher order comparison predicate P.
-	% As and Bs must be sorted.
-:- pred list__merge_and_remove_dups(pred(X, X, comparison_result),
-	list(X), list(X), list(X)).
-:- mode list__merge_and_remove_dups(pred(in, in, out) is det,
-	in, in, out) is det.
-
-:- func list__merge_and_remove_dups(func(X, X) = comparison_result, list(X), list(X)) = list(X).
+:- func list__merge_and_remove_dups(comparison_func(X), list(X), list(X))
+	= list(X).
 
 %-----------------------------------------------------------------------------%
 
@@ -902,12 +918,13 @@
 	( A = [X | Xs] ->
 		( B = [Y | Ys] ->
 			C = [Z | Zs],
-			( compare(<, X, Y) ->
-				Z = X,
-				list__merge(Xs, B, Zs)
-			;
+			( compare(>, X, Y) ->
 				Z = Y,
 				list__merge(A, Ys, Zs)
+			;
+				% If compare((=), X, Y), take X first.
+				Z = X,
+				list__merge(Xs, B, Zs)
 			)
 		;
 			C = A
@@ -920,14 +937,18 @@
 	( A = [X | Xs] ->
 		( B = [Y | Ys] ->
 			compare(Res, X, Y),
-			( Res = (<) ->
+			(
+				Res = (<),
 				C = [X | Zs],
 				list__merge_and_remove_dups(Xs, B, Zs)
-			; Res = (>) ->
+			;
+				Res = (>),
 				C = [Y | Zs],
 				list__merge_and_remove_dups(A, Ys, Zs)
 			;
-				list__merge_and_remove_dups(Xs, B, C)
+				Res = (=),
+				C = [X | Zs],
+				list__merge_and_remove_dups(Xs, Ys, Zs)
 			)
 		;
 			C = A
@@ -1058,7 +1079,7 @@
 list__remove_adjacent_dups_2([], X, [X]).
 list__remove_adjacent_dups_2([X1 | Xs], X0, L) :-
 	(X0 = X1 ->
-		list__remove_adjacent_dups_2(Xs, X1, L)
+		list__remove_adjacent_dups_2(Xs, X0, L)
 	;
 		L = [X0 | L0],
 		list__remove_adjacent_dups_2(Xs, X1, L0)
@@ -1391,7 +1412,23 @@
 
 list__sort_and_remove_dups(P, L0, L) :-
 	list__sort(P, L0, L1),
-	list__remove_adjacent_dups(L1, L).
+	list__remove_adjacent_dups(P, L1, L).
+
+list__remove_adjacent_dups(_, [], []).
+list__remove_adjacent_dups(P, [X | Xs], L) :-
+	list__remove_adjacent_dups_2(P, Xs, X, L).
+
+:- pred list__remove_adjacent_dups_2(comparison_pred(T), list(T), T, list(T)).
+:- mode list__remove_adjacent_dups_2(in(comparison_pred), in, in, out) is det.
+
+list__remove_adjacent_dups_2(_, [], X, [X]).
+list__remove_adjacent_dups_2(P, [X1 | Xs], X0, L) :-
+	( P(X0, X1, (=)) ->
+		list__remove_adjacent_dups_2(P, Xs, X0, L)
+	;
+		L = [X0 | L0],
+		list__remove_adjacent_dups_2(P, Xs, X1, L0)
+	).
 
 list__sort(P, L0, L) :-
 	list__length(L0, N),
@@ -1408,9 +1445,8 @@
 	).
 
 % list__hosort is actually det but the compiler can't confirm it
-:- pred list__hosort(pred(X, X, comparison_result), int, list(X),
-	list(X), list(X)).
-:- mode list__hosort(pred(in, in, out) is det, in, in, out, out) is semidet.
+:- pred list__hosort(comparison_pred(X), int, list(X), list(X), list(X)).
+:- mode list__hosort(in(comparison_pred), in, in, out, out) is semidet.
 
 	% list__hosort is a Mercury implementation of the mergesort
 	% described in The Craft of Prolog.
@@ -1452,19 +1488,14 @@
 list__merge(_P, [], [Y | Ys], [Y | Ys]).
 list__merge(_P, [X | Xs], [], [X | Xs]).
 list__merge(P, [H1 | T1], [H2 | T2], L) :-
-	call(P, H1, H2, C),
 	(
-		C = (<),
-		L = [H1 | T],
-		list__merge(P, T1, [H2 | T2], T)
-	;
-		C = (=),
-		L = [H1, H2 | T],
-		list__merge(P, T1, T2, T)
-	;
-		C = (>),
+		P(H1, H2, (>))
+	->
 		L = [H2 | T],
 		list__merge(P, [H1 | T1], T2, T)
+	;
+		L = [H1 | T],
+		list__merge(P, T1, [H2 | T2], T)
 	).
 
 list__merge_and_remove_dups(_P, [], [], []).
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.165
diff -u -r1.165 Mmakefile
--- tests/hard_coded/Mmakefile	4 Sep 2002 08:31:52 -0000	1.165
+++ tests/hard_coded/Mmakefile	12 Sep 2002 11:54:33 -0000
@@ -130,6 +130,7 @@
 	space \
 	special_char \
 	split_c_files \
+	stable_sort \
 	string_alignment \
 	string_alignment_bug \
 	string_loop \
Index: tests/hard_coded/stable_sort.exp
===================================================================
RCS file: tests/hard_coded/stable_sort.exp
diff -N tests/hard_coded/stable_sort.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/stable_sort.exp	12 Sep 2002 13:32:25 -0000
@@ -0,0 +1 @@
+list__sort/3 appears stable
Index: tests/hard_coded/stable_sort.m
===================================================================
RCS file: tests/hard_coded/stable_sort.m
diff -N tests/hard_coded/stable_sort.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/stable_sort.m	12 Sep 2002 13:30:40 -0000
@@ -0,0 +1,93 @@
+:- module stable_sort.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module list, random, int, bool.
+
+main -->
+	{ generate_random_list(42, List) },
+	% io__write(List),
+	% io__nl,
+	{ sort_is_stable(List, Stable) },
+	(
+		{ Stable = yes },
+		io__write_string("list__sort/3 appears stable\n")
+	;
+		{ Stable = no },
+		io__write_string("list__sort/3 is not stable\n")
+	).
+
+:- pred generate_random_list(int, list({int, int})).
+:- mode generate_random_list(in, out) is det.
+
+generate_random_list(Seed, List) :-
+	random__init(Seed, RS),
+	%
+	% We generate random integers from 0 to 9.  The list length
+	% must be large enough to ensure that there are plenty of
+	% duplications, otherwise the test is trivial.
+	%
+	Count = 100,
+	generate_random_list_2(Count, [], List, RS, _).
+
+:- pred generate_random_list_2(int, list({int, int}), list({int, int}),
+	random__supply, random__supply).
+:- mode generate_random_list_2(in, in, out, mdi, muo) is det.
+
+generate_random_list_2(Count, List0, List) -->
+	(
+		{ Count > 0 }
+	->
+		rnd_mod_10(R1),
+		rnd_mod_10(R2),
+		generate_random_list_2(Count - 1, [{R1, R2} | List0], List)
+	;
+		{ List = List0 }
+	).
+
+:- pred rnd_mod_10(int, random__supply, random__supply).
+:- mode rnd_mod_10(out, mdi, muo) is det.
+
+rnd_mod_10(N) -->
+	random__random(R),
+	{ N = R mod 10 }.
+
+:- pred sort_is_stable(list({int, int}), bool).
+:- mode sort_is_stable(in, out) is det.
+
+sort_is_stable(Unsorted, Stable) :-
+	%
+	% If the sort is stable then sorting on the second component
+	% followed by sorting on the first component should give a
+	% fully sorted result.
+	%
+	list__sort(compare_second, Unsorted, SortedOnSecond),
+	list__sort(compare_first, SortedOnSecond, SortedOnSecondThenFirst),
+
+	%
+	% Check the result is fully sorted.
+	%
+	list__sort(Unsorted, Sorted),
+	(
+		SortedOnSecondThenFirst = Sorted
+	->
+		Stable = yes
+	;
+		Stable = no
+	).
+
+:- pred compare_first({int, int}, {int, int}, comparison_result).
+:- mode compare_first(in, in, out) is det.
+
+compare_first({A, _}, {B, _}, Res) :-
+	compare(Res, A, B).
+
+:- pred compare_second({int, int}, {int, int}, comparison_result).
+:- mode compare_second(in, in, out) is det.
+
+compare_second({_, A}, {_, B}, Res) :-
+	compare(Res, A, B).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list