[m-rev.] for review: IL back-end: use value types for environments

[Fergus Henderson]

I haven't really tested this yet, except by manually looking
at the generated IL, so there might still be some problems.
But we may as well overlap testing and code review.

----------

Estimated hours taken: 5
Branches: main

For the IL back-end, use value types rather than class types
for the environment structures used for nondeterministic code.

compiler/ml_elim_nested.m:
	Delete the previous IL-specific hacks, because they aren't
	needed anymore.
	Fix up the type of the env_ptr variable,
	so that it doesn't remain "mlds__unknown_type".

compiler/mlds_to_il.m:
	Change il_envptr_type to `refany'.
	Handle casts to/from `refany' specially --
	generate the `mkrefany' / `refanyval' instructions.

	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_call_gen.m:
compiler/ml_code_util.m:
	Cast the env_ptr argument to mlds__generic_env_ptr_type.
	Although the C, Java, etc. back-ends don't need a cast here,
	since this is just an upcast, the cast is needed for the IL
	back-end because it gets converted to a special instruction
	(mkrefany).

runtime/mercury_mcpp.cpp:
	Delete the `Environment' type, since it is no longer needed
	(we use `refany' instead).

Workspace: /home/mars/fjh/ws1/mercury
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.25
diff -u -d -r1.25 ml_call_gen.m
--- compiler/ml_call_gen.m	2001/07/06 17:11:59	1.25
+++ compiler/ml_call_gen.m	2001/07/13 14:32:30
@@ -406,8 +406,10 @@
 		( { UseNestedFuncs = yes } ->
 			{ ArgRvals = list__append(ArgRvals0, [FuncPtrRval]) }
 		;
+			{ CastEnvPtrRval = unop(cast(
+				mlds__generic_env_ptr_type), EnvPtrRval) },
 			{ ArgRvals = list__append(ArgRvals0,
-				[FuncPtrRval, EnvPtrRval]) }
+				[FuncPtrRval, CastEnvPtrRval]) }
 		),
 		% for --nondet-copy-out, the output arguments will be
 		% passed to the continuation rather than being returned
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.43
diff -u -d -r1.43 ml_code_util.m
--- compiler/ml_code_util.m	2001/07/13 08:04:41	1.43
+++ compiler/ml_code_util.m	2001/07/13 13:37:31
@@ -1692,7 +1692,8 @@
 	;
 		{ ArgTypes = list__append(ArgTypes0,
 			[mlds__generic_env_ptr_type]) },
-		{ ArgRvals = list__append(ArgRvals0, [EnvPtrRval]) }
+		{ ArgRvals = list__append(ArgRvals0,
+			[unop(cast(mlds__generic_env_ptr_type), EnvPtrRval)]) }
 	),
 	{ RetTypes = [] },
 	{ Signature = mlds__func_signature(ArgTypes, RetTypes) },
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.35
diff -u -d -r1.35 ml_elim_nested.m
--- compiler/ml_elim_nested.m	2001/07/13 10:27:44	1.35
+++ compiler/ml_elim_nested.m	2001/07/13 14:12:42
@@ -383,33 +383,12 @@
 	EnvTypeFlags = env_type_decl_flags,
 	Fields = list__map(convert_local_to_field, LocalVars),
 
-		% 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 ->
-			% 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]
-	;
-		Ctors = []
-	),
-	EnvTypeDefnBody = mlds__class(mlds__class_defn(EnvTypeKind, [], 
-		[mlds__generic_env_ptr_type], [], Ctors, Fields)),
+	Imports = [],
+	Inherits = [],
+	Implements = [],
+	Ctors = [],
+	EnvTypeDefnBody = mlds__class(mlds__class_defn(EnvTypeKind, Imports, 
+		Inherits, Implements, Ctors, Fields)),
 	EnvTypeDefn = mlds__defn(EnvTypeEntityName, Context, EnvTypeFlags,
 		EnvTypeDefnBody),
 
@@ -430,29 +409,10 @@
 	%
 	EnvVar = qual(ModuleName, mlds__var_name("env", no)),
 
-		% 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.
-	( Target = il ->
-		EnvVarAddr = lval(var(EnvVar, EnvTypeName)),
-		ml_init_env(EnvTypeName, EnvVarAddr, Context, ModuleName,
-			 Globals, EnvPtrVarDecl, InitEnv0),
-		
-		NewObj = mlds__statement(
-				atomic(new_object(
-					var(EnvVar, EnvTypeName), 
-					no, EnvTypeName, no, no, [], [])),
-				Context),
-		InitEnv = mlds__statement(block([], 
-			[NewObj, InitEnv0]), Context),
-		EnvDecls = [EnvVarDecl, EnvPtrVarDecl]
-	;
-		EnvVarAddr = mem_addr(var(EnvVar, EnvTypeName)),
-		ml_init_env(EnvTypeName, EnvVarAddr, Context, ModuleName,
-			Globals, EnvPtrVarDecl, InitEnv),
-		EnvDecls = [EnvVarDecl, EnvPtrVarDecl]
-	).
+	EnvVarAddr = mem_addr(var(EnvVar, EnvTypeName)),
+	ml_init_env(EnvTypeName, EnvVarAddr, Context, ModuleName,
+		Globals, EnvPtrVarDecl, InitEnv),
+	EnvDecls = [EnvVarDecl, EnvPtrVarDecl].
 
 	% When converting local variables into fields of the
 	% environment struct, we need to change `local' access
@@ -531,17 +491,8 @@
 	).
 
 :- func ml_make_env_ptr_type(globals, mlds__type) = mlds__type.
-ml_make_env_ptr_type(Globals, EnvType)  = EnvPtrType :-
-		% IL uses classes instead of structs, so the type
-		% is a little different.
-		% XXX Perhaps if we used value classes this could go
-		% away.
-	globals__get_target(Globals, Target),
-	( Target = il ->
-		EnvPtrType = EnvType
-	;
-		EnvPtrType = mlds__ptr_type(EnvType)
-	).
+ml_make_env_ptr_type(_Globals, EnvType)  = EnvPtrType :-
+	EnvPtrType = mlds__ptr_type(EnvType).
 
 	% Create the environment pointer and initialize it:
 	%
@@ -1140,6 +1091,15 @@
 			EnvPtrVarType),
 		Tag = yes(0),
 		Lval = field(Tag, EnvPtr, FieldName, FieldType, EnvPtrVarType)
+	;
+		% Check for references to the env_ptr itself.
+		% For those, the code generator will have left the
+		% type as mlds__unknown_type, and we need to fill
+		% it in here.
+		ThisVarName = mlds__var_name("env_ptr", no),
+		ThisVarType = mlds__unknown_type
+	->
+		Lval = var(ThisVar, EnvPtrVarType)
 	;
 		%
 		% leave everything else unchanged
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.49
diff -u -d -r1.49 mlds_to_il.m
--- compiler/mlds_to_il.m	2001/07/13 12:02:18	1.49
+++ compiler/mlds_to_il.m	2001/07/13 15:39:59
@@ -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),
@@ -1485,19 +1496,15 @@
 	DataRep =^ il_data_rep,
 	( 
 		{ 
-			Type = mlds__generic_env_ptr_type 
-		; 
-			Type = mlds__class_type(_, _, _) 
+			Type = mlds__class_type(_, _, mlds__class) 
 		;
-			Type = mlds__commit_type
-		; 
 			DataRep ^ highlevel_data = yes,
 			Type = mlds__mercury_type(_, user_type)
 		}
 	->
-			% If this is an env_ptr we should call the
+			% If this is an class, we should call the
 			% constructor.  
-			% (This is also how we will handle high-level data).
+			% (This is needed to handle high-level data).
 			% We generate code of the form:
 			%
 			% 	... load memory reference ...
@@ -1828,23 +1835,54 @@
 unaryop_to_il(std_unop((not)), _,
 	node([ldc(int32, i(1)), clt(unsigned)])) --> [].
 
-		% if we are casting from an unboxed type, we should box
-		% it first.
-		% XXX should also test the cast-to type, to handle the
-		% cases where it is unboxed.
-unaryop_to_il(cast(Type), Rval, Instrs) -->
+unaryop_to_il(cast(DestType), Rval, Instrs) -->
 	DataRep =^ il_data_rep,
-	{ ILType = mlds_type_to_ilds_type(DataRep, Type) },
+	{ ILDestType = mlds_type_to_ilds_type(DataRep, DestType) },
 	{ 
+	%
+	% we need to handle casts to/from "refany" specially --
+	% IL has special instructions for those
+	%
+		% is it a cast to refany?
+		ILDestType = ilds__type(_, refany)
+	->
+		rval_to_type(Rval, SrcType),
+		ILSrcType = mlds_type_to_ilds_type(DataRep, SrcType),
+		(
+			% is it from refany?
+			ILSrcType = ilds__type(_, refany)
+		->
+			% cast from refany to refany is a NOP
+			Instrs = empty
+		;
+			% cast to refany: use "mkrefany" instruction
+			Instrs = node([mkrefany(ILSrcType)])
+		)
+	;
+		% is it a cast from refany?
+		Rval = lval(_),
+		rval_to_type(Rval, SrcType),
+		ILSrcType = mlds_type_to_ilds_type(DataRep, SrcType),
+		ILSrcType = ilds__type(_, refany)
+	->
+		% cast from refany: use "refanyval" instruction
+		Instrs = node([refanyval(ILDestType)])
+	;
+	%
+	% if we are casting from an unboxed type, we should box
+	% it first.
+	% XXX should also test the cast-to type, to handle the
+	% cases where it is unboxed.
+	%
 		Rval = const(Const),
-		RvalType = rval_const_to_type(Const),
-		RvalILType = mlds_type_to_ilds_type(DataRep, RvalType),
-		not already_boxed(RvalILType)
+		SrcType = rval_const_to_type(Const),
+		ILSrcType = mlds_type_to_ilds_type(DataRep, SrcType),
+		not already_boxed(ILSrcType)
 	->
-		Instrs = node([call(convert_to_object(RvalILType)),
-			castclass(ILType)])
+		Instrs = node([call(convert_to_object(ILSrcType)),
+			castclass(ILDestType)])
 	;
-		Instrs = node([castclass(ILType)])
+		Instrs = node([castclass(ILDestType)])
 	}.
 
 
@@ -2296,9 +2334,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.
 
@@ -2338,6 +2377,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 :-
@@ -2358,10 +2409,7 @@
 
 
 
-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.
 
@@ -3027,6 +3075,14 @@
 
 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"]).
+
 %-----------------------------------------------------------------------------%
 %
 % The mapping to the array type (used like MR_Word).
@@ -3064,14 +3120,7 @@
 %
 
 :- func il_envptr_type = ilds__type.
-il_envptr_type = ilds__type([], il_envptr_simple_type).
-
-:- func il_envptr_simple_type = simple_type.
-il_envptr_simple_type = class(il_envptr_class_name).
-
-:- func il_envptr_class_name = ilds__class_name.
-il_envptr_class_name = mercury_runtime_name(["Environment"]).
-
+il_envptr_type = ilds__type([], refany).
 
 %-----------------------------------------------------------------------------%
 %

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