[m-dev.] diff: add more tests of user-defined equality

[Fergus Henderson]

Estimated hours taken: 0.5

tests/hard_coded/Mmakefile:
tests/hard_coded/myset.m:
tests/hard_coded/myset_test.m:
tests/hard_coded/myset_test.exp:
	Add some more tests of user-defined equality types.

Workspace: /home/mercury0/fjh/mercury
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.69
diff -u -d -r1.69 Mmakefile
--- Mmakefile	1999/10/26 15:01:46	1.69
+++ Mmakefile	1999/10/26 15:02:28
@@ -66,6 +66,7 @@
 	merge_and_remove_dups \
 	minint_bug \
 	mode_choice \
+	myset_test \
 	name_mangling \
 	no_fully_strict \
 	no_inline \
Index: tests/hard_coded/myset.m
===================================================================
RCS file: myset.m
diff -N myset.m
--- /dev/null	Wed Oct 27 01:10:20 1999
+++ myset.m	Wed Oct 27 01:06:35 1999
@@ -0,0 +1,86 @@
+:- module myset.
+:- interface.
+:- import_module list, io.
+:- type set(T).
+
+% convert list to set
+:- func set(list(T)) = set(T).
+
+% convert set to list
+:- pred set_to_list(set(T)::in, list(T)::out) is cc_multi.
+:- func set_to_sorted_list(set(T)) = list(T).
+
+% empty set
+:- func {} = set(T).
+:- pred is_empty(set(T)::in) is semidet.
+
+% singleton set
+:- func {T} = set(T).
+
+% union of two sets
+:- func set(T) + set(T) = set(T).
+:- mode in + in = out is det.
+
+% union of an element and a set
+:- func [T | set(T)] = set(T).
+% :- mode [in | in] = out is det.
+:- mode [out | out] = in is cc_nondet.
+
+:- pred print_myset_rep(set(T)::in, io__state::di, io__state::uo)
+	is cc_multi.
+
+:- implementation.
+:- import_module bool, require.
+
+:- type set(T) ---> set_rep(list(T))
+	where equality is set_equal.
+
+:- pred set_equal(set(T)::in, set(T)::in) is semidet.
+set_equal(Set1, Set2) :-
+	set_to_sorted_list(Set1) = set_to_sorted_list(Set2).
+
+set(List) = set_rep(List).
+
+set_to_list(set_rep(List), List).
+
+set_to_sorted_list(Set) =
+	promise_only_solution((pred(Sorted::out) is cc_multi :-
+		Set = set_rep(Unsorted),
+		list__sort(Unsorted, Sorted)
+	)).
+
+{} = set_rep([]).
+
+{X} = set_rep([X]).
+
+is_empty(Set) :-
+	promise_only_solution((pred(Empty::out) is cc_multi :-
+		Set = set_rep(List),
+		Empty = (if List = [] then yes else no)
+	)) = yes.
+
+Set1 + Set2 =
+	promise_only_solution((pred(Union::out) is cc_multi :-
+		Set1 = set_rep(List1),
+		Set2 = set_rep(List2),
+		list__append(List1, List2, UnionList),
+		Union = set_rep(UnionList)
+	)).
+
+% [Element | set_rep(Rest)] = set_rep([Element | Rest]).
+[Element | set_rep(Rest)] = UnionSet :-
+	( is_empty(UnionSet) ->
+		fail
+	;
+		UnionSet = set_rep(UnionList),
+		( UnionList = [Element1 | Rest1] ->
+			Element = Element1,
+			Rest = Rest1
+		;
+			error("unexpected non-empty list")
+		)
+	).
+
+print_myset_rep(set_rep(List)) -->
+	print("set_rep("), print(List), print(")").
+
Index: tests/hard_coded/myset_test.exp
===================================================================
RCS file: myset_test.exp
diff -N myset_test.exp
--- /dev/null	Wed Oct 27 01:10:20 1999
+++ myset_test.exp	Wed Oct 27 01:08:47 1999
@@ -0,0 +1,6 @@
+set_rep([1])
+set_rep([1, 2])
+set_rep([2, 1])
+1+set_rep([2])
+2+set_rep([1])
+yes
Index: tests/hard_coded/myset_test.m
===================================================================
RCS file: myset_test.m
diff -N myset_test.m
--- /dev/null	Wed Oct 27 01:10:20 1999
+++ myset_test.m	Wed Oct 27 01:05:53 1999
@@ -0,0 +1,32 @@
+% "Hello World" in Mercury.
+
+:- module myset_test.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+:- import_module myset, list.
+
+main -->
+	print_myset_rep({1}), nl,
+	print_myset_rep({1} + {2}), nl,
+	print_myset_rep({2} + {1}), nl,
+	( { {1} + {2} = [First | Rest] } ->
+		print(First), print("+"), print_myset_rep(Rest), nl
+	;
+		print("failed\n")
+	),
+	( { {2} + {1} = [First2 | Rest2] } ->
+		print(First2), print("+"), print_myset_rep(Rest2), nl
+	;
+		print("failed\n")
+	),
+	{ S1 = {3} + {4} },
+	{ S2 = {4} + {3} },
+	( { append([S1], [S2], [S2, S1]) } ->
+		print("yes"), nl
+	;
+		print("no"), nl
+	).

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------