[m-rev.] diff: some more --highlevel-data fixes.

[Tyson Dowd]

Hi,

Another chapter in the continuing saga of trying to get --highlevel-data
to work in the .NET backend. 

Strangely enough, this change was written while sitting on Warwick
Harvey's couch, which means he's *still* indirectly contributing to the
Mercury project ;-)

===================================================================


Estimated hours taken: 2.5
Branches: main

Various fixes for --grade il.

compiler/mlds_to_il.m:
	Only add "mercury_code" suffixes to a module name if it is
	necessary.  This allows us to omit "mercury_code" when generating
	field references correctly for classes that are generated for 
	user-defined types when using --high-level-data.

	Generate code for new_object using the class-based approach (as
	opposed to the low-level data array based approach).

	Fix the code for generating fieldrefs so that we use the
	module name in the named_field to generate a classname.

compiler/mlds_to_csharp.m:
compiler/mlds_to_mcpp.m:
	Minor changes to handle the new interface to
	mlds_module_name_to_class_name.


Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_csharp.m,v
retrieving revision 1.3
diff -u -r1.3 mlds_to_csharp.m
--- compiler/mlds_to_csharp.m	2001/05/08 10:20:35	1.3
+++ compiler/mlds_to_csharp.m	2001/05/22 07:33:46
@@ -91,7 +91,7 @@
 
 	{ MLDS = mlds(ModuleName, ForeignCode, _Imports, Defns) },
 	{ ClassName = mlds_module_name_to_class_name(
-		mercury_module_name_to_mlds(ModuleName)) },
+		mercury_module_name_to_mlds(ModuleName), yes) },
 
 	io__nl,
 	io__write_strings([
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.27
diff -u -r1.27 mlds_to_il.m
--- compiler/mlds_to_il.m	2001/05/14 13:24:45	1.27
+++ compiler/mlds_to_il.m	2001/05/23 05:42:38
@@ -122,8 +122,10 @@
 	maybe(mlds__func_sequence_num), ilds__class_name, ilds__id).
 :- mode mangle_mlds_proc_label(in, in, out, out) is det.
 
-	% Turn an MLDS module name into a class_name name
-:- func mlds_module_name_to_class_name(mlds_module_name) = ilds__class_name.
+	% Turn an MLDS module name into a class_name name, adding a
+	% "mercury_code" suffix if the bool is "yes".
+:- func mlds_module_name_to_class_name(mlds_module_name, bool) =
+	ilds__class_name.
 
 
 	% Return the class_name for the generic class.
@@ -213,7 +215,7 @@
 		Info3),
 	list__condense(OtherDeclsList, OtherDecls),
 
-	ClassName = mlds_module_name_to_class_name(ModuleName),
+	ClassName = mlds_module_name_to_class_name(ModuleName, yes),
 
 		% Make this module an assembly unless it is in the standard
 		% library.  Standard library modules all go in the one
@@ -382,7 +384,7 @@
 generate_method_defn(DataDefn) --> 
 	{ DataDefn = defn(data(DataName), Context, _DeclsFlags, Entity) },
 	il_info_get_module_name(ModuleName),
-	{ ClassName = mlds_module_name_to_class_name(ModuleName) },
+	{ ClassName = mlds_module_name_to_class_name(ModuleName, yes) },
 
 		% Generate a term (we use it to emit the complete
 		% method definition as a comment, which is nice
@@ -494,7 +496,7 @@
 :- mode generate_other_decls(in, out, in, out) is det.
 generate_other_decls(MLDSDefn, Decls) -->
 	ModuleName =^ module_name,
-	{ ClassName = mlds_module_name_to_class_name(ModuleName) },
+	{ ClassName = mlds_module_name_to_class_name(ModuleName, yes) },
 	{ MLDSDefn = mlds__defn(EntityName, _Context, _DeclFlags, Entity) }, 
 	{ term__type_to_term(MLDSDefn, MLDSDefnTerm) },
 	( { EntityName = type(TypeName0, Arity) },
@@ -981,7 +983,7 @@
 		{ mangle_foreign_code_module(ModuleName, Lang,
 			OutlineLangModuleName) },
 		{ ClassName = mlds_module_name_to_class_name(
-			OutlineLangModuleName) },
+			OutlineLangModuleName, yes) },
 		signature(_, RetType, Params) =^ signature, 
 
 		( { ReturnLvals = [] } ->
@@ -1028,7 +1030,8 @@
 			% XXX we hardcode managed C++ here
 		^ method_foreign_lang := yes(managed_cplusplus),
 		{ mangle_dataname_module(no, ModuleName, NewModuleName) },
-		{ ClassName = mlds_module_name_to_class_name(NewModuleName) },
+		{ ClassName = mlds_module_name_to_class_name(NewModuleName,
+				no) },
 		signature(_, RetType, Params) =^ signature, 
 			% If there is a return value, put it in succeeded.
 			% XXX this is incorrect for functions, which might
@@ -1089,9 +1092,16 @@
 
 atomic_statement_to_il(new_object(Target, _MaybeTag, Type, Size, _CtorName,
 		Args, ArgTypes), Instrs) -->
+	DataRep =^ il_data_rep,
 	( 
-		{ Type = mlds__generic_env_ptr_type 
-		; Type = mlds__class_type(_, _, _) }
+		{ 
+			Type = mlds__generic_env_ptr_type 
+		; 
+			Type = mlds__class_type(_, _, _) 
+		; 
+			DataRep ^ highlevel_data = yes,
+			Type = mlds__mercury_type(_, user_type)
+		}
 	->
 			% If this is an env_ptr we should call the
 			% constructor.  
@@ -1104,7 +1114,6 @@
 			%	call ClassName::.ctor
 			%	... store to memory reference ...
 			%
-		DataRep =^ il_data_rep,
 		{ ClassName = mlds_type_to_ilds_class_name(DataRep, Type) },
 		list__map_foldl(load, Args, ArgsLoadInstrsTrees),
 		{ ArgsLoadInstrs = tree__list(ArgsLoadInstrsTrees) },
@@ -1759,7 +1768,7 @@
 	test_rtti_initialization_field(DoneFieldRef, TestInstrs),
 	set_rtti_initialization_field(DoneFieldRef, SetInstrs),
 	{ CCtorCalls = list__map((func(X) = call_class_constructor(
-		mlds_module_name_to_class_name(X))), Imports) },
+		mlds_module_name_to_class_name(X, yes))), Imports) },
 	{ AllInstrs = list__condense([TestInstrs, AllocInstrs, SetInstrs,
 		CCtorCalls, InitInstrs, [ret]]) },
 	{ MethodDecls = [instrs(AllInstrs)] }.
@@ -1936,7 +1945,6 @@
 :- func mercury_type_to_highlevel_class_type(mercury_type) = ilds__type.
 mercury_type_to_highlevel_class_type(MercuryType) = ILType :-
 	( type_to_type_id(MercuryType, TypeId, _Args) ->
-
 		(
 			type_id_is_array(TypeId)
 		->
@@ -1964,7 +1972,7 @@
 		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),
+		mlds_module_name_to_class_name(MldsModuleName, yes),
 		[MldsClassName]).
 
 mlds_type_to_ilds_class_name(DataRep, MldsType) = 
@@ -2110,7 +2118,7 @@
 	Var = qual(ModuleName, _),
 	mangle_mlds_var(Var, MangledVarStr),
 	mangle_dataname_module(no, ModuleName, NewModuleName),
-	ClassName = mlds_module_name_to_class_name(NewModuleName),
+	ClassName = mlds_module_name_to_class_name(NewModuleName, yes),
 	FieldRef = make_fieldref(
 		mlds_type_to_ilds_type(DataRep, VarType), ClassName,
 		MangledVarStr).
@@ -2212,7 +2220,7 @@
 	% We turn procedures into methods of classes.
 mangle_mlds_proc_label(qual(ModuleName, PredLabel - ProcId), MaybeSeqNum,
 		ClassName, PredStr) :-
-	ClassName = mlds_module_name_to_class_name(ModuleName),
+	ClassName = mlds_module_name_to_class_name(ModuleName, yes),
 	predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, PredStr).
 
 :- pred mangle_entity_name(mlds__entity_name, string).
@@ -2259,10 +2267,10 @@
 mlds_to_il__sym_name_to_string_2(unqualified(Name), _) -->
         [Name].
 
-mlds_module_name_to_class_name(MldsModuleName) = 
+mlds_module_name_to_class_name(MldsModuleName, AddMercuryCode) = 
 		structured_name(AssemblyName, ClassName) :-
 	SymName = mlds_module_name_to_sym_name(MldsModuleName),
-	sym_name_to_class_name(SymName, ClassName),
+	sym_name_to_class_name(SymName, AddMercuryCode, ClassName),
 	( 
 		ClassName = ["mercury" | _]
 	->
@@ -2271,11 +2279,18 @@
 		mlds_to_il__sym_name_to_string(SymName, AssemblyName)
 	).
 
-:- pred sym_name_to_class_name(sym_name, list(ilds__id)).
-:- mode sym_name_to_class_name(in, out) is det.
-sym_name_to_class_name(SymName, Ids) :-
+:- pred sym_name_to_class_name(sym_name, bool, list(ilds__id)).
+:- mode sym_name_to_class_name(in, in, out) is det.
+sym_name_to_class_name(SymName, AddMercuryCode, Ids) :-
 	sym_name_to_class_name_2(SymName, Ids0),
-	list__reverse(["mercury_code" | Ids0], Ids).
+	( 
+		AddMercuryCode = yes,
+		Ids1 = ["mercury_code" | Ids0]
+	;
+		AddMercuryCode = no,
+		Ids1 = Ids0
+	),
+	list__reverse(Ids1, Ids).
 
 :- pred sym_name_to_class_name_2(sym_name, list(ilds__id)).
 :- mode sym_name_to_class_name_2(in, out) is det.
@@ -2398,7 +2413,7 @@
 data_addr_constant_to_fieldref(data_addr(ModuleName, DataName), FieldRef) :-
 	mangle_dataname(DataName, FieldName),
 	mangle_dataname_module(yes(DataName), ModuleName, NewModuleName),
-	ClassName = mlds_module_name_to_class_name(NewModuleName),
+	ClassName = mlds_module_name_to_class_name(NewModuleName, yes),
 	FieldRef = make_fieldref(il_array_type, ClassName, FieldName).
 
 
@@ -2415,24 +2430,17 @@
 	% the same thing when creating the fields.
 :- func get_fieldref(il_data_rep, field_id, mlds__type, mlds__type) = fieldref.
 get_fieldref(DataRep, FieldNum, FieldType, ClassType) = FieldRef :-
-		FieldILType0 = mlds_type_to_ilds_type(DataRep, FieldType),
-		ClassILType = mlds_type_to_ilds_type(DataRep, ClassType),
+		FieldILType0 = mlds_type_to_ilds_type(DataRep,
+			FieldType),
 		( FieldILType0 = ilds__type(_, '&'(FieldILType1)) ->
 			FieldILType = FieldILType1
 		;
 			FieldILType = FieldILType0
 		),
-		( ClassILType = ilds__type(_, class(ClassTypeName0)) ->
-			ClassName = ClassTypeName0
-		;
-			ClassILType = ilds__type(_, Unknown),
-			functor(Unknown, Functor, _Arity),
-			ClassName = structured_name("", 
-				["invalid_field_access_class", Functor])
-			% unexpected(this_file, "not a class for field access")
-		),
 		( 
 			FieldNum = offset(OffsetRval),
+			ClassName = mlds_type_to_ilds_class_name(DataRep,
+				ClassType),
 			( OffsetRval = const(int_const(Num)) ->
 				string__format("f%d", [i(Num)], FieldId)
 			;
@@ -2440,8 +2448,10 @@
 					"offsets for non-int_const rvals")
 			)
 		; 
-			FieldNum = named_field(qual(_ModuleName, FieldId),
-				_Type)
+			FieldNum = named_field(qual(ModuleName, FieldId),
+				_Type),
+			ClassName = mlds_module_name_to_class_name(ModuleName,
+				no)
 		),
 		FieldRef = make_fieldref(FieldILType, ClassName, FieldId).
 
@@ -2654,7 +2664,7 @@
 
 mlds_to_il__generate_extern_assembly(Imports, AllDecls) :-
 	Gen = (pred(Import::in, Decl::out) is semidet :-
-		ClassName = mlds_module_name_to_class_name(Import),
+		ClassName = mlds_module_name_to_class_name(Import, yes),
 		ClassName = structured_name(Assembly, _),
 		not (Assembly = "mercury"),
 		Decl = extern_assembly(Assembly, [])
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_mcpp.m,v
retrieving revision 1.4
diff -u -r1.4 mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m	2001/05/14 13:24:46	1.4
+++ compiler/mlds_to_mcpp.m	2001/05/22 07:33:47
@@ -94,7 +94,7 @@
 	{ MLDS = mlds(ModuleName, ForeignCode, _Imports, Defns) },
 	{ prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
 	{ ClassName = mlds_module_name_to_class_name(
-		mercury_module_name_to_mlds(ModuleName)) },
+		mercury_module_name_to_mlds(ModuleName), yes) },
 
 	io__nl,
 	io__write_strings([


-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't everyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------