[m-rev.] diff: IL back-end: some fixes for --high-level-datas

[Fergus Henderson]

Estimated hours taken: 2
Branches: main

Fix a couple of bugs in the IL back-end that caused it to generate incorrect 
refences to constructor names when --high-level-data was enabled.
One was that it was using the base class type rather than the
derived type for the appropriate constructor.
The other was that it was using "." rather than "/" as the class qualifier
when referencing nested classes.
(This change is only a partial fix for the latter problem.)

compiler/ilds.m:
	Change the structured_type so that nested classes are stored
	a separate field from the namespace-qualified top-level class.

	Rename "append_class_name" as "append_toplevel_class_name",
	and add a new routine "append_nested_class_name".
	
compiler/ilasm.m:
	Output "/" rather than "." as the class qualifier for nested classes.

compiler/mlds_to_csharp.m:
compiler/mlds_to_mcpp.m:
	Minor changes to handle the new definition of structured_type.

compiler/mlds_to_il.m:
	Handle the new definition of structured_type.
	Use the MaybeCtorName field of new_object instructions
	to determine the type to allocate.

Workspace: /home/venus/fjh/ws-venus4/mercury
Index: compiler/ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ilasm.m,v
retrieving revision 1.18
diff -u -d -r1.18 ilasm.m
--- compiler/ilasm.m	9 Aug 2001 16:30:24 -0000	1.18
+++ compiler/ilasm.m	13 Aug 2001 01:37:31 -0000
@@ -1420,17 +1420,14 @@
 	ilasm_info::in, ilasm_info::out, io__state::di, io__state::uo) is det.
 output_class_member_name(class_member_name(StructuredName, MemberName),
 		Info0, Info) -->
-	( { StructuredName = structured_name(_, [_ | _]) } ->
-		output_structured_name(StructuredName, Info0, Info),
-		io__write_string("::")
-	;
-		{ Info = Info0 }
-	),
+	output_structured_name(StructuredName, Info0, Info),
+	io__write_string("::"),
 	output_member_name(MemberName).
 
 :- pred output_structured_name(structured_name::in, ilasm_info::in,
 	ilasm_info::out, io__state::di, io__state::uo) is det.
-output_structured_name(structured_name(Asm, DottedName), Info, Info) -->
+output_structured_name(structured_name(Asm, DottedName, NestedClasses),
+		Info, Info) -->
 	( { Asm = assembly(Assembly) },
 		maybe_output_quoted_assembly_name(Assembly, Info)
 	; { Asm = module(Module, Assembly) },
@@ -1444,7 +1441,9 @@
 			maybe_output_quoted_assembly_name(Assembly, Info)
 		)
 	),
-	output_dotted_name(DottedName).
+	output_dotted_name(DottedName),
+	output_nested_class_quals(NestedClasses).
+
 
 :- pred maybe_output_quoted_assembly_name(ilds__id::in, ilasm_info::in,
 		io__state::di, io__state::uo) is det.
@@ -1461,6 +1460,14 @@
 	io__state::di, io__state::uo) is det.
 output_dotted_name(Name) -->
 	io__write_list(Name, ".", output_id).
+
+:- pred output_nested_class_quals(nested_class_name::in,
+	io__state::di, io__state::uo) is det.
+output_nested_class_quals(Name) -->
+	list__foldl(
+		(pred(Id::in, di, uo) is det -->
+			io__write_char('/'), output_id(Id)),
+		Name).
 
 :- pred output_id(ilds__id::in, io__state::di, io__state::uo) is det.
 output_id(Id) -->
Index: compiler/ilds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ilds.m,v
retrieving revision 1.9
diff -u -d -r1.9 ilds.m
--- compiler/ilds.m	9 Aug 2001 16:30:24 -0000	1.9
+++ compiler/ilds.m	13 Aug 2001 01:37:31 -0000
@@ -61,7 +61,18 @@
 	% in the same assembly. 
 
 :- type structured_name ---> 
-		structured_name(assembly_name, namespace_qual_name).
+		structured_name(
+			assembly_name,		% the name of the assembly
+			namespace_qual_name,	% the name of the top-level class
+						% (i.e. the namespace name
+						% and the outermost class name),
+						% or just the namespace name,
+						% if this structured_name is
+						% a namespace
+			nested_class_name).	% the name of the nested class
+						% within the top-level class,
+						% or the empty list if it is
+						% not a nested class
 
 	% If we are referencing a sub-module, then we need to record two
 	% names.  One is the sub-module name, which is used for
@@ -77,12 +88,23 @@
 	;	assembly(ilds__id).
 
 :- type namespace_qual_name == list(ilds__id). 
+:- type nested_class_name == list(ilds__id).
 
 	
-	% A namespace qualified class name is a structured name.
-	% [Foo]Foo::Bar::Baz is structured_name("Foo", ["Foo", "Bar", "Baz"])
+	% An assembly- and namespace-qualified class name is a structured name.
+	% E.g. the ILASM name [Foo]Bar1.Bar2.Baz1/Baz2/Quux is
+	% structured_name("Foo", ["Bar1", "Bar2", "Baz1"], ["Baz2", "Quux"]).
+	% "[Foo]" is the assembly qualifier,
+	% "Bar1.Bar2." is the namespace qualiifer,
+	% "Baz1/Baz2/" is a class qualifier,
+	% and "Quux" is the name of the nested class.
 :- type class_name == structured_name.
 
+	% A assembly-qualified namespace name is a structured name.
+	% E.g. the ILASM name [Foo]Bar1.Bar2 is
+	% structured_name("Foo", ["Bar1", "Bar2"], []).
+:- type namespace_name == structured_name.
+
 	% A member of a class 
 :- type class_member_name
 	---> class_member_name(
@@ -344,31 +366,39 @@
 
 	% Get the non-namespace portion of a class name.
 
-:- func get_class_suffix(ilds__class_name) = ilds__id.
+:- func get_class_suffix(ilds__class_name) = list(ilds__id).
 
-	% Add an extra identifier to the end of an IL class name, e.g.
+	% Add an extra identifier to the end of an IL namespace name, e.g.
 	% append Foo to [mercury]mercury.runtime to make
 	% [mercury]mercury.runtime.Foo
 
-:- func append_class_name(ilds__class_name, ilds__namespace_qual_name) =
+:- func append_toplevel_class_name(ilds__namespace_name, ilds__id) =
+	ilds__class_name.
+
+	% Add an extra identifier to the end of an IL class name, e.g.
+	% append Bar to [mercury]mercury.runtime.Foo to make
+	% [mercury]mercury.runtime.Foo.Bar
+
+:- func append_nested_class_name(ilds__class_name, ilds__nested_class_name) =
 	ilds__class_name.
 
 :- implementation.
 
-:- import_module int.
+:- import_module int, require.
 :- import_module error_util.
 
-get_class_suffix(structured_name(_, FullName)) = SuffixName :-
+get_class_suffix(structured_name(_, OuterClassFullName, NestedClass))
+		= SuffixName :-
 	( 
-		list__last(FullName, Last)
+		list__last(OuterClassFullName, Last)
 	->
-		SuffixName = Last
+		SuffixName = [Last | NestedClass]
 	;
 			% This class has no name whatsoever.
 		unexpected(this_file, "get_class_namespace: class has no name")
 	).
 
-get_class_namespace(structured_name(_, FullName)) = NamespaceName :-
+get_class_namespace(structured_name(_, FullName, _)) = NamespaceName :-
 	( 
 		list__last(FullName, Last),
 		list__remove_suffix(FullName, [Last], NamespaceName0)
@@ -379,9 +409,16 @@
 		unexpected(this_file, "get_class_namespace: class has no name")
 	).
 
-append_class_name(structured_name(Assembly, ClassName), ExtraClass) =
-		structured_name(Assembly, NewClassName) :-
-	list__append(ClassName, ExtraClass, NewClassName).
+append_toplevel_class_name(structured_name(Assembly, Namespace, NestedClass),
+		Class) = structured_name(Assembly, ClassName, []) :-
+	require(unify(NestedClass, []),
+		"append_toplevel_class_name: namespace name has nested class?"),
+	list__append(Namespace, [Class], ClassName).
+
+append_nested_class_name(StructuredName0, ExtraNestedClasses) = StructuredName :-
+	StructuredName0 = structured_name(Assembly, Class, NestedClasses),
+	StructuredName = structured_name(Assembly, Class,
+				NestedClasses ++ ExtraNestedClasses).
 
 calculate_max_stack(Instrs) = 
 	calculate_max_stack_2(Instrs, 0, 0).
Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_csharp.m,v
retrieving revision 1.14
diff -u -d -r1.14 mlds_to_csharp.m
--- compiler/mlds_to_csharp.m	12 Aug 2001 13:29:11 -0000	1.14
+++ compiler/mlds_to_csharp.m	13 Aug 2001 01:37:31 -0000
@@ -498,8 +498,8 @@
 
 :- pred write_csharp_class_name(structured_name::in, io__state::di,
 	io__state::uo) is det.
-write_csharp_class_name(structured_name(_Assembly, DottedName)) -->
-	io__write_list(DottedName, ".", io__write_string).
+write_csharp_class_name(structured_name(_Assembly, DottedName, NestedClasses)) -->
+	io__write_list(DottedName ++ NestedClasses, ".", io__write_string).
 
 :- pred write_il_type_as_csharp_type(ilds__type::in,
 	io__state::di, io__state::uo) is det.
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.66
diff -u -d -r1.66 mlds_to_il.m
--- compiler/mlds_to_il.m	12 Aug 2001 21:57:34 -0000	1.66
+++ compiler/mlds_to_il.m	13 Aug 2001 01:37:31 -0000
@@ -219,7 +219,7 @@
 	ForeignLangs = IlInfo ^ file_foreign_langs,
 
 	ClassName = mlds_module_name_to_class_name(ModuleName),
-	ClassName = structured_name(_, NamespaceName),
+	ClassName = structured_name(_, NamespaceName, _),
 
 		% Make this module an assembly unless it is in the standard
 		% library.  Standard library modules all go in the one
@@ -525,7 +525,7 @@
 		% when that assembly is created by al.exe.
 		% This occurs for nondet environment classes in the
 		% mercury std library.
-	( ClassName = structured_name(assembly("mercury"), _) ->
+	( ClassName = structured_name(assembly("mercury"), _, _) ->
 		Flags = set_access(Flags0, public)
 	;
 		Flags = Flags0
@@ -582,7 +582,8 @@
 	).
 
 class_name(Module, Name)
-	= append_class_name(mlds_module_name_to_class_name(Module), [Name]).
+	= append_toplevel_class_name(mlds_module_name_to_class_name(Module),
+		Name).
 
 :- func sym_name_to_list(sym_name) = list(string).
 
@@ -738,7 +739,7 @@
 	( semidet_succeed ->
 		sorry(this_file, "interface_id_to_class_name NYI")
 	;
-		Result = structured_name(assembly("XXX"), [])
+		Result = structured_name(assembly("XXX"), [], [])
 		
 	).
 
@@ -966,10 +967,11 @@
 		{ RenameNode = (func(N) = list__map(RenameRets, N)) },
 
 		{ ExceptionClassName = structured_name(assembly("mscorlib"),
-				["System", "Exception"]) },
+				["System", "Exception"], []) },
 
-		{ ConsoleWriteName = class_member_name(structured_name(
-				il_system_assembly_name, ["System", "Console"]),
+		{ ConsoleWriteName = class_member_name(
+				structured_name(il_system_assembly_name,
+					["System", "Console"], []),
 				id("Write")) },
 		{ WriteString = methoddef(call_conv(no, default),
 					void, ConsoleWriteName,
@@ -1617,7 +1619,7 @@
 	get_load_store_lval_instrs(Target, LoadInstrs, StoreInstrs),
 	{ Instrs = tree__list([LoadInstrs, instr_node(ldnull), StoreInstrs]) }.
 
-atomic_statement_to_il(new_object(Target, _MaybeTag, Type, Size, _CtorName,
+atomic_statement_to_il(new_object(Target, _MaybeTag, Type, Size, MaybeCtorName,
 		Args, ArgTypes), Instrs) -->
 	DataRep =^ il_data_rep,
 	( 
@@ -1641,7 +1643,17 @@
 			%	call ClassName::.ctor
 			%	... store to memory reference ...
 			%
-		{ ClassName = mlds_type_to_ilds_class_name(DataRep, Type) },
+		{ ClassName0 = mlds_type_to_ilds_class_name(DataRep, Type) },
+		( { MaybeCtorName = yes(QualifiedCtorName) } ->
+			{ QualifiedCtorName = qual(_,
+				ctor_id(CtorName, CtorArity)) },
+			{ CtorType = entity_name_to_ilds_id(
+				type(CtorName, CtorArity)) },
+		 	{ ClassName = append_nested_class_name(ClassName0,
+				[CtorType]) }
+		;
+		 	{ ClassName = ClassName0 }
+		),
 		list__map_foldl(load, Args, ArgsLoadInstrsTrees),
 		{ ArgsLoadInstrs = tree__list(ArgsLoadInstrsTrees) },
 		get_load_store_lval_instrs(Target, LoadMemRefInstrs,
@@ -2651,9 +2663,8 @@
 mlds_class_name_to_ilds_class_name(
 		qual(MldsModuleName, MldsClassName0), Arity) = IldsClassName :-
 	MldsClassName = string__format("%s_%d", [s(MldsClassName0), i(Arity)]),
-	IldsClassName = append_class_name(
-		mlds_module_name_to_class_name(MldsModuleName),
-		[MldsClassName]).
+	IldsClassName = append_toplevel_class_name(
+		mlds_module_name_to_class_name(MldsModuleName), MldsClassName).
 
 mlds_type_to_ilds_class_name(DataRep, MldsType) = 
 	get_ilds_type_class_name(mlds_type_to_ilds_type(DataRep, MldsType)).
@@ -2989,7 +3000,7 @@
 :- func mlds_module_name_to_class_name(mlds_module_name) = ilds__class_name.
 
 mlds_module_name_to_class_name(MldsModuleName) = 
-		structured_name(AssemblyName, ClassName) :-
+		structured_name(AssemblyName, ClassName, []) :-
 	SymName = mlds_module_name_to_sym_name(MldsModuleName),
 	sym_name_to_class_name(SymName, ClassName),
 	AssemblyName = mlds_module_name_to_assembly_name(MldsModuleName).
@@ -3443,29 +3454,21 @@
 	% qualifiy a name with "[mercury]mercury."
 :- func mercury_library_name(ilds__namespace_qual_name) = ilds__class_name.
 mercury_library_name(Name) = 
-	append_class_name(mercury_library_namespace_name, Name).
-
-:- func mercury_library_namespace_name = ilds__class_name.
-mercury_library_namespace_name
-	= structured_name(assembly("mercury"), ["mercury"]).
+	structured_name(assembly("mercury"), ["mercury" | Name], []).
 
 %-----------------------------------------------------------------------------
 
 	% qualifiy a name with "[mercury]mercury.runtime."
 :- func mercury_runtime_name(ilds__namespace_qual_name) = ilds__class_name.
 mercury_runtime_name(Name) = 
-	append_class_name(mercury_runtime_class_name, Name).
-
-:- func mercury_runtime_class_name = ilds__class_name.
-mercury_runtime_class_name
-	= structured_name(assembly("mercury"), ["mercury", "runtime"]).
+	structured_name(assembly("mercury"), ["mercury", "runtime" | Name], []).
 
 %-----------------------------------------------------------------------------
 
 	% qualifiy a name with "[mscorlib]System."
 :- func il_system_name(ilds__namespace_qual_name) = ilds__class_name.
 il_system_name(Name) = structured_name(il_system_assembly_name, 
-		[il_system_namespace_name | Name]).
+		[il_system_namespace_name | Name], []).
 
 :- func il_system_assembly_name = assembly_name.
 il_system_assembly_name = assembly("mscorlib").
@@ -3623,7 +3626,7 @@
 :- func runtime_init_module_name = ilds__class_name.
 runtime_init_module_name = 
 	structured_name(assembly("mercury"),
-		["mercury", "private_builtin__cpp_code", wrapper_class_name]).
+		["mercury", "private_builtin__cpp_code", wrapper_class_name], []).
 
 :- func runtime_init_method_name = ilds__member_name.
 runtime_init_method_name = id("init_runtime").
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_mcpp.m,v
retrieving revision 1.17
diff -u -d -r1.17 mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m	12 Aug 2001 13:29:12 -0000	1.17
+++ compiler/mlds_to_mcpp.m	13 Aug 2001 01:37:31 -0000
@@ -614,8 +614,9 @@
 
 :- pred write_managed_cpp_class_name(structured_name::in, io__state::di,
 	io__state::uo) is det.
-write_managed_cpp_class_name(structured_name(_Assembly, DottedName)) -->
-	io__write_list(DottedName, "::", io__write_string).
+write_managed_cpp_class_name(structured_name(_Assembly, DottedName,
+		NestedClasses)) -->
+	io__write_list(DottedName ++ NestedClasses, "::", io__write_string).
 
 :- pred write_il_type_as_managed_cpp_type(ilds__type::in,
 	io__state::di, io__state::uo) is det.

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