[m-rev.] [dotnet-foreign] diff: re-enable foreign classes with the new mlds_to_il

[Peter Ross]

Hi,


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


Estimated hours taken: 2
Branches: dotnet-foreign

compiler/mlds_to_il.m:
    Change the private access for fields to assembly, so that foreign
    classes can call private members of the mercury_code class.
    Rename definitions in class declarations, so that foreign classes
    can refer to the correct methods in the mercury_code class.
    Reintroduce the code for merging properties in the non mercury code
    class.


Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.15.4.26
diff -u -r1.15.4.26 mlds_to_il.m
--- compiler/mlds_to_il.m	12 Jul 2001 09:51:55 -0000	1.15.4.26
+++ compiler/mlds_to_il.m	12 Jul 2001 10:57:30 -0000
@@ -247,7 +247,8 @@
 			)
 		), MLDS0 ^ defns, MercuryCodeMembers, Others),
 	MLDS = MLDS0 ^ defns := [wrapper_class(
-			list__map(rename_defn, MercuryCodeMembers)) | Others].
+			list__map(rename_defn, MercuryCodeMembers)) |
+			list__map(rename_defn, Others)].
 
 
 :- func wrapper_class(mlds__defns) = mlds__defn.
@@ -275,8 +276,12 @@
 			MaybeStmt = no
 		),
 		Entity = function(MaybePredProcId, Params, MaybeStmt, Attrs)
-	; Entity0 = class(_),
-		unexpected(this_file, "nested class")
+	; Entity0 = class(ClassDefn),
+		ClassDefn = class_defn(Kind, Imports, Inherits, Implements,
+				Ctors, Members),
+		Entity = class(class_defn(Kind, Imports, Inherits, Implements,
+				list__map(rename_defn, Ctors),
+				list__map(rename_defn, Members)))
 	).
 
 :- func rename_statement(mlds__statement) = mlds__statement.
@@ -483,7 +488,7 @@
 		Info = Info2
 	),
 	Decl = class(decl_flags_to_classattrs(Flags), EntityName, Extends,
-			Interfaces, MethodDecls).
+			Interfaces, merge_properties(MethodDecls)).
 
 :- pred generate_class_body(mlds__entity_name::in, mlds__class_defn::in,
 		ilds__class_name::out, ilds__id::out, extends::out,
@@ -505,7 +510,8 @@
 			MethodsAndFields, Info0, Info1),
 	list__map_foldl(generate_method(ClassName, yes(Parent)), Ctors,
 			IlCtors, Info1, Info),
-	ClassDecls = IlCtors ++ MethodsAndFields.
+	ClassDecls = list__condense(IlCtors) ++
+			list__condense(MethodsAndFields).
 
 
 :- func generate_parent_and_extends(il_data_rep, list(mlds__class_id))
@@ -611,7 +617,13 @@
 	; AccessFlag = protected,
 		Access = [family]
 	; AccessFlag = private,
-		Access = [private]
+			% Rather then using private which only allows
+			% methods in the same type to call the method,
+			% we use assembly which means that this method
+			% can be called from any method in the module.
+			% This is currently neccessary for implementing
+			% foreign_classes.
+		Access = [assembly]
 	; AccessFlag = default,
 		Access = [assembly]
 	; AccessFlag = local,
@@ -697,10 +709,10 @@
 %-----------------------------------------------------------------------------%
 
 :- pred generate_method(ilds__class_name::in, maybe(ilds__class_name)::in,
-		mlds__defn::in, class_member::out,
+		mlds__defn::in, list(class_member)::out,
 		il_info::in, il_info::out) is det.
 
-generate_method(ClassName, _, defn(Name, Context, Flags, Entity), ClassDecl) -->
+generate_method(ClassName, _, defn(Name, Ctxt, Flags, Entity), ClassDecls) -->
 	{ Entity = data(Type, DataInitializer) },
 
 	{ FieldName = entity_name_to_ilds_id(Name) },
@@ -762,7 +774,7 @@
 		% Add a store after the alloc instrs (if necessary)
 	{ AllocInstrs = list__condense(tree__flatten(
 		tree__list([
-			context_node(Context),
+			context_node(Ctxt),
 			comment_node(string__append("allocation for ",
 				FieldName)),
 			AllocInstrsTree, 
@@ -771,7 +783,7 @@
 		% Add a load before the init instrs (if necessary)
 	{ InitInstrs = list__condense(tree__flatten(
 		tree__list([
-			context_node(Context),
+			context_node(Ctxt),
 			comment_node(string__append("initializer for ",
 				FieldName)),
 			LoadTree,
@@ -790,10 +802,11 @@
 	{ MaybeOffset = no },
 	{ Initializer = none },
 
-	{ ClassDecl = field(Attrs, IlType, FieldName,
-			MaybeOffset, Initializer) }.
+	{ ClassDecls = [field(Attrs, IlType, FieldName,
+			MaybeOffset, Initializer)] }.
 
-generate_method(_, IsCons, defn(Name, Context, Flags, Entity), ClassDecl) -->
+generate_method(ClassName, IsCons,
+		defn(Name, Context, Flags, Entity), ClassDecls) -->
 	{ Entity = function(_, Params, MaybeStatement, Attributes) },
 
 	il_info_get_module_name(ModuleName),
@@ -908,10 +921,49 @@
 	{ list__condense([EntryPoint, CustomAttrs, MethodBody],
 			MethodContents) },
 
-	{ ClassDecl = ilasm__method(methodhead(Attrs, MemberName,
-			ILSignature, []), MethodContents)}.
+	{ MethodHead = methodhead(Attrs, MemberName, ILSignature, []) },
+	{ Method = ilasm__method(MethodHead, MethodContents) },
+
+		% Check to see whether we should generate a property
+		% decl as well.
+	{ ClassName = structured_name(_, QualifiedName) },
+	{
+			% XXX Very hacky.  Only classes which are not
+			% the wrapper class can have properties in them.
+		\+ list__last(QualifiedName, "mercury_code")
+	->
+		( 
+			MemberName = id(IdName),
+			string__append("get_", PropertyName, IdName)
+		->
+			ILSignature = signature(_, ReturnType, _),
+			( ReturnType = simple_type(SimpleType) ->
+				ILDSType = ilds__type([], SimpleType)
+			;
+				unexpected(this_file,
+					"no return type for get method")
+			),
+			Property = property(ILDSType, id(PropertyName),
+					yes(MethodHead), no),
+			ClassDecls = [Method, Property]
+		;
+			MemberName = id(IdName),
+			string__append("set_", PropertyName, IdName)
+		->
+			ILSignature = signature(_, _, ILParams),
+			ILDSType - _Name = list__det_head(
+					list__reverse(ILParams)),
+			Property = property(ILDSType, id(PropertyName),
+					no, yes(MethodHead)),
+			ClassDecls = [Method, Property]
+		;
+			ClassDecls = [Method]
+		)
+	;
+		ClassDecls = [Method]
+	}.
 
-generate_method(_, _, defn(Name, _Context, Flags, Entity), ClassDecl) -->
+generate_method(_, _, defn(Name, _Context, Flags, Entity), [ClassDecl]) -->
 	{ Entity = class(ClassDefn) },
 	generate_class_body(Name, ClassDefn, _ClassName, EntityName,
 			Extends, Interfaces, ClassDecls),

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