[m-rev.] For review: RTTI for Java

[James Goddard]

Estimated hours taken: 30 
Branches: main

Implement RTTI for the Java-backend (incomplete)

java/runtime/PseudoTypeInfo.java:
java/runtime/TypeCtorInfo_Struct.java:
java/runtime/TypeInfo_Struct.java:
	Implement the `unify' operation for these classes.  This implementation
	actually just compares them.

library/rtti_implementation.m:
	Change the foreign type of `type_info' from `TypeInfo_Struct' to
	`PseudoTypeInfo' in Java.

	Define the foreign type of `type_layout' as `TypeLayout' in Java.

	Correct an off-by-one error in type_ctor_and_args/3.

	Implement deconstruct/8 for TypeCtorRep = enum.

	Implement the following predicates in Java:
		get_var_arity_typeinfo_arity/1
		get_pti_from_arg_types/2
		typeinfo_is_variable/2
		get_type_ctor_info/1
		get_primary_tag/1
		get_remote_secondary_tag/1
		ptag_index/2
		sectag_locn/1
		du_sectag_alternatives/2
		type_info_index/2
		type_ctor_arity/1
		type_ctor_rep/1
		type_ctor_module_name/1
		type_ctor_name/1
		type_ctor_functors/1
		type_layout/1
		unsafe_cast/1
		du_functor_desc/3
		du_functor_name/1
		du_functor_arity/1
		du_functor_arg_type_contains_var/1
		du_functor_sectag_locn/1
		du_functor_primary/1
		du_functor_secondary/1
		du_functor_ordinal/1
		du_functor_arg_types/1
		du_functor_arg_names/1
		du_functor_exist_info/1
		enum_functor_desc/3
		enum_functor_name/1
		enum_functor_ordinal/1
		notag_functor_desc/3
		notag_functor_name/1
		notag_functor_arg_type/1
		notag_functor_arg_name/1
		null/1
		null_string/0
		unsafe_get_enum_value/1

library/type_desc.m:
	Implement the following procedures for Java:
		type_of/1
		has_type/1
		type_ctor_and_args/3
		type_ctor_name_and_arity/4
	
	Implement the Java classes `type_desc_0' and `type_ctor_desc_0'.



Index: java/runtime/PseudoTypeInfo.java
===================================================================
RCS file: /home/mercury1/repository/mercury/java/runtime/PseudoTypeInfo.java,v
retrieving revision 1.3
diff -u -d -r1.3 PseudoTypeInfo.java
--- java/runtime/PseudoTypeInfo.java	19 Feb 2004 09:37:20 -0000	1.3
+++ java/runtime/PseudoTypeInfo.java	20 Feb 2004 04:11:35 -0000
@@ -25,4 +25,13 @@
 	public int variable_number;
 	public    PseudoTypeInfo(int n) { variable_number = n; }
 	protected PseudoTypeInfo()      { variable_number = -1; }
+
+	public boolean unify(PseudoTypeInfo ti) {
+		if (this.getClass() == TypeInfo_Struct.class &&
+				ti.getClass() == TypeInfo_Struct.class) {
+			return ((TypeInfo_Struct) this).unify(
+						(TypeInfo_Struct) ti);
+		}
+		return variable_number == ti.variable_number;
+	}
 }
Index: java/runtime/TypeCtorInfo_Struct.java
===================================================================
RCS file: /home/mercury1/repository/mercury/java/runtime/TypeCtorInfo_Struct.java,v
retrieving revision 1.6
diff -u -d -r1.6 TypeCtorInfo_Struct.java
--- java/runtime/TypeCtorInfo_Struct.java	9 Feb 2004 11:54:51 -0000	1.6
+++ java/runtime/TypeCtorInfo_Struct.java	22 Feb 2004 03:45:50 -0000
@@ -48,4 +48,13 @@
 			value_ordered_functor_descs;
 		type_ctor_flags = flags;
 	}
+
+	public boolean unify(TypeCtorInfo_Struct tci) {
+		return this == tci;
+		/*
+		return type_ctor_module_name.equals(tci.type_ctor_module_name)
+				&& type_ctor_name.equals(tci.type_ctor_name)
+				&& arity == tci.arity;
+		*/
+	}
 }
Index: java/runtime/TypeInfo_Struct.java
===================================================================
RCS file: /home/mercury1/repository/mercury/java/runtime/TypeInfo_Struct.java,v
retrieving revision 1.4
diff -u -d -r1.4 TypeInfo_Struct.java
--- java/runtime/TypeInfo_Struct.java	19 Feb 2004 09:37:20 -0000	1.4
+++ java/runtime/TypeInfo_Struct.java	22 Feb 2004 03:44:50 -0000
@@ -125,4 +125,31 @@
 			}
 		}
 	}
+
+	public boolean unify(TypeInfo_Struct ti) {
+		if (this == ti) {
+			return true;
+		}
+
+		if (type_ctor.unify(ti.type_ctor) == false) {
+			return false;
+		}
+
+		if (args == null || ti.args == null) {
+			if (args == null && ti.args == null) {
+				return true;
+			}
+			return false;
+		}
+
+		for (int i = 0; i < args.length || i < ti.args.length; i++) {
+			if (i == args.length || i == ti.args.length) {
+				return false;
+			}
+			if (args[i].unify(ti.args[i]) == false) {
+				return false;
+			}
+		}
+		return true;
+	}
 }
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.51
diff -u -d -r1.51 rtti_implementation.m
--- library/rtti_implementation.m	20 Feb 2004 01:56:33 -0000	1.51
+++ library/rtti_implementation.m	26 Feb 2004 07:29:55 -0000
@@ -24,6 +24,13 @@
 % The plan is to migrate most of the Mercury level data structures in
 % compiler/rtti.m here, and to interpret them, instead of relying on access
 % to C level data structures.
+%
+% XXX The Java implementation of this module is incomplete.  Currently, it can
+% handle strings, ints, floats and enumerated types, but anything more
+% complicated will throw exceptions.  This is mainly due to the fact that a lot
+% of the low-level procedures have yet to be implemented for the Java back-end.
+%
+% XXX Also, the existing Java code needs to be reviewed.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -32,7 +39,8 @@
 
 :- interface.
 
-:- import_module deconstruct, list.
+:- import_module deconstruct.
+:- import_module list.
 
 :- use_module std_util.
 :- use_module type_desc.
@@ -85,7 +93,11 @@
 
 :- implementation.
 
-:- import_module array, bool, int, require, string.
+:- import_module array.
+:- import_module bool.
+:- import_module int.
+:- import_module require.
+:- import_module string.
 
 	% std_util has a lot of types and functions with the same names,
 	% so we prefer to keep the namespace separate.
@@ -147,11 +159,14 @@
 
 :- type type_info ---> type_info(c_pointer).
 :- pragma foreign_type("Java", type_info,
-		% XXX should this be "mercury.runtime.PseudoTypeInfo" instead?
-		"mercury.runtime.TypeInfo_Struct").
+		% XXX should this be "mercury.runtime.TypeInfo_Struct" instead?
+		"mercury.runtime.PseudoTypeInfo").
 
 :- type compare_pred ---> compare_pred(c_pointer).
+
 :- type type_layout ---> type_layout(c_pointer).
+:- pragma foreign_type("Java", type_layout, "mercury.runtime.TypeLayout").
+
 :- type pred_type ---> pred_type(c_pointer).
 :- type pseudo_type_info ---> pred_type(c_pointer).
 
@@ -503,7 +518,7 @@
 	get_var_arity_typeinfo_arity(TypeInfo::in) = (Arity::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
 " 
-	Arity = TypeInfo.args.length;
+	Arity = ((TypeInfo_Struct) TypeInfo).args.length;
 ").
 
 :- pragma foreign_proc("C#",
@@ -950,12 +965,13 @@
 		type_ctor_is_variable_arity(TypeCtorInfo)
 	->
 		Arity = get_var_arity_typeinfo_arity(TypeInfo),
-		TypeArgs = iterate(1, Arity,
+		% XXX Do indexes start at 0?
+		TypeArgs = iterate(0, Arity - 1,
 			(func(X) = TypeInfo ^ var_arity_type_info_index(X))
 		)
 	;
 		Arity = type_ctor_arity(TypeCtorInfo),
-		TypeArgs = iterate(1, Arity,
+		TypeArgs = iterate(0, Arity - 1,
 			(func(X) = TypeInfo ^ type_info_index(X))
 		)
 	).
@@ -1011,7 +1027,10 @@
 				NonCanon, Functor, Arity, Arguments)
 	; 	
 		TypeCtorRep = enum,
-		Functor = "some_enum", 
+		TypeFunctors = type_ctor_functors(TypeCtorInfo),
+		EnumFunctorDesc = enum_functor_desc(TypeCtorRep,
+				unsafe_get_enum_value(Term), TypeFunctors),
+		Functor = enum_functor_name(EnumFunctorDesc),
 		Arity = 0,
 		Arguments = []
 	;
@@ -1490,6 +1509,16 @@
 get_pti_from_arg_types(_::in, _::in) = (42::out) :-
 	det_unimplemented("get_pti_from_arg_types").
 
+:- pragma foreign_proc("Java",
+	get_pti_from_arg_types(ArgTypes::in, Index::in) = (ArgTypeInfo::out),
+	[will_not_call_mercury, promise_pure],
+"
+	// XXX Should this be something else?
+	TypeInfo_for_T = null;
+
+	ArgTypeInfo = ArgTypes[Index];
+").
+
 :- pragma foreign_proc("C#",
 	get_pti_from_arg_types(ArgTypes::in, Index::in) =
 		(ArgTypeInfo::out), [promise_pure], "
@@ -1591,6 +1620,21 @@
 	}
 ").
 
+:- pragma foreign_proc("Java",
+	typeinfo_is_variable(TypeInfo::in, VarNum::out),
+	[will_not_call_mercury, promise_pure],
+"
+	succeeded = (TypeInfo.getClass() ==
+			mercury.runtime.PseudoTypeInfo.class);
+	if (succeeded) {
+		// This number is used to index into an array, hence the -1
+		VarNum = ((mercury.runtime.PseudoTypeInfo)TypeInfo).
+				variable_number - 1;
+	} else {
+		VarNum = -1; // just to keep the compiler happy
+	}
+").
+
 	% Tests for universal and existentially quantified variables.
 
 :- pred type_variable_is_univ_quant(int::in) is semidet.
@@ -1688,6 +1732,13 @@
 	}
 ").
 
+:- pragma foreign_proc("Java",
+	get_type_ctor_info(TypeInfo::in) = (TypeCtorInfo::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	TypeCtorInfo = ((mercury.runtime.TypeInfo_Struct) TypeInfo).type_ctor;
+").
+
 :- pragma foreign_proc("C",
 	get_type_ctor_info(TypeInfo::in) = (TypeCtorInfo::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
@@ -1756,6 +1807,28 @@
 	}
 ").
 
+:- pragma foreign_proc("Java",
+	get_primary_tag(_X::in) = (Tag::out), [promise_pure],
+"
+	// For the Java back-end, there is no primary tag, so always return 0.
+	Tag = 0;
+").
+
+:- pragma foreign_proc("Java",
+	get_remote_secondary_tag(X::in) = (Tag::out), [promise_pure],
+"
+	// If there is a secondary tag, it will be in a member called
+	// `data_tag', which we obtain by reflection.  Otherwise we return -1.
+	// XXX Is this the correct behaviour?
+
+	try {
+		Tag = X.getClass().getField(""data_tag"").getInt(X);
+	}
+	catch (java.lang.Exception e) {
+		return -1;
+	}
+").
+
 :- type sectag_locn ---> none ; local ; remote ; variable.
 % :- pragma foreign_type("Java", sectag_locn, "mercury.runtime.Sectag_Locn").
 
@@ -1791,6 +1864,12 @@
 	PtagEntry = (object[]) TypeLayout[X];
 ").
 
+:- pragma foreign_proc("Java",
+	ptag_index(X::in, TypeLayout::in) = (PtagEntry::out), [promise_pure],
+"
+	PtagEntry = TypeLayout.layout_du()[X];
+").
+
 :- func sectag_locn(ptag_entry) = sectag_locn.
 
 sectag_locn(PTagEntry::in) = (unsafe_cast(PTagEntry)::out) :- 
@@ -1802,6 +1881,15 @@
 		PTagEntry[(int) ptag_layout_field_nums.sectag_locn]);
 ").
 
+:- pragma foreign_proc("Java",
+	sectag_locn(PTagEntry::in) = (SectagLocn::out), [promise_pure],
+"
+	mercury.runtime.Sectag_Locn SL_struct = PTagEntry.sectag_locn;
+
+	SectagLocn = new mercury.rtti_implementation.sectag_locn_0(
+			SL_struct.value);
+").
+
 :- func du_sectag_alternatives(int, ptag_entry) = du_functor_desc.
 
 du_sectag_alternatives(_::in, PTagEntry::in) = (unsafe_cast(PTagEntry)::out) :- 
@@ -1816,6 +1904,13 @@
 	FunctorDescriptor = (object []) sectag_alternatives[X];
 ").
 
+:- pragma foreign_proc("Java",
+		du_sectag_alternatives(X::in, PTagEntry::in) =
+		(FunctorDescriptor::out), [promise_pure],
+"
+	FunctorDescriptor = PTagEntry.sectag_alternatives[X];
+").
+
 :- func typeinfo_locns_index(int, exist_info) = typeinfo_locn.
 
 typeinfo_locns_index(X::in, _::in) = (unsafe_cast(X)::out) :- 
@@ -1920,6 +2015,14 @@
 type_info_index(_::in, TypeInfo::in) = (TypeInfo::out) :- 
 	det_unimplemented("type_info_index").
 
+:- pragma foreign_proc("Java",
+	type_info_index(X::in, TypeInfo::in) = (TypeInfoAtIndex::out),
+	[will_not_call_mercury, promise_pure],
+"
+	TypeInfoAtIndex = (TypeInfo_Struct)
+			((TypeInfo_Struct) TypeInfo).args[X];
+").
+
 :- pragma foreign_proc("C#",
 	type_info_index(X::in, TypeInfo::in) = (TypeInfoAtIndex::out),
 	[will_not_call_mercury, promise_pure],
@@ -1967,6 +2070,12 @@
 	Arity = (int) TypeCtorInfo[
 			(int) type_ctor_info_field_nums.type_ctor_arity];
 ").
+:- pragma foreign_proc("Java",
+	type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Arity = ((TypeCtorInfo_Struct) TypeCtorInfo).arity;
+").
 :- pragma foreign_proc("C",
 	type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
@@ -2031,6 +2140,14 @@
 		(int) type_ctor_info_field_nums.type_ctor_rep];
 	TypeCtorRep = mercury.runtime.LowLevelData.make_enum(rep);
 ").
+:- pragma foreign_proc("Java",
+	type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	TypeCtorRep = new type_ctor_rep_0(
+			((mercury.runtime.TypeCtorInfo_Struct) TypeCtorInfo).
+			type_ctor_rep.value);
+").
 :- pragma foreign_proc("C",
 	type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
@@ -2054,6 +2171,13 @@
 		type_ctor_info_field_nums.type_ctor_module_name];
 ").
 
+:- pragma foreign_proc("Java",
+	type_ctor_module_name(TypeCtorInfo::in) = (Name::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Name = TypeCtorInfo.type_ctor_module_name;
+").
+
 :- pragma foreign_proc("C",
 	type_ctor_module_name(TypeCtorInfo::in) = (Name::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
@@ -2076,6 +2200,12 @@
 	Name = (string)
 		TypeCtorInfo[(int) type_ctor_info_field_nums.type_ctor_name];
 ").
+:- pragma foreign_proc("Java",
+	type_ctor_name(TypeCtorInfo::in) = (Name::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Name = TypeCtorInfo.type_ctor_name;
+").
 :- pragma foreign_proc("C",
 	type_ctor_name(TypeCtorInfo::in) = (Name::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
@@ -2101,6 +2231,13 @@
 		TypeCtorInfo[(int) type_ctor_info_field_nums.type_functors];
 ").
 
+:- pragma foreign_proc("Java",
+	type_ctor_functors(TypeCtorInfo::in) = (Functors::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Functors = TypeCtorInfo.type_functors;
+").
+
 type_ctor_functors(_) = _ :-
 	% This version is only used for back-ends for which there is no
 	% matching foreign_proc version.
@@ -2117,6 +2254,12 @@
 	TypeLayout = (object[])
 		TypeCtorInfo[(int) type_ctor_info_field_nums.type_layout];
 ").
+:- pragma foreign_proc("Java",
+	type_layout(TypeCtorInfo::in) = (TypeLayout::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	TypeLayout = TypeCtorInfo.type_layout;
+").
 :- pragma foreign_proc("C",
 	type_layout(TypeCtorInfo::in) = (TypeLayout::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
@@ -2158,6 +2301,12 @@
 "
 	VarOut = VarIn;
 ").
+:- pragma foreign_proc("Java",
+	unsafe_cast(VarIn::in) = (VarOut::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	VarOut = VarIn;
+").
 
 unsafe_cast(_) = _ :-
 	% This version is only used for back-ends for which there is no
@@ -2195,43 +2344,136 @@
 du_functor_desc(_, Num, TypeFunctors) = DuFunctorDesc :-
 	DuFunctorDesc = TypeFunctors ^ unsafe_index(Num).
 
+:- pragma foreign_proc("Java",
+	du_functor_desc(_TypeCtorRep::in(du), X::in, TypeFunctors::in) =
+			(DuFunctorDesc::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	DuFunctorDesc = TypeFunctors.functors_du()[X];
+").
+
 :- func du_functor_name(du_functor_desc) = string.
+
 du_functor_name(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(0).
 
+:- pragma foreign_proc("Java",
+	du_functor_name(DuFunctorDesc::in) = (Name::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Name = DuFunctorDesc.du_functor_name;
+").
+
 :- func du_functor_arity(du_functor_desc) = int.
+
 du_functor_arity(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(1).
 
+:- pragma foreign_proc("Java",
+	du_functor_arity(DuFunctorDesc::in) = (Arity::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Arity = DuFunctorDesc.du_functor_orig_arity;
+").
+
 :- func du_functor_arg_type_contains_var(du_functor_desc) = int.
+
 du_functor_arg_type_contains_var(DuFunctorDesc) =
 		DuFunctorDesc ^ unsafe_index(2).
 
+:- pragma foreign_proc("Java",
+	du_functor_arg_type_contains_var(DuFunctorDesc::in) = (Contains::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Contains = DuFunctorDesc.du_functor_arg_type_contains_var;
+").
+
 :- func du_functor_sectag_locn(du_functor_desc) = sectag_locn.
+
 du_functor_sectag_locn(DuFunctorDesc) =
 	unsafe_make_enum(DuFunctorDesc ^ unsafe_index(3)).
 
+:- pragma foreign_proc("Java",
+	du_functor_sectag_locn(DuFunctorDesc::in) = (SectagLocn::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	SectagLocn = DuFunctorDesc.du_functor_sectag_locn;
+").
+
 :- func du_functor_primary(du_functor_desc) = int.
+
 du_functor_primary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(4).
 
+:- pragma foreign_proc("Java",
+	du_functor_primary(DuFunctorDesc::in) = (Primary::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Primary = DuFunctorDesc.du_functor_primary;
+").
+
 :- func du_functor_secondary(du_functor_desc) = int.
+
 du_functor_secondary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(5).
 
+:- pragma foreign_proc("Java",
+	du_functor_secondary(DuFunctorDesc::in) = (Secondary::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Secondary = DuFunctorDesc.du_functor_secondary;
+").
+
 :- func du_functor_ordinal(du_functor_desc) = int.
+
 du_functor_ordinal(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(6).
 
+:- pragma foreign_proc("Java",
+	du_functor_ordinal(DuFunctorDesc::in) = (Ordinal::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Ordinal = DuFunctorDesc.du_functor_ordinal;
+").
+
 :- func du_functor_arg_types(du_functor_desc) = arg_types.
+
 du_functor_arg_types(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(7).
 
-:- func du_functor_arg_names(du_functor_desc::in) = (arg_names::out) is semidet.
+:- pragma foreign_proc("Java",
+	du_functor_arg_types(DuFunctorDesc::in) = (ArgTypes::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	ArgTypes = DuFunctorDesc.du_functor_arg_types;
+").
+
+:- func du_functor_arg_names(du_functor_desc::in) =
+		(arg_names::out) is semidet.
+
 du_functor_arg_names(DuFunctorDesc) = ArgNames :-
 	ArgNames = DuFunctorDesc ^ unsafe_index(8),
 	not null(ArgNames).
 
+:- pragma foreign_proc("Java",
+	du_functor_arg_names(DuFunctorDesc::in) = (ArgNames::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	ArgNames = DuFunctorDesc.du_functor_arg_names;
+
+	succeeded = (ArgNames != null);
+").
+
 :- func du_functor_exist_info(du_functor_desc::in) =
 		(exist_info::out) is semidet.
+
 du_functor_exist_info(DuFunctorDesc) = ExistInfo :-
 	ExistInfo = DuFunctorDesc ^ unsafe_index(9),
 	not null(ExistInfo).
 
+:- pragma foreign_proc("Java",
+	du_functor_exist_info(DuFunctorDesc::in) = (ExistInfo::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	ExistInfo = DuFunctorDesc.du_functor_exist_info;
+
+	succeeded = (ExistInfo != null);
+").
+
  %--------------------------%
 
 :- func enum_functor_desc(type_ctor_rep, int, type_functors)
@@ -2241,12 +2483,36 @@
 enum_functor_desc(_, Num, TypeFunctors) = EnumFunctorDesc :-
 	EnumFunctorDesc = TypeFunctors ^ unsafe_index(Num).
 
+:- pragma foreign_proc("Java",
+	enum_functor_desc(_TypeCtorRep::in(enum), X::in, TypeFunctors::in) =
+			(EnumFunctorDesc::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	EnumFunctorDesc = (TypeFunctors.functors_enum())[X];
+").
+
 :- func enum_functor_name(enum_functor_desc) = string.
+
 enum_functor_name(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(0).
 
+:- pragma foreign_proc("Java",
+	enum_functor_name(EnumFunctorDesc::in) = (Name::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Name = EnumFunctorDesc.enum_functor_name;
+").
+
 :- func enum_functor_ordinal(enum_functor_desc) = int.
+
 enum_functor_ordinal(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(1).
 
+:- pragma foreign_proc("Java",
+	enum_functor_ordinal(EnumFunctorDesc::in) = (Ordinal::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Ordinal = EnumFunctorDesc.enum_functor_ordinal;
+").
+
  %--------------------------%
 
 :- func notag_functor_desc(type_ctor_rep, int, type_functors)
@@ -2256,15 +2522,47 @@
 notag_functor_desc(_, Num, TypeFunctors) = NoTagFunctorDesc :-
 	NoTagFunctorDesc = TypeFunctors ^ unsafe_index(Num).
 
+:- pragma foreign_proc("Java",
+	notag_functor_desc(_TypeCtorRep::in(notag), _X::in, TypeFunctors::in) =
+			(NotagFunctorDesc::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	NotagFunctorDesc = TypeFunctors.functors_notag();
+").
+
 :- func notag_functor_name(notag_functor_desc) = string.
+
 notag_functor_name(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(0).
 
+:- pragma foreign_proc("Java",
+	notag_functor_name(NotagFunctorDesc::in) = (Name::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	Name = NotagFunctorDesc.no_tag_functor_name;
+").
+
 :- func notag_functor_arg_type(notag_functor_desc) = type_info.
+
 notag_functor_arg_type(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(1).
 
+:- pragma foreign_proc("Java",
+	notag_functor_arg_type(NotagFunctorDesc::in) = (ArgType::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	ArgType = NotagFunctorDesc.no_tag_functor_arg_type;
+").
+
 :- func notag_functor_arg_name(notag_functor_desc) = string.
+
 notag_functor_arg_name(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(2).
 
+:- pragma foreign_proc("Java",
+	notag_functor_arg_name(NotagFunctorDesc::in) = (ArgName::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	ArgName = NotagFunctorDesc.no_tag_functor_arg_name;
+").
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -2304,6 +2602,12 @@
 "
 	SUCCESS_INDICATOR = (S == null);
 ").
+:- pragma foreign_proc("Java",
+	null(S::in),
+	[will_not_call_mercury, thread_safe, promise_pure],
+"
+	succeeded = (S == null);
+").
 null(_) :-
 	% This version is only used for back-ends for which there is no
 	% matching foreign_proc version.
@@ -2324,10 +2628,39 @@
 "
 	Str = null;
 ").
+:- pragma foreign_proc("Java",
+	null_string = (Str::out),
+	[will_not_call_mercury, thread_safe, promise_pure],
+"
+	Str = null;
+").
 null_string = _ :-
 	% This version is only used for back-ends for which there is no
 	% matching foreign_proc version.
 	private_builtin__sorry("rtti_implementation__null_string/0").
+
+ %--------------------------%
+
+:- func unsafe_get_enum_value(T) = int.
+
+:- pragma foreign_proc("Java",
+	unsafe_get_enum_value(Enum::in) = (Value::out),
+	[will_not_call_mercury, thread_safe, promise_pure],
+"
+	try {
+		Value = Enum.getClass().getField(""value"").getInt(Enum);
+	}
+	catch (java.lang.Exception e) {
+		throw new java.lang.RuntimeException(
+				""unsafe_get_enum_value/1 called on an "" +
+				""object which is not of enumerated type."");
+	}
+").
+
+unsafe_get_enum_value(_) = _ :-
+	% This version is only used for back-ends for which there is no
+	% matching foreign_proc version.
+	private_builtin__sorry("rtti_implementation__unsafe_get_enum_value/1").
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.23
diff -u -d -r1.23 type_desc.m
--- library/type_desc.m	1 Dec 2003 13:17:11 -0000	1.23
+++ library/type_desc.m	20 Feb 2004 09:11:02 -0000
@@ -253,7 +253,8 @@
 	type_of(_Value::unused) = (TypeInfo::out),
 	[will_not_call_mercury, thread_safe, promise_pure],
 "
-	TypeInfo = TypeInfo_for_T;
+	TypeInfo = new mercury.type_desc.type_desc_0(
+			(mercury.runtime.TypeInfo_Struct) TypeInfo_for_T);
 ").
 
 
@@ -275,7 +276,7 @@
 	has_type(_Arg::unused, TypeInfo::in),
 	[will_not_call_mercury, thread_safe, promise_pure],
 "
-	TypeInfo_for_T = TypeInfo;
+	TypeInfo_for_T = ((mercury.type_desc.type_desc_0) TypeInfo).struct;
 ").
 
 
@@ -404,6 +405,29 @@
 	MR_restore_transient_registers();
 }").
 
+:- pragma foreign_proc("Java",
+	type_ctor_and_args(TypeDesc::in, TypeCtorDesc::out, ArgTypes::out),
+	[may_call_mercury, thread_safe, promise_pure],
+"
+	java.lang.Object [] result =
+			mercury.rtti_implementation.type_ctor_and_args_3_p_0(
+			((mercury.type_desc.type_desc_0) TypeDesc).struct);
+	
+	TypeCtorDesc = new type_ctor_desc_0((TypeCtorInfo_Struct) result[0]);
+	ArgTypes = result[1];
+
+	// Convert list from TypeInfo_Struct to type_desc_0
+	mercury.list.list_1 type_list = (mercury.list.list_1) ArgTypes;
+	while (type_list.data_tag == 1) {
+		((mercury.list.list_1.f_cons_2) type_list).F1 =
+				new mercury.type_desc.type_desc_0(
+				(TypeInfo_Struct)
+				((mercury.list.list_1.f_cons_2) type_list).F1);
+		type_list = (mercury.list.list_1)
+				((mercury.list.list_1.f_cons_2) type_list).F2;
+	}
+").
+
 type_ctor_and_args(TypeDesc::in, TypeCtorDesc::out, ArgTypes::out) :-
 	rtti_implementation__type_ctor_and_args(
 		rtti_implementation__unsafe_cast(TypeDesc),
@@ -514,6 +538,20 @@
         }
 }").
 
+:- pragma foreign_proc("Java",
+	type_ctor_name_and_arity(TypeCtorDesc::in, TypeCtorModuleName::out,
+		TypeCtorName::out, TypeCtorArity::out),
+        [will_not_call_mercury, thread_safe, promise_pure],
+"
+	Object[] result = mercury.rtti_implementation.
+			type_ctor_name_and_arity_4_p_0(
+			((type_ctor_desc_0) TypeCtorDesc).struct);
+	
+	TypeCtorModuleName = (java.lang.String) result[0];
+	TypeCtorName = (java.lang.String) result[1];
+	TypeCtorArity = ((java.lang.Integer) result[2]).intValue();
+").
+
 type_ctor_name_and_arity(TypeCtorDesc::in, ModuleName::out,
 		TypeCtorName::out, TypeCtorArity::out) :-
 	rtti_implementation__type_ctor_name_and_arity(
@@ -541,20 +579,28 @@
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_code("Java", "
-	public class type_desc_0 {
-		// stub only
+	public static class type_desc_0 {
+		public mercury.runtime.TypeInfo_Struct struct;
+
+		public type_desc_0(mercury.runtime.TypeInfo_Struct init) {
+			struct = init;
+		}
 	}
-	public class type_ctor_desc_0 {
-		// stub only
+	public static class type_ctor_desc_0 {
+		public mercury.runtime.TypeCtorInfo_Struct struct;
+
+		public type_ctor_desc_0(
+				mercury.runtime.TypeCtorInfo_Struct init)
+		{
+			struct = init;
+		}
 	}
 
 	public static boolean
 	__Unify____type_desc_0_0(mercury.type_desc.type_desc_0 x,
 		mercury.type_desc.type_desc_0 y)
 	{
-		// stub only
-		throw new java.lang.Error
-			(""unify/2 called for type_desc type not implemented"");
+		return x.struct.unify(y.struct);
 	}
 
 	public static boolean
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------