[m-rev.] For review: Bug fix for polymorphism.m

[James Goddard]

Estimated hours taken: 24
Branches: main

Bug fix for polymorphism.m

compiler/polymorphism.m:
	error appears in debug output in: store.hlds_dump.*
	Where the type_info/typeclass_info types were in the wrong order,
	which meant that the java code generated was trying to cast type_infos
	to typeclass_infos and vice versa.

	The problem was that in polymorphism__process_foreign_proc_args the
	ArgInfo list was being generated in a certain order:

	typeinfos ++ typeclass_infos ++ oldinfos

	as is in fact documented in the predicate, but the corresponding type
	list OrigArgTypes had:

	typeclass_info types ++ typeinfo types ++ OrigArgTypes

	So this has been altered so that the typeinfo types go first.

compiler/hlds_out.m:
	hlds_out__write_goal_2 modified so as to print out the type list
	after the argument names list.

Index: polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.249
diff -u -d -r1.249 polymorphism.m
--- polymorphism.m	1 Dec 2003 15:55:45 -0000	1.249
+++ polymorphism.m	4 Feb 2004 02:55:46 -0000
@@ -1623,9 +1623,9 @@
 		TypeInfoTypes),
 	list__map(polymorphism__build_typeclass_info_type, UnivCs, UnivTypes),
 	list__map(polymorphism__build_typeclass_info_type, ExistCs, ExistTypes),
-	list__append(TypeInfoTypes, OrigArgTypes0, OrigArgTypes1),
-	list__append(ExistTypes, OrigArgTypes1, OrigArgTypes2),
-	list__append(UnivTypes, OrigArgTypes2, OrigArgTypes).
+	list__append(ExistTypes, OrigArgTypes0, OrigArgTypes1),
+	list__append(UnivTypes, OrigArgTypes1, OrigArgTypes2),
+	list__append(TypeInfoTypes, OrigArgTypes2, OrigArgTypes).
 
 :- pred polymorphism__foreign_proc_add_typeclass_infos(
 	list(class_constraint)::in, list(class_constraint)::in,
Index: hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.323
diff -u -d -r1.323 hlds_out.m
--- hlds_out.m	12 Jan 2004 06:43:29 -0000	1.323
+++ hlds_out.m	30 Jan 2004 01:55:53 -0000
@@ -1724,8 +1724,9 @@
 		true
 	).
 
-hlds_out__write_goal_2(foreign_proc(Attributes, _, _, ArgVars, ArgNames, _,
-		PragmaCode), _, _, _, Indent, Follow, _, !IO) :-
+hlds_out__write_goal_2(foreign_proc(Attributes, _PredId, _ProcId, ArgVars,
+		ArgNames, OrigArgTypes, PragmaCode),
+		_, _, AppendVarNums, Indent, Follow, _, !IO) :-
 	ForeignLang = foreign_language(Attributes),
 	hlds_out__write_indent(Indent, !IO),
 	io__write_string("$pragma_foreign_proc( /* ", !IO),
@@ -1735,6 +1736,12 @@
 	io__write_string("], [", !IO),
 	get_pragma_foreign_var_names(ArgNames, Names),
 	hlds_out__write_string_list(Names, !IO),
+	io__write_string("], [", !IO),
+	% XXX We don't have the TypeVarSet available here,
+	%     but it's only used for printing out the names of the
+	%     type variables, which isn't essential.
+	varset__init(TypeVarSet),
+	hlds_out__write_type_list(OrigArgTypes, TypeVarSet, AppendVarNums, !IO),
 	io__write_string("], ", !IO),
 	(
 		PragmaCode = ordinary(C_Code, _),
@@ -2710,6 +2717,14 @@
 	io__write_string("pseudo_imported").
 hlds_out__write_import_status(exported_to_submodules) -->
 	io__write_string("exported_to_submodules").
+
+:- pred hlds_out__write_type_list(list(type)::in, tvarset::in, bool::in,
+		io::di, io::uo) is det.
+hlds_out__write_type_list(Types, TypeVarSet, AppendVarNums) -->
+	list__foldl((pred(Type::in, di, uo) is det -->
+		mercury_output_term(Type, TypeVarSet, AppendVarNums),
+		io__write_string(", ")),
+		Types).
 
 :- pred hlds_out__write_var_types(int::in, prog_varset::in, bool::in,
 	vartypes::in, tvarset::in, io::di, io::uo) is det.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------