[m-rev.] diff:

Zoltan Somogyi zs at cs.mu.OZ.AU
Sat May 17 14:40:54 AEST 2003
Previous message: [m-rev.] diff:
Next message: [m-rev.] diff:
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
On 17-May-2003, Zoltan Somogyi <zs at cs.mu.OZ.AU> wrote:
> I will back out my change to mlds.m and replace it with the solution you
> requested (which I am bootchecking on aral right now in both hlc.gc and hl.gc)
> *after* the change to mlds.m has been installed on all three of roy, ceres and
> hg, enabling bootstrapping of the change to array.m.

The following is the diff I am testing; it includes the previously posted
diff to array.m unchanged.

BTW, I noticed that hg hasn't had mercury-latest installed since April 6.
The May 10 output says a lock is still in place. Fergus, please check
if this is a stray lock, and if so, delete it.

Zoltan.

Have the compiler define the RTTI of the array type, instead of having
it be handwritten.

library/array.m:
	Add a type definition for the array type, making it a foreign type
	(MR_ArrayPtr) with the existing predicates array_equal and
	array_compare as its unify and compare preds.

	Change array_compare to return the result as uo, not out,
	to make this possible.

	Delete all the hand-written code and data structures needed by
	RTTI, since they are now compiler-generated.

	Delete the old casts from MR_Word to MR_ArrayType *, since
	they are now not needed (MR_ArrayPtr is defined as MR_ArrayType *).

	Add a macro to centralize the LVALUE_CAST we now need when calling
	MR_incr_hp_msg (which assumes that it assigning to an MR_Word).

compiler/mlds_to_c.m:
	Generate MR_ArrayPtr instead of MR_Array for array/1.

compiler/mlds.m:
	Back out my earlier change to mlds.m, since it isn't needed for
	bootstrapping anymore.

runtime/mercury_hlc_types.h:
	Delete MR_Array, since it isn't needed anymore.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.101
diff -u -b -r1.101 mlds.m
--- compiler/mlds.m	16 May 2003 09:48:53 -0000	1.101
+++ compiler/mlds.m	17 May 2003 03:27:08 -0000
@@ -1687,6 +1687,12 @@
 
 mercury_type_to_mlds_type(ModuleInfo, Type) = MLDSType :-
 	( 
+		type_to_ctor_and_args(Type, TypeCtor, [ElemType]),
+		TypeCtor = qualified(unqualified("array"), "array") - 1
+	->
+		MLDSElemType = mercury_type_to_mlds_type(ModuleInfo, ElemType),
+		MLDSType = mlds__mercury_array_type(MLDSElemType)
+	;
 		type_to_ctor_and_args(Type, TypeCtor, _),
 		module_info_types(ModuleInfo, Types),
 		map__search(Types, TypeCtor, TypeDefn),
@@ -1734,12 +1740,6 @@
 			)
 		),
 		MLDSType = mlds__foreign_type(ForeignType)
-	;
-		type_to_ctor_and_args(Type, TypeCtor, [ElemType]),
-		TypeCtor = qualified(unqualified("array"), "array") - 1
-	->
-		MLDSElemType = mercury_type_to_mlds_type(ModuleInfo, ElemType),
-		MLDSType = mlds__mercury_array_type(MLDSElemType)
 	;
 		classify_type(Type, ModuleInfo, Category),
 		ExportedType = to_exported_type(ModuleInfo, Type),
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.147
diff -u -b -r1.147 mlds_to_c.m
--- compiler/mlds_to_c.m	9 May 2003 00:45:07 -0000	1.147
+++ compiler/mlds_to_c.m	17 May 2003 03:31:37 -0000
@@ -700,9 +700,8 @@
 :- mode mlds_output_pragma_export_type(in, in, di, uo) is det.
 
 mlds_output_pragma_export_type(suffix, _Type) --> [].
-		% Array types are exported as MR_Word
 mlds_output_pragma_export_type(prefix, mercury_array_type(_ElemType)) -->
-	io__write_string("MR_Word").
+	io__write_string("MR_ArrayPtr").
 mlds_output_pragma_export_type(prefix, mercury_type(_, _, ExportedType)) -->
 	io__write_string(foreign__to_type_string(c, ExportedType)).
 mlds_output_pragma_export_type(prefix, mlds__cont_type(_)) -->
@@ -1795,9 +1794,7 @@
 			qualified(unqualified("array"), "array") - 1,
 			user_type)
 	;
-		% for the --no-high-level-data case,
-		% we just treat everything as `MR_Word'
-		io__write_string("MR_Array")
+		io__write_string("MR_ArrayPtr")
 	).
 mlds_output_type_prefix(mlds__native_int_type)   --> io__write_string("int").
 mlds_output_type_prefix(mlds__native_float_type) --> io__write_string("float").
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/array.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.121
diff -u -b -r1.121 array.m
--- library/array.m	9 May 2003 09:10:34 -0000	1.121
+++ library/array.m	15 May 2003 23:46:17 -0000
@@ -316,7 +316,7 @@
 :- mode array__map(func(in) = out is det, array_di) = array_uo is det.
 
 :- func array_compare(array(T), array(T)) = comparison_result.
-:- mode array_compare(in, in) = out is det.
+:- mode array_compare(in, in) = uo is det.
 
 	% array__sort(Array) returns a version of Array sorted
 	% into ascending order.
@@ -366,284 +366,20 @@
 % Everything beyond here is not intended as part of the public interface,
 % and will not appear in the Mercury Library Reference Manual.
 
-%-----------------------------------------------------------------------------%
-:- interface.
-
-	% The following predicates have to be declared in the interface,
-	% otherwise dead code elimination will remove them.
-	% But they're an implementation detail; user code should just
-	% use the generic versions.
-
-	% unify/2 for arrays
-
-:- pred array_equal(array(T), array(T)).
-:- mode array_equal(in, in) is semidet.
-
-	% compare/3 for arrays
-
-:- pred array_compare(comparison_result, array(T), array(T)).
-:- mode array_compare(out, in, in) is det.
-
-%-----------------------------------------------------------------------------%
-
-:- implementation.
 :- import_module exception, int, require, string.
 
-/****
-lower bounds other than zero are not supported
-	% array__resize takes an array and new lower and upper bounds.
-	% the array is expanded or shrunk at each end to make it fit
-	% the new bounds.
-:- pred array__resize(array(T), int, int, array(T)).
-:- mode array__resize(in, in, in, out) is det.
-****/
-
-%-----------------------------------------------------------------------------%
-
-% Arrays are implemented using the C interface.
-
-% The C type which defines the representation of arrays is
-% MR_ArrayType; it is defined in runtime/mercury_library_types.h.
-
-%-----------------------------------------------------------------------------%
-
-:- pragma foreign_decl("C", "
-#ifdef MR_HIGHLEVEL_CODE
-  MR_bool MR_CALL mercury__array__do_unify__array_1_0(
-  	MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y);
-  MR_bool MR_CALL mercury__array____Unify____array_1_0(
-	MR_Mercury_Type_Info type_info, MR_Array x, MR_Array y);
-  void MR_CALL mercury__array__do_compare__array_1_0(MR_Mercury_Type_Info
- 	 type_info, MR_Comparison_Result *result, MR_Box x, MR_Box y);
-  void MR_CALL mercury__array____Compare____array_1_0(MR_Mercury_Type_Info
-	type_info, MR_Comparison_Result *result, MR_Array x, MR_Array y);
-#endif
-").
-
-:- pragma foreign_code("C", "
-
-#include ""mercury_deep_profiling_hand.h""
-
-
-#ifdef	MR_DEEP_PROFILING
-MR_proc_static_compiler_plain(array, __Unify__,   array, 1, 0,
-	array, array_equal,   2, 0, ""array.m"", 99, MR_TRUE);
-MR_proc_static_compiler_plain(array, __Compare__, array, 1, 0,
-	array, array_compare, 3, 0, ""array.m"", 99, MR_TRUE);
-#endif
-
-MR_DEFINE_TYPE_CTOR_INFO(array, array, 1, ARRAY);
-
-#ifdef MR_HIGHLEVEL_CODE
-
-MR_bool MR_CALL
-mercury__array__do_unify__array_1_0(MR_Mercury_Type_Info type_info,
-	MR_Box x, MR_Box y)
-{
-	return mercury__array____Unify____array_1_0(
-		type_info, (MR_Array) x, (MR_Array) y);
-}
-
-MR_bool MR_CALL
-mercury__array____Unify____array_1_0(MR_Mercury_Type_Info type_info,
-	MR_Array x, MR_Array y)
-{
-	return mercury__array__array_equal_2_p_0(type_info, x, y);
-}
-
-void MR_CALL
-mercury__array__do_compare__array_1_0(
-	MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
-	MR_Box x, MR_Box y)
-{
-	mercury__array____Compare____array_1_0(
-		type_info, result, (MR_Array) x, (MR_Array) y);
-}
-
-void MR_CALL
-mercury__array____Compare____array_1_0(
-	MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
-	MR_Array x, MR_Array y)
-{
-	mercury__array__array_compare_3_p_0(type_info, result, x, y);
-}
-
-#else
-
-MR_declare_entry(mercury__array__array_equal_2_0);
-MR_declare_entry(mercury__array__array_compare_3_0);
-
-MR_BEGIN_MODULE(array_module_builtins)
-	MR_init_entry(mercury____Unify___array__array_1_0);
-	MR_init_entry(mercury____Compare___array__array_1_0);
-#ifdef	MR_DEEP_PROFILING
-	MR_init_label(mercury____Unify___array__array_1_0_i1);
-	MR_init_label(mercury____Unify___array__array_1_0_i2);
-	MR_init_label(mercury____Unify___array__array_1_0_i3);
-	MR_init_label(mercury____Unify___array__array_1_0_i4);
-	MR_init_label(mercury____Unify___array__array_1_0_i5);
-	MR_init_label(mercury____Unify___array__array_1_0_i6);
-	MR_init_label(mercury____Compare___array__array_1_0_i1);
-	MR_init_label(mercury____Compare___array__array_1_0_i2);
-	MR_init_label(mercury____Compare___array__array_1_0_i3);
-	MR_init_label(mercury____Compare___array__array_1_0_i4);
-#endif
-MR_BEGIN_CODE
-	/*
-	** Unification and comparison for arrays are implemented in Mercury,
-	** not hand-coded low-level C
-	*/
-
-#ifdef	MR_DEEP_PROFILING
-
-#define	proc_label	mercury____Unify___array__array_1_0
-#define proc_static	MR_proc_static_compiler_name(array, __Unify__,	\
-				array, 1, 0)
-#define	body_code	MR_deep_prepare_normal_call(			\
-			  mercury____Unify___array__array_1_0, 3,	\
-			  mercury____Unify___array__array_1_0_i5, 0);	\
-			MR_call_localret(				\
-			  MR_ENTRY(mercury__array__array_equal_2_0),	\
-			  mercury____Unify___array__array_1_0_i6,	\
-			  MR_ENTRY(mercury____Unify___array__array_1_0));\
-			MR_define_label(				\
-			  mercury____Unify___array__array_1_0_i6);
-
-#include ""mercury_hand_unify_body.h""
-
-#undef	body_code
-#undef	proc_static
-#undef	proc_label
-
-#define	proc_label	mercury____Compare___array__array_1_0
-#define proc_static	MR_proc_static_compiler_name(array, __Compare__,\
-				array, 1, 0)
-#define	body_code	MR_deep_prepare_normal_call(			\
-			  mercury____Compare___array__array_1_0, 3,	\
-			  mercury____Compare___array__array_1_0_i3, 0);	\
-			MR_call_localret(				\
-			  MR_ENTRY(mercury__array__array_compare_3_0),	\
-			  mercury____Compare___array__array_1_0_i4,	\
-			  MR_ENTRY(mercury____Compare___array__array_1_0));\
-			MR_define_label(				\
-			  mercury____Compare___array__array_1_0_i4);
-
-#include ""mercury_hand_compare_body.h""
-
-#undef	body_code
-#undef	proc_static
-#undef	proc_label
-
-#else
-
-MR_define_entry(mercury____Unify___array__array_1_0);
-	MR_tailcall(MR_ENTRY(mercury__array__array_equal_2_0),
-		MR_ENTRY(mercury____Unify___array__array_1_0));
-
-MR_define_entry(mercury____Compare___array__array_1_0);
-	/* this is implemented in Mercury, not hand-coded low-level C */
-	MR_tailcall(MR_ENTRY(mercury__array__array_compare_3_0),
-		MR_ENTRY(mercury____Compare___array__array_1_0));
-
-#endif
-
-MR_END_MODULE
-
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc array_module_builtins;
-
-#endif /* ! MR_HIGHLEVEL_CODE */
-
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT mercury_sys_init_array_module_builtins
-*/
-
-/* suppress gcc -Wmissing-decl warning */
-void mercury_sys_init_array_module_builtins_init(void);
-void mercury_sys_init_array_module_builtins_init_type_tables(void);
-#ifdef	MR_DEEP_PROFILING
-void mercury_sys_init_array_module_builtins_write_out_proc_statics(FILE *fp);
-#endif
-
-void
-mercury_sys_init_array_module_builtins_init(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
-	array_module_builtins();
-	MR_INIT_TYPE_CTOR_INFO(
-		mercury_data_array__type_ctor_info_array_1,
-		array__array_1_0);
-#endif
-}
-
-void
-mercury_sys_init_array_module_builtins_init_type_tables(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
-	MR_register_type_ctor_info(
-		&mercury_data_array__type_ctor_info_array_1);
-#endif
-}
-
-#ifdef	MR_DEEP_PROFILING
-void
-mercury_sys_init_array_module_builtins_write_out_proc_statics(FILE *fp)
-{
-	MR_write_out_proc_static(fp, (MR_ProcStatic *)
-		&MR_proc_static_compiler_name(array, __Unify__, array, 1, 0));
-	MR_write_out_proc_static(fp, (MR_ProcStatic *)
-		&MR_proc_static_compiler_name(array, __Compare__, array, 1, 0));
-}
-#endif
-
-").
-
-:- pragma foreign_code("MC++", "
-    MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(array, array, 1, MR_TYPECTOR_REP_ARRAY)
-
-    static MR_bool
-    special___Unify___array_1_0(MR_TypeInfo type_info, MR_Array x, MR_Array y)
-    {
-            return mercury::array::mercury_code::ML_array_equal(
-	    	type_info, x, y);
-    }
-
-    static void
-    special___Compare___array_1_0(
-            MR_TypeInfo type_info, MR_ComparisonResult *result, MR_Array x, MR_Array y)
-    {
-            mercury::array::mercury_code::ML_array_compare(
-	    	type_info, result, x, y);
-    }
-
-    static MR_bool
-    do_unify__array_1_0(MR_TypeInfo type_info, MR_Box x, MR_Box y)
-    {
-            return mercury::array__cpp_code::mercury_code::special___Unify___array_1_0(
-                    type_info, 
-                    dynamic_cast<MR_Array>(x),
-                    dynamic_cast<MR_Array>(y));
-    }
-
-    static void
-    do_compare__array_1_0(
-            MR_TypeInfo type_info, MR_ComparisonResult *result, MR_Box x, MR_Box y)
-    {
-            mercury::array__cpp_code::mercury_code::special___Compare___array_1_0(
-                    type_info, result, 
-                    dynamic_cast<MR_Array>(x),
-                    dynamic_cast<MR_Array>(y));
-    }
-").
-
-
-%-----------------------------------------------------------------------------%
+	% MR_ArrayPtr is defined in runtime/mercury_library_types.h.
+:- pragma foreign_type("C", array(T), "MR_ArrayPtr")
+	where equality is array__array_equal,
+	comparison is array__array_compare.
+:- pragma foreign_type(il,  array(T), "class [mscorlib]System.Array")
+	where equality is array__array_equal,
+	comparison is array__array_compare.
 
+	% unify/2 for arrays
 
+:- pred array_equal(array(T)::in, array(T)::in) is semidet.
 :- pragma export(array_equal(in, in), "ML_array_equal").
-:- pragma export(array_compare(out, in, in), "ML_array_compare").
-
-	% unify/2 for arrays
 
 array_equal(Array1, Array2) :-
 	array__size(Array1, Size),
@@ -665,6 +401,10 @@
 
 	% compare/3 for arrays
 
+:- pred array_compare(comparison_result::uo, array(T)::in, array(T)::in)
+	is det.
+:- pragma export(array_compare(uo, in, in), "ML_array_compare").
+
 array_compare(Result, Array1, Array2) :-
 	array__size(Array1, Size1),
 	array__size(Array2, Size2),
@@ -677,7 +417,7 @@
 
 :- pred array__compare_elements(int, int, array(T), array(T),
 			comparison_result).
-:- mode array__compare_elements(in, in, in, in, out) is det.
+:- mode array__compare_elements(in, in, in, in, uo) is det.
 
 array__compare_elements(N, Size, Array1, Array2, Result) :-
 	( N = Size ->
@@ -726,11 +466,15 @@
 
 :- pragma foreign_decl("C", "
 #include ""mercury_heap.h""		/* for MR_maybe_record_allocation() */
-#include ""mercury_library_types.h""	/* for MR_ArrayType */
+#include ""mercury_library_types.h""	/* for MR_ArrayPtr */
+
+#define	ML_alloc_array(newarray, arraysize, proclabel)	\
+	MR_incr_hp_msg(MR_LVALUE_CAST(MR_Word, (newarray)), (arraysize), \
+		proclabel, ""array:array/1"")
 ").
 
 :- pragma foreign_decl("C", "
-void ML_init_array(MR_ArrayType *, MR_Integer size, MR_Word item);
+void ML_init_array(MR_ArrayPtr, MR_Integer size, MR_Word item);
 ").
 
 :- pragma foreign_code("C", "
@@ -739,7 +483,7 @@
 ** This routine does the job of initializing the already-allocated memory.
 */
 void
-ML_init_array(MR_ArrayType *array, MR_Integer size, MR_Word item)
+ML_init_array(MR_ArrayPtr array, MR_Integer size, MR_Word item)
 {
 	MR_Integer i;
 
@@ -764,16 +508,16 @@
 	array__init_2(Size::in, Item::in, Array::array_uo),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
-	ML_init_array((MR_ArrayType *)Array, Size, Item);
+	ML_alloc_array(Array, Size + 1, MR_PROC_LABEL);
+	ML_init_array(Array, Size, Item);
 ").
 
 :- pragma foreign_proc("C",
 	array__make_empty_array(Array::array_uo),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	MR_incr_hp_msg(Array, 1, MR_PROC_LABEL, ""array:array/1"");
-	ML_init_array((MR_ArrayType *)Array, 0, 0);
+	ML_alloc_array(Array, 1, MR_PROC_LABEL);
+	ML_init_array(Array, 0, 0);
 ").
 
 :- pragma foreign_proc("C#", 
@@ -836,13 +580,13 @@
 	array__max(Array::array_ui, Max::out), 
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	Max = ((MR_ArrayType *)Array)->size - 1;
+	Max = Array->size - 1;
 ").
 :- pragma foreign_proc("C",
 	array__max(Array::in, Max::out), 
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	Max = ((MR_ArrayType *)Array)->size - 1;
+	Max = Array->size - 1;
 ").
 :- pragma foreign_proc("C#", 
 	array__max(Array::array_ui, Max::out), 
@@ -875,13 +619,13 @@
 	array__size(Array::array_ui, Max::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	Max = ((MR_ArrayType *)Array)->size;
+	Max = Array->size;
 ").
 :- pragma foreign_proc("C",
 	array__size(Array::in, Max::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	Max = ((MR_ArrayType *)Array)->size;
+	Max = Array->size;
 ").
 
 :- pragma foreign_proc("C#",
@@ -944,15 +688,13 @@
 	array__unsafe_lookup(Array::array_ui, Index::in, Item::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "{
-	MR_ArrayType *array = (MR_ArrayType *)Array;
-	Item = array->elements[Index];
+	Item = Array->elements[Index];
 }").
 :- pragma foreign_proc("C",
 	array__unsafe_lookup(Array::in, Index::in, Item::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "{
-	MR_ArrayType *array = (MR_ArrayType *)Array;
-	Item = array->elements[Index];
+	Item = Array->elements[Index];
 }").
 
 :- pragma foreign_proc("C#",
@@ -985,8 +727,7 @@
 		Item::in, Array::array_uo),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "{
-	MR_ArrayType *array = (MR_ArrayType *)Array0;
-	array->elements[Index] = Item;	/* destructive update! */
+	Array0->elements[Index] = Item;	/* destructive update! */
 	Array = Array0;
 }").
 
@@ -1001,8 +742,17 @@
 
 %-----------------------------------------------------------------------------%
 
+/****
+lower bounds other than zero are not supported
+	% array__resize takes an array and new lower and upper bounds.
+	% the array is expanded or shrunk at each end to make it fit
+	% the new bounds.
+:- pred array__resize(array(T), int, int, array(T)).
+:- mode array__resize(in, in, in, out) is det.
+****/
+
 :- pragma foreign_decl("C", "
-void ML_resize_array(MR_ArrayType *new_array, MR_ArrayType *old_array,
+void ML_resize_array(MR_ArrayPtr new_array, MR_ArrayPtr old_array,
 					MR_Integer array_size, MR_Word item);
 ").
 
@@ -1014,7 +764,7 @@
 ** and deallocating the old array.
 */
 void
-ML_resize_array(MR_ArrayType *array, MR_ArrayType *old_array,
+ML_resize_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
 	MR_Integer array_size, MR_Word item)
 {
 	MR_Integer i;
@@ -1048,13 +798,11 @@
 		Array::array_uo),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	if (((MR_ArrayType *)Array0)->size == Size) {
+	if ((Array0)->size == Size) {
 		Array = Array0;
 	} else {
-		MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL,
-			""array:array/1"");
-		ML_resize_array((MR_ArrayType *) Array,
-			(MR_ArrayType *) Array0, Size, Item);
+		ML_alloc_array(Array, Size + 1, MR_PROC_LABEL);
+		ML_resize_array(Array, Array0, Size, Item);
 	}
 ").
 
@@ -1086,7 +834,7 @@
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_decl("C", "
-void ML_shrink_array(MR_ArrayType *array, MR_ArrayType *old_array,
+void ML_shrink_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
 					MR_Integer array_size);
 ").
 
@@ -1097,7 +845,7 @@
 ** new array and deallocating the old array.
 */
 void
-ML_shrink_array(MR_ArrayType *array, MR_ArrayType *old_array,
+ML_shrink_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
 	MR_Integer array_size)
 {
 	MR_Integer i;
@@ -1134,9 +882,8 @@
 		array__shrink_2(Array0::array_di, Size::in, Array::array_uo),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
-	ML_shrink_array((MR_ArrayType *)Array, (MR_ArrayType *) Array0,
-		Size);
+	ML_alloc_array(Array, Size + 1, MR_PROC_LABEL);
+	ML_shrink_array(Array, Array0, Size);
 ").
 
 :- pragma foreign_proc("C#",
@@ -1151,7 +898,7 @@
 %-----------------------------------------------------------------------------%
 
 :- pragma foreign_decl("C", "
-void ML_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array);
+void ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array);
 ").
 
 :- pragma foreign_code("C", "
@@ -1160,7 +907,7 @@
 ** This routine does the job of copying the array elements.
 */
 void
-ML_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array)
+ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array)
 {
 	/*
 	** Any changes to this function will probably also require
@@ -1175,7 +922,6 @@
 	for (i = 0; i < array_size; i++) {
 		array->elements[i] = old_array->elements[i];
 	}
-
 }
 ").
 
@@ -1183,18 +929,16 @@
 		array__copy(Array0::array_ui, Array::array_uo),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	MR_incr_hp_msg(Array, (((const MR_ArrayType *) Array0)->size) + 1,
-		MR_PROC_LABEL, ""array:array/1"");
-	ML_copy_array((MR_ArrayType *) Array, (const MR_ArrayType *) Array0);
+	ML_alloc_array(Array, Array0->size + 1, MR_PROC_LABEL);
+	ML_copy_array(Array, (MR_ConstArrayPtr) Array0);
 ").
 
 :- pragma foreign_proc("C",
 		array__copy(Array0::in, Array::array_uo),
 	[will_not_call_mercury, promise_pure, thread_safe],
 "
-	MR_incr_hp_msg(Array, (((const MR_ArrayType *) Array0)->size) + 1,
-		MR_PROC_LABEL, ""array:array/1"");
-	ML_copy_array((MR_ArrayType *) Array, (const MR_ArrayType *) Array0);
+	ML_alloc_array(Array, Array0->size + 1, MR_PROC_LABEL);
+	ML_copy_array(Array, (MR_ConstArrayPtr) Array0);
 ").
 
 :- pragma foreign_proc("C#",
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_hlc_types.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_hlc_types.h,v
retrieving revision 1.2
diff -u -b -r1.2 mercury_hlc_types.h
--- runtime/mercury_hlc_types.h	10 Feb 2003 17:03:57 -0000	1.2
+++ runtime/mercury_hlc_types.h	17 May 2003 03:32:42 -0000
@@ -61,7 +61,6 @@
   typedef struct mercury__private_builtin__ref_1_s * MR_Reference;
   typedef MR_ClosurePtr MR_Pred;
   typedef MR_ClosurePtr MR_Func;
-  typedef struct mercury__array__array_1_s * MR_Array;
   typedef struct mercury__std_util__univ_0_s * MR_Univ;
   typedef struct mercury__type_desc__type_desc_0_s * MR_Type_Desc;
   typedef struct mercury__type_desc__type_ctor_desc_0_s * MR_Type_Ctor_Desc;
@@ -82,7 +81,6 @@
   typedef MR_Word MR_Reference;
   typedef MR_Word MR_Pred;
   typedef MR_Word MR_Func;
-  typedef MR_Word MR_Array;
   typedef MR_Word MR_Univ;
   typedef MR_Word MR_Type_Desc;
   typedef MR_Word MR_Type_Ctor_Desc;
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
Previous message: [m-rev.] diff:
Next message: [m-rev.] diff:
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the reviews mailing list