[m-rev.] diff: IL back-end: handle of value types

[Fergus Henderson]

Estimated hours taken: 2
Branches: main

Fix bugs in the handling of value types for the IL back-end.

compiler/mlds_to_il.m:
	Don't call constructors for non-class types,
	for mlds__generic_env_ptr_type,
	or for mlds__commit_type.

	Fix bugs where it wasn't handling value types correctly:
	- map mlds__struct classes to the `ilds__value_class' type
	  rather than to the `ilds__class' type
	- mlds__struct classes must inherit from System.ValueType
	- likewise mlds__enum classes are must inherit from System.EnumType

compiler/ml_elim_nested.m:
	For the IL back-end, mark the environment types as mlds__class
	rather than mlds__struct.

Workspace: /home/mars/fjh/ws2/mercury
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.37
diff -u -d -r1.37 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2001/07/14 19:52:15	1.37
+++ compiler/ml_elim_nested.m	2001/07/14 19:52:21
@@ -376,7 +376,16 @@
 	%		<LocalVars>
 	%	};
 	%
-	EnvTypeKind = mlds__struct,
+		% IL uses classes instead of structs, so the code
+		% generated needs to be a little different.
+		% XXX Perhaps if we used value classes this could go
+		% away.
+	globals__get_target(Globals, Target),
+	( Target = il ->
+		EnvTypeKind = mlds__class
+	;
+		EnvTypeKind = mlds__struct
+	),
 	EnvTypeName = class_type(qual(ModuleName, EnvClassName), 0,
 		EnvTypeKind),
 	EnvTypeEntityName = type(EnvClassName, 0),
@@ -387,7 +396,6 @@
 		% generated needs to be a little different.
 		% XXX Perhaps if we used value classes this could go
 		% away.
-	globals__get_target(Globals, Target),
 	( Target = il ->
 			% Generate a ctor for the class.
 
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.50
diff -u -d -r1.50 mlds_to_il.m
--- compiler/mlds_to_il.m	2001/07/13 14:21:21	1.50
+++ compiler/mlds_to_il.m	2001/07/14 19:31:06
@@ -23,6 +23,9 @@
 %
 % [ ] advanced name mangling: 
 %	- optionally only mangle names when it is absolutely necessary
+%	(Partly done; we now mangle names less often than we used to.
+%	The only way to mangle less would be to use a context-sensitive
+%	name mangling algorithm, which may not be a good idea.)
 % [ ] solutions
 % [ ] Type classes
 %	- now work, but...
@@ -497,10 +500,10 @@
 generate_class_body(Name, ClassDefn, ClassName, EntityName, Extends, Interfaces,
 		ClassDecls, Info0, Info) :-
 	EntityName = entity_name_to_ilds_id(Name),
-	ClassDefn = class_defn(_Kind, _Imports, Inherits, Implements,
+	ClassDefn = class_defn(Kind, _Imports, Inherits, Implements,
 			Ctors, Members),
 	Parent - Extends = generate_parent_and_extends(Info0 ^ il_data_rep,
-			Inherits),
+			Kind, Inherits),
 	Interfaces = implements(
 			list__map(interface_id_to_class_name, Implements)),
 
@@ -512,13 +515,21 @@
 	ClassDecls = IlCtors ++ MethodsAndFields.
 
 
-:- func generate_parent_and_extends(il_data_rep, list(mlds__class_id))
-	= pair(ilds__class_name, extends).
+:- func generate_parent_and_extends(il_data_rep, mlds__class_kind,
+		list(mlds__class_id)) = pair(ilds__class_name, extends).
 
-generate_parent_and_extends(DataRep, Inherits) = Parent - Extends :-
+generate_parent_and_extends(DataRep, Kind, Inherits) = Parent - Extends :-
 	( Inherits = [],
-		Parent = il_generic_class_name,
-		Extends = extends_nothing
+		( Kind = mlds__struct ->
+			Parent = il_generic_valuetype_name,
+			Extends = extends(Parent)
+		; Kind = mlds__enum ->
+			Parent = il_generic_enum_name,
+			Extends = extends(Parent)
+		; % Kind = mlds__class, mlds__package, or mlds__interface
+			Parent = il_generic_class_name,
+			Extends = extends_nothing
+		)
 	; Inherits = [Parent0 | Rest],
 		( Rest = [] ->
 			Parent = mlds_type_to_ilds_class_name(DataRep, Parent0),
@@ -1544,19 +1555,17 @@
 	DataRep =^ il_data_rep,
 	( 
 		{ 
-			Type = mlds__generic_env_ptr_type 
-		; 
-			Type = mlds__class_type(_, _, _) 
+			Type = mlds__generic_env_ptr_type
 		;
-			Type = mlds__commit_type
-		; 
+			Type = mlds__class_type(_, _, mlds__class) 
+		;
 			DataRep ^ highlevel_data = yes,
 			Type = mlds__mercury_type(_, user_type)
 		}
 	->
-			% If this is an env_ptr we should call the
-			% constructor.  
-			% (This is also how we will handle high-level data).
+			% If this is a class, we should call the
+			% constructor.  (This is needed for nondet environment
+			% classes, and also for high-level data.)
 			% We generate code of the form:
 			%
 			% 	... load memory reference ...
@@ -2355,9 +2364,10 @@
 	% 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)) = 
-	ilds__type([], class(
-		mlds_class_name_to_ilds_class_name(Class, Arity))).
+mlds_type_to_ilds_type(_, mlds__class_type(Class, Arity, Kind)) =
+		ilds__type([], SimpleType) :-
+	ClassName = mlds_class_name_to_ilds_class_name(Class, Arity),
+	SimpleType = mlds_class_to_ilds_simple_type(Kind, ClassName).
 
 mlds_type_to_ilds_type(_, mlds__commit_type) = il_commit_type.
 
@@ -2397,6 +2407,18 @@
 	;
 		il_array_type
 	).
+mlds_type_to_ilds_type(_, mlds__unknown_type) = _ :-
+	unexpected(this_file, "mlds_type_to_ilds_type: unknown_type").
+
+:- func mlds_class_to_ilds_simple_type(mlds__class_kind, ilds__class_name) =
+	ilds__simple_type.
+mlds_class_to_ilds_simple_type(Kind, ClassName) = SimpleType :-
+	( Kind = mlds__package,		SimpleType = class(ClassName)
+	; Kind = mlds__class,		SimpleType = class(ClassName)
+	; Kind = mlds__interface,	SimpleType = class(ClassName)
+	; Kind = mlds__struct,		SimpleType = value_class(ClassName)
+	; Kind = mlds__enum,		SimpleType = value_class(ClassName)
+	).
 
 :- func mercury_type_to_highlevel_class_type(mercury_type) = ilds__type.
 mercury_type_to_highlevel_class_type(MercuryType) = ILType :-
@@ -2417,9 +2439,6 @@
 
 
 
-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, arity) =
 	ilds__class_name.
@@ -3085,6 +3104,14 @@
 il_generic_simple_type = class(il_generic_class_name).
 
 il_generic_class_name = il_system_name(["Object"]).
+
+	% Return the class name for System.ValueType.
+:- func il_generic_valuetype_name = ilds__class_name.
+il_generic_valuetype_name = il_system_name(["ValueType"]).
+
+	% Return the class name for System.Enum
+:- func il_generic_enum_name = ilds__class_name.
+il_generic_enum_name = il_system_name(["Enum"]).
 
 %-----------------------------------------------------------------------------%
 %

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