[m-rev.] for review: add type to array_index operator

[Fergus Henderson]

Another step in the path towards fixing string switches for the IL back-end.

Estimated hours taken: 4
Branches: main

Add type information to the array_index operator.
This is needed for both the GCC back-end and the IL back-end.

compiler/builtin_ops.m:
	In the array_index constructor for the unary_op type,
	add the array element type as a field.

compiler/ml_string_switch.m:
compiler/string_switch.m:
compiler/mlds_to_java.m:
	When generating array_index operators, generate the new field.

compiler/bytecode.m:
compiler/llds.m:
compiler/llds_out.m:
compiler/mlds_to_c.m:
compiler/mlds_to_java.m:
	When consuming array_index operators, ignore the new field.

compiler/mlds_to_gcc.m:
	When consuming array_index operators, use the array element type,
	rather than wrongly assuming the element type is always 'MR_Integer'.

compiler/mlds_to_il.m:
	Add code to handle the array_index operator,
	rather than calling `throw_unimplemented'.

compiler/bytecode.m:
	Delete the reverse mode of binop_code.  This was not used,
	it was just there to get the compiler to check that we didn't
	map two different binary operators to the same code.  This
	mode no longer works, since we map array_index operators to
	the same code regardless of the the array element type.

compiler/rtti_to_mlds.m:
compiler/ml_string_switch.m:
compiler/ml_code_util.m:
	To avoid code duplication, move ml_string_type, which was defined in
	both rtti_to_mlds.m and ml_string_switch.m, into ml_code_util.m.

compiler/ml_string_switch.m:
	Minor changes to avoid some code duplication.

compiler/mlds_to_java.m:
	Fix a bug where it was using the wrong type for the `args' variable.
	Add an XXX comment about what looks to me like another bug.

Workspace: /home/administrator/ws/ws1
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.6
diff -u -d -r1.6 builtin_ops.m
--- compiler/builtin_ops.m	13 Mar 2001 12:40:05 -0000	1.6
+++ compiler/builtin_ops.m	8 Jul 2001 11:12:02 -0000
@@ -49,7 +49,7 @@
 	;	eq	% ==
 	;	ne	% !=
 	;	body
-	;	array_index
+	;	array_index(array_elem_type)
 	;	str_eq	% string comparisons
 	;	str_ne
 	;	str_lt
@@ -77,6 +77,20 @@
 	;	float_gt
 	;	float_le
 	;	float_ge.
+
+	% For the MLDS back-end, we need to know the element type for each
+	% array_index operation.
+	%
+	% Currently array index operations are only generated in limited
+	% circumstances.  Using a simple representation for them here,
+	% rather than just putting the MLDS type here, avoids the need
+	% for this module to depend on back-end specific stuff like MLDS types.
+:- type array_elem_type
+	--->	elem_type_string	% ml_string_type
+	;	elem_type_int		% mlds__native_int_type
+	;	elem_type_generic	% mlds__generic_type
+	.
+
 
 	% translate_builtin:
 	%
Index: compiler/bytecode.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode.m,v
retrieving revision 1.47
diff -u -d -r1.47 bytecode.m
--- compiler/bytecode.m	13 Mar 2001 12:40:06 -0000	1.47
+++ compiler/bytecode.m	8 Jul 2001 11:12:03 -0000
@@ -1037,7 +1037,6 @@
 
 :- pred binop_code(binary_op, int).
 :- mode binop_code(in, out) is det.
-:- mode binop_code(out, in) is semidet.	% enforce non-duplication of bytecodes
 
 binop_code((+),			 0).
 binop_code((-),			 1).
@@ -1053,7 +1052,7 @@
 binop_code((or),		11).
 binop_code(eq,			12).
 binop_code(ne,			13).
-binop_code(array_index,		14).
+binop_code(array_index(_Type),	14).
 binop_code(str_eq,		15).
 binop_code(str_ne,		16).
 binop_code(str_lt,		17).
@@ -1094,7 +1093,7 @@
 binop_debug((or),		"or").
 binop_debug(eq,			"eq").
 binop_debug(ne,			"ne").
-binop_debug(array_index,	"array_index").
+binop_debug(array_index(_Type),	"array_index").
 binop_debug(str_eq,		"str_eq").
 binop_debug(str_ne,		"str_ne").
 binop_debug(str_lt,		"str_lt").
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.277
diff -u -d -r1.277 llds.m
--- compiler/llds.m	31 May 2001 05:59:40 -0000	1.277
+++ compiler/llds.m	8 Jul 2001 11:12:05 -0000
@@ -1205,7 +1205,7 @@
 llds__binop_return_type((or), bool).
 llds__binop_return_type(eq, bool).
 llds__binop_return_type(ne, bool).
-llds__binop_return_type(array_index, word).
+llds__binop_return_type(array_index(_Type), word).
 llds__binop_return_type(str_eq, bool).
 llds__binop_return_type(str_ne, bool).
 llds__binop_return_type(str_lt, bool).
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.176
diff -u -d -r1.176 llds_out.m
--- compiler/llds_out.m	31 May 2001 05:59:42 -0000	1.176
+++ compiler/llds_out.m	8 Jul 2001 11:12:07 -0000
@@ -3798,7 +3798,7 @@
 	io__write_string(")").
 output_rval(binop(Op, X, Y)) -->
 	(
-		{ Op = array_index }
+		{ Op = array_index(_Type) }
 	->
 		io__write_string("("),
 		output_rval_as_type(X, data_ptr),
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.37
diff -u -d -r1.37 ml_code_util.m
--- compiler/ml_code_util.m	8 Jun 2001 09:13:33 -0000	1.37
+++ compiler/ml_code_util.m	8 Jul 2001 11:12:08 -0000
@@ -17,7 +17,7 @@
 
 :- import_module prog_data.
 :- import_module hlds_module, hlds_pred.
-:- import_module rtti, code_model.
+:- import_module builtin_ops, rtti, code_model.
 :- import_module mlds.
 :- import_module globals.
 
@@ -117,6 +117,15 @@
 :- pred ml_gen_type(prog_type, mlds__type, ml_gen_info, ml_gen_info).
 :- mode ml_gen_type(in, out, in, out) is det.
 
+	% Convert the element type for an array_index operator
+	% to an MLDS type.
+	%
+:- func ml_gen_array_elem_type(builtin_ops__array_elem_type) = mlds__type.
+
+	% Return the MLDS type corresponding to a Mercury string type.
+	%
+:- func ml_string_type = mlds__type.
+
 %-----------------------------------------------------------------------------%
 %
 % Routines for generating function declarations (i.e. mlds__func_params).
@@ -941,6 +950,12 @@
 	=(Info),
 	{ ml_gen_info_get_module_info(Info, ModuleInfo) },
 	{ MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type) }.
+
+ml_gen_array_elem_type(elem_type_string) = ml_string_type.
+ml_gen_array_elem_type(elem_type_int) = mlds__native_int_type.
+ml_gen_array_elem_type(elem_type_generic) = mlds__generic_type.
+
+ml_string_type = mercury_type(string_type, str_type).
 
 %-----------------------------------------------------------------------------%
 %
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.6
diff -u -d -r1.6 ml_string_switch.m
--- compiler/ml_string_switch.m	2 May 2001 11:36:37 -0000	1.6
+++ compiler/ml_string_switch.m	8 Jul 2001 11:12:08 -0000
@@ -56,16 +56,18 @@
 	ml_gen_info_new_cond_var(SlotVarSeq),
 	{ SlotVarName = mlds__var_name(
 		string__format("slot_%d", [i(SlotVarSeq)]), no) },
-	{ SlotVarDefn = ml_gen_mlds_var_decl(var(SlotVarName),
-		mlds__native_int_type, MLDS_Context) },
-	ml_gen_var_lval(SlotVarName, mlds__native_int_type, SlotVarLval),
+	{ SlotVarType = mlds__native_int_type },
+	{ SlotVarDefn = ml_gen_mlds_var_decl(var(SlotVarName), SlotVarType,
+		MLDS_Context) },
+	ml_gen_var_lval(SlotVarName, SlotVarType, SlotVarLval),
 
 	ml_gen_info_new_cond_var(StringVarSeq),
 	{ StringVarName = mlds__var_name(
 		string__format("str_%d", [i(StringVarSeq)]), no) },
+	{ StringVarType = ml_string_type },
 	{ StringVarDefn = ml_gen_mlds_var_decl(var(StringVarName),
-		ml_string_type, MLDS_Context) },
-	ml_gen_var_lval(StringVarName, ml_string_type, StringVarLval),
+		StringVarType, MLDS_Context) },
+	ml_gen_var_lval(StringVarName, StringVarType, StringVarLval),
 
 	%
 	% Generate new labels
@@ -112,7 +114,7 @@
 	ml_gen_info_new_const(NextSlotsSeq),
 	ml_format_static_const_name("next_slots_table", NextSlotsSeq,
 		NextSlotsName),
-	{ NextSlotsType = mlds__array_type(mlds__native_int_type) },
+	{ NextSlotsType = mlds__array_type(SlotVarType) },
 	{ NextSlotsDefn = ml_gen_static_const_defn(NextSlotsName,
 		NextSlotsType,
 		init_array(NextSlots), Context) },
@@ -121,7 +123,7 @@
 	ml_gen_info_new_const(StringTableSeq),
 	ml_format_static_const_name("string_table", StringTableSeq,
 		StringTableName),
-	{ StringTableType = mlds__array_type(ml_string_type) },
+	{ StringTableType = mlds__array_type(StringVarType) },
 	{ StringTableDefn = ml_gen_static_const_defn(StringTableName,
 		StringTableType, init_array(Strings), Context) },
 	ml_gen_var_lval(StringTableName, StringTableType ,StringTableLval),
@@ -130,7 +132,7 @@
 	% Generate code which does the hash table lookup.
 	%
 
-	{ SwitchStmt0 = switch(mlds__native_int_type, lval(SlotVarLval),
+	{ SwitchStmt0 = switch(SlotVarType, lval(SlotVarLval),
 		range(0, TableSize - 1),
 		SlotsCases, default_is_unreachable) },
 	ml_simplify_switch(SwitchStmt0, MLDS_Context, SwitchStatement),
@@ -139,7 +141,7 @@
 			binop(and,
 				binop(ne,
 					lval(StringVarLval),
-					const(null(ml_string_type))),
+					const(null(StringVarType))),
 				binop(str_eq,
 					lval(StringVarLval),
 					VarRval)
@@ -162,7 +164,7 @@
 				MLDS_Context),
 			mlds__statement(
 				atomic(assign(StringVarLval,
-					binop(array_index,
+					binop(array_index(elem_type_string),
 						lval(StringTableLval),
 						lval(SlotVarLval)))),
 				MLDS_Context),
@@ -178,7 +180,7 @@
 				MLDS_Context),
 			mlds__statement(
 				atomic(assign(SlotVarLval,
-					binop(array_index,
+					binop(array_index(elem_type_int),
 						lval(NextSlotsLval),
 						lval(SlotVarLval)))),
 				MLDS_Context)
@@ -291,6 +293,3 @@
 		{ NextSlotRval = const(int_const(-2)) },
 		{ MLDS_Cases = [] }
 	).
-
-:- func ml_string_type = mlds__type.
-ml_string_type = mercury_type(string_type, str_type).
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.87
diff -u -d -r1.87 mlds_to_c.m
--- compiler/mlds_to_c.m	8 Jun 2001 09:13:38 -0000	1.87
+++ compiler/mlds_to_c.m	8 Jul 2001 11:12:09 -0000
@@ -2830,7 +2830,7 @@
 	
 mlds_output_binop(Op, X, Y) -->
 	(
-		{ Op = array_index }
+		{ Op = array_index(_Type) }
 	->
 		mlds_output_bracketed_rval(X),
 		io__write_string("["),
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.40
diff -u -d -r1.40 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m	10 May 2001 15:07:58 -0000	1.40
+++ compiler/mlds_to_gcc.m	8 Jul 2001 11:12:11 -0000
@@ -3140,11 +3140,10 @@
 convert_binary_op(eq,		gcc__eq_expr,	     gcc__boolean_type_node).
 convert_binary_op(ne,		gcc__ne_expr,	     gcc__boolean_type_node).
 convert_binary_op(body,		gcc__minus_expr,     'MR_intptr_t').
-convert_binary_op(array_index,  gcc__array_ref,	     Type) :-
-	% XXX temp hack -- this is wrong.
-	% We should change builtin_ops:array_index
-	% so that it takes the type as an argument.
-	Type = 'MR_Integer'.
+convert_binary_op(array_index(ElemType),
+				gcc__array_ref,	     GCC_Type) :-
+	MLDS_Type = ml_gen_array_elem_type(ElemType),
+	build_type(MLDS_Type, no_initializer, GlobalInfo0, GCC_Type).
 convert_binary_op(str_eq, _, _) :- unexpected(this_file, "str_eq").
 convert_binary_op(str_ne, _, _) :- unexpected(this_file, "str_ne").
 convert_binary_op(str_lt, _, _) :- unexpected(this_file, "str_lt").
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.33
diff -u -d -r1.33 mlds_to_il.m
--- compiler/mlds_to_il.m	18 Jun 2001 09:18:01 -0000	1.33
+++ compiler/mlds_to_il.m	8 Jul 2001 11:12:13 -0000
@@ -1424,7 +1424,7 @@
 	il_info) is det.
 :- mode unaryop_to_il(in, in, out, in, out) is det.
 
-	% Once upon a time the code generator generated primary tag tests
+	% Once upon a time the MLDS code generator generated primary tag tests
 	% (but we don't use primary tags).
 	% If we make mktag return its operand (since it will always be
 	% called with 0 as its operand), and we make tag return 0, it will
@@ -1439,9 +1439,8 @@
 unaryop_to_il(std_unop(mkbody),	_, comment_node("mkbody (a no-op)")) --> [].
 unaryop_to_il(std_unop(unmkbody), _, comment_node("unmkbody (a no-op)")) --> [].
 
-		% XXX implement this using string__hash
-unaryop_to_il(std_unop(hash_string), _,
-	throw_unimplemented("unimplemented hash_string unop")) --> [].
+unaryop_to_il(std_unop(hash_string), _, node([call(il_mercury_string_hash)]))
+		--> [].
 unaryop_to_il(std_unop(bitwise_complement), _, node([not])) --> [].
 
 		% might want to revisit this and define not to be only
@@ -1559,10 +1558,11 @@
 	{ unexpected(this_file, "binop: body") }.
 
 
-	% XXX we need to know what kind of thing is being indexed
-	% from the array in general. 
-binaryop_to_il(array_index, throw_unimplemented("array index unimplemented")) 
-		--> [].
+binaryop_to_il(array_index(ElemType), instr_node(I)) -->
+	DataRep =^ il_data_rep,
+	{ MLDS_Type = ml_gen_array_elem_type(ElemType) },
+	{ ILSimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type) },
+	{ I = ldelem(ILSimpleType) }.
 
 	% String operations.
 binaryop_to_il(str_eq, node([
@@ -2573,6 +2573,15 @@
 il_string_compare = get_static_methodref(il_string_class_name, id("Compare"), 
 	simple_type(int32), [il_string_type, il_string_type]).
 
+	% Note that we need to use the hash function from the Mercury
+	% standard library, rather than the one from the .NET BCL
+	% (Base Class Library), because it must match the one used by
+	% the Mercury compiler when computing the hash tables for
+	% string switches.
+:- func il_mercury_string_hash = methodref.
+il_mercury_string_hash = get_static_methodref(mercury_string_class_name,
+	id("hash_2"), simple_type(int32), [il_string_type]).
+
 :- func il_string_class_name = ilds__class_name.
 il_string_class_name = il_system_name(["String"]).
 
@@ -2582,6 +2591,10 @@
 :- func il_string_type = ilds__type.
 il_string_type = ilds__type([], il_string_simple_type).
 
+:- func mercury_string_class_name = ilds__class_name.
+mercury_string_class_name = mercury_library_name(StringClass) :-
+	sym_name_to_class_name(unqualified("string"), yes, StringClass).
+
 %-----------------------------------------------------------------------------%
 %
 % The mapping to the generic type (used like MR_Box).
@@ -2654,6 +2667,16 @@
 
 :- func il_commit_class_name = ilds__class_name.
 il_commit_class_name = mercury_runtime_name(["Commit"]).
+
+%-----------------------------------------------------------------------------
+
+	% qualifiy a name with "[mercury]mercury."
+:- func mercury_library_name(ilds__namespace_qual_name) = ilds__class_name.
+mercury_library_name(Name) = 
+	append_class_name(mercury_library_namespace_name, Name).
+
+:- func mercury_library_namespace_name = ilds__class_name.
+mercury_library_namespace_name = structured_name("mercury", ["mercury"]).
 
 %-----------------------------------------------------------------------------
 
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.5
diff -u -d -r1.5 mlds_to_java.m
--- compiler/mlds_to_java.m	8 Jun 2001 09:13:43 -0000	1.5
+++ compiler/mlds_to_java.m	8 Jul 2001 11:12:14 -0000
@@ -484,11 +484,14 @@
 	NewVarName = qual(mercury_module_name_to_mlds(ModuleName), 
 		mercury_module_name_to_mlds(ModuleName), 
 		var_name("args", no)),
-	NewArgLval = var(NewVarName, mlds__generic_type),
+	NewArgLval = var(NewVarName, mlds__array_type(mlds__generic_type)),
 	%	
-	% Package everything together.
+	% Package everything together. 
 	%
-	Initializer = binop(array_index, lval(NewArgLval), ArrayIndex),
+	% XXX Don't we need a cast here? -fjh.
+	%
+	Initializer = binop(array_index(elem_type_generic),
+		lval(NewArgLval), ArrayIndex),
 	Body = mlds__data(Type, init_obj(Initializer)),	
 	Defn = mlds__defn(Name, Context, Flags, Body),
 	%	
@@ -2120,7 +2123,7 @@
 	
 output_binop(Op, X, Y) -->
 	(
-		{ Op = array_index }
+		{ Op = array_index(_Type) }
 	->
 		output_bracketed_rval(X),
 		io__write_string("["),
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.15
diff -u -d -r1.15 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m	8 Jun 2001 09:13:45 -0000	1.15
+++ compiler/rtti_to_mlds.m	8 Jul 2001 11:12:14 -0000
@@ -248,9 +248,6 @@
 gen_init_rtti_data_defn(pseudo_type_info(Pseudo), ModuleName, _, Init, []) :-
 	Init = gen_init_pseudo_type_info_defn(Pseudo, ModuleName).
 
-:- func ml_string_type = mlds__type.
-ml_string_type = mercury_type(string_type, str_type).
-
 :- func gen_init_functors_info(type_ctor_functors_info, module_name,
 		rtti_type_id) = mlds__initializer.
 gen_init_functors_info(enum_functors(EnumFunctorsInfo), ModuleName,
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.36
diff -u -d -r1.36 string_switch.m
--- compiler/string_switch.m	23 Nov 2000 04:32:47 -0000	1.36
+++ compiler/string_switch.m	8 Jul 2001 11:12:14 -0000
@@ -102,15 +102,15 @@
 			  "compute the hash value of the input string",
 			label(LoopLabel) -
 			  "begin hash chain loop",
-			assign(StringReg, binop(array_index, StringTable,
-							lval(SlotReg))) -
+			assign(StringReg, binop(array_index(elem_type_string),
+					StringTable, lval(SlotReg))) -
 			  "lookup the string for this hash slot",
 			if_val(binop(and, lval(StringReg),
 				binop(str_eq, lval(StringReg), VarRval)),
 					label(JumpLabel)) -
 			  "did we find a match?",
-			assign(SlotReg, binop(array_index, NextSlotsTable,
-							lval(SlotReg))) -
+			assign(SlotReg, binop(array_index(elem_type_int),
+					NextSlotsTable, lval(SlotReg))) -
 			  "not yet, so get next slot in hash chain",
 			if_val(binop(>=, lval(SlotReg), const(int_const(0))),
 				label(LoopLabel)) -

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