[m-rev.] diff: IL back-end: add constructors for all classes

[Fergus Henderson]

Estimated hours taken: 1
Branches: main

Fix another bug with --high-level-data in the IL back-end.

compiler/mlds_to_il.m:
	If a class doesn't have any constructors, add an empty one.
	
compiler/ml_elim_nested.m:
	Delete code to add empty constructors for environment types,
	since this is now handled by mlds_to_il.m.

Workspace: /home/venus/fjh/ws-venus4/mercury
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.40
diff -u -d -r1.40 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2 Aug 2001 19:50:36 -0000	1.40
+++ compiler/ml_elim_nested.m	13 Aug 2001 01:52:35 -0000
@@ -378,46 +378,25 @@
 	%
 		% If we're allocating it on the heap, then we need to use 
 		% a class type rather than a struct (value type).
-		% This is needed for the IL back-end.
+		% This is needed for verifiable code on the IL back-end.
 	globals__lookup_bool_option(Globals, put_nondet_env_on_heap, OnHeap),
 	( OnHeap = yes ->
-		EnvTypeKind = mlds__class
+		EnvTypeKind = mlds__class,
+		BaseClasses = [mlds__generic_env_ptr_type]
 	;
-		EnvTypeKind = mlds__struct
+		EnvTypeKind = mlds__struct,
+		BaseClasses = []
 	),
 	EnvTypeName = class_type(qual(ModuleName, EnvClassName), 0,
 		EnvTypeKind),
 	EnvTypeEntityName = type(EnvClassName, 0),
 	EnvTypeFlags = env_type_decl_flags,
 	Fields = list__map(convert_local_to_field, LocalVars),
-
-		% If we're allocating it on the heap, then we're using
-		% a class type, and (for some back-ends, at least, e.g. IL)
-		% that means we need to define a constructor for it.
-	( OnHeap = yes ->
-			% Generate a ctor for the class.
-
-			% We generate an empty block for the body of the
-			% constructor.
-		Stmt = mlds__statement(block([], []), Context),
-
-		Ctor = mlds__function(no, func_params([], []),
-				defined_here(Stmt)),
-		CtorFlags = init_decl_flags(public, per_instance, non_virtual,
-				overridable, modifiable, concrete),
-
-			% Note that the name of constructor is
-			% determined by the backend convention.
-		CtorDefn = mlds__defn(export("<constructor>"), Context,
-				CtorFlags, Ctor),
-		Ctors = [CtorDefn],
-		BaseClasses = [mlds__generic_env_ptr_type]
-	;
-		Ctors = [],
-		BaseClasses = []
-	),
-	EnvTypeDefnBody = mlds__class(mlds__class_defn(EnvTypeKind, [], 
-		BaseClasses, [], Ctors, Fields)),
+	Imports = [],
+	Ctors = [], % mlds_to_il.m will add an empty constructor if needed
+	Interfaces = [],
+	EnvTypeDefnBody = mlds__class(mlds__class_defn(EnvTypeKind, Imports, 
+		BaseClasses, Interfaces, Ctors, Fields)),
 	EnvTypeDefn = mlds__defn(EnvTypeEntityName, Context, EnvTypeFlags,
 		EnvTypeDefnBody),
 
@@ -549,8 +528,7 @@
 	globals__lookup_bool_option(Globals, put_nondet_env_on_heap, OnHeap),
 	globals__get_target(Globals, Target),
 	( Target = il, OnHeap = yes ->
-		% IL uses classes instead of structs, so the type
-		% is a little different.
+		% For IL, a class type is already a pointer (object reference).
 		EnvPtrType = EnvType
 	;
 		EnvPtrType = mlds__ptr_type(EnvType)
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.67
diff -u -d -r1.67 mlds_to_il.m
--- compiler/mlds_to_il.m	13 Aug 2001 01:39:31 -0000	1.67
+++ compiler/mlds_to_il.m	13 Aug 2001 02:06:00 -0000
@@ -488,12 +488,12 @@
 		function(_MaybePredProcId, _Params, _MaybeStmts)),
 		_Decl, Info, Info) :-
 	sorry(this_file, "top level function definition!").
-mlds_defn_to_ilasm_decl(defn(Name, _Context, Flags0, class(ClassDefn)),
+mlds_defn_to_ilasm_decl(defn(Name, Context, Flags0, class(ClassDefn)),
 		Decl, Info0, Info) :-
 	il_info_new_class(ClassDefn, Info0, Info1),
 
-	generate_class_body(Name, ClassDefn, ClassName, EntityName, Extends,
-			Interfaces, MethodsAndFieldsAndCtors, Info1, Info2),
+	generate_class_body(Name, Context, ClassDefn, ClassName, EntityName,
+		Extends, Interfaces, MethodsAndFieldsAndCtors, Info1, Info2),
 
 		% Only the wrapper class needs to have the
 		% initialization instructions executed by the class
@@ -533,28 +533,54 @@
 	Decl = class(decl_flags_to_classattrs(Flags), EntityName, Extends,
 			Interfaces, MethodDecls).
 
-:- pred generate_class_body(mlds__entity_name::in, mlds__class_defn::in,
+:- pred generate_class_body(mlds__entity_name::in, mlds__context::in,
+		mlds__class_defn::in,
 		ilds__class_name::out, ilds__id::out, extends::out,
 		implements::out, list(classdecl)::out,
 		il_info::in, il_info::out) is det.
 
-generate_class_body(Name, ClassDefn, ClassName, EntityName, Extends, Interfaces,
-		ClassDecls, Info0, Info) :-
+generate_class_body(Name, Context, ClassDefn,
+		ClassName, EntityName, Extends, Interfaces, ClassDecls,
+		Info0, Info) :-
 	EntityName = entity_name_to_ilds_id(Name),
 	ClassDefn = class_defn(Kind, _Imports, Inherits, Implements,
-			Ctors, Members),
+			Ctors0, Members),
 	Parent - Extends = generate_parent_and_extends(Info0 ^ il_data_rep,
 			Kind, Inherits),
 	Interfaces = implements(
 			list__map(interface_id_to_class_name, Implements)),
-
 	ClassName = class_name(Info0 ^ module_name, EntityName),
 	list__map_foldl(generate_method(ClassName, no), Members,
 			MethodsAndFields, Info0, Info1),
+	Ctors = maybe_add_empty_ctor(Ctors0, Kind, Context),
 	list__map_foldl(generate_method(ClassName, yes(Parent)), Ctors,
 			IlCtors, Info1, Info),
 	ClassDecls = IlCtors ++ MethodsAndFields.
 
+	% For IL, every class needs a constructor,
+	% otherwise you can't use the newobj instruction to
+	% allocate instances of the class.
+	% So if a class doesn't already have one, we add an empty one.
+:- func maybe_add_empty_ctor(mlds__defns, mlds__class_kind, mlds__context) =
+	mlds__defns.
+maybe_add_empty_ctor(Ctors0, Kind, Context) = Ctors :-
+	(
+		Kind = mlds__class,
+		Ctors0 = [] 
+	->
+		% Generate an empty block for the body of the constructor.
+		Stmt = mlds__statement(block([], []), Context),
+
+		Ctor = mlds__function(no, func_params([], []),
+				defined_here(Stmt)),
+		CtorFlags = init_decl_flags(public, per_instance, non_virtual,
+				overridable, modifiable, concrete),
+
+		CtorDefn = mlds__defn(export(".ctor"), Context, CtorFlags, Ctor),
+		Ctors = [CtorDefn]
+	;
+		Ctors = Ctors0
+	).
 
 :- func generate_parent_and_extends(il_data_rep, mlds__class_kind,
 		list(mlds__class_id)) = pair(ilds__class_name, extends).
@@ -1020,9 +1046,9 @@
 	{ ClassDecl = ilasm__method(methodhead(Attrs, MemberName,
 			ILSignature, []), MethodContents)}.
 
-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,
+	generate_class_body(Name, Context, ClassDefn, _ClassName, EntityName,
 			Extends, Interfaces, ClassDecls),
 	{ ClassDecl = nested_class(decl_flags_to_nestedclassattrs(Flags),
 			EntityName, Extends, Interfaces, ClassDecls) }.

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