[m-rev.] java type class support

[Fergus Henderson]

Estimated hours taken: 1
Branches: main

library/private_builtin.m:
	Provide Java implementations of the typeclass-related builtins.

tests/hard_coded/typeclasses/Mmakefile:
	Enable some of the tests in this directory for grade java,
	since they now pass.

tests/hard_coded/typeclasses/impure_methods.m:
	Provide Java foreign_proc clauses, to match the C# ones.

Workspace: /home/jupiter/fjh/ws-jupiter/mercury
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.135
diff -u -d -r1.135 private_builtin.m
--- library/private_builtin.m	9 Feb 2004 11:54:58 -0000	1.135
+++ library/private_builtin.m	20 Feb 2004 05:27:31 -0000
@@ -380,6 +380,45 @@
 
 ").
 
+:- pragma foreign_code("Java", "
+
+public static TypeInfo_Struct
+MR_typeclass_info_param_type_info(/* typeclass_info */ Object[] tcinfo,
+	int index)
+{
+	/* typeclass_info */ Object[] base_tcinfo;
+	int t1;
+
+	base_tcinfo = (Object[]) tcinfo[0];
+	t1 = ((Integer) base_tcinfo[0]).intValue() + index;
+	return (TypeInfo_Struct) tcinfo[t1];
+}
+
+public static TypeInfo_Struct MR_typeclass_info_instance_tvar_type_info(
+	/* typeclass_info */ Object[] tcinfo, int index) 
+{
+	return (TypeInfo_Struct) tcinfo[index];
+}
+
+public static /* typeclass_info */ Object[] MR_typeclass_info_superclass_info(
+	/* typeclass_info */ Object[] tcinfo, int index)
+{
+	/* typeclass_info */ Object[] base_tcinfo;
+	int t1;
+
+	base_tcinfo = (Object[]) tcinfo[0];
+	t1 = ((Integer) base_tcinfo[0]).intValue() + index;
+	return (/* typeclass_info */ Object[]) tcinfo[t1];
+}
+
+public static /* typeclass_info */ Object[] MR_typeclass_info_arg_typeclass_info(
+	/* typeclass_info */ Object[] tcinfo, int index) 
+{
+	return (/* typeclass_info */ Object[]) tcinfo[index];
+}
+
+").
+
 :- pragma foreign_code("C#", "
 
 	// XXX These static constants are duplicated both here and in
@@ -570,6 +609,42 @@
 "
 	TypeClassInfo =
 		MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
+").
+
+:- pragma foreign_proc("Java",
+	type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
+		TypeInfo::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	TypeInfo = MR_typeclass_info_param_type_info(
+			(Object[]) TypeClassInfo, Index);
+").
+
+:- pragma foreign_proc("Java",
+	unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
+		Index::in, TypeInfo::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	TypeInfo = MR_typeclass_info_instance_tvar_type_info(
+			(Object[]) TypeClassInfo, Index);
+").
+
+:- pragma foreign_proc("Java",
+	superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
+		TypeClassInfo::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	TypeClassInfo = MR_typeclass_info_superclass_info(
+			(Object[]) TypeClassInfo0, Index);
+").
+
+:- pragma foreign_proc("Java",
+	instance_constraint_from_typeclass_info(TypeClassInfo0::in,
+		Index::in, TypeClassInfo::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	TypeClassInfo = MR_typeclass_info_arg_typeclass_info(
+			(Object[]) TypeClassInfo0, Index);
 ").
 
 %-----------------------------------------------------------------------------%
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.51
diff -u -d -r1.51 Mmakefile
--- tests/hard_coded/typeclasses/Mmakefile	12 Jan 2003 22:33:27 -0000	1.51
+++ tests/hard_coded/typeclasses/Mmakefile	20 Feb 2004 05:53:36 -0000
@@ -65,9 +65,30 @@
 	use_abstract_instance \
 	use_abstract_typeclass
 
-# We currently don't do any testing in grade java on this directory.
+# XXX We currently do only limited testing in grade java on this directory.
+
+JAVA_TYPECLASSES_PROGS= \
+	ground_constraint \
+	implied_instance \
+	implied_instance_poly \
+	impure_methods \
+	intermod_typeclass_bug \
+	lambda_multi_constraint_same_tvar \
+	multi_constraint_diff_tvar \
+	multi_constraint_same_tvar \
+	multi_parameter \
+	multi_parameter_bug \
+	nondet_class_method \
+	reordered_existential_constraint \
+	superclass_bug \
+	superclass_bug2 \
+	superclass_bug3 \
+	superclass_call \
+	test_default_func_mode \
+	typeclass_test_5
+
 ifneq "$(findstring java,$(GRADE))" ""
-	PROGS=
+	PROGS=$(JAVA_TYPECLASSES_PROGS)
 else
 	PROGS=$(TYPECLASSES_PROGS)
 endif
Index: tests/hard_coded/typeclasses/impure_methods.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/impure_methods.m,v
retrieving revision 1.2
diff -u -d -r1.2 impure_methods.m
--- tests/hard_coded/typeclasses/impure_methods.m	28 Nov 2002 13:14:40 -0000	1.2
+++ tests/hard_coded/typeclasses/impure_methods.m	20 Feb 2004 05:43:25 -0000
@@ -65,6 +65,13 @@
 :- pragma foreign_proc("C#", foo_m2(_F::in, Val::out),
 		[promise_semipure], "Val = foo_counter;").
 
+:- pragma foreign_code("Java", "static int foo_counter = 0;").
+
+:- pragma foreign_proc("Java", foo_m1(_F::in),
+		[], "foo_counter++;").
+:- pragma foreign_proc("Java", foo_m2(_F::in, Val::out),
+		[promise_semipure], "Val = foo_counter;").
+
 goo_m1(_).
 goo_m2(_, 42).
 
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------