[m-rev.] for review: user defined equality and comparison on sets
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Apr 8 13:54:31 AEST 2005
For review by anyone.
For the main branch only.
Zoltan.
library/set_ordlist.m:
library/set_unordlist.m:
Convert these modules to use user-defined equality and comparison.
This has become possible only recently with the introduction of
promise_equivalent_solutions scopes.
For set_unordlist, the default syntactic definitions of unify and
compare are semantically incorrect; the change to user-defined
equality and comparison is therefore a bug fix, even though it leads
to a slow down (since the lists must be sorted and duplicates removed
before the lists can be compared).
For set_ordlist, the default syntactic definitions of unify and
compare are semantically correct, so we use them to avoid unnecessary
overhead.
tests/hardcoded/string_alignment_bug.m:
This test used to depend on set_ordlist(T) being defined as equivalent
to list(T), which is no longer the case. Change the test case to
operate on lists directly.
cvs diff: Diffing .
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/include
cvs diff: Diffing boehm_gc/include/private
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 debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
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/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
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/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
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/odbc
cvs diff: Diffing extras/posix
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/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
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/set_ordlist.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/set_ordlist.m,v
retrieving revision 1.21
diff -u -b -r1.21 set_ordlist.m
--- library/set_ordlist.m 24 Jan 2005 23:16:39 -0000 1.21
+++ library/set_ordlist.m 8 Apr 2005 03:32:24 -0000
@@ -5,7 +5,7 @@
%---------------------------------------------------------------------------%
% File: set_ordlist.m.
-% Main authors: conway, fjh.
+% Main authors: conway, fjh, zs.
% Stability: medium.
% This file contains a `set' ADT.
@@ -65,6 +65,20 @@
%
:- pred set_ordlist__equal(set_ordlist(T)::in, set_ordlist(T)::in) is semidet.
+ % `set_ordlist__compare_total_order(R, SetA, SetB)' is true iff
+ % to_sorted_list(SetA) R to_sorted_list(SetB), where R is =, < or >.
+ %
+ % The natural comparison operation on sets is the partial order given
+ % by the subset relation. This predicate implements a total order;
+ % it is intended to allow the use of sets in data structures that
+ % require a total order on items. For example, set_ordlist(T) requires
+ % T to support a total order, so the ability to construct sets
+ % containing sets requires sets to have a total comparison operation.
+ % This predicate is that operation.
+ %
+:- pred set_ordlist__compare_total_order(comparison_result::uo,
+ set_ordlist(T)::in, set_ordlist(T)::in) is det.
+
% `set_ordlist__empty(Set)' is true iff `Set' is an empty set.
%
:- pred set_ordlist__empty(set_ordlist(_T)::in) is semidet.
@@ -270,48 +284,97 @@
:- import_module list, std_util.
-:- type set_ordlist(T) == list(T).
+:- type set_ordlist(T)
+ ---> ord(list(T)).
+ % You can add
+ %
+ % where equality is set_ordlist__equal,
+ % comparison is set_ordlist__compare_total_order.
+ %
+ % if you wish; the code below has had the proper promises added to it
+ % to make this work. However, for set_ordlist, unlike set_unordlist,
+ % the default syntactic unify and compare predicates are semantically
+ % valid. Since adding user-defined equality and comparison slows things
+ % down slightly (you need to call unify for set_ordlist, which calls
+ % unify for list, instead of calling unify for list directly), we
+ % use the default unify and compare.
-set_ordlist__list_to_set(List0, List) :-
+set_ordlist__list_to_set(List0, ord(List)) :-
list__sort_and_remove_dups(List0, List).
-set_ordlist__from_list(List0) = List :-
- set_ordlist__list_to_set(List0, List).
+set_ordlist__from_list(List0) = Set :-
+ set_ordlist__list_to_set(List0, Set).
-set_ordlist__sorted_list_to_set(List0, List) :-
+set_ordlist__sorted_list_to_set(List0, ord(List)) :-
list__remove_adjacent_dups(List0, List).
-set_ordlist__from_sorted_list(List0) = List :-
- set_ordlist__sorted_list_to_set(List0, List).
+set_ordlist__from_sorted_list(List0) = Set :-
+ set_ordlist__sorted_list_to_set(List0, Set).
-set_ordlist__to_sorted_list(List, List).
+set_ordlist__to_sorted_list(Set, List) :-
+ promise_equivalent_solutions [List] (
+ Set = ord(List)
+ ).
set_ordlist__insert_list(Set0, List0, Set) :-
list__sort_and_remove_dups(List0, List),
- set_ordlist__union(List, Set0, Set).
+ set_ordlist__union(ord(List), Set0, Set).
+
+set_ordlist__insert(Set0, Item, Set) :-
+ promise_equivalent_solutions [Set] (
+ Set0 = ord(List0),
+ set_ordlist__insert_2(Item, List0, List),
+ Set = ord(List)
+ ).
+
+:- pred set_ordlist__insert_2(T::in, list(T)::in, list(T)::out) is det.
-set_ordlist__insert([], E, [E]).
-set_ordlist__insert([I|Is], E, Js) :-
- compare(R, I, E),
+set_ordlist__insert_2(E, [], [E]).
+set_ordlist__insert_2(E, [H | T], L) :-
+ compare(R, H, E),
(
R = (<),
- set_ordlist__insert(Is, E, Ks),
- Js = [I|Ks]
+ set_ordlist__insert_2(E, T, LT),
+ L = [H | LT]
;
R = (=),
- Js = [I|Is]
+ L = [H | T]
;
R = (>),
- Js = [E,I|Is]
+ L = [E, H | T]
).
-set_ordlist__init([]).
+set_ordlist__init(ord([])).
-set_ordlist__singleton_set([X], X).
+:- pragma promise_pure(set_ordlist__singleton_set/2).
-set_ordlist__equal(Set, Set).
+set_ordlist__singleton_set(Set::in, Item::out) :-
+ promise_equivalent_solutions [List] (
+ Set = ord(List)
+ ),
+ List = [Item].
+set_ordlist__singleton_set(Set::out, Item::in) :-
+ Set = ord([Item]).
+
+set_ordlist__equal(SetA, SetB) :-
+ promise_equivalent_solutions [ListA, ListB] (
+ SetA = ord(ListA),
+ SetB = ord(ListB)
+ ),
+ ListA = ListB.
-set_ordlist__empty([]).
+set_ordlist__compare_total_order(Result, SetA, SetB) :-
+ promise_equivalent_solutions [ListA, ListB] (
+ SetA = ord(ListA),
+ SetB = ord(ListB)
+ ),
+ compare(Result, ListA, ListB).
+
+set_ordlist__empty(Set) :-
+ promise_equivalent_solutions [List] (
+ Set = ord(List)
+ ),
+ List = [].
set_ordlist__subset(Subset, Set) :-
set_ordlist__intersect(Set, Subset, Subset).
@@ -321,34 +384,45 @@
:- pragma promise_pure(set_ordlist__member/2).
-set_ordlist__member(E::out, S::in) :-
- list__member(E, S).
-set_ordlist__member(E::in, S::in) :-
- set_ordlist__is_member(E, S, yes).
-
-set_ordlist__is_member(_E, [], no).
-set_ordlist__is_member(E, [H | T], R) :-
- compare(Res, H, E),
+set_ordlist__member(Item::out, Set::in) :-
+ promise_equivalent_solutions [List] (
+ Set = ord(List)
+ ),
+ list__member(Item, List).
+set_ordlist__member(Item::in, Set::in) :-
+ set_ordlist__is_member(Item, Set, yes).
+
+set_ordlist__is_member(Item, Set, IsMember) :-
+ promise_equivalent_solutions [IsMember] (
+ Set = ord(List),
+ set_ordlist__is_member_2(Item, List, IsMember)
+ ).
+
+:- pred set_ordlist__is_member_2(T::in, list(T)::in, bool::out) is det.
+
+set_ordlist__is_member_2(_Item, [], no).
+set_ordlist__is_member_2(Item, [H | T], IsMember) :-
+ compare(Res, H, Item),
(
Res = (<),
- set_ordlist__is_member(E, T, R)
+ set_ordlist__is_member_2(Item, T, IsMember)
;
Res = (=),
- R = yes
+ IsMember = yes
;
Res = (>),
- R = no
+ IsMember = no
).
-set_ordlist__contains(S, E) :-
- set_ordlist__member(E, S).
+set_ordlist__contains(Set, Item) :-
+ set_ordlist__member(Item, Set).
-set_ordlist__delete_list(S0, D, S) :-
- list__sort_and_remove_dups(D, DS),
- set_ordlist__difference(S0, DS, S).
+set_ordlist__delete_list(Set0, ToDelete, Set) :-
+ list__sort_and_remove_dups(ToDelete, ToDeleteSet),
+ set_ordlist__difference(Set0, ord(ToDeleteSet), Set).
set_ordlist__delete(Set0, Elem, Set) :-
- set_ordlist__difference(Set0, [Elem], Set).
+ set_ordlist__difference(Set0, ord([Elem]), Set).
set_ordlist__remove_list(Set0, Elems, Set) :-
set_ordlist__sort_no_dups(Elems, ElemSet),
@@ -361,11 +435,12 @@
:- pred set_ordlist__sort_no_dups(list(T)::in, set_ordlist(T)::out) is semidet.
set_ordlist__sort_no_dups(List, Set) :-
- list__sort(List, Set),
+ list__sort(List, SortedList),
+ ord(SortedList) = Set,
(
- Set = []
+ SortedList = []
;
- Set = [Elem|Elems],
+ SortedList = [Elem | Elems],
set_ordlist__no_dups(Elem, Elems)
).
@@ -374,86 +449,147 @@
:- pred set_ordlist__no_dups(T::in, list(T)::in) is semidet.
set_ordlist__no_dups(_, []).
-set_ordlist__no_dups(Elem, [Elem0|Elems]) :-
- Elem \= Elem0,
- set_ordlist__no_dups(Elem0, Elems).
+set_ordlist__no_dups(Elem, [Head | Tail]) :-
+ Elem \= Head,
+ set_ordlist__no_dups(Head, Tail).
set_ordlist__remove(Set0, Elem, Set) :-
- list__delete_first(Set0, Elem, Set).
+ promise_equivalent_solutions [List0] (
+ Set0 = ord(List0)
+ ),
+ list__delete_first(List0, Elem, List),
+ Set = ord(List).
-set_ordlist__remove_least([Elem|Set], Elem, Set).
+set_ordlist__remove_least(Set0, Elem, Set) :-
+ promise_equivalent_solutions [List] (
+ Set0 = ord(List)
+ ),
+ List = [Elem | Rest],
+ Set = ord(Rest).
-set_ordlist__union(Set0, Set1, Set) :-
- list__merge_and_remove_dups(Set0, Set1, Set).
+set_ordlist__union(SetA, SetB, Set) :-
+ promise_equivalent_solutions [Set] (
+ SetA = ord(ListA),
+ SetB = ord(ListB),
+ list__merge_and_remove_dups(ListA, ListB, List),
+ Set = ord(List)
+ ).
set_ordlist__union_list(ListofSets) = Set :-
set_ordlist__init(Set0),
set_ordlist__power_union_2(ListofSets, Set0, Set).
set_ordlist__power_union(SetofSets, Set) :-
+ promise_equivalent_solutions [Set] (
+ SetofSets = ord(ListofSets),
set_ordlist__init(Set0),
- set_ordlist__power_union_2(SetofSets, Set0, Set).
+ set_ordlist__power_union_2(ListofSets, Set0, Set)
+ ).
-:- pred set_ordlist__power_union_2(list(set_ordlist(T))::in, set_ordlist(T)::in,
- set_ordlist(T)::out) is det.
+:- pred set_ordlist__power_union_2(list(set_ordlist(T))::in,
+ set_ordlist(T)::in, set_ordlist(T)::out) is det.
set_ordlist__power_union_2([], Set, Set).
-set_ordlist__power_union_2([NextSet|SetofSets], Set0, Set) :-
+set_ordlist__power_union_2([NextSet | SetofSets], Set0, Set) :-
set_ordlist__union(Set0, NextSet, Set1),
set_ordlist__power_union_2(SetofSets, Set1, Set).
-set_ordlist__intersect([], _, []).
-set_ordlist__intersect([_|_], [], []).
-set_ordlist__intersect([X|Xs], [Y|Ys], Set) :-
+:- pragma promise_pure(set_ordlist__intersect/3).
+
+set_ordlist__intersect(SetA::in, SetB::in, Set::in) :-
+ promise_equivalent_solutions [ListA, ListB, List] (
+ SetA = ord(ListA),
+ SetB = ord(ListB),
+ Set = ord(List)
+ ),
+ set_ordlist__intersect_2(ListA, ListB, List).
+set_ordlist__intersect(SetA::in, SetB::in, Set::out) :-
+ promise_equivalent_solutions [Set] (
+ SetA = ord(ListA),
+ SetB = ord(ListB),
+ set_ordlist__intersect_2(ListA, ListB, List),
+ Set = ord(List)
+ ).
+
+:- pred set_ordlist__intersect_2(list(T), list(T), list(T)).
+:- mode set_ordlist__intersect_2(in, in, in) is semidet.
+:- mode set_ordlist__intersect_2(in, in, out) is det.
+
+set_ordlist__intersect_2([], _, []).
+set_ordlist__intersect_2([_ | _], [], []).
+set_ordlist__intersect_2([X | Xs], [Y | Ys], Set) :-
compare(R, X, Y),
(
R = (<),
- set_ordlist__intersect(Xs, [Y|Ys], Set)
+ set_ordlist__intersect_2(Xs, [Y | Ys], Set)
;
R = (=),
- set_ordlist__intersect(Xs, Ys, Set0),
- Set = [X|Set0]
+ set_ordlist__intersect_2(Xs, Ys, Set0),
+ Set = [X | Set0]
;
R = (>),
- set_ordlist__intersect([X|Xs], Ys, Set)
+ set_ordlist__intersect_2([X | Xs], Ys, Set)
).
-set_ordlist__power_intersect([], []).
-set_ordlist__power_intersect([S0|Ss], S) :-
+set_ordlist__power_intersect(SetOfSets, Set) :-
+ promise_equivalent_solutions [Set] (
+ SetOfSets = ord(ListOfSets),
+ set_ordlist__power_intersect_2(ListOfSets, Set)
+ ).
+
+:- pred set_ordlist__power_intersect_2(list(set_ordlist(T))::in,
+ set_ordlist(T)::out) is det.
+
+set_ordlist__power_intersect_2([], ord([])).
+set_ordlist__power_intersect_2([Head | Tail], Set) :-
(
- Ss = []
- ->
- S = S0
+ Tail = [],
+ Set = Head
;
- set_ordlist__power_intersect(Ss, S1),
- set_ordlist__intersect(S1, S0, S)
+ Tail = [_ | _],
+ set_ordlist__power_intersect_2(Tail, TailIntersect),
+ set_ordlist__intersect(TailIntersect, Head, Set)
).
-set_ordlist__intersect_list(Sets) =
- set_ordlist__power_intersect(Sets).
+set_ordlist__intersect_list(Sets) = Set :-
+ set_ordlist__power_intersect_2(Sets, Set).
%--------------------------------------------------------------------------%
-set_ordlist__difference([], _, []).
-set_ordlist__difference([X|Xs], [], [X|Xs]).
-set_ordlist__difference([X|Xs], [Y|Ys], Set) :-
+set_ordlist__difference(SetA, SetB, Set) :-
+ promise_equivalent_solutions [Set] (
+ SetA = ord(ListA),
+ SetB = ord(ListB),
+ set_ordlist__difference_2(ListA, ListB, List),
+ Set = ord(List)
+ ).
+
+:- pred set_ordlist__difference_2(list(T)::in, list(T)::in,
+ list(T)::out) is det.
+
+set_ordlist__difference_2([], _, []).
+set_ordlist__difference_2([X | Xs], [], [X | Xs]).
+set_ordlist__difference_2([X | Xs], [Y | Ys], Set) :-
compare(R, X, Y),
(
R = (<),
- set_ordlist__difference(Xs, [Y|Ys], Set0),
- Set = [X|Set0]
+ set_ordlist__difference_2(Xs, [Y | Ys], Set0),
+ Set = [X | Set0]
;
R = (=),
- set_ordlist__difference(Xs, Ys, Set)
+ set_ordlist__difference_2(Xs, Ys, Set)
;
R = (>),
- set_ordlist__difference([X|Xs], Ys, Set)
+ set_ordlist__difference_2([X | Xs], Ys, Set)
).
%--------------------------------------------------------------------------%
set_ordlist__count(Set, Count) :-
- list__length(Set, Count).
+ promise_equivalent_solutions [Count] (
+ Set = ord(List),
+ list__length(List, Count)
+ ).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -519,37 +655,43 @@
% The calls to reverse allow us to make set_ordlist__divide_2 tail
% recursive. This costs us a higher constant factor, but allows
% set_ordlist__divide to work in constant stack space.
-set_ordlist__divide(Pred, Set, TruePart, FalsePart) :-
- set_ordlist__divide_2(Pred, Set, [], RevTruePart, [], RevFalsePart),
+set_ordlist__divide(Pred, Set, TrueSet, FalseSet) :-
+ promise_equivalent_solutions [TrueSet, FalseSet] (
+ Set = ord(List),
+ set_ordlist__divide_2(Pred, List,
+ [], RevTruePart, [], RevFalsePart),
list__reverse(RevTruePart, TruePart),
- list__reverse(RevFalsePart, FalsePart).
+ list__reverse(RevFalsePart, FalsePart),
+ TrueSet = ord(TruePart),
+ FalseSet = ord(FalsePart)
+ ).
-:- pred set_ordlist__divide_2(pred(T)::in(pred(in) is semidet),
- set_ordlist(T)::in,
- set_ordlist(T)::in, set_ordlist(T)::out,
- set_ordlist(T)::in, set_ordlist(T)::out) is det.
+:- pred set_ordlist__divide_2(pred(T)::in(pred(in) is semidet), list(T)::in,
+ list(T)::in, list(T)::out, list(T)::in, list(T)::out) is det.
-set_ordlist__divide_2(_Pred, [], RevTrue, RevTrue, RevFalse, RevFalse).
-set_ordlist__divide_2(Pred, [H | T], RevTrue0, RevTrue, RevFalse0, RevFalse) :-
+set_ordlist__divide_2(_Pred, [], !RevTrue, !RevFalse).
+set_ordlist__divide_2(Pred, [H | T], !RevTrue, !RevFalse) :-
( call(Pred, H) ->
- RevTrue1 = [H | RevTrue0],
- RevFalse1 = RevFalse0
+ !:RevTrue = [H | !.RevTrue]
;
- RevTrue1 = RevTrue0,
- RevFalse1 = [H | RevFalse0]
+ !:RevFalse = [H | !.RevFalse]
),
- set_ordlist__divide_2(Pred, T, RevTrue1, RevTrue, RevFalse1, RevFalse).
+ set_ordlist__divide_2(Pred, T, !RevTrue, !RevFalse).
-set_ordlist__divide_by_set(DivideBySet, Set, TruePart, FalsePart) :-
- set_ordlist__divide_by_set_2(DivideBySet, Set,
+set_ordlist__divide_by_set(DivideBySet, Set, TrueSet, FalseSet) :-
+ promise_equivalent_solutions [TrueSet, FalseSet] (
+ DivideBySet = ord(DivideByList),
+ Set = ord(List),
+ set_ordlist__divide_by_set_2(DivideByList, List,
[], RevTruePart, [], RevFalsePart),
list__reverse(RevTruePart, TruePart),
- list__reverse(RevFalsePart, FalsePart).
+ list__reverse(RevFalsePart, FalsePart),
+ TrueSet = ord(TruePart),
+ FalseSet = ord(FalsePart)
+ ).
-:- pred set_ordlist__divide_by_set_2(set_ordlist(T1)::in,
- set_ordlist(T1)::in,
- set_ordlist(T1)::in, set_ordlist(T1)::out,
- set_ordlist(T1)::in, set_ordlist(T1)::out) is det.
+:- pred set_ordlist__divide_by_set_2(list(T1)::in, list(T1)::in,
+ list(T1)::in, list(T1)::out, list(T1)::in, list(T1)::out) is det.
set_ordlist__divide_by_set_2([], [], !RevTrue, !RevFalse).
set_ordlist__divide_by_set_2([], [H | T], !RevTrue, !RevFalse) :-
Index: library/set_unordlist.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/set_unordlist.m,v
retrieving revision 1.23
diff -u -b -r1.23 set_unordlist.m
--- library/set_unordlist.m 24 Jan 2005 23:16:39 -0000 1.23
+++ library/set_unordlist.m 5 Apr 2005 15:01:01 -0000
@@ -5,7 +5,7 @@
%---------------------------------------------------------------------------%
% File: set_unordlist.m.
-% Main authors: conway, fjh.
+% Main authors: conway, fjh, zs.
% Stability: medium.
% This file contains a `set' ADT.
@@ -67,6 +67,23 @@
:- pred set_unordlist__equal(set_unordlist(T)::in, set_unordlist(T)::in)
is semidet.
+ % `set_unordlist__compare_total_order(R, SetA, SetB)' is true iff
+ % to_sorted_list(SetA) R to_sorted_list(SetB), where R is =, < or >.
+ %
+ % The natural comparison operation on sets is the partial order given
+ % by the subset relation. This predicate implements a total order;
+ % it is intended to allow the use of sets in data structures that
+ % require a total order on items. For example, map(K, V) requires
+ % K to support a total order, so the ability to construct maps
+ % with sets as keys requires sets to have a total comparison operation.
+ % This predicate is that operation.
+ %
+ % This operation requires sorting both lists, and is therefore not very
+ % efficient.
+ %
+:- pred set_unordlist__compare_total_order(comparison_result::uo,
+ set_unordlist(T)::in, set_unordlist(T)::in) is det.
+
% `set_unordlist__empty(Set)' is true iff `Set' is an empty set.
%
:- pred set_unordlist__empty(set_unordlist(_T)::in) is semidet.
@@ -243,134 +260,202 @@
:- import_module list, std_util.
-:- type set_unordlist(T) == list(T).
+:- type set_unordlist(T)
+ ---> unord(list(T)) where
+ equality is set_unordlist__equal,
+ comparison is set_unordlist__compare_total_order.
-set_unordlist__list_to_set(List, List).
+set_unordlist__list_to_set(List, unord(List)).
-set_unordlist__from_list(List) = List.
+set_unordlist__from_list(List) = unord(List).
-set_unordlist__sorted_list_to_set(List, List).
+set_unordlist__sorted_list_to_set(List, unord(List)).
-set_unordlist__from_sorted_list(List) = List.
+set_unordlist__from_sorted_list(List) = unord(List).
set_unordlist__to_sorted_list(Set, List) :-
- list__sort_and_remove_dups(Set, List).
+ promise_equivalent_solutions [List] (
+ Set = unord(UnsortedList),
+ list__sort_and_remove_dups(UnsortedList, List)
+ ).
-set_unordlist__insert_list(Set0, List, Set) :-
- list__append(List, Set0, Set).
+set_unordlist__insert_list(Set0, Items, Set) :-
+ promise_equivalent_solutions [Set] (
+ Set0 = unord(List0),
+ list__append(Items, List0, List),
+ Set = unord(List)
+ ).
+
+set_unordlist__insert(Set0, Item, Set) :-
+ promise_equivalent_solutions [Set] (
+ Set0 = unord(List0),
+ Set = unord([Item | List0])
+ ).
-set_unordlist__insert(S0, E, [E|S0]).
+set_unordlist__init(unord([])).
-set_unordlist__init([]).
+:- pragma promise_pure(set_unordlist__singleton_set/2).
-set_unordlist__singleton_set([X], X).
+set_unordlist__singleton_set(Set::in, X::out) :-
+ set_unordlist__to_sorted_list(Set, SortedList),
+ SortedList = [X].
+set_unordlist__singleton_set(Set::out, X::in) :-
+ Set = unord([X]).
+
+ % The compiler currently can't figure out that these predicates
+ % terminate because the implementation of set_unordlist__to_sorted_list
+ % depends on code from another module.
+:- pragma terminates(set_unordlist__equal/2).
+:- pragma terminates(set_unordlist__compare_total_order/3).
set_unordlist__equal(SetA, SetB) :-
- set_unordlist__subset(SetA, SetB),
- set_unordlist__subset(SetB, SetA).
+ set_unordlist__to_sorted_list(SetA, SortedListA),
+ set_unordlist__to_sorted_list(SetB, SortedListB),
+ SortedListA = SortedListB.
+
+set_unordlist__compare_total_order(Result, SetA, SetB) :-
+ set_unordlist__to_sorted_list(SetA, SortedListA),
+ set_unordlist__to_sorted_list(SetB, SortedListB),
+ compare(Result, SortedListA, SortedListB).
+
+set_unordlist__empty(Set) :-
+ set_unordlist__to_sorted_list(Set, SortedList),
+ SortedList = [].
+
+set_unordlist__subset(SetA, SetB) :-
+ set_unordlist__to_sorted_list(SetA, SortedListA),
+ set_unordlist__to_sorted_list(SetB, SortedListB),
+ set_unordlist__subset_2(SortedListA, SortedListB).
+
+:- pred set_unordlist__subset_2(list(T)::in, list(T)::in) is semidet.
+
+set_unordlist__subset_2([], _).
+set_unordlist__subset_2([H | T], SuperSet) :-
+ list__member(H, SuperSet),
+ set_unordlist__subset_2(T, SuperSet).
-set_unordlist__empty([]).
+set_unordlist__superset(SetA, SetB) :-
+ set_unordlist__subset(SetB, SetA).
-set_unordlist__subset([], _).
-set_unordlist__subset([E|S0], S1) :-
- set_unordlist__member(E, S1),
- set_unordlist__subset(S0, S1).
-
-set_unordlist__superset(S0, S1) :-
- set_unordlist__subset(S1, S0).
-
-set_unordlist__member(E, S) :-
- list__member(E, S).
-
-set_unordlist__is_member(E, S, R) :-
- ( set_unordlist__member(E, S) ->
- R = yes
+set_unordlist__member(Item, Set) :-
+ set_unordlist__to_sorted_list(Set, SortedList),
+ list__member(Item, SortedList).
+
+set_unordlist__is_member(Item, Set, IsMember) :-
+ ( set_unordlist__member(Item, Set) ->
+ IsMember = yes
;
- R = no
+ IsMember = no
).
set_unordlist__contains(S, E) :-
set_unordlist__member(E, S).
-set_unordlist__delete_list(S, [], S).
-set_unordlist__delete_list(S0, [X | Xs], S) :-
- set_unordlist__delete(S0, X, S1),
- set_unordlist__delete_list(S1, Xs, S).
-
-set_unordlist__delete(S0, E, S) :-
- list__delete_all(S0, E, S).
-
-set_unordlist__remove_list(S, [], S).
-set_unordlist__remove_list(S0, [X | Xs], S) :-
- set_unordlist__remove(S0, X, S1),
- set_unordlist__remove_list(S1, Xs, S).
-
-set_unordlist__remove(S0, E, S) :-
- list__member(E, S0),
- set_unordlist__delete(S0, E, S).
-
-set_unordlist__remove_least(Set0, E, Set) :-
- Set0 = [_|_], % fail early on an empty set
- set_unordlist__to_sorted_list(Set0, [E|Set]).
+set_unordlist__delete_list(Set, [], Set).
+set_unordlist__delete_list(Set0, [H | T], Set) :-
+ set_unordlist__delete(Set0, H, Set1),
+ set_unordlist__delete_list(Set1, T, Set).
+
+set_unordlist__delete(Set0, Item, Set) :-
+ promise_equivalent_solutions [Set] (
+ Set0 = unord(List0),
+ list__delete_all(List0, Item, List),
+ Set = unord(List)
+ ).
-set_unordlist__union(Set0, Set1, Set) :-
- list__append(Set1, Set0, Set).
+set_unordlist__remove_list(Set, [], Set).
+set_unordlist__remove_list(Set0, [H | T], Set) :-
+ set_unordlist__remove(Set0, H, Set1),
+ set_unordlist__remove_list(Set1, T, Set).
+
+set_unordlist__remove(Set0, Item, Set) :-
+ set_unordlist__member(Item, Set0),
+ set_unordlist__delete(Set0, Item, Set).
+
+set_unordlist__remove_least(Set0, Item, Set) :-
+ set_unordlist__to_sorted_list(Set0, SortedList0),
+ SortedList0 = [Item | SortedList],
+ Set = unord(SortedList).
+
+set_unordlist__union(SetA, SetB, Set) :-
+ promise_equivalent_solutions [Set] (
+ SetA = unord(ListA),
+ SetB = unord(ListB),
+ list__append(ListB, ListA, List),
+ Set = unord(List)
+ ).
set_unordlist__union_list(LS) = S :-
- set_unordlist__power_union(LS, S).
+ set_unordlist__power_union(unord(LS), S).
-set_unordlist__power_union(PS, S) :-
- set_unordlist__init(S0),
- set_unordlist__power_union_2(PS, S0, S1),
- list__sort_and_remove_dups(S1, S).
+set_unordlist__power_union(PowerSet, Union) :-
+ promise_equivalent_solutions [Union] (
+ PowerSet = unord(PowerList),
+ set_unordlist__power_union_2(PowerList,
+ set_unordlist__init, UnionPrime),
+ set_unordlist__optimize(UnionPrime, Union)
+ ).
:- pred set_unordlist__power_union_2(list(set_unordlist(T))::in,
set_unordlist(T)::in, set_unordlist(T)::out) is det.
-set_unordlist__power_union_2([], S, S).
-set_unordlist__power_union_2([T|Ts], S0, S) :-
- set_unordlist__union(S0, T, S1),
- set_unordlist__power_union_2(Ts, S1, S).
-
-set_unordlist__intersect(S0, S1, S) :-
- set_unordlist__intersect_2(S0, S1, [], S).
+set_unordlist__power_union_2([], !S).
+set_unordlist__power_union_2([T | Ts], !S) :-
+ set_unordlist__union(!.S, T, !:S),
+ set_unordlist__power_union_2(Ts, !S).
+
+set_unordlist__intersect(SetA, SetB, Set) :-
+ promise_equivalent_solutions [Set] (
+ SetA = unord(ListA),
+ SetB = unord(ListB),
+ set_unordlist__intersect_2(ListA, ListB, [], List),
+ Set = unord(List)
+ ).
-:- pred set_unordlist__intersect_2(set_unordlist(T)::in, set_unordlist(T)::in,
- set_unordlist(T)::in, set_unordlist(T)::out) is det.
+:- pred set_unordlist__intersect_2(list(T)::in, list(T)::in, list(T)::in,
+ list(T)::out) is det.
-set_unordlist__intersect_2([], _, S, S).
-set_unordlist__intersect_2([E|S0], S1, S2, S) :-
- ( list__member(E, S1) ->
- S3 = [E|S2]
+set_unordlist__intersect_2([], _, !Set).
+set_unordlist__intersect_2([H | T], TestSet, !Set) :-
+ ( list__member(H, TestSet) ->
+ !:Set = [H | !.Set]
;
- S3 = S2
+ true
),
- set_unordlist__intersect_2(S0, S1, S3, S).
+ set_unordlist__intersect_2(T, TestSet, !Set).
-set_unordlist__power_intersect([], []).
-set_unordlist__power_intersect([S0|Ss], S) :-
- ( Ss = [] ->
- S = S0
- ;
- set_unordlist__power_intersect(Ss, S1),
- set_unordlist__intersect(S1, S0, S)
+set_unordlist__power_intersect(Sets, Intersection) :-
+ promise_equivalent_solutions [Intersection] (
+ Sets = unord(Lists),
+ Intersection = set_unordlist__intersect_list(Lists)
).
-set_unordlist__intersect_list(Sets) =
- set_unordlist__power_intersect(Sets).
+set_unordlist__intersect_list([]) = unord([]).
+set_unordlist__intersect_list([H | T]) = Set :-
+ (
+ T = [],
+ Set = H
+ ;
+ T = [_ | _],
+ Set1 = set_unordlist__intersect_list(T),
+ set_unordlist__intersect(Set1, H, Set)
+ ).
%--------------------------------------------------------------------------%
-set_unordlist__difference(A, B, C) :-
- set_unordlist__difference_2(B, A, C).
+set_unordlist__difference(SetA, SetB, Set) :-
+ promise_equivalent_solutions [Set] (
+ SetB = unord(ListB),
+ set_unordlist__delete_list_elements(ListB, SetA, Set)
+ ).
-:- pred set_unordlist__difference_2(set_unordlist(T)::in, set_unordlist(T)::in,
- set_unordlist(T)::out) is det.
+:- pred set_unordlist__delete_list_elements(list(T)::in,
+ set_unordlist(T)::in, set_unordlist(T)::out) is det.
-set_unordlist__difference_2([], C, C).
-set_unordlist__difference_2([E|Es], A, C) :-
- set_unordlist__delete(A, E, B),
- set_unordlist__difference_2(Es, B, C).
+set_unordlist__delete_list_elements([], !Set).
+set_unordlist__delete_list_elements([H | T], !Set) :-
+ set_unordlist__delete(!.Set, H, !:Set),
+ set_unordlist__delete_list_elements(T, !Set).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -430,23 +515,38 @@
set_unordlist__fold(F, S, A) = B :-
B = list__foldl(F, set_unordlist__to_sorted_list(S), A).
-set_unordlist__divide(Pred, Set, RevTruePart, RevFalsePart) :-
- set_unordlist__divide_2(Pred, Set, [], RevTruePart, [], RevFalsePart).
+set_unordlist__divide(Pred, Set, TrueSet, FalseSet) :-
+ promise_equivalent_solutions [TrueSet, FalseSet] (
+ Set = unord(List),
+ set_unordlist__divide_2(Pred, List,
+ [], RevTrueList, [], RevFalseList),
+ TrueSet = unord(RevTrueList),
+ FalseSet = unord(RevFalseList)
+ ).
:- pred set_unordlist__divide_2(pred(T1)::in(pred(in) is semidet),
- set_unordlist(T1)::in,
- set_unordlist(T1)::in, set_unordlist(T1)::out,
- set_unordlist(T1)::in, set_unordlist(T1)::out) is det.
-
-set_unordlist__divide_2(_Pred, [], RevTrue, RevTrue, RevFalse, RevFalse).
-set_unordlist__divide_2(Pred, [H | T],
- RevTrue0, RevTrue, RevFalse0, RevFalse) :-
+ list(T1)::in, list(T1)::in, list(T1)::out, list(T1)::in, list(T1)::out)
+ is det.
+
+set_unordlist__divide_2(_Pred, [], !RevTrue, !RevFalse).
+set_unordlist__divide_2(Pred, [H | T], !RevTrue, !RevFalse) :-
( call(Pred, H) ->
- RevTrue1 = [H | RevTrue0],
- RevFalse1 = RevFalse0
+ !:RevTrue = [H | !.RevTrue]
;
- RevTrue1 = RevTrue0,
- RevFalse1 = [H | RevFalse0]
+ !:RevFalse = [H | !.RevFalse]
),
- set_unordlist__divide_2(Pred, T,
- RevTrue1, RevTrue, RevFalse1, RevFalse).
+ set_unordlist__divide_2(Pred, T, !RevTrue, !RevFalse).
+
+%-----------------------------------------------------------------------------%
+
+:- pred set_unordlist__optimize(set_unordlist(T)::in, set_unordlist(T)::out)
+ is det.
+
+set_unordlist__optimize(Set0, Set) :-
+ promise_equivalent_solutions [Set] (
+ Set0 = unord(List0),
+ list__sort_and_remove_dups(List0, List),
+ Set = unord(List)
+ ).
+
+%-----------------------------------------------------------------------------%
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/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
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 tests
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
Index: tests/hard_coded/string_alignment_bug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/string_alignment_bug.m,v
retrieving revision 1.4
diff -u -b -r1.4 string_alignment_bug.m
--- tests/hard_coded/string_alignment_bug.m 21 Jan 2005 03:32:20 -0000 1.4
+++ tests/hard_coded/string_alignment_bug.m 7 Apr 2005 02:21:51 -0000
@@ -8,35 +8,34 @@
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io::di, io::uo) is det.
:- implementation.
-:- import_module bool, int, list, map, require, set_ordlist, std_util, string.
+:- import_module bool, int, list, map, require, std_util, string.
-main -->
- init_globals,
- { gen_tiles(10, 10, Tiles) },
- set_global("Tiles", Tiles),
- { init_selection(Selection) },
- set_global("Selection", Selection),
- { init_file(MFN) },
- set_global("CurrentFile", MFN).
- %main(bedit__setup, ["robot"]).
+main(!IO) :-
+ init_globals(!IO),
+ gen_tiles(10, 10, Tiles),
+ set_global("Tiles", Tiles, !IO),
+ init_selection(Selection),
+ set_global("Selection", Selection, !IO),
+ init_file(MFN),
+ set_global("CurrentFile", MFN, !IO).
:- pred init_file(maybe(string)::out) is det.
+
init_file(no).
%------------------------------------------------------------------------------%
:- type pos == pair(int).
-:- type selection == set_ordlist(pos).
+:- type selection == list(pos).
:- pred init_selection(selection::out) is det.
-init_selection(Sel) :-
- set_ordlist__init(Sel).
+init_selection([]).
%------------------------------------------------------------------------------%
@@ -78,73 +77,68 @@
%------------------------------------------------------------------------------%
-:- pred init_globals(io__state, io__state).
-:- mode init_globals(di, uo) is det.
-
-:- pred get_global(string, T, io__state, io__state).
-:- mode get_global(in, out, di, uo) is det.
-
-:- pred set_global(string, T, io__state, io__state).
-:- mode set_global(in, in, di, uo) is det.
+:- pred init_globals(io::di, io::uo) is det.
-:- import_module list, map, require, string, std_util.
+:- pred get_global(string::in, T::out, io::di, io::uo) is det.
-init_globals -->
- { my_map_init(Map) },
- { type_to_univ(Map, UMap1) },
- { copy(UMap1, UMap) },
- io__set_globals(UMap).
+:- pred set_global(string::in, T::in, io::di, io::uo) is det.
-get_global(Name, Value) -->
- io__get_globals(UMap0),
- (
- { univ_to_type(UMap0, Map0) }
- ->
- (
- { map__search(Map0, Name, UValue) }
- ->
- (
- { univ_to_type(UValue, Value0) }
- ->
- { Value = Value0 }
+:- import_module list.
+:- import_module map.
+:- import_module require.
+:- import_module string.
+:- import_module std_util.
+
+init_globals(!IO) :-
+ my_map_init(Map),
+ type_to_univ(Map, UMap1),
+ copy(UMap1, UMap),
+ io__set_globals(UMap, !IO).
+
+get_global(Name, Value, !IO) :-
+ io__get_globals(UMap0, !IO),
+ ( univ_to_type(UMap0, Map0) ->
+ ( map__search(Map0, Name, UValue) ->
+ ( univ_to_type(UValue, Value0) ->
+ Value = Value0
;
- { string__format(
+ string__format(
"globals: value for `%s' has bad type",
- [s(Name)], Str) },
- { error(Str) }
+ [s(Name)], Str),
+ error(Str)
)
;
- { string__format("globals: %s not found",
- [s(Name)], Str) },
- { error(Str) }
+ string__format("globals: %s not found",
+ [s(Name)], Str),
+ error(Str)
)
;
- { error("globals: global store stuffed up") }
+ error("globals: global store stuffed up")
).
-set_global(Name, Value) -->
- io__get_globals(UMap0),
+set_global(Name, Value, !IO) :-
+ io__get_globals(UMap0, !IO),
(
- { univ_to_type(UMap0, Map0) }
+ univ_to_type(UMap0, Map0)
->
- { type_to_univ(Value, UValue) },
- io__write_string("Current global store:\n"),
- io__write(Map0),
- nl,
- io__write_string("Adding `"),
- io__write_string(Name),
- io__write_string("': "),
- io__write(Value),
- nl,
- { map__set(Map0, Name, UValue, Map) },
- io__write_string("New global store:\n"),
- io__write(Map),
- nl,
- { type_to_univ(Map, UMap1) },
- { copy(UMap1, UMap) },
- io__set_globals(UMap)
+ type_to_univ(Value, UValue),
+ io__write_string("Current global store:\n", !IO),
+ io__write(Map0, !IO),
+ io__nl(!IO),
+ io__write_string("Adding `", !IO),
+ io__write_string(Name, !IO),
+ io__write_string("': ", !IO),
+ io__write(Value, !IO),
+ io__nl(!IO),
+ map__set(Map0, Name, UValue, Map),
+ io__write_string("New global store:\n", !IO),
+ io__write(Map, !IO),
+ io__nl(!IO),
+ type_to_univ(Map, UMap1),
+ copy(UMap1, UMap),
+ io__set_globals(UMap, !IO)
;
- { error("globals: global store stuffed up") }
+ error("globals: global store stuffed up")
).
:- pred my_map_init(map(string, univ)::out) is det.
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/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
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: 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