[m-rev.] diff: bug fixes for il grade

[Tyson Dowd]

Hi,

Here's a better fix that visually looks OK, but might need more work
when I actually test it.

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


Estimated hours taken: 2
Branches: main

Add support for nested classes.
Fix the implementation of inheritance.

compiler/ilasm.m:
	Add code to allow nested classes in the IL assembler.
	
compiler/mlds_to_il.m:
	Add code to generate nested classes.
	Fix bugs in the code to handle inheritance -- most of the
	inheritance was hand-coded for the case of continutation
	environments.


Index: compiler/ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ilasm.m,v
retrieving revision 1.7
diff -u -r1.7 ilasm.m
--- compiler/ilasm.m	2001/04/11 10:17:22	1.7
+++ compiler/ilasm.m	2001/04/19 11:17:52
@@ -117,6 +117,15 @@
 			maybe(int32),		% offset for explicit layout
 			field_initializer	% initializer
 		)
+		% .class (a nested class)
+	;	nested_class(
+			list(classattr),	% attributes for the class
+			ilds__id,		% name of the class
+			extends,		% what is the parent class
+			implements, 		% what interfaces are 
+						% implemented
+			list(classdecl)		% methods and fields
+		)
 		% comments
 	;	comment_term(term)
 	;	comment(string)
@@ -417,6 +426,11 @@
 	io__write_string(" "),
 	output_id(IlId),
 	output_field_initializer(Initializer).
+
+ilasm__output_classdecl(nested_class(Attrs, Id, Extends, Implements, Contents),
+		Info0, Info) --> 
+	ilasm__output_decl(class(Attrs, Id, Extends, Implements, Contents),
+		Info0, Info).
 
 ilasm__output_classdecl(comment(CommentStr), Info, Info) --> 
 	globals__io_lookup_bool_option(auto_comments, PrintComments),
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.18
diff -u -r1.18 mlds_to_il.m
--- compiler/mlds_to_il.m	2001/04/11 10:17:22	1.18
+++ compiler/mlds_to_il.m	2001/04/19 13:50:22
@@ -471,33 +471,21 @@
 		( 
 			Entity = mlds__class(ClassDefn) 
 		->
-			ClassDefn = mlds__class_defn(ClassType, _Imports, 
-				_Inherits, _Implements, Defns),
-			( 
-				ClassType = mlds__class
-			->
-				list__map(defn_to_class_decl, Defns, ILDefns),
-				make_constructor(FullClassName, ClassDefn, 
-					ConstructorILDefn),
-				Decls = [comment_term(MLDSDefnTerm),
-					class([public], TypeName,
-					extends_nothing, implements([]),
-					[ConstructorILDefn | ILDefns])]
-			; 
-				ClassType = mlds__struct
-			->
-				list__map(defn_to_class_decl, Defns, ILDefns),
-				make_constructor(FullClassName, ClassDefn, 
-					ConstructorILDefn),
-				Decls = [comment_term(MLDSDefnTerm),
-					class([public], TypeName, 
-					extends(il_envptr_class_name), 
-					implements([]), 
-					[ConstructorILDefn | ILDefns])]
-			;
-				Decls = [comment_term(MLDSDefnTerm),
-					comment("This type unimplemented.")]
-			)
+			ClassDefn = mlds__class_defn(_ClassType, _Imports, 
+				Inherits, _Implements, Defns),
+			( Inherits = [],
+				Extends = extends_nothing
+			; Inherits = [InheritType | _],
+				Extends = extends(mlds_type_to_ilds_class_name(
+					InheritType))
+			),
+			list__map(defn_to_class_decl, Defns, ILDefns),
+			make_constructor(FullClassName, ClassDefn, 
+				ConstructorILDefn),
+			Decls = [comment_term(MLDSDefnTerm),
+				class([public], TypeName,
+				Extends, implements([]),
+				[ConstructorILDefn | ILDefns])]
 		;
 			Decls = [comment_term(MLDSDefnTerm),
 				comment("This type unimplemented.")]
@@ -663,12 +651,25 @@
 	mlds__function(_PredProcId, _Params, _MaybeStatements)), ILClassDecl) :-
 		ILClassDecl = comment("unimplemented: functions in classes").
 
-	% XXX this might not need to be implemented (nested classes)
-	% since it will probably be flattened earlier.
-defn_to_class_decl(mlds__defn(_Name, _Context, _DeclFlags,
-		mlds__class(_)), _ILClassDecl) :-
-	error("nested data definition not expected here").
-
+defn_to_class_decl(mlds__defn(EntityName, _Context, _DeclFlags,
+		mlds__class(ClassDefn)), ILClassDecl) :-
+	( EntityName = type(TypeName, _Arity) ->
+		ClassDefn = mlds__class_defn(_ClassType, _Imports, 
+			Inherits, _Implements, Defns),
+		FullClassName = structured_name("", [TypeName]),
+		list__map(defn_to_class_decl, Defns, ILDefns),
+		make_constructor(FullClassName, ClassDefn, ConstructorILDefn),
+		( Inherits = [],
+			Extends = extends_nothing
+		; Inherits = [InheritType | _],
+			Extends = extends(mlds_type_to_ilds_class_name(
+				InheritType))
+		),
+		ILClassDecl = nested_class([public], TypeName, Extends,
+			implements([]), [ConstructorILDefn | ILDefns])
+	;
+		error("expected type entity name for a nested class")
+	).
 
 %-----------------------------------------------------------------------------%
 %
@@ -891,12 +892,7 @@
 	il_info_make_next_label(DoneLabel),
 
 	rval_to_type(lval(Ref), MLDSRefType),
-	{ RefType = mlds_type_to_ilds_type(MLDSRefType) },
-	{ RefType = ilds__type(_, class(ClassName0)) ->
-			ClassName = ClassName0
-		;
-			unexpected(this_file, "non-class for commit ref")
-	},	
+	{ ClassName = mlds_type_to_ilds_class_name(MLDSRefType) },
 	{ Instrs = tree__list([
 		context_node(Context),
 		comment_node("try_commit/3"),
@@ -1021,14 +1017,7 @@
 			%	call ClassName::.ctor
 			%	... store to memory reference ...
 			%
-		{ ILType = mlds_type_to_ilds_type(Type) },
-		{ 
-			ILType = ilds__type(_, class(ClassName0))
-		->
-			ClassName = ClassName0
-		;
-			unexpected(this_file, "non-class for new_object")
-		},	
+		{ ClassName = mlds_type_to_ilds_class_name(Type) },
 		list__map_foldl(load, Args, ArgsLoadInstrsTrees),
 		{ ArgsLoadInstrs = tree__list(ArgsLoadInstrsTrees) },
 		get_load_store_lval_instrs(Target, LoadMemRefInstrs,
@@ -1780,13 +1769,8 @@
 	% see comments about function types above.
 mlds_type_to_ilds_type(mlds__cont_type(_ArgTypes)) = ilds__type([], int32).
 
-mlds_type_to_ilds_type(mlds__class_type(Class, _Arity, _Kind)) = ILType :-
-	Class = qual(MldsModuleName, MldsClassName),
-	structured_name(Assembly, ClassName) = 
-		mlds_module_name_to_class_name(MldsModuleName),
-	list__append(ClassName, [MldsClassName], FullClassName),
-	ILType = ilds__type([], class(
-		structured_name(Assembly, FullClassName))).
+mlds_type_to_ilds_type(mlds__class_type(Class, _Arity, _Kind)) = 
+	ilds__type([], class(mlds_class_name_to_ilds_class_name(Class))).
 
 mlds_type_to_ilds_type(mlds__commit_type) = il_commit_type.
 
@@ -1842,6 +1826,27 @@
 
 mlds_type_to_ilds_type(mlds__unknown_type) = _ :-
 	unexpected(this_file, "mlds_type_to_ilds_type: unknown_type").
+
+
+:- func mlds_class_name_to_ilds_class_name(mlds__class) = ilds__class_name.
+
+mlds_class_name_to_ilds_class_name(qual(MldsModuleName, MldsClassName)) = 
+	append_class_name(mlds_module_name_to_class_name(MldsModuleName),
+		[MldsClassName]).
+
+:- func mlds_type_to_ilds_class_name(mlds__type) = ilds__class_name.
+mlds_type_to_ilds_class_name(MldsType) = ClassName :-
+	ILType = mlds_type_to_ilds_type(MldsType),
+	( 
+		ILType = ilds__type(_, class(ClassName0))
+	->
+		ClassName = ClassName0
+	;
+		unexpected(this_file,
+			"mlds_type_to_ilds_class_name: type not a class")
+	).	
+
+
 %-----------------------------------------------------------------------------
 %
 % Name mangling.
@@ -2466,12 +2471,10 @@
 :- mode make_constructor(in, in, out) is det.
 make_constructor(ClassName, mlds__class_defn(_,  _Imports, Inherits, 
 		_Implements, Defns), ILDecl) :-
-	( Inherits = [] ->
+	( Inherits = [],
 		CtorMemberName = il_generic_class_name
-	;
-		% XXX this needs to be calculated correctly
-		% (i.e. according to the value of inherits)
-		CtorMemberName = il_envptr_class_name
+	; Inherits = [InheritType | _],
+		CtorMemberName = mlds_type_to_ilds_class_name(InheritType)
 	),
 	list__map(call_field_constructor(ClassName), Defns, 
 		FieldConstrInstrsLists),


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