for review: test cases for typeclasses

[David Glen JEFFERY]

Hi,

Fergus, can you please review these test cases and changes to the test module
to test the typeclasses stuff? These are only the hard_coded tests. I will
add the invalid tests once I have made the error messages from the compiler
a little nicer.

(BTW, I haven't included the .exp files in the diff because they're boring).


Estimated hours taken: 15

Added a new typeclass directory to hold the hard_coded typeclass tests.

hard_coded/Mmakefile:
	Execute everything in the typeclass subdirectory as well
hard_coded/typeclasses/{*.m,*.exp}:
	The new test cases
hard_coded/typeclasses/Mmakefile:
	Mmakefile for the typeclass tests.

Index: Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmakefile,v
retrieving revision 1.10
diff -u -r1.10 Mmakefile
--- Mmakefile	1998/01/22 07:12:28	1.10
+++ Mmakefile	1998/01/28 06:38:22
@@ -88,14 +88,33 @@
 
 #-----------------------------------------------------------------------------#
 
+SUBDIRS = typeclasses
+
+#-----------------------------------------------------------------------------#
+
 dep:	$(DEPS)
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && mmake $(MMAKEFLAGS) dep) || exit 1; \
+	done
 
 depend:	$(DEPENDS)
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && mmake $(MMAKEFLAGS) depend) || exit 1; \
+	done
 
 check:	$(OUTS) $(RESS)
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && mmake $(MMAKEFLAGS) check) || exit 1; \
+	done
 
 mods:	$(MODS)
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && mmake $(MMAKEFLAGS) mods) || exit 1; \
+	done
 
 all:	$(PROGS)
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && mmake $(MMAKEFLAGS) all) || exit 1; \
+	done
 
 #-----------------------------------------------------------------------------#

==== New File: hard_coded/typeclasses/Mmakefile ====

#-----------------------------------------------------------------------------#

main_target: check

include ../../Mmake.common

#-----------------------------------------------------------------------------#

PROGS=	\
	constrained_lambda \
	extract_typeinfo \
	ho_map \
	implied_instance \
	implied_instance_poly \
	multi_constraint_diff_tvar \
	multi_constraint_same_tvar \
	multi_parameter \
	nondet_class_method \
	operator_classname \
	superclass_call

# implied_instance_missing_constraint is not yet included as there is a bug
# stopping it from working.
#
# Actually, there is a bug, but it isn't in that test case. I'm trying to
# find exactly how to trigger the bug. Oh well...

#-----------------------------------------------------------------------------#

DEPS=	$(PROGS:%=%.dep)
DEPENDS=$(PROGS:%=%.depend)
OUTS=	$(PROGS:%=%.out)
RESS=	$(PROGS:%=%.res)
MODS=	$(PROGS:%=%.mod)

#-----------------------------------------------------------------------------#

dep:	$(DEPS)

depend:	$(DEPENDS)

check:	$(OUTS) $(RESS)

mods:	$(MODS)

all:	$(PROGS)

#-----------------------------------------------------------------------------#


==== New File: hard_coded/typeclasses/constrained_lambda.m ====

:- module constrained_lambda.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- implementation.

:- import_module list, int.

main -->  
	{ list__map(lambda([A::in, B::out] is det, p(A,B)), [1,2], X) }, 
	io__write(X),
	io__nl.

:- typeclass foo(T) where [
	pred p(T::in, T::out) is det
].

:- instance foo(int) where [
	pred(p/2) is blah
].

:- pred blah(int::in, int::out) is det.

blah(X, X+1).

==== New File: hard_coded/typeclasses/extract_typeinfo.m ====


:- module extract_typeinfo.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- implementation.

main -->
	p(1),
	io__nl.

:- import_module list.

:- typeclass foo(T) where [
	pred printit(T::in, io__state::di, io__state::uo) is det
].

:- instance foo(int) where [
	pred(printit/3) is io__write_int
].

:- pred p(T, io__state, io__state) <= foo(T).
:- mode p(in, di, uo) is det.

p(X) -->
	(
			% At this call, the type-info gets extracted from the
			% typeclass-info.
		{ list__append([X], [X], [X,X]) }
	->
		printit(X)
	;
		[]
	).

==== New File: hard_coded/typeclasses/ho_map.m ====

:- module ho_map.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- implementation.

:- import_module list, int.

main -->  
	{ list__map(p, [1,2], X) }, 
	io__write(X),
	io__nl.

:- typeclass foo(T) where [
	pred p(T::in, T::out) is det
].

:- instance foo(int) where [
	pred(p/2) is blah
].

:- pred blah(int::in, int::out) is det.

blah(X, X+1).

==== New File: hard_coded/typeclasses/implied_instance.m ====

:- module implied_instance.

:- interface.

:- pred main(io__state::di, io__state::uo) is det.

:- import_module io.

:- implementation.

:- import_module list.

:- typeclass printable(A) where [
	pred p(A::in, io__state::di, io__state::uo) is det
].

:- instance printable(int) where [
	pred(p/3) is io__write_int
].

:- instance printable(list(T)) <= printable(T) where [
	pred(p/3) is my_write_list
].

main -->
	p(2),
	io__write_string("\n"),
	p([42, 24, 1, 2, 3]),
	io__write_string("\n").


:- pred my_write_list(list(T), io__state, io__state) <= printable(T).
:- mode my_write_list(in, di, uo) is det.

my_write_list([]) --> 
	io__write_string("[]").
my_write_list([X|Xs]) --> 
	io__write_string("[\n"),
	my_write_list_2([X|Xs]),
	io__write_string("]").

:- pred my_write_list_2(list(T), io__state, io__state) <= printable(T).
:- mode my_write_list_2(in, di, uo) is det.

my_write_list_2([]) --> [].
my_write_list_2([X|Xs]) --> 
	p(X),
	io__write_string("\n"),
	my_write_list_2(Xs).


==== New File: hard_coded/typeclasses/implied_instance_missing_constraint.m ====

:- module implied_instance_missing_constraint.

:- interface.

:- pred main(io__state::di, io__state::uo) is det.

:- import_module io.

:- implementation.

:- import_module list, int.

:- typeclass printable(A) where [
	pred p(A::in, io__state::di, io__state::uo) is det,
	pred foo(A, A),
	mode foo(in, out) is det
].

:- instance printable(int) where [
	pred(p/3) is io__write_int,
	pred(foo/2) is foo_int
].

:- pred foo_int(int::in, int::out) is det.
foo_int(X, X+1).


	% This test case is interesting because the "printable(T)" constraint
	% below comes only from the implementation of p/3, not foo/2, so the
	% implementation needs to discard the typeclass_info for printable(T)
	% for that call.
	%
	% XXX we currently fail this
	%
	% XXX actually, there is a bug in this test, so we don't actually fail
	% XXX it at the moment. Soon I'll debug the test case so I can debug
	% XXX the compiler.
:- instance printable(list(T)) <= printable(T) where [
	pred(p/3) is my_write_list,
	pred(foo/2) is foo_list
].

:- pred foo_list(list(T)::in, list(T)::out) is det.
foo_list(X, Y) :-
	(
		X = [A,B|_],
		% Here's where it crashes... rather than the type-info, the
		% typeclass-info for foo(T) was erroneously passed.
		A = B
	->
		Y = X
	;
		Y = []
	).

main -->
	{ zzz([1,2,3], X) },
	p(X),
	io__nl.

:- pred zzz(T, T) <= printable(T).
:- mode zzz(in, out) is det.
:- pragma no_inline(zzz/2).

zzz(X, Y) :- foo(X, Y).


:- pred my_write_list(list(T), io__state, io__state) <= printable(T).
:- mode my_write_list(in, di, uo) is det.

my_write_list([]) --> 
	io__write_string("[]").
my_write_list([X|Xs]) --> 
	io__write_string("[\n"),
	my_write_list_2([X|Xs]),
	io__write_string("]").

:- pred my_write_list_2(list(T), io__state, io__state) <= printable(T).
:- mode my_write_list_2(in, di, uo) is det.

my_write_list_2([]) --> [].
my_write_list_2([X|Xs]) --> 
	p(X),
	io__write_string("\n"),
	my_write_list_2(Xs).


==== New File: hard_coded/typeclasses/implied_instance_poly.m ====

:- module implied_instance_poly.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- implementation.

:- import_module list.

:- typeclass f(T) where [
	pred p(T::in, io__state::di, io__state::uo) is det
].

:- instance f(int) where [
	pred(p/3) is io__write_int
].

:- instance f(list(T)) <= f(T) where [
	pred(p/3) is my_write_list
].

main --> foo(1), io__nl.

:- pred my_write_list(list(T), io__state, io__state) <= f(T).
:- mode my_write_list(in, di, uo) is det.


my_write_list(X) --> io__write_list(X, ", ", p).


:- pred foo(T, io__state, io__state) <= f(T).
:- mode foo(in, di, uo) is det.

foo(X) -->
	p([X, X, X]).

==== New File: hard_coded/typeclasses/multi_constraint_diff_tvar.m ====

:- module multi_constraint_diff_tvar.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- implementation.

:- typeclass c(T) where [
	pred p(T::in, io__state::di, io__state::uo) is det
].

:- instance c(int) where [
	pred(p/3) is io__write_int
].

:- pred foo(T1, T2, io__state, io__state) <= (c(T1), c(T2)).
:- mode foo(in, in, di, uo) is det.

foo(X, Y) -->
	p(X),
	p(Y),
	io__nl.

main --> foo(42, 24).

==== New File: hard_coded/typeclasses/multi_constraint_same_tvar.m ====

:- module multi_constraint_same_tvar.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- implementation.

:- typeclass c1(T) where [
	pred p1(T::in, io__state::di, io__state::uo) is det
].

:- instance c1(int) where [
	pred(p1/3) is io__write_int
].

:- typeclass c2(T) where [
	pred p2(T::in, io__state::di, io__state::uo) is det
].

:- instance c2(int) where [
	pred(p2/3) is io__write_int
].

:- pred foo(T, io__state, io__state) <= (c1(T), c2(T)).
:- mode foo(in, di, uo) is det.

foo(X) -->
	p1(X),
	p2(X),
	io__nl.

main --> foo(42).

==== New File: hard_coded/typeclasses/multi_parameter.m ====

:- module multi_parameter.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- implementation.

:- import_module char.

:- typeclass m(A, B) where [
	pred a(A, B),
	mode a(in, out) is det
].

:- instance m(char, int) where [
	pred(a/2) is char__to_int
].

main -->
	{ foo('z', X) },
	io__write_int(X),
	io__nl.

:- pred foo(A, B) <= m(A,B).
:- mode foo(in, out) is det.
:- pragma no_inline(foo/2).

foo(X, Y) :- a(X, Y).

==== New File: hard_coded/typeclasses/nondet_class_method.m ====

:- module nondet_class_method.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is cc_multi.

:- implementation.

:- import_module int.

:- typeclass c(T) where [
	pred a(T::out) is multi
].

:- instance c(int) where [
	pred(a/1) is foo
].

:- pred foo(int::out) is multi.
foo(1).
foo(2).
foo(3).
foo(4).
foo(5).
foo(6).

:- pred b(T) <= c(T).
:- mode b(out) is multi.
:- pragma no_inline(b/1).

b(X) :- a(X).

main -->
	(
		{ b(X) },
		{ X > 3 }
	->
		io__write_int(X)
	;
		io__write_string("failed")
	),
	io__nl.

==== New File: hard_coded/typeclasses/operator_classname.m ====

:- module operator_classname.

:- interface.

:- import_module io.

:- pred main(io__state::di, io__state::uo) is det.

:- typeclass +(T) where [
	pred p(T::in, io__state::di, io__state::uo) is det
].

:- instance +(int) where [
	pred(p/3) is io__write_int
].

:- implementation.

main --> foo(1), io__nl.


:- pred foo(T, io__state, io__state) <= +(T).
:- mode foo(in, di, uo) is det.

foo(X) --> p(X).

==== New File: hard_coded/typeclasses/superclass_call.m ====

:- module superclass_call.

:- interface.

:- pred main(io__state::di, io__state::uo) is det.

:- import_module io.

:- implementation.

:- typeclass printable(A) where [
	pred p(A::in, io__state::di, io__state::uo) is det
].

:- typeclass foo(A) <= printable(A) where [
	pred b(A::in) is semidet
].

:- instance printable(int) where [
	pred(p/3) is io__write_int
].

:- instance foo(int) where [
	pred(b/1) is foo_b
].

main -->
	p(42), 
	io__write_string("\n"),
	blah(101),
	io__write_string("\n").


:- pred foo_b(int::in) is semidet.
foo_b(1).

:- pred blah(T, io__state, io__state) <= foo(T).
:- mode blah(in, di, uo) is det.

blah(X) -->
	(
		% This also tests the semidet class method call mechanism
		{ b(X) }
	->
		io__write_string("true\n")
	;
		io__write_string("false\n")
	),

	% at this call to the superclass method, the printable typeclass_info
	% gets extracted from the foo typeclass_info.
	p(X).




love and cuddles,
dgj
-- 
David Jeffery (dgj at cs.mu.oz.au) |  Marge: Did you just call everyone "chicken"?
MEngSc student,                 |  Homer: Noooo.  I swear on this Bible!
Department of Computer Science  |  Marge: That's not a Bible; that's a book of
University of Melbourne         |         carpet samples!
Australia                       |  Homer: Ooooh... Fuzzy.