[m-rev.] fix java back-end bug with constructors

[Fergus Henderson]

Estimated hours taken: 1
Branches: main

A bug fix for the Java back-end.

compiler/ml_type_gen.m:
	Fix a bug where we were generating invalid Java code for constructors.
	For a constructor Foo with an argument of type Bar, we were generating

		public Foo(Bar F1) {
			((modulename.Foo)this).F1 = 
				modulename.Foo.F1; // XXX
		}

        instead of

		public Foo(Bar F1) {
			((modulename.typename)this).F1 = F1;
		}
		 
	The fix was to change ml_type_gen.m so that for the Java back-end,
	it generates MLDS corresponding to

		public Foo(Bar F1) {
			((modulename.typename)this).F1 = modulename.F1;
		}

	and then the "modulename." qualifier on F1 gets removed by the
	existing code in mlds_to_java.m.

Workspace: /home/jupiter/fjh/ws-jupiter/mercury
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.33
diff -u -d -r1.33 ml_type_gen.m
--- compiler/ml_type_gen.m	25 Jul 2003 02:27:21 -0000	1.33
+++ compiler/ml_type_gen.m	28 Nov 2003 08:42:15 -0000
@@ -669,7 +669,7 @@
 					BaseClassQualifier, UnqualCtorName,
 					CtorArity)
 			),
-			CtorFunction = gen_constructor_function(
+			CtorFunction = gen_constructor_function(Target,
 				BaseClassId, CtorClassType, CtorClassQualifier,
 				SecondaryTagClassId, MaybeSecTagVal, Members,
 				MLDS_Context),
@@ -686,7 +686,7 @@
 				),
 				Members \= []
 			->
-				ZeroArgCtor = gen_constructor_function(
+				ZeroArgCtor = gen_constructor_function(Target,
 					BaseClassId, CtorClassType,
 					CtorClassQualifier,
 					SecondaryTagClassId, no, [],
@@ -759,15 +759,28 @@
 target_uses_empty_base_classes(java)	= yes.
 target_uses_empty_base_classes(asm)	= no.
 
-:- func gen_constructor_function(mlds__class_id, mlds__type, mlds_module_name,
-		mlds__class_id, maybe(int), mlds__defns, mlds__context) =
-		mlds__defn.
-gen_constructor_function(BaseClassId, ClassType, ClassQualifier,
+	% This should return yes if references to function parameters in
+	% constructor functions must be qualified with the module name,
+	% not the class name.
+	% We need to do this for the Java back-end, since MLDS names which
+	% are qualified with the module name get unqualified when output
+	% as Java, and parameter names must all be unqualified.
+	% XXX perhaps we should do the same for all back-ends?
+:- func target_requires_module_qualified_params(compilation_target) = bool.
+target_requires_module_qualified_params(c)	 = no.
+target_requires_module_qualified_params(il)	 = no.
+target_requires_module_qualified_params(java)    = yes.
+target_requires_module_qualified_params(asm)	 = no.
+
+:- func gen_constructor_function(compilation_target, mlds__class_id,
+		mlds__type, mlds_module_name, mlds__class_id, maybe(int),
+		mlds__defns, mlds__context) = mlds__defn.
+gen_constructor_function(Target, BaseClassId, ClassType, ClassQualifier,
 		SecondaryTagClassId, MaybeTag, Members, Context) = CtorDefn :-
 	Args = list__map(make_arg, Members),
 	ReturnValues = [],
 
-	InitMembers0 = list__map(gen_init_field(BaseClassId,
+	InitMembers0 = list__map(gen_init_field(Target, BaseClassId,
 			ClassType, ClassQualifier), Members),
 	(
 		MaybeTag = yes(TagVal)
@@ -803,9 +816,10 @@
 	).
 
 	% Generate "this-><fieldname> = <fieldname>;".
-:- func gen_init_field(mlds__class_id, mlds__type, mlds_module_name, mlds__defn)
-		= mlds__statement is det.
-gen_init_field(BaseClassId, ClassType, ClassQualifier, Member) = Statement :-
+:- func gen_init_field(compilation_target, mlds__class_id, mlds__type,
+		mlds_module_name, mlds__defn) = mlds__statement is det.
+gen_init_field(Target, BaseClassId, ClassType, ClassQualifier, Member) =
+		Statement :-
 	Member = mlds__defn(EntityName, Context, _Flags, Defn),
 	( Defn = data(Type0, _Init, _GC_TraceCode) ->
 		Type = Type0
@@ -821,7 +835,19 @@
 	;
 		unexpected(this_file, "gen_init_field: non-var member")
 	),
-	Param = mlds__lval(mlds__var(qual(ClassQualifier, VarName), Type)),
+	(
+		target_requires_module_qualified_params(Target) = yes
+	->
+		( BaseClassId = mlds__class_type(qual(ModuleName, _), _, _) ->
+			QualVarName = qual(ModuleName, VarName)
+		;
+			unexpected(this_file,
+				"gen_init_field: invalid BaseClassId")
+		)
+	;
+		QualVarName = qual(ClassQualifier, VarName)
+	),
+	Param = mlds__lval(mlds__var(QualVarName, Type)),
 	Field = mlds__field(yes(0), self(ClassType),
 			named_field(qual(ClassQualifier, Name),
 				mlds__ptr_type(ClassType)),

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