[m-rev.] more Java back-end fixes

Fergus Henderson fjh at cs.mu.OZ.AU
Mon Dec 1 23:57:57 AEDT 2003


Estimated hours taken: 10
Branches: main

Bug fixes for the Java back-end.
The standard library now almost compiles in grade java.

compiler/mlds_to_java.m:
	Output Java foreign declarations before any other code,
	to fix a problem with references to the TYPE_CTOR_REP
	constants in library/private_builtin.m.
	
	Fix some bugs where we were not being consistent about mangling
	the module name when naming the classes used to simulate taking
	procedure addresses.  This bug broke Java compilation of library/char.m.

	Fix some bugs where the compiler was getting confused about
	which types map to array types in Java.

	For MLDS casts that cast to type_info or pseudo_type_info,
	generate Java constructor calls, not Java casts.
	This fixes type errors in the generated Java code.

	Simplify the code for hand_defined_type.

compiler/rtti.m:
	Fix a bug in tc_rtti_name_java_type: map typeclass_infos to
	the Java type "java.lang.Object[]", not "java.lang.Integer[]".
	The latter didn't work because the elements which hold the method
	addresses do not have type java.lang.Integer.

java/runtime/DuExistInfo.java:
java/runtime/NotagFunctorDesc.java:
	Define constructors for these types.

java/runtime/TypeInfo_Struct.java:
	Define some additional constructors for this type.

library/builtin.m:
	Provide Java stub definitions of
	- classes for the types func/0 and c_pointer/0;
	- unify/compare preds for func, c_pointer, tuple, and void;
	
	Define Java definitions for the additional modes of compare/3
	(they just call the first mode).

library/exception.m:
	Define Java versions of make_io_state and consume_io_state,
	and Java stubs for throw_impl and catch_impl.

	Change try_all so that it calls catch_impl, like try does,
	rather than calling builtin_catch directly.  This is needed
	since the .NET and Java back-ends only define catch_impl,
	not builtin_catch.

library/private_builtin.m:
	Delete the Java definition of the type_info for type_info/1,
	because that is generated automatically now,
	after petdr's recent bug fix.

	Provide Java stubs definitions of the unify/compare preds
	for ref/1, heap_pointer/0, type_ctor_info, type_info,
	base_typeclass_info, and typeclass_info.

	Provide Java definition of dummy_var.

library/type_desc.m:
	Provide Java stub definitions of
	- classes for type_desc/0 and type_ctor_desc/0
	- unify/compare preds for those types

library/store.m:
	Define unification and comparison predicates for the store(S)
	type.  This is needed because the automatically generated ones
	might not have the right semantics, but also because the Java
	back-end generates some invalid code for the automatically
	generated unification and compare predicates (the generated
	code has some invalid references to "dummy_var").

Workspace: /home/jupiter/fjh/ws-jupiter/mercury
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.46
diff -u -d -r1.46 mlds_to_java.m
--- compiler/mlds_to_java.m	1 Dec 2003 06:53:29 -0000	1.46
+++ compiler/mlds_to_java.m	1 Dec 2003 12:10:09 -0000
@@ -401,18 +401,22 @@
 	%
 	% Output transformed MLDS as Java source.  
 	%
+	% The order is important here, because Java requires static constants
+	% be defined before they can be used in static initializers.
+	% We start with the Java foreign code declarations, since for
+	% library/private_builtin.m they contain static constants
+	% that will get used in the RTTI definitions.
+	%
 	output_src_start(Indent, ModuleName, Imports, ForeignDecls, Defns), 
+	io__write_list(ForeignBodyCode, "\n", output_java_body_code(Indent)),
+	{ CtorData = none },  % Not a constructor.
 	% XXX do we need to split this into RTTI and non-RTTI defns???
 	{ list__filter(defn_is_rtti_data, Defns, RttiDefns, NonRttiDefns) },
 	output_defns(Indent + 1, MLDS_ModuleName, CtorData, RttiDefns),
-	% Output Java foreign code declarations.
-	io__write_list(ForeignBodyCode, "\n", output_java_body_code(Indent)),
-	{ CtorData = none },  % Not a constructor.
 	output_defns(Indent + 1, MLDS_ModuleName, CtorData, NonRttiDefns),
 	output_src_end(Indent, ModuleName).
 	% XXX Need to handle non-Java foreign code at this point.
 
-
 %-----------------------------------------------------------------------------%
 % 
 % Code for working with Java `foreign_code'.
@@ -751,8 +755,10 @@
 	% Create a name for this wrapper class based on the fully qualified
 	% method (predicate) name.
 	%
-	ModuleNameStr = mlds_module_name_to_string(ModuleQualifier),	
-	ClassEntityName = "AddrOf__" ++ ModuleNameStr ++ "__" ++ PredName,
+	ModuleQualifierSym = mlds_module_name_to_sym_name(ModuleQualifier),
+	mangle_mlds_sym_name_for_java(ModuleQualifierSym, "__", ModuleNameStr),
+	ClassEntityName = "AddrOf__" ++ ModuleNameStr ++
+		"__" ++ PredName,
 	MangledClassEntityName = name_mangle(ClassEntityName),
 	%
 	% Put it all together.
@@ -1455,14 +1461,7 @@
 		ModuleName) --> 
 	io__write_string("new "),
 	output_type(StructType),
-	(
-		{ StructType = mercury_type(MercuryType, _, _) },
-		{ hand_defined_type(MercuryType, _, IsArray0) }
-	->
-		{ IsArray = IsArray0 }
-	;
-		{ IsArray = no }
-	),
+	{ IsArray = type_is_array(StructType) },
 	io__write_string(if IsArray = yes then " {" else "("),
 	io__write_list(FieldInits, ",\n\t\t",
 		(pred(FieldInit::in, di, uo) is det -->
@@ -1753,7 +1752,7 @@
 		% We need to handle type_info (etc.) types
 		% specially -- they get mapped to types in the
 		% runtime rather than in private_builtin.
-		{ hand_defined_type(Type, SubstituteName, _) }
+		{ hand_defined_type(TypeCategory, SubstituteName) }
 	->
 		io__write_string(SubstituteName)
 	;
@@ -1866,7 +1865,7 @@
 		io__write_string("java.lang.Object")
 	;
 		{ TypeCategory = tuple_type }, 
-		io__write_string("/* Tuple */ java.lang.Object")
+		io__write_string("/* tuple */ java.lang.Object[]")
 	;
 		{ TypeCategory = higher_order_type },
 		io__write_string("/* closure */ java.lang.Object[]")
@@ -1898,25 +1897,50 @@
 			"output_mercury_user_type: not a user type") }
 	).
 
+	% return yes if the corresponding Java type is an array type.
+:- func type_is_array(mlds__type) = bool.
+type_is_array(Type) = IsArray :-
+	( Type = mlds__array_type(_) ->
+		IsArray = yes
+	; Type = mlds__mercury_array_type(_) ->
+		IsArray = yes
+	; Type = mercury_type(_, TypeCategory, _) ->
+		IsArray = type_category_is_array(TypeCategory)
+	; Type = mlds__rtti_type(RttiId) ->
+		rtti_id_java_type(RttiId, _JavaTypeName, IsArray)
+	;
+		IsArray = no
+	).
+
+	% return yes if the corresponding Java type is an array type.
+:- func type_category_is_array(type_category) = bool.
+type_category_is_array(int_type) = no.
+type_category_is_array(char_type) = no.
+type_category_is_array(str_type) = no.
+type_category_is_array(float_type) = no.
+type_category_is_array(higher_order_type) = yes.
+type_category_is_array(tuple_type) = yes.
+type_category_is_array(enum_type) = no.
+type_category_is_array(variable_type) = no.
+type_category_is_array(type_info_type) = no.
+type_category_is_array(type_ctor_info_type) = no.
+type_category_is_array(typeclass_info_type) = yes.
+type_category_is_array(base_typeclass_info_type) = yes.
+type_category_is_array(void_type) = no.
+type_category_is_array(user_ctor_type) = no.
+
 	% We need to handle type_info (etc.) types
 	% specially -- they get mapped to types in the
 	% runtime rather than in private_builtin.
 	%
-:- pred hand_defined_type(prog_type::in, string::out, bool::out) is semidet.
-hand_defined_type(Type, SubstituteName, IsArray) :-
-	sym_name_and_args(Type, SymName, _Args),
-	SymName = qualified(PB, UnqualType),
-	mercury_private_builtin_module(PB),
-	hand_defined_type_2(UnqualType, SubstituteName, IsArray).
-
-:- pred hand_defined_type_2(string::in, string::out, bool::out) is semidet.
-hand_defined_type_2("type_info", "mercury.runtime.TypeInfo_Struct", no).
-hand_defined_type_2("type_ctor_info", "mercury.runtime.TypeCtorInfo_Struct",
-	no).
-hand_defined_type_2("base_typeclass_info",
-	"/* base_typeclass_info */ java.lang.Object[]", yes).
-hand_defined_type_2("typeclass_info",
-	"/* typeclass_info */ java.lang.Object[]", yes).
+	% hand_defined_type(Type, SubstituteName):
+:- pred hand_defined_type(type_category::in, string::out) is semidet.
+hand_defined_type(type_info_type, "mercury.runtime.TypeInfo_Struct").
+hand_defined_type(type_ctor_info_type, "mercury.runtime.TypeCtorInfo_Struct").
+hand_defined_type(base_typeclass_info_type,
+	"/* base_typeclass_info */ java.lang.Object[]").
+hand_defined_type(typeclass_info_type,
+	"/* typeclass_info */ java.lang.Object[]").
 
 %-----------------------------------------------------------------------------%
 %
@@ -2693,10 +2717,8 @@
 	%
 	(
 		{ MaybeCtorName = yes(QualifiedCtorId) },
-		{ \+ (
-			Type = mlds__mercury_type(MercuryType, _, _),
-			hand_defined_type(MercuryType, _, yes)
-		) }
+		{ \+ (Type = mercury_type(_, TypeCategory, _),
+		      hand_defined_type(TypeCategory, _)) }
 	->
 		output_type(Type),
 		io__write_char('.'),
@@ -2707,15 +2729,9 @@
 	;
 		output_type(Type)
 	),
-	(
-		{ Type = mlds__array_type(_Type)
-		; Type = mlds__mercury_type(_Type, higher_order_type, _)
-		; Type = mlds__mercury_type(MercType, _, _),
-		  hand_defined_type(MercType, _, yes)
-		} 
-	->
+	( { type_is_array(Type) = yes } ->
 		%
-		% The new object will be an array of java.lang.Object, so we
+		% The new object will be an array, so we
 		% need to initialise it using array literals syntax.
 		%
 		io__write_string(" {"),
@@ -2986,7 +3002,30 @@
 :- mode output_unop(in, in, in, di, uo) is det.
 	
 output_unop(cast(Type), Exprn, ModuleName) -->
-	output_cast_rval(Type, Exprn, ModuleName).
+	% rtti_to_mlds.m generates casts from int to
+	% mercury.runtime.PseudoTypeInfo, but for Java
+	% we need to treat these as constructions, not casts.
+	% Similarly for conversions from TypeCtorInfo to TypeInfo.
+	(
+		{ Type = mlds__pseudo_type_info_type },
+		{ Exprn = const(int_const(_)) }
+	->
+		maybe_output_comment("cast"),
+		io__write_string("new mercury.runtime.PseudoTypeInfo("),
+		output_rval(Exprn, ModuleName),
+		io__write_string(")")
+	;
+		( { Type = mlds__mercury_type(_, type_info_type, _) }
+		; { Type = mlds__type_info_type }
+		)
+	->
+		maybe_output_comment("cast"),
+		io__write_string("new mercury.runtime.TypeInfo_Struct("),
+		output_rval(Exprn, ModuleName),
+		io__write_string(")")
+	;
+		output_cast_rval(Type, Exprn, ModuleName)
+	).
 output_unop(box(Type), Exprn, ModuleName) -->
 	output_boxed_rval(Type, Exprn, ModuleName).
 output_unop(unbox(Type), Exprn, ModuleName) -->
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.37
diff -u -d -r1.37 rtti.m
--- compiler/rtti.m	1 Dec 2003 06:53:29 -0000	1.37
+++ compiler/rtti.m	1 Dec 2003 09:11:04 -0000
@@ -1636,7 +1636,7 @@
 	).
 
 tc_rtti_name_java_type(_TCRttiName, JavaTypeName, IsArray) :-
-	JavaTypeName = "java.lang.Integer",
+	JavaTypeName = "java.lang.Object",
 	IsArray = yes.
 	% tc_rtti_name_type(TCRttiName, _GenTypeName, IsArray),
 	% JavaTypeName = string__append("mercury.runtime.", GenTypeName).
Index: java/runtime/DuExistInfo.java
===================================================================
RCS file: /home/mercury1/repository/mercury/java/runtime/DuExistInfo.java,v
retrieving revision 1.1
diff -u -d -r1.1 DuExistInfo.java
--- java/runtime/DuExistInfo.java	11 Feb 2002 06:31:32 -0000	1.1
+++ java/runtime/DuExistInfo.java	1 Dec 2003 08:50:20 -0000
@@ -13,4 +13,12 @@
 	public int exist_tcis;
 	public /* final */ mercury.runtime.DuExistLocn[] exist_typeinfo_locns;
 
+	public DuExistInfo(int typeinfos_plain, int typeinfos_in_tci, int tcis,
+		mercury.runtime.DuExistLocn[] typeinfo_locns)
+	{
+		exist_typeinfos_plain = typeinfos_plain;
+		exist_typeinfos_in_tci = typeinfos_in_tci;
+		exist_tcis = tcis;
+		exist_typeinfo_locns = typeinfo_locns;
+	}
 }
Index: java/runtime/NotagFunctorDesc.java
===================================================================
RCS file: /home/mercury1/repository/mercury/java/runtime/NotagFunctorDesc.java,v
retrieving revision 1.1
diff -u -d -r1.1 NotagFunctorDesc.java
--- java/runtime/NotagFunctorDesc.java	11 Feb 2002 06:31:32 -0000	1.1
+++ java/runtime/NotagFunctorDesc.java	1 Dec 2003 11:20:39 -0000
@@ -11,5 +11,15 @@
 	public java.lang.String no_tag_functor_name;
 	public mercury.runtime.PseudoTypeInfo no_tag_functor_arg_type;
 	public java.lang.String no_tag_functor_arg_name;
+
+	public NotagFunctorDesc(java.lang.String functor_name,
+		mercury.runtime.PseudoTypeInfo functor_arg_type,
+		java.lang.Object functor_arg_name)
+	{
+		no_tag_functor_name = functor_name;
+		no_tag_functor_arg_type = functor_arg_type;
+		// XXX cast might fail
+		no_tag_functor_arg_name = (java.lang.String) functor_arg_name;
+	}
 }
 		
Index: java/runtime/TypeInfo_Struct.java
===================================================================
RCS file: /home/mercury1/repository/mercury/java/runtime/TypeInfo_Struct.java,v
retrieving revision 1.1
diff -u -d -r1.1 TypeInfo_Struct.java
--- java/runtime/TypeInfo_Struct.java	8 Jul 2003 10:30:00 -0000	1.1
+++ java/runtime/TypeInfo_Struct.java	1 Dec 2003 11:30:14 -0000
@@ -11,12 +11,33 @@
 	public TypeCtorInfo_Struct type_ctor;
 	public PseudoTypeInfo args[];
     
+    	// raw constructor
 	public TypeInfo_Struct(TypeCtorInfo_Struct tc, PseudoTypeInfo[] as)
 	{
 		type_ctor = tc;
 		args = as;
 	}
 
+	// copy constructor
+	// XXX Rather than invoking this constructor, and allocating a new
+	//     type_info object on the heap, we should generate code which
+	//     just copies the pointer,
+	public TypeInfo_Struct(TypeInfo_Struct ti)
+	{
+		type_ctor = ti.type_ctor;
+		args = ti.args;
+	}
+
+	// XXX a temp hack just to get things to link
+	public TypeInfo_Struct(java.lang.Object ti)
+	{
+		throw new java.lang.Error("TypeInfo_Struct(Object)");
+	}
+
+	//
+	// constructors for fixed-arity type_infos
+	//
+
 	public TypeInfo_Struct(TypeCtorInfo_Struct tc)
 	{
 		type_ctor = tc;
@@ -32,6 +53,32 @@
 	public TypeInfo_Struct(TypeCtorInfo_Struct tc, PseudoTypeInfo a1,
 				PseudoTypeInfo a2)
 	{
+		type_ctor = tc;
+		args = new PseudoTypeInfo[] { a1, a2 };
+	}
+
+	//
+	// constructors for variable-arity type_infos (tuple, pred, func)
+	//
+
+	public TypeInfo_Struct(TypeCtorInfo_Struct tc, int arity)
+	{
+		// assert arity == 0;
+		type_ctor = tc;
+		args = new PseudoTypeInfo[] { };
+	}
+
+	public TypeInfo_Struct(TypeCtorInfo_Struct tc, int arity, PseudoTypeInfo a1)
+	{
+		// assert arity == 1;
+		type_ctor = tc;
+		args = new PseudoTypeInfo[] { a1 };
+	}
+
+	public TypeInfo_Struct(TypeCtorInfo_Struct tc, int arity, PseudoTypeInfo a1,
+				PseudoTypeInfo a2)
+	{
+		// assert arity == 2;
 		type_ctor = tc;
 		args = new PseudoTypeInfo[] { a1, a2 };
 	}
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.99
diff -u -d -r1.99 builtin.m
--- library/builtin.m	1 Dec 2003 06:51:08 -0000	1.99
+++ library/builtin.m	1 Dec 2003 09:35:37 -0000
@@ -675,7 +675,6 @@
 	}
 }
 ").
-
 :- pragma foreign_code("Java", "
 	public static class void_0
 	{
@@ -685,30 +684,146 @@
 		{
 		}
 	}
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_code("Java", "
+
+	//
+	// Definitions of builtin types
+	//
 
 	public static class tuple_0
 	{
 		// stub only
 	}
-").
 
-%-----------------------------------------------------------------------------%
+	public static class func_0
+	{
+		// stub only
+	}
 
-:- pragma foreign_code("Java", "
+	public static class c_pointer_0
+	{
+		// stub only
+	}
 
-    public static boolean unify_2_p_0(mercury.private_builtin.type_info_1 ti,
-		    java.lang.Object x, java.lang.Object y)
-    {
-      throw new java.lang.Error(""unify/3 not implemented"");
-    }
+	//
+	// Generic unification/comparison routines
+	//
 
-    public static comparison_result_0 compare_3_p_0(
-	mercury.private_builtin.type_info_1 ti,
-	java.lang.Object x, java.lang.Object y)
-    {
-      throw new java.lang.Error(""compare/3 not implemented"");
-    }
+	public static boolean
+	unify_2_p_0 (mercury.runtime.TypeInfo_Struct ti,
+		     java.lang.Object x, java.lang.Object y)
+	{
+		// stub only
+		throw new java.lang.Error (""unify/3 not implemented"");
+	}
+
+	public static comparison_result_0
+	compare_3_p_0 (mercury.runtime.TypeInfo_Struct ti,
+		       java.lang.Object x, java.lang.Object y)
+	{
+		// stub only
+		throw new java.lang.Error (""compare/3 not implemented"");
+	}
+
+	public static comparison_result_0
+	compare_3_p_1 (mercury.runtime.TypeInfo_Struct ti,
+		       java.lang.Object x, java.lang.Object y)
+	{
+		return compare_3_p_0(ti, x, y);
+	}
+
+	public static comparison_result_0
+	compare_3_p_2 (mercury.runtime.TypeInfo_Struct ti,
+		       java.lang.Object x, java.lang.Object y)
+	{
+		return compare_3_p_0(ti, x, y);
+	}
 
+	public static comparison_result_0
+	compare_3_p_3 (mercury.runtime.TypeInfo_Struct ti,
+		       java.lang.Object x, java.lang.Object y)
+	{
+		return compare_3_p_0(ti, x, y);
+	}
+
+	//
+	// Type-specific unification routines for builtin types
+	//
+
+	public static boolean
+	__Unify____tuple_0_0
+		(mercury.builtin.tuple_0 x, mercury.builtin.tuple_0 y)
+	{
+		// stub only
+		throw new java.lang.Error (""unify/2 for tuple types not implemented"");
+	}
+
+	public static boolean
+	__Unify____func_0_0
+		(mercury.builtin.func_0 x, mercury.builtin.func_0 y)
+	{
+		// stub only
+		throw new java.lang.Error (""unify/2 for tuple types not implemented"");
+	}
+
+
+	public static boolean
+	__Unify____c_pointer_0_0
+		(java.lang.Object x, java.lang.Object y)
+	{
+		// XXX should we try calling a Java comparison routine?
+		throw new java.lang.Error (""unify/2 called for c_pointer type"");
+	}
+
+	public static boolean
+	__Unify____void_0_0
+		(mercury.builtin.void_0 x, mercury.builtin.void_0 y)
+	{
+		// there should never be any values of type void/0
+		throw new java.lang.Error (""unify/2 called for void type"");
+	}
+
+	//
+	// Type-specific comparison routines for builtin types
+	//
+
+	public static comparison_result_0
+	__Compare____tuple_0_0
+		(mercury.builtin.tuple_0 x, mercury.builtin.tuple_0 y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""compare/3 for tuple types not implemented"");
+	}
+
+	public static comparison_result_0
+	__Compare____func_0_0
+		(mercury.builtin.func_0 x, mercury.builtin.func_0 y)
+	{
+		// comparing values of higher-order types is a run-time error
+		throw new java.lang.Error (""compare/3 called for func type"");
+	}
+
+	public static comparison_result_0
+	__Compare____c_pointer_0_0
+		(java.lang.Object x, java.lang.Object y)
+	{
+		// XXX should we try calling a Java comparison routine?
+		throw new java.lang.Error
+			(""compare/3 called for c_pointer type"");
+	}
+
+	public static comparison_result_0
+	__Compare____void_0_0
+		(mercury.builtin.void_0 x, mercury.builtin.void_0 y)
+	{
+		// there should never be any values of type void/0
+		throw new java.lang.Error (""compare/3 called for void type"");
+	}
 ").
 
 :- end_module builtin.
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.83
diff -u -d -r1.83 exception.m
--- library/exception.m	13 Nov 2003 17:06:11 -0000	1.83
+++ library/exception.m	1 Dec 2003 12:23:08 -0000
@@ -456,20 +456,20 @@
 	).
 try_all(multi, Goal, ResultList) :-
 	unsorted_solutions((pred(Result::out) is multi :-
-		builtin_catch((pred(R::out) is multi :-
+		catch_impl((pred(R::out) is multi :-
 				wrap_success(Goal, R)),
 			wrap_exception, Result)),
 		ResultList).
 try_all(nondet, Goal, ResultList) :-
 	unsorted_solutions((pred(Result::out) is nondet :-
-		builtin_catch((pred(R::out) is nondet :-
+		catch_impl((pred(R::out) is nondet :-
 				wrap_success(Goal, R)),
 			wrap_exception, Result)),
 		ResultList).
 
 incremental_try_all(Goal, AccPred, Acc0, Acc) :-
 	unsorted_aggregate((pred(Result::out) is nondet :-
-		builtin_catch((pred(R::out) is nondet :-
+		catch_impl((pred(R::out) is nondet :-
 				wrap_success(Goal, R)),
 			wrap_exception, Result)),
 		AccPred, Acc0, Acc).
@@ -557,12 +557,16 @@
 		[will_not_call_mercury, thread_safe], "").
 :- pragma foreign_proc("C#", make_io_state(_IO::uo),
 		[will_not_call_mercury, thread_safe], "").
+:- pragma foreign_proc("Java", make_io_state(_IO::uo),
+		[will_not_call_mercury, thread_safe], "").
 
 :- impure pred consume_io_state(io__state::di) is det.
 :- pragma foreign_proc("C", consume_io_state(_IO::di),
 		[will_not_call_mercury, thread_safe], "").
 :- pragma foreign_proc("C#", consume_io_state(_IO::di),
 		[will_not_call_mercury, thread_safe], "").
+:- pragma foreign_proc("Java", consume_io_state(_IO::di),
+		[will_not_call_mercury, thread_safe], "").
 
 :- pred wrap_exception(univ::in, exception_result(T)::out) is det.
 wrap_exception(Exception, exception(Exception)).
@@ -1317,6 +1321,75 @@
 
 /*
 *******/
+
+:- pragma foreign_proc("Java", throw_impl(_T::in),
+		[will_not_call_mercury, promise_pure], "
+	throw new java.lang.Error(""throw_impl not yet implemented"");
+").
+
+:- pragma foreign_proc("Java", 
+	catch_impl(_Pred::pred(out) is det, _Handler::in(handler), _T::out),
+		[will_not_call_mercury, promise_pure], "
+{
+	// the shenanigans with `if (always)' are to avoid errors from
+	// the Java compiler about unreachable code.
+	boolean always = true;
+	if (always) {
+		throw new java.lang.Error(""catch_impl not yet implemented"");
+	}
+}
+").
+:- pragma foreign_proc("Java", 
+	catch_impl(_Pred::pred(out) is semidet, _Handler::in(handler), T::out),
+		[will_not_call_mercury, promise_pure], "
+{
+	// the shenanigans with `if (always)' are to avoid errors from
+	// the Java compiler about unreachable code.
+	boolean always = true;
+	if (always) {
+		throw new java.lang.Error(""catch_impl not yet implemented"");
+	}
+	T = null;
+}
+").
+:- pragma foreign_proc("Java", 
+	catch_impl(_Pred::pred(out) is cc_multi, _Handler::in(handler),
+		T::out),
+		[will_not_call_mercury, promise_pure], "
+{
+	// the shenanigans with `if (always)' are to avoid errors from
+	// the Java compiler about unreachable code.
+	boolean always = true;
+	if (always) {
+		throw new java.lang.Error(""catch_impl not yet implemented"");
+	}
+	T = null;
+}
+").
+:- pragma foreign_proc("Java", 
+	catch_impl(_Pred::pred(out) is cc_nondet, _Handler::in(handler),
+		T::out),
+		[will_not_call_mercury, promise_pure], "
+{
+	// the shenanigans with `if (always)' are to avoid errors from
+	// the Java compiler about unreachable code.
+	boolean always = true;
+	if (always) {
+		throw new java.lang.Error(""catch_impl not yet implemented"");
+	}
+	T = null;
+}
+").
+:- pragma foreign_proc("Java", 
+	catch_impl(_Pred::pred(out) is multi, _Handler::in(handler), _T::out),
+		[will_not_call_mercury, promise_pure], "
+	throw new java.lang.Error(""catch_impl not yet implemented"");
+").
+:- pragma foreign_proc("Java", 
+	catch_impl(_Pred::pred(out) is nondet, _Handler::in(handler), _T::out),
+		[will_not_call_mercury, promise_pure], "
+	throw new java.lang.Error(""catch_impl not yet implemented"");
+").
 
 %-----------------------------------------------------------------------------%
 %
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.131
diff -u -d -r1.131 private_builtin.m
--- library/private_builtin.m	1 Dec 2003 06:51:09 -0000	1.131
+++ library/private_builtin.m	1 Dec 2003 11:50:25 -0000
@@ -1132,19 +1132,15 @@
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_code("Java", "
-    public static mercury.private_builtin.type_info_1
-	    private_builtin__type_ctor_info_type_info_1 =
-		    new mercury.private_builtin.type_info_1();
-
     public static class ref_1
-     {
+    {
      	// XXX stub only
-     }
+    }
 
     public static class heap_pointer_0
-     {
+    {
      	// XXX stub only
-     }
+    }
 
     // TypeCtorRep constants
     public static final int MR_TYPECTOR_REP_ENUM = 0;
@@ -1193,6 +1189,132 @@
     public static final int MR_SECTAG_LOCAL	= 1;
     public static final int MR_SECTAG_REMOTE	= 2;
     public static final int MR_SECTAG_VARIABLE	= 3;
+
+    // The dummy_var is used to represent io__states and other Mercury
+    // parameters that are not really passed around.  Occasionally a dummy
+    // variable will be used by the code generator as an lval, so we use
+    // private_builtin:dummy_var as that lval.
+    public static class Dummy {
+    	public java.lang.Object F1;
+    };
+    public static Dummy dummy_var = new Dummy();
+").
+
+:- pragma foreign_code("Java", "
+	//
+	// Type-specific unification and comparison routines
+	//
+
+	public static boolean
+	__Unify____ref_1_0(mercury.runtime.TypeInfo_Struct ti,
+		mercury.private_builtin.ref_1 x,
+		mercury.private_builtin.ref_1 y)
+	{
+		// stub only
+		throw new java.lang.Error
+		    (""unify/2 for type private_builtin.ref not implemented"");
+	}
+
+	public static boolean
+	__Unify____heap_pointer_0_0 (mercury.private_builtin.heap_pointer_0 x,
+		mercury.private_builtin.heap_pointer_0 y)
+	{
+		// stub only
+		throw new java.lang.Error(""unify/2 for type heap_pointer/0"");
+	}
+
+	public static boolean
+	__Unify____type_ctor_info_1_0(mercury.runtime.TypeInfo_Struct ti,
+		mercury.runtime.TypeCtorInfo_Struct x,
+		mercury.runtime.TypeCtorInfo_Struct y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""unify/2 for type type_ctor_info/1"");
+	}
+
+	public static boolean
+	__Unify____type_info_1_0(mercury.runtime.TypeInfo_Struct ti,
+		mercury.runtime.TypeInfo_Struct x,
+		mercury.runtime.TypeInfo_Struct y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""unify/2 for type type_info/1"");
+	}
+
+	public static boolean
+	__Unify____base_typeclass_info_1_0(mercury.runtime.TypeInfo_Struct ti,
+		java.lang.Object[] x, java.lang.Object[] y)
+	{
+		// stub only
+		throw new java.lang.Error(""unify/2 for type typeclass_info/1"");
+	}
+
+	public static boolean
+	__Unify____typeclass_info_1_0(mercury.runtime.TypeInfo_Struct ti,
+		java.lang.Object[] x, java.lang.Object[] y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""unify/2 for type typeclass_info/1"");
+	}
+
+	public static mercury.builtin.comparison_result_0
+	__Compare____ref_1_0(mercury.runtime.TypeInfo_Struct ti,
+		mercury.private_builtin.ref_1 x,
+		mercury.private_builtin.ref_1 y)
+	{
+		// stub only
+		throw new java.lang.Error
+		    (""called compare/3 for type private_builtin.ref"");
+	}
+
+	public static mercury.builtin.comparison_result_0
+	__Compare____heap_pointer_0_0 (mercury.private_builtin.heap_pointer_0 x,
+		mercury.private_builtin.heap_pointer_0 y)
+	{
+		// stub only
+		throw new java.lang.Error(""compare/2 for type heap_pointer/0"");
+	}
+
+	public static mercury.builtin.comparison_result_0
+	__Compare____type_ctor_info_1_0(mercury.runtime.TypeInfo_Struct ti,
+		mercury.runtime.TypeCtorInfo_Struct x,
+		mercury.runtime.TypeCtorInfo_Struct y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""compare/2 for type type_ctor_info/1"");
+	}
+
+	public static mercury.builtin.comparison_result_0
+	__Compare____type_info_1_0(mercury.runtime.TypeInfo_Struct ti,
+		mercury.runtime.TypeInfo_Struct x,
+		mercury.runtime.TypeInfo_Struct y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""compare/2 for type type_info/1"");
+	}
+
+	public static mercury.builtin.comparison_result_0
+	__Compare____base_typeclass_info_1_0(mercury.runtime.TypeInfo_Struct ti,
+		java.lang.Object[] x, java.lang.Object[] y)
+	{
+		// stub only
+		throw new java.lang.Error(""compare/2 for type typeclass_info/1"");
+	}
+
+	public static mercury.builtin.comparison_result_0
+	__Compare____typeclass_info_1_0(mercury.runtime.TypeInfo_Struct ti,
+		java.lang.Object[] x, java.lang.Object[] y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""compare/2 for type typeclass_info/1"");
+	}
+
 ").
 
 %-----------------------------------------------------------------------------%
Index: library/store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.41
diff -u -d -r1.41 store.m
--- library/store.m	20 Oct 2003 07:29:27 -0000	1.41
+++ library/store.m	1 Dec 2003 11:38:47 -0000
@@ -235,7 +235,7 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module std_util.
+:- import_module std_util, require.
 
 :- typeclass store(T) where [].
 :- instance store(store(S)) where []. 
@@ -249,7 +249,15 @@
 	% XXX we use `mkstore' here rather than `store' to work
 	%     around a bug with the Java back-end: it generates
 	%     invalid Java code if we use `store'.
-:- type store(S) ---> mkstore(c_pointer).
+:- type store(S) ---> mkstore(c_pointer)
+	where equality is store_equal, comparison is store_compare.
+
+:- pred store_equal(store(S)::in, store(S)::in) is semidet.
+store_equal(_, _) :- error("attempt to unify two stores").
+
+:- pred store_compare(comparison_result::uo, store(S)::in, store(S)::in)
+	is det.
+store_compare(_, _, _) :- error("attempt to compare two stores").
 
 % Mutvars and references are each represented as a pointer to a single word
 % on the heap.
@@ -268,6 +276,10 @@
 :- mode store__do_init(uo) is det.
 
 :- pragma foreign_proc("C", store__do_init(_S0::uo),
+	[will_not_call_mercury, promise_pure], "").
+:- pragma foreign_proc("C#", store__do_init(_S0::uo),
+	[will_not_call_mercury, promise_pure], "").
+:- pragma foreign_proc("Java", store__do_init(_S0::uo),
 	[will_not_call_mercury, promise_pure], "").
 
 /* 
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.22
diff -u -d -r1.22 type_desc.m
--- library/type_desc.m	20 Nov 2003 11:35:43 -0000	1.22
+++ library/type_desc.m	1 Dec 2003 09:37:20 -0000
@@ -542,11 +542,48 @@
 
 :- pragma foreign_code("Java", "
 	public class type_desc_0 {
-		// ...
+		// stub only
 	}
 	public class type_ctor_desc_0 {
-		// ...
+		// stub only
 	}
+
+	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"");
+	}
+
+	public static boolean
+	__Unify____type_ctor_desc_0_0(mercury.type_desc.type_ctor_desc_0 x,
+		mercury.type_desc.type_ctor_desc_0 y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""unify/2 for type_ctor_desc type not implemented"");
+	}
+
+	public static mercury.builtin.comparison_result_0
+	__Compare____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
+			(""compare/3 for type_desc type implemented"");
+	}
+
+	public static mercury.builtin.comparison_result_0
+	__Compare____type_ctor_desc_0_0(mercury.type_desc.type_ctor_desc_0 x,
+		mercury.type_desc.type_ctor_desc_0 y)
+	{
+		// stub only
+		throw new java.lang.Error
+			(""compare/3 for type_ctor_desc type implemented"");
+	}
+
 ").
 
 %-----------------------------------------------------------------------------%

-- 
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
--------------------------------------------------------------------------



More information about the reviews mailing list