[m-dev.] diff: MLDS back-end: more misc fixes

Fergus Henderson fjh at cs.mu.OZ.AU
Fri May 5 20:12:29 AEST 2000


Estimated hours taken: 8

More fixes for the MLDS back-end.

compiler/ml_code_gen.m:
library/private_builtin.m:
runtime/mercury.h:
	Don't treat unsafe_type_cast as an inline builtin, since the
	code generated for it as an inline builtin is not type-correct.
	Instead, declare `unsafe_type_cast/2' as external in
	library/private_builtin.m, so that the generated code
	for this module does not try to declare or define it.
	And in runtime/mercury.h, define unsafe_type_cast/2 as a
	macro / inline function.

library/private_builtin.m:
	Fix a bug in my previous change: add a missing cast.

runtime/mercury_type_info.h:
	Declare the constants mercury_data___type_ctor_info_{pred,func}_0;
	used by the MR_TYPE_CTOR_INFO_HO_{FUNC,PRED} macros.
	Add some conditional code so that those macros do the right
	thing for the MLDS back-end.

runtime/mercury_deep_copy.c:
runtime/mercury_tabling.c:
library/std_util.m:
	Delete the now unnecessary declarations of
	mercury_data___type_ctor_info_{pred,func}_0;
	these are now declared in runtime/mercury_type_info.h.

library/std_util.m:
	Delete the redundant definitions of the MR_TYPE_CTOR_INFO_*()
	macros; these were defined identically in runtime/mercury_type_info.h.
	Also use MR_TYPE_CTOR_INFO_HO_{FUNC,PRED} rather than hard-coding
	their definitions.

runtime/mercury.h:
runtime/mercury.c:
	Update to reflect recent RTTI changes.
	In particular, use MR_TypeCtorInfo rather than MR_BaseTypeInfo,
	and delete the code for the index/2 predicate.

runtime/mercury_std.h:
runtime/mercury.h:
	Move the definition of MR_INLINE and MR_EXTERN_INLINE
	from mercury.h to mercury_std.h, since they're used in
	mercury_heap.h.

runtime/mercury.c:
	Wrap `#ifdef MR_HIGHLEVEL_CODE' around the whole of this file,
	so that it does the right thing in LLDS-based grades.

runtime/mercury_heap.h:
runtime/mercury_imp.h:
runtime/mercury_deep_copy.h:
runtime/mercury_layout_util.h:
	Add some missing `#include' directives.

runtime/Mmakefile:
	Add mercury.c and mercury.h to the respective file lists.
	Split the HDRS variable into HDRS and BODY_HDRS, so that
	`mmake check_headers' does not assume that *_body.h
	will be syntactically correct.

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.34
diff -u -d -r1.34 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/05/01 17:42:06	1.34
+++ compiler/ml_code_gen.m	2000/05/05 05:51:01
@@ -1277,10 +1277,22 @@
 	ml_gen_generic_call(GenericCall, Vars, Modes, CodeModel, Context,
 		MLDS_Decls, MLDS_Statements).
 
-ml_gen_goal_expr(call(PredId, ProcId, ArgVars, BuiltinState, _, _PredName),
+ml_gen_goal_expr(call(PredId, ProcId, ArgVars, BuiltinState, _, PredName),
 		CodeModel, Context, MLDS_Decls, MLDS_Statements) -->
 	(
-		{ BuiltinState = not_builtin }
+		{
+			BuiltinState = not_builtin
+		;
+			% For the MLDS back-end, we can't treat
+			% private_builtin:unsafe_type_cast as an
+			% inline builtin, since the code that
+			% builtin_ops__translate_builtin generates
+			% for it is not type-correct.  Instead,
+			% we treat it as an ordinary polymorphic
+			% procedure; ml_gen_call will then generate
+			% the proper type conversions automatically.
+			PredName = qualified(_, "unsafe_type_cast")
+		}
 	->
 		ml_gen_var_list(ArgVars, ArgLvals),
 		=(MLDSGenInfo),
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.49
diff -u -d -r1.49 private_builtin.m
--- library/private_builtin.m	2000/05/01 17:42:41	1.49
+++ library/private_builtin.m	2000/05/05 06:23:51
@@ -390,8 +390,10 @@
 	% that sometimes have calls to them emitted by the compiler.
 
 	% unsafe_type_cast/2 is used internally by the compiler. Bad things
-	% will happen if this is used in programs. It has no definition,
+	% will happen if this is used in programs.
+	% With the LLDS back-end, it has no definition,
 	% since for efficiency the code generator treats it as a builtin.
+	% With the MLDS back-end, it is defined in runtime/mercury.h.
 
 :- pred unsafe_type_cast(T1, T2).
 :- mode unsafe_type_cast(in, out) is det.
@@ -400,6 +402,8 @@
 
 :- implementation.
 
+:- external(unsafe_type_cast/2).
+
 unused :-
 	( semidet_succeed ->
 		error("attempted use of dead predicate")
@@ -1249,7 +1253,7 @@
 	table = (MR_TrieNode) T;
 #ifdef MR_HIGHLEVEL_CODE
 	MR_TABLE_SAVE_ANSWER(table, Offset,
-		MR_box_float(F),
+		(Word) MR_box_float(F),
 		&mercury_data___type_ctor_info_float_0);
 #else
 	MR_TABLE_SAVE_ANSWER(table, Offset,
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.191
diff -u -d -r1.191 std_util.m
--- library/std_util.m	2000/05/01 17:42:44	1.191
+++ library/std_util.m	2000/05/05 09:36:21
@@ -1285,28 +1285,10 @@
 #define MR_TYPECTOR_DESC_GET_HOT_TYPE_CTOR_INFO(T)                      \
         ( MR_CHECK_EXPR_TYPE(T, MR_TypeCtorDesc),			\
           ((Unsigned) (T) % 2 != 0)      				\
-                ? (MR_TypeCtorInfo)					\
-			&mercury_data___type_ctor_info_func_0           \
-                : (MR_TypeCtorInfo)					\
-			&mercury_data___type_ctor_info_pred_0 )
-
-/*---------------------------------------------------------------------------*/
-
-/*
-** Macros dealing with the MR_TypeCtorInfo type.
-*/
-#define MR_TYPE_CTOR_INFO_HO_PRED                                       \
-        ((MR_TypeCtorInfo) &mercury_data___type_ctor_info_pred_0)
-#define MR_TYPE_CTOR_INFO_HO_FUNC                                       \
-        ((MR_TypeCtorInfo) &mercury_data___type_ctor_info_func_0)
-#define MR_TYPE_CTOR_INFO_IS_HO_PRED(T)                                 \
-        (T == MR_TYPE_CTOR_INFO_HO_PRED)
-#define MR_TYPE_CTOR_INFO_IS_HO_FUNC(T)                                 \
-        (T == MR_TYPE_CTOR_INFO_HO_FUNC)
-#define MR_TYPE_CTOR_INFO_IS_HO(T)                                      \
-        (MR_TYPE_CTOR_INFO_IS_HO_FUNC(T) || MR_TYPE_CTOR_INFO_IS_HO_PRED(T))
-
-#endif
+                ? MR_TYPE_CTOR_INFO_HO_FUNC				\
+                : MR_TYPE_CTOR_INFO_HO_PRED )
+		
+#endif /* ML_TYPECTORDESC_GUARD */
 
 ").
 
@@ -1474,13 +1456,6 @@
 
 extern	MR_TypeCtorDesc ML_make_type_ctor_desc(MR_TypeInfo type_info,
 				MR_TypeCtorInfo type_ctor_info);
-
-	/*
-	** Several predicates use these (the MR_TYPE_CTOR_INFO_IS_HO_*
-	** macros need access to these addresses).
-	*/
-MR_DECLARE_TYPE_CTOR_INFO_STRUCT(mercury_data___type_ctor_info_pred_0);
-MR_DECLARE_TYPE_CTOR_INFO_STRUCT(mercury_data___type_ctor_info_func_0);
 
 ").
 
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.1
diff -u -d -r1.1 mercury.c
--- runtime/mercury.c	1999/12/04 02:05:54	1.1
+++ runtime/mercury.c	2000/05/05 09:12:41
@@ -14,6 +14,8 @@
 #include "mercury_type_info.h"	/* for MR_TYPECTOR_REP* */
 #include "mercury_misc.h"	/* for fatal_error() */
 
+#ifdef MR_HIGHLEVEL_CODE
+
 /*---------------------------------------------------------------------------*/
 /*
 ** Variable definitions
@@ -35,15 +37,6 @@
 typedef bool MR_UnifyFunc_5(MR_Word, MR_Word, MR_Word, MR_Word, MR_Word,
 			    MR_Box, MR_Box);
 
-typedef void MR_IndexFunc_0(MR_Box, MR_Integer *);
-typedef void MR_IndexFunc_1(MR_Word, MR_Box, MR_Integer *);
-typedef void MR_IndexFunc_2(MR_Word, MR_Word, MR_Box, MR_Integer *);
-typedef void MR_IndexFunc_3(MR_Word, MR_Word, MR_Word, MR_Box, MR_Integer *);
-typedef void MR_IndexFunc_4(MR_Word, MR_Word, MR_Word, MR_Word,
-			    MR_Box, MR_Integer *);
-typedef void MR_IndexFunc_5(MR_Word, MR_Word, MR_Word, MR_Word, MR_Word,
-			    MR_Box, MR_Integer *);
-
 typedef void MR_CompareFunc_0(MR_Word *, MR_Box, MR_Box);
 typedef void MR_CompareFunc_1(MR_Word, MR_Word *, MR_Box, MR_Box);
 typedef void MR_CompareFunc_2(MR_Word, MR_Word, MR_Word *, MR_Box, MR_Box);
@@ -60,18 +53,20 @@
 */
 
 /*
-** Define MR_BaseTypeInfos for the builtin types
+** Define MR_TypeCtorInfos for the builtin types
 */
 
-#define MR_base_type_info_name(MODULE, TYPE, ARITY)			      \
+#define MR_type_ctor_info_name(MODULE, TYPE, ARITY)			      \
 	MR_PASTE2(mercury__,						      \
 	MR_PASTE2(MODULE,						      \
-	MR_PASTE2(__base_type_info_,					      \
+	MR_PASTE2(__,							      \
+	MR_PASTE2(MODULE,						      \
+	MR_PASTE2(__type_ctor_info_,					      \
 	MR_PASTE2(TYPE,							      \
 	MR_PASTE2(_,							      \
-	          ARITY)))))
+	          ARITY)))))))
 
-#define MR_base_type_info_func_name(MODULE, TYPE, ARITY, FUNC)		      \
+#define MR_type_ctor_info_func_name(MODULE, TYPE, ARITY, FUNC)		      \
 	MR_PASTE2(mercury__,						      \
 	MR_PASTE2(MODULE,						      \
 	MR_PASTE2(__,							      \
@@ -84,50 +79,53 @@
 #define MR_special_func_type(NAME, ARITY) \
 	MR_PASTE2(MR_, MR_PASTE2(NAME, MR_PASTE2(Func_, ARITY)))
 
-#define MR_define_base_type_info(module, type, arity, type_rep)		      \
+#define MR_define_type_ctor_info(module, type, arity, type_rep)		      \
 									      \
 	extern MR_special_func_type(Unify, arity)			      \
-		MR_base_type_info_func_name(module, type, arity, __Unify__);  \
-	extern MR_special_func_type(Index, arity)			      \
-		MR_base_type_info_func_name(module, type, arity, __Index__);  \
+		MR_type_ctor_info_func_name(module, type, arity, __Unify__);  \
 	extern MR_special_func_type(Compare, arity)			      \
-		MR_base_type_info_func_name(module, type, arity, __Compare__);\
+		MR_type_ctor_info_func_name(module, type, arity, __Compare__);\
 									      \
-	const MR_BaseTypeInfo MR_base_type_info_name(module, type, arity) =   \
+	const struct MR_TypeCtorInfo_Struct				      \
+		MR_type_ctor_info_name(module, type, arity) =		      \
 	{								      \
 		arity,							      \
-		(MR_Box) MR_base_type_info_func_name(module, type, arity,     \
+		(MR_Box) MR_type_ctor_info_func_name(module, type, arity,     \
 				__Unify__),				      \
-		(MR_Box) MR_base_type_info_func_name(module, type, arity,     \
-				__Index__),				      \
-		(MR_Box) MR_base_type_info_func_name(module, type, arity,     \
+		(MR_Box) MR_type_ctor_info_func_name(module, type, arity,     \
+				__Unify__),				      \
+		(MR_Box) MR_type_ctor_info_func_name(module, type, arity,     \
 				__Compare__),				      \
 		type_rep,						      \
 		NULL,							      \
 		NULL,							      \
 		MR_STRINGIFY(module),					      \
 		MR_STRINGIFY(type),					      \
-		MR_RTTI_VERSION						      \
+		MR_RTTI_VERSION,					      \
+		{ 0 },							      \
+		{ 0 },							      \
+		-1,							      \
+		-1							      \
 	}
 
-MR_define_base_type_info(builtin, int, 0, MR_TYPECTOR_REP_INT);
-MR_define_base_type_info(builtin, string, 0, MR_TYPECTOR_REP_STRING);
-MR_define_base_type_info(builtin, float, 0, MR_TYPECTOR_REP_FLOAT);
-MR_define_base_type_info(builtin, character, 0, MR_TYPECTOR_REP_CHAR);
-MR_define_base_type_info(builtin, void, 0, MR_TYPECTOR_REP_VOID);
-MR_define_base_type_info(builtin, c_pointer, 0, MR_TYPECTOR_REP_C_POINTER);
-MR_define_base_type_info(builtin, pred, 0, MR_TYPECTOR_REP_PRED);
-MR_define_base_type_info(builtin, func, 0, MR_TYPECTOR_REP_PRED);
-MR_define_base_type_info(array, array, 1, MR_TYPECTOR_REP_ARRAY);
-MR_define_base_type_info(std_util, univ, 0, MR_TYPECTOR_REP_UNIV);
-MR_define_base_type_info(std_util, type_info, 0, MR_TYPECTOR_REP_TYPEINFO);
-MR_define_base_type_info(private_builtin, type_ctor_info, 1,
+MR_define_type_ctor_info(builtin, int, 0, MR_TYPECTOR_REP_INT);
+MR_define_type_ctor_info(builtin, string, 0, MR_TYPECTOR_REP_STRING);
+MR_define_type_ctor_info(builtin, float, 0, MR_TYPECTOR_REP_FLOAT);
+MR_define_type_ctor_info(builtin, character, 0, MR_TYPECTOR_REP_CHAR);
+MR_define_type_ctor_info(builtin, void, 0, MR_TYPECTOR_REP_VOID);
+MR_define_type_ctor_info(builtin, c_pointer, 0, MR_TYPECTOR_REP_C_POINTER);
+MR_define_type_ctor_info(builtin, pred, 0, MR_TYPECTOR_REP_PRED);
+MR_define_type_ctor_info(builtin, func, 0, MR_TYPECTOR_REP_PRED);
+MR_define_type_ctor_info(array, array, 1, MR_TYPECTOR_REP_ARRAY);
+MR_define_type_ctor_info(std_util, univ, 0, MR_TYPECTOR_REP_UNIV);
+MR_define_type_ctor_info(std_util, type_desc, 0, MR_TYPECTOR_REP_TYPEINFO);
+MR_define_type_ctor_info(private_builtin, type_ctor_info, 1,
 	MR_TYPECTOR_REP_TYPEINFO);
-MR_define_base_type_info(private_builtin, type_info, 1,
+MR_define_type_ctor_info(private_builtin, type_info, 1,
 	MR_TYPECTOR_REP_TYPEINFO);
-MR_define_base_type_info(private_builtin, base_typeclass_info, 1,
+MR_define_type_ctor_info(private_builtin, base_typeclass_info, 1,
 	MR_TYPECTOR_REP_TYPECLASSINFO);
-MR_define_base_type_info(private_builtin, typeclass_info, 1,
+MR_define_type_ctor_info(private_builtin, typeclass_info, 1,
 	MR_TYPECTOR_REP_TYPECLASSINFO);
 
 /*---------------------------------------------------------------------------*/
@@ -136,162 +134,95 @@
 */
 
 /*
-** Define the builtin unify/2, index/2, and compare/3 functions.
+** Define the builtin unify/2 and compare/3 functions.
 */
 
 bool
 mercury__builtin__unify_2_p_0(Word ti, MR_Box x, MR_Box y)
 {
-	Word *type_info;
-	MR_BaseTypeInfo *base_type_info;
-	int arity;
+	MR_TypeInfo		type_info;
+	MR_TypeCtorInfo		type_ctor_info;
+	int			arity;
+	MR_TypeInfoParams	params;
+	MR_Word			*args;
 
-	type_info = (Word *) ti;
-	if (*type_info == 0) {
-		base_type_info = (MR_BaseTypeInfo *)type_info;
+	type_info = (MR_TypeInfo) ti;
+	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+	if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+		arity = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info);
+		params = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info);
 	} else {
-		base_type_info = *(MR_BaseTypeInfo **)type_info;
+		arity = type_ctor_info->arity;
+		params = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
 	}
+	args = (MR_Word *) params;
 
-	/*
-	** For higher-order predicates and functions,
-	** the arity is stored in the type_info, not in the
-	** base_type_info, and so we need to skip past the
-	** arity field.
-	*/
-	if (base_type_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
-		arity = type_info[1];
-		type_info++;
-	} else {
-		arity = base_type_info->type_arity;
-	}
-		
 	switch(arity) {
 		/*
-		** cast base_type_info->unify to the right type
+		** cast type_ctor_info->unify_pred to the right type
 		** and then call it, passing the right number of
 		** type_info arguments
 		*/
-		case 0: return ((MR_UnifyFunc_0 *) base_type_info->unify)
+		case 0: return ((MR_UnifyFunc_0 *) type_ctor_info->unify_pred)
 				(x, y);
-		case 1: return ((MR_UnifyFunc_1 *) base_type_info->unify)
-				(type_info[1], x, y);
-		case 2: return ((MR_UnifyFunc_2 *) base_type_info->unify)
-				(type_info[1], type_info[2], x, y);
-		case 3: return ((MR_UnifyFunc_3 *) base_type_info->unify)
-				(type_info[1], type_info[2], type_info[3],
+		case 1: return ((MR_UnifyFunc_1 *) type_ctor_info->unify_pred)
+				(args[1], x, y);
+		case 2: return ((MR_UnifyFunc_2 *) type_ctor_info->unify_pred)
+				(args[1], args[2], x, y);
+		case 3: return ((MR_UnifyFunc_3 *) type_ctor_info->unify_pred)
+				(args[1], args[2], args[3],
 				 x, y);
-		case 4: return ((MR_UnifyFunc_4 *) base_type_info->unify)
-				(type_info[1], type_info[2], type_info[3],
-				 type_info[4], x, y);
-		case 5: return ((MR_UnifyFunc_5 *) base_type_info->unify)
-				(type_info[1], type_info[2], type_info[3],
-				 type_info[4], type_info[5], x, y);
+		case 4: return ((MR_UnifyFunc_4 *) type_ctor_info->unify_pred)
+				(args[1], args[2], args[3],
+				 args[4], x, y);
+		case 5: return ((MR_UnifyFunc_5 *) type_ctor_info->unify_pred)
+				(args[1], args[2], args[3],
+				 args[4], args[5], x, y);
 		default:
 			fatal_error("unify/2: type arity > 5 not supported");
 	}
 }
 
 void
-mercury__builtin__index_2_p_3(Word ti, MR_Box x, Integer *y)
-{
-	Word *type_info;
-	MR_BaseTypeInfo *base_type_info;
-	int arity;
-
-	type_info = (Word *) ti;
-	if (*type_info == 0) {
-		base_type_info = (MR_BaseTypeInfo *)type_info;
-	} else {
-		base_type_info = *(MR_BaseTypeInfo **)type_info;
-	}
-
-	/*
-	** For higher-order predicates and functions,
-	** the arity is stored in the type_info, not in the
-	** base_type_info, and so we need to skip past the
-	** arity field.
-	*/
-	if (base_type_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
-		arity = type_info[1];
-		type_info++;
-	} else {
-		arity = base_type_info->type_arity;
-	}
-		
-	switch(arity) {
-		/*
-		** cast base_type_info->index to the right type
-		** and then call it, passing the right number of
-		** type_info arguments
-		*/
-		case 0: return ((MR_IndexFunc_0 *) base_type_info->index)
-				(x, y);
-		case 1: return ((MR_IndexFunc_1 *) base_type_info->index)
-				(type_info[1], x, y);
-		case 2: return ((MR_IndexFunc_2 *) base_type_info->index)
-				(type_info[1], type_info[2], x, y);
-		case 3: return ((MR_IndexFunc_3 *) base_type_info->index)
-				(type_info[1], type_info[2], type_info[3],
-				 x, y);
-		case 4: return ((MR_IndexFunc_4 *) base_type_info->index)
-				(type_info[1], type_info[2], type_info[3],
-				 type_info[4], x, y);
-		case 5: return ((MR_IndexFunc_5 *) base_type_info->index)
-				(type_info[1], type_info[2], type_info[3],
-				 type_info[4], type_info[5], x, y);
-		default:
-			fatal_error("index/2: type arity > 5 not supported");
-	}
-}
-
-void
 mercury__builtin__compare_3_p_0(Word ti, Word *res, MR_Box x, MR_Box y)
 {
-	Word *type_info;
-	MR_BaseTypeInfo *base_type_info;
-	int arity;
+	MR_TypeInfo		type_info;
+	MR_TypeCtorInfo		type_ctor_info;
+	int			arity;
+	MR_TypeInfoParams	params;
+	MR_Word			*args;
 
-	type_info = (Word *) ti;
-	if (*type_info == 0) {
-		base_type_info = (MR_BaseTypeInfo *)type_info;
+	type_info = (MR_TypeInfo) ti;
+	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+	if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+		arity = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info);
+		params = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info);
 	} else {
-		base_type_info = *(MR_BaseTypeInfo **)type_info;
+		arity = type_ctor_info->arity;
+		params = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
 	}
+	args = (MR_Word *) params;
 
-	/*
-	** For higher-order predicates and functions,
-	** the arity is stored in the type_info, not in the
-	** base_type_info, and so we need to skip past the
-	** arity field.
-	*/
-	if (base_type_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
-		arity = type_info[1];
-		type_info++;
-	} else {
-		arity = base_type_info->type_arity;
-	}
-		
 	switch(arity) {
 		/*
-		** cast base_type_info->compare to the right type
+		** cast type_ctor_info->compare to the right type
 		** and then call it, passing the right number of
 		** type_info arguments
 		*/
-		case 0: ((MR_CompareFunc_0 *) base_type_info->compare)
+		case 0: ((MR_CompareFunc_0 *) type_ctor_info->compare_pred)
 			 (res, x, y);
-		case 1: ((MR_CompareFunc_1 *) base_type_info->compare)
-			 (type_info[1], res, x, y);
-		case 2: ((MR_CompareFunc_2 *) base_type_info->compare)
-			 (type_info[1], type_info[2], res, x, y);
-		case 3: ((MR_CompareFunc_3 *) base_type_info->compare)
-			 (type_info[1], type_info[2], type_info[3], res, x, y);
-		case 4: ((MR_CompareFunc_4 *) base_type_info->compare)
-			 (type_info[1], type_info[2], type_info[3],
-			  type_info[4], res, x, y);
-		case 5: ((MR_CompareFunc_5 *) base_type_info->compare)
-			 (type_info[1], type_info[2], type_info[3],
-			  type_info[4], type_info[5], res, x, y);
+		case 1: ((MR_CompareFunc_1 *) type_ctor_info->compare_pred)
+			 (args[1], res, x, y);
+		case 2: ((MR_CompareFunc_2 *) type_ctor_info->compare_pred)
+			 (args[1], args[2], res, x, y);
+		case 3: ((MR_CompareFunc_3 *) type_ctor_info->compare_pred)
+			 (args[1], args[2], args[3], res, x, y);
+		case 4: ((MR_CompareFunc_4 *) type_ctor_info->compare_pred)
+			 (args[1], args[2], args[3],
+			  args[4], res, x, y);
+		case 5: ((MR_CompareFunc_5 *) type_ctor_info->compare_pred)
+			 (args[1], args[2], args[3],
+			  args[4], args[5], res, x, y);
 		default:
 			fatal_error("index/2: type arity > 5 not supported");
 	}
@@ -314,3 +245,5 @@
 {
 	return mercury__builtin__compare_3_p_0(type_info, res, x, y);
 }
+
+#endif /* MR_HIGHLEVEL_CODE */
Index: runtime/mercury_deep_copy.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.c,v
retrieving revision 1.17
diff -u -d -r1.17 mercury_deep_copy.c
--- runtime/mercury_deep_copy.c	2000/04/14 07:20:33	1.17
+++ runtime/mercury_deep_copy.c	2000/05/05 09:17:02
@@ -19,9 +19,6 @@
 #include "mercury_memory.h"
 
 
-MR_DECLARE_TYPE_CTOR_INFO_STRUCT(mercury_data___type_ctor_info_pred_0);
-MR_DECLARE_TYPE_CTOR_INFO_STRUCT(mercury_data___type_ctor_info_func_0);
-
 /*
 ** deep_copy(): see mercury_deep_copy.h for documentation.
 */
Index: runtime/mercury_deep_copy.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.h,v
retrieving revision 1.9
diff -u -d -r1.9 mercury_deep_copy.h
--- runtime/mercury_deep_copy.h	2000/04/14 07:20:34	1.9
+++ runtime/mercury_deep_copy.h	2000/05/05 08:45:35
@@ -10,6 +10,7 @@
 #define	MERCURY_DEEP_COPY_H
 
 #include "mercury_types.h"	/* for `Word' */
+#include "mercury_type_info.h"	/* for `MR_TypeInfo' */
 
 /*
 ** deep_copy:
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.5
diff -u -d -r1.5 mercury.h
--- runtime/mercury.h	2000/05/01 17:43:10	1.5
+++ runtime/mercury.h	2000/05/05 08:08:50
@@ -261,18 +261,6 @@
   		((MR_Word) (type *) GC_MALLOC(size)) 
 #endif
 
-/* this should probably go in mercury_std.h */
-#if defined(__GNUC__) 
-  #define MR_INLINE __inline__
-  #define MR_EXTERN_INLINE extern __inline__
-#elif defined(__cplusplus) || __STDC_VERSION__ >= 199901
-  #define MR_INLINE inline
-  #define MR_EXTERN_INLINE extern inline
-#else
-  #define MR_INLINE static
-  #define MR_EXTERN_INLINE static
-#endif
-
 /*
 ** Code to box/unbox floats
 **
@@ -300,13 +288,26 @@
   #define MR_unbox_float(ptr) (*(MR_Float *)ptr)
 #endif
 
+#ifdef MR_AVOID_MACROS
+  MR_EXTERN_INLINE void mercury__private_builtin__unsafe_type_cast_2_p_0(
+  	MR_Box src, MR_Box *dest);
+
+  MR_EXTERN_INLINE void mercury__private_builtin__unsafe_type_cast_2_p_0(
+  	MR_Box src, MR_Box *dest)
+  {
+  	*dest = src;
+  }
+#else
+  #define mercury__private_builtin__unsafe_type_cast_2_p_0(src, dest) \
+	(*(dest) = (src))
+#endif
+
 /*-----------------------------------------------------------------------------*/
 /*
 ** Function declarations
 */
 
 bool mercury__builtin__unify_2_p_0(Word type_info, MR_Box, MR_Box);
-void mercury__builtin__index_2_p_3(Word type_info, MR_Box, Integer *);
 void mercury__builtin__compare_3_p_0(Word type_info, Word *, MR_Box, MR_Box);
 void mercury__builtin__compare_3_p_1(Word type_info, Word *, MR_Box, MR_Box);
 void mercury__builtin__compare_3_p_2(Word type_info, Word *, MR_Box, MR_Box);
Index: runtime/mercury_heap.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_heap.h,v
retrieving revision 1.14
diff -u -d -r1.14 mercury_heap.h
--- runtime/mercury_heap.h	2000/05/01 17:43:11	1.14
+++ runtime/mercury_heap.h	2000/05/05 08:42:32
@@ -12,6 +12,10 @@
 #include "mercury_types.h"		/* for `Word' */
 #include "mercury_context.h"		/* for min_heap_reclamation_point() */
 #include "mercury_heap_profile.h"	/* for MR_record_allocation() */
+#include "mercury_std.h"		/* for MR_EXTERN_INLINE */
+#ifdef MR_HIGHLEVEL_CODE
+  #include "mercury.h"			/* for MR_new_object() */
+#endif
 
 #ifdef CONSERVATIVE_GC
 
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_imp.h,v
retrieving revision 1.14
diff -u -d -r1.14 mercury_imp.h
--- runtime/mercury_imp.h	1998/11/11 02:14:17	1.14
+++ runtime/mercury_imp.h	2000/05/05 08:39:01
@@ -38,6 +38,10 @@
 
 #include	"mercury_regs.h"	/* must come before system headers */
 
+#ifdef MR_HIGHLEVEL_CODE
+  #include	"mercury.h"
+#endif
+
 #include	"mercury_std.h"
 #include	"mercury_debug.h"
 
Index: runtime/mercury_layout_util.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_layout_util.h,v
retrieving revision 1.9
diff -u -d -r1.9 mercury_layout_util.h
--- runtime/mercury_layout_util.h	2000/03/24 10:27:49	1.9
+++ runtime/mercury_layout_util.h	2000/05/05 08:49:06
@@ -8,8 +8,9 @@
 #define	MERCURY_LAYOUT_UTIL_H
 
 #include "mercury_std.h"
-#include "mercury_types.h"
-#include "mercury_stack_layout.h"
+#include "mercury_types.h"		/* for Word, etc. */
+#include "mercury_stack_layout.h"	/* for MR_Stack_Layout_Vars, etc. */
+#include "mercury_type_info.h"		/* for MR_TypeInfoParams, etc. */
 
 /*
 ** These two functions copy the register state to and from the provided
Index: runtime/mercury_std.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_std.h,v
retrieving revision 1.11
diff -u -d -r1.11 mercury_std.h
--- runtime/mercury_std.h	2000/04/02 06:37:21	1.11
+++ runtime/mercury_std.h	2000/05/05 08:05:34
@@ -101,6 +101,24 @@
 
 /*---------------------------------------------------------------------------*/
 
+/* Macros for inlining */
+
+#if defined(__GNUC__) 
+  /* GNU C */
+  #define MR_INLINE __inline__
+  #define MR_EXTERN_INLINE extern __inline__
+#elif defined(__cplusplus) || __STDC_VERSION__ >= 199901
+  /* C++ or C99 */
+  #define MR_INLINE inline
+  #define MR_EXTERN_INLINE extern inline
+#else
+  /* C89 */
+  #define MR_INLINE static
+  #define MR_EXTERN_INLINE static
+#endif
+
+/*---------------------------------------------------------------------------*/
+
 /*
 ** C preprocessor tricks.
 */
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.24
diff -u -d -r1.24 mercury_tabling.c
--- runtime/mercury_tabling.c	2000/03/24 10:27:50	1.24
+++ runtime/mercury_tabling.c	2000/05/05 09:17:31
@@ -603,12 +603,7 @@
 
 /*
 ** This part defines the MR_table_type() function.
-*/
-
-MR_DECLARE_TYPE_CTOR_INFO_STRUCT(mercury_data___type_ctor_info_pred_0);
-MR_DECLARE_TYPE_CTOR_INFO_STRUCT(mercury_data___type_ctor_info_func_0);
-
-/*
+**
 ** Due to the depth of the control here, we'll use 4 space indentation.
 **
 ** NOTE: changes to this function will probably also have to be reflected
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.50
diff -u -d -r1.50 mercury_type_info.h
--- runtime/mercury_type_info.h	2000/05/01 17:43:13	1.50
+++ runtime/mercury_type_info.h	2000/05/05 10:02:31
@@ -922,10 +922,23 @@
 
 /*---------------------------------------------------------------------------*/
 
-#define MR_TYPE_CTOR_INFO_HO_PRED                                       \
+#ifdef MR_HIGHLEVEL_CODE
+  extern const struct MR_TypeCtorInfo_Struct 
+        mercury__builtin__builtin__type_ctor_info_pred_0,
+        mercury__builtin__builtin__type_ctor_info_func_0;
+  #define MR_TYPE_CTOR_INFO_HO_PRED                                     \
+        (&mercury__builtin__builtin__type_ctor_info_pred_0)
+  #define MR_TYPE_CTOR_INFO_HO_FUNC                                     \
+        (&mercury__builtin__builtin__type_ctor_info_func_0)
+#else
+  MR_DECLARE_TYPE_CTOR_INFO_STRUCT(mercury_data___type_ctor_info_pred_0);
+  MR_DECLARE_TYPE_CTOR_INFO_STRUCT(mercury_data___type_ctor_info_func_0);
+  #define MR_TYPE_CTOR_INFO_HO_PRED                                     \
         ((MR_TypeCtorInfo) &mercury_data___type_ctor_info_pred_0)
-#define MR_TYPE_CTOR_INFO_HO_FUNC                                       \
+  #define MR_TYPE_CTOR_INFO_HO_FUNC                                     \
         ((MR_TypeCtorInfo) &mercury_data___type_ctor_info_func_0)
+#endif
+
 #define MR_TYPE_CTOR_INFO_IS_HO_PRED(T)                                 \
         (T == MR_TYPE_CTOR_INFO_HO_PRED)
 #define MR_TYPE_CTOR_INFO_IS_HO_FUNC(T)                                 \
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.53
diff -u -d -r1.53 Mmakefile
--- runtime/Mmakefile	2000/03/24 10:27:46	1.53
+++ runtime/Mmakefile	2000/05/05 08:57:05
@@ -26,8 +26,12 @@
 
 #-----------------------------------------------------------------------------#
 
+# All the headers in $(HDRS) should be syntactically well-formed
+# header files, unlike the headers in $(BODY_HDRS).
+
 #		  keep this list in alphabetical order, please
 HDRS		=	\
+			mercury.h		\
 			mercury_accurate_gc.h	\
 			mercury_agc_debug.h	\
 			mercury_array_macros.h	\
@@ -38,7 +42,6 @@
 			mercury_context.h	\
 			mercury_debug.h		\
 			mercury_deep_copy.h	\
-			mercury_deep_copy_body.h \
 			mercury_dummy.h		\
 			mercury_dlist.h		\
 		  	mercury_engine.h	\
@@ -55,7 +58,6 @@
 			mercury_label.h		\
 			mercury_layout_util.h	\
 			mercury_library_types.h	\
-			mercury_make_type_info_body.h	\
 			mercury_memory.h	\
 			mercury_memory_zones.h	\
 			mercury_memory_handlers.h	\
@@ -81,12 +83,18 @@
 			mercury_trail.h		\
 			mercury_types.h		\
 			mercury_type_info.h	\
-			mercury_unify_compare_body.h	\
 			mercury_wrapper.h	\
 			$(LIB_DLL_H)
 
-# Note that $(LIB_GLOBALS_H) cannot be part of $(HDR), since it depends on
-# lib$(RT_LIB_NAME)$(DLL_DEF_LIB).a, and $(OBJ) : $(HDR) would create a
+# The headers in $(BODY_HDRS) do not have to be syntactically well-formed.
+
+BODY_HDRS	=	\
+			mercury_deep_copy_body.h \
+			mercury_make_type_info_body.h	\
+			mercury_unify_compare_body.h
+
+# Note that $(LIB_GLOBALS_H) cannot be part of $(HDRS), since it depends on
+# lib$(RT_LIB_NAME)$(DLL_DEF_LIB).a, and $(OBJ) : $(HDRS) would create a
 # circular dependency.
 
 MACHHDRS	= 	machdeps/no_regs.h	\
@@ -100,6 +108,7 @@
 
 #		  keep this list in alphabetical order, please
 CFILES		= 	\
+			mercury.c		\
 			mercury_accurate_gc.c	\
 			mercury_agc_debug.c	\
 			mercury_bootstrap.c	\
@@ -182,7 +191,7 @@
 
 #-----------------------------------------------------------------------------#
 
-$(OBJS) $(PIC_OBJS): $(HDRS) $(MACHHDRS)
+$(OBJS) $(PIC_OBJS): $(HDRS) $(BODY_HDRS) $(MACHHDRS)
 
 #-----------------------------------------------------------------------------#
 
@@ -215,8 +224,8 @@
 .PHONY: cs
 cs: $(CFILES)
 
-tags: $(CFILES) $(HDRS)
-	ctags $(CFILES) $(HDRS)
+tags: $(CFILES) $(HDRS) $(BODY_HDRS)
+	ctags $(CFILES) $(HDRS) $(BODY_HDRS)
 
 #-----------------------------------------------------------------------------#
 #
@@ -282,8 +291,8 @@
 	-[ -d $(INSTALL_MERC_LIB_DIR) ] || mkdir -p $(INSTALL_MERC_LIB_DIR)
 
 .PHONY: install_headers
-install_headers: $(HDRS) $(MACHHDRS) $(LIB_GLOBALS_H) install_dirs
-	cp `vpath_find $(HDRS) $(LIB_GLOBALS_H)` $(INSTALL_INC_DIR)
+install_headers: $(HDRS) $(BODY_HDRS) $(MACHHDRS) $(LIB_GLOBALS_H) install_dirs
+	cp `vpath_find $(HDRS) $(BODY_HDRS) $(LIB_GLOBALS_H)` $(INSTALL_INC_DIR)
 	-chmod u+w $(INSTALL_INC_DIR)/mercury_conf.h
 	cp `vpath_find $(MACHHDRS)` $(INSTALL_INC_DIR)/machdeps
 

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list