[m-rev.] for review: distinguish type_ctor_infos from type_infos

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon Jan 28 18:39:03 AEDT 2002


For review by anyone.

Estimated hours taken: 10
Branches: main

Fix a bug by distinguishing the type_ctor_reps of type_infos and
type_ctor_infos. The type_ctor_infos of types with nonzero arity
cannot be printed, copied etc like type_infos; any attempt to do so
causes a core dump.

For similar reasons, add a separate type_ctor_rep for
base_typeclass_infos separate from typeclass_infos.

runtime/mercury_type_info.h:
runtime/mercury_mcpp.h:
compiler/mlds_to_gcc.m:
library/rtti_implementation.m:
	Add new type_ctor_reps for type_ctor_infos and base_typeclass_infos.

library/private_builtin.m:
runtime/mercury.c:
	Use the new type_ctor_reps in the type_ctor_infos of the builtin types
	type_ctor_info and base_typeclass_info.

runtime/mercury_type_info.[ch]:
	Add a function for comparing type_ctor_infos.

	Move some interface documentation from the source file to the header
	file.

runtime/mercury_deep_copy_body.h:
	Add code to handle the new type_ctor_reps.

	Simplify some code.

	Make the whole file use 4-space indentation.

library/std_util.m:
runtime/mercury_ml_expand_body.h:
runtime/mercury_unify_compare_body.h:
runtime/mercury_ho_call.c:
runtime/mercury_tabling.c:
	Add code to handle the new type_ctor_reps.

Zoltan.

cvs diff: Diffing .
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_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.60
diff -u -b -r1.60 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m	2002/01/28 06:59:39	1.60
+++ compiler/mlds_to_gcc.m	2002/01/28 07:01:29
@@ -2165,7 +2165,11 @@
 rtti_enum_const("MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ", 28).
 rtti_enum_const("MR_TYPECTOR_REP_EQUIV_GROUND", 29).
 rtti_enum_const("MR_TYPECTOR_REP_TUPLE", 30).
-rtti_enum_const("MR_TYPECTOR_REP_UNKNOWN", 31).
+rtti_enum_const("MR_TYPECTOR_REP_RESERVED_ADDR", 31).
+rtti_enum_const("MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ", 32).
+rtti_enum_const("MR_TYPECTOR_REP_TYPECTORINFO", 33).
+rtti_enum_const("MR_TYPECTOR_REP_BASETYPECLASSINFO", 34).
+rtti_enum_const("MR_TYPECTOR_REP_UNKNOWN", 35).
 rtti_enum_const("MR_SECTAG_NONE", 0).
 rtti_enum_const("MR_SECTAG_LOCAL", 1).
 rtti_enum_const("MR_SECTAG_REMOTE", 2).
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/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/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 library
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.86
diff -u -b -r1.86 private_builtin.m
--- library/private_builtin.m	2002/01/20 07:32:22	1.86
+++ library/private_builtin.m	2002/01/25 03:53:55
@@ -363,14 +363,14 @@
 	*/
 
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, type_ctor_info, 1,
-	MR_TYPECTOR_REP_TYPEINFO,
+	MR_TYPECTOR_REP_TYPECTORINFO,
 	mercury____Unify___private_builtin__type_info_1_0,
 	mercury____Compare___private_builtin__type_info_1_0);
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, type_info, 1,
 	MR_TYPECTOR_REP_TYPEINFO);
 
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, base_typeclass_info, 1,
-	MR_TYPECTOR_REP_TYPECLASSINFO,
+	MR_TYPECTOR_REP_BASETYPECLASSINFO,
 	mercury____Unify___private_builtin__typeclass_info_1_0,
 	mercury____Compare___private_builtin__typeclass_info_1_0);
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, typeclass_info, 1,
@@ -524,11 +524,11 @@
 :- pragma foreign_code("MC++", "
 
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, type_ctor_info, 1,
-	MR_TYPECTOR_REP_TYPEINFO) 
+	MR_TYPECTOR_REP_TYPECTORINFO) 
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, type_info, 1,
 	MR_TYPECTOR_REP_TYPEINFO) 
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, base_typeclass_info, 1,
-	MR_TYPECTOR_REP_TYPECLASSINFO) 
+	MR_TYPECTOR_REP_BASETYPECLASSINFO) 
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, typeclass_info, 1,
 	MR_TYPECTOR_REP_TYPECLASSINFO) 
 
@@ -576,7 +576,9 @@
 static int MR_TYPECTOR_REP_TUPLE		=30;
 static int MR_TYPECTOR_REP_RESERVED_ADDR	=31;
 static int MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ	=32;
-static int MR_TYPECTOR_REP_UNKNOWN		=33;
+static int MR_TYPECTOR_REP_TYPECTORINFO		=33;
+static int MR_TYPECTOR_REP_BASETYPECLASSINFO	=34;
+static int MR_TYPECTOR_REP_UNKNOWN		=35;
 
 static int MR_SECTAG_NONE				= 0;
 static int MR_SECTAG_LOCAL				= 1;
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.11
diff -u -b -r1.11 rtti_implementation.m
--- library/rtti_implementation.m	2002/01/25 08:23:09	1.11
+++ library/rtti_implementation.m	2002/01/25 08:59:30
@@ -110,9 +110,10 @@
 	;	tuple
 	;	reserved_addr
 	;	reserved_addr_usereq
+	;	type_ctor_info
+	;	base_typeclass_info
 	;	unknown.
 
-
 	% We keep all the other types abstract.
 
 :- type type_ctor_info ---> type_ctor_info(c_pointer).
@@ -747,6 +748,16 @@
 	;
 		TypeCtorRep = reserved_addr_usereq,
 		Functor = "some_reserved_addr_usereq", 
+		Arity = 0,
+		Arguments = []
+	;
+		TypeCtorRep = type_ctor_info,
+		Functor = "some_typectorinfo", 
+		Arity = 0,
+		Arguments = []
+	;
+		TypeCtorRep = base_typeclass_info,
+		Functor = "some_base_typeclass_info", 
 		Arity = 0,
 		Arguments = []
 	;
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.258
diff -u -b -r1.258 std_util.m
--- library/std_util.m	2002/01/25 08:24:23	1.258
+++ library/std_util.m	2002/01/25 08:59:31
@@ -2758,7 +2758,9 @@
     case MR_TYPECTOR_REP_VOID:
     case MR_TYPECTOR_REP_C_POINTER:
     case MR_TYPECTOR_REP_TYPEINFO:
+    case MR_TYPECTOR_REP_TYPECTORINFO:
     case MR_TYPECTOR_REP_TYPECLASSINFO:
+    case MR_TYPECTOR_REP_BASETYPECLASSINFO:
     case MR_TYPECTOR_REP_ARRAY:
     case MR_TYPECTOR_REP_SUCCIP:
     case MR_TYPECTOR_REP_HP:
@@ -3105,7 +3107,9 @@
         case MR_TYPECTOR_REP_VOID:
         case MR_TYPECTOR_REP_C_POINTER:
         case MR_TYPECTOR_REP_TYPEINFO:
+        case MR_TYPECTOR_REP_TYPECTORINFO:
         case MR_TYPECTOR_REP_TYPECLASSINFO:
+        case MR_TYPECTOR_REP_BASETYPECLASSINFO:
         case MR_TYPECTOR_REP_ARRAY:
         case MR_TYPECTOR_REP_SUCCIP:
         case MR_TYPECTOR_REP_HP:
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.31
diff -u -b -r1.31 mercury.c
--- runtime/mercury.c	2002/01/25 08:23:21	1.31
+++ runtime/mercury.c	2002/01/25 08:59:32
@@ -133,13 +133,13 @@
 MR_define_type_ctor_info(builtin, tuple, 0, MR_TYPECTOR_REP_TUPLE);
 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_TYPECTOR_REP_TYPECTORINFO);
 MR_define_type_ctor_info(private_builtin, type_info, 1,
 	MR_TYPECTOR_REP_TYPEINFO);
 MR_define_type_ctor_info(private_builtin, base_typeclass_info, 1,
 	MR_TYPECTOR_REP_TYPECLASSINFO);
 MR_define_type_ctor_info(private_builtin, typeclass_info, 1,
-	MR_TYPECTOR_REP_TYPECLASSINFO);
+	MR_TYPECTOR_REP_BASETYPECLASSINFO);
 
 /*---------------------------------------------------------------------------*/
 
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.42
diff -u -b -r1.42 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h	2002/01/25 08:23:21	1.42
+++ runtime/mercury_deep_copy_body.h	2002/01/25 11:56:52
@@ -58,7 +58,9 @@
     case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
         {
             int j;
-            MR_ReservedAddrTypeLayout ra_layout =
+            MR_ReservedAddrTypeLayout ra_layout;
+
+            ra_layout =
                 MR_type_ctor_layout(type_ctor_info).layout_reserved_addr;
 
             /*
@@ -476,12 +478,11 @@
             data_value = (MR_Word *) MR_body(data, MR_mktag(0));
 
             /*
-            ** predicate closures store the number of curried arguments
-            ** as their first argument, the MR_Code * as their second, and
-            ** then the arguments
+            ** Closures have the structure given by the MR_Closure type.
             **
-            ** Their type-infos have a pointer to type_ctor_info for
-            ** pred/0, arity, and then argument typeinfos.
+            ** Their type_infos have a pointer to type_ctor_info for
+            ** pred/0 or func/0, the number of argument typeinfos,
+            ** and then the argument typeinfos themselves.
             **
             ** XXX pred needs to handle traversals.
             */
@@ -528,7 +529,8 @@
                             type_info_arg_vector, arg_pseudo_type_info,
                             lower_limit, upper_limit);
                 }
-                if (type_info_arg_vector) {
+
+                if (type_info_arg_vector != NULL) {
                     MR_free(type_info_arg_vector);
                 }
 
@@ -635,6 +637,21 @@
             lower_limit, upper_limit);
         break;
 
+    case MR_TYPECTOR_REP_TYPECTORINFO:
+        /* type_ctor_infos are always static */
+        new_data = data;
+        break;
+
+    case MR_TYPECTOR_REP_TYPECLASSINFO:
+        new_data = (MR_Word) copy_typeclass_info(data_ptr,
+            lower_limit, upper_limit);
+        break;
+
+    case MR_TYPECTOR_REP_BASETYPECLASSINFO:
+        /* base_typeclass_infos are always static */
+        new_data = data;
+        break;
+
     case MR_TYPECTOR_REP_C_POINTER:
         {
             MR_Word *data_value;
@@ -836,7 +853,7 @@
             ** typeclass declaration (superclass constraints).  
             */
         for (i = num_unconstrained + 1; 
-                i < num_unconstrained + num_instance_constraints + num_super + 1; 
+            i <= num_unconstrained + num_instance_constraints + num_super; 
                 i++) 
         {
             new_typeclass_info[i] = (MR_Word) copy_typeclass_info(
@@ -848,8 +865,8 @@
             ** head of the type class declaration.
             */
         for (i = num_unconstrained + num_instance_constraints + num_super + 1;
-            i < num_unconstrained + num_instance_constraints + 
-                        num_super + num_arg_typeinfos + 1;
+            i <= num_unconstrained + num_instance_constraints + num_super
+                + num_arg_typeinfos;
             i++)
         {
             new_typeclass_info[i] = (MR_Word) copy_type_info(
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.48
diff -u -b -r1.48 mercury_ho_call.c
--- runtime/mercury_ho_call.c	2002/01/25 08:23:22	1.48
+++ runtime/mercury_ho_call.c	2002/01/25 08:59:32
@@ -98,6 +98,10 @@
 	"mercury_ho_call.c", 0, TRUE);
 MR_proc_static_user_builtin_empty(typeinfo_compare, 3, 0,
 	"mercury_ho_call.c", 0, TRUE);
+MR_proc_static_user_builtin_empty(typectorinfo_unify, 2, 0,
+	"mercury_ho_call.c", 0, TRUE);
+MR_proc_static_user_builtin_empty(typectorinfo_compare, 3, 0,
+	"mercury_ho_call.c", 0, TRUE);
 
 #endif
 
@@ -539,5 +543,9 @@
 		&MR_proc_static_user_builtin_name(typeinfo_unify, 2, 0));
 	MR_write_out_proc_static(fp, (MR_ProcStatic *)
 		&MR_proc_static_user_builtin_name(typeinfo_compare, 3, 0));
+	MR_write_out_proc_static(fp, (MR_ProcStatic *)
+		&MR_proc_static_user_builtin_name(typectorinfo_unify, 2, 0));
+	MR_write_out_proc_static(fp, (MR_ProcStatic *)
+		&MR_proc_static_user_builtin_name(typectorinfo_compare, 3, 0));
 }
 #endif
Index: runtime/mercury_mcpp.cpp
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_mcpp.cpp,v
retrieving revision 1.10
diff -u -b -r1.10 mercury_mcpp.cpp
--- runtime/mercury_mcpp.cpp	2001/08/28 12:48:52	1.10
+++ runtime/mercury_mcpp.cpp	2002/01/28 03:41:37
@@ -156,6 +156,11 @@
     static int MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ	=28;
     static int MR_TYPECTOR_REP_EQUIV_GROUND		=29;
     static int MR_TYPECTOR_REP_TUPLE			=30;
+    static int MR_TYPECTOR_REP_RESERVED_ADDR		=31;
+    static int MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ	=32;
+    static int MR_TYPECTOR_REP_TYPECTORINFO	        =33;
+    static int MR_TYPECTOR_REP_BASETYPECLASSINFO        =34;
+    static int MR_TYPECTOR_REP_UNKNOWN		        =35;
 
     static int MR_SECTAG_NONE				= 0;
     static int MR_SECTAG_LOCAL				= 1;
Index: runtime/mercury_mcpp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_mcpp.h,v
retrieving revision 1.14
diff -u -b -r1.14 mercury_mcpp.h
--- runtime/mercury_mcpp.h	2002/01/25 08:23:22	1.14
+++ runtime/mercury_mcpp.h	2002/01/25 08:59:32
@@ -128,6 +128,8 @@
 #define MR_TYPECTOR_REP_NOTAG_val			4
 #define MR_TYPECTOR_REP_NOTAG_USEREQ_val		5
 #define MR_TYPECTOR_REP_EQUIV_val			6
+	// MR_TYPECTOR_REP_EQUIV_VAR_val is unused - it is retained
+	// only for backwards compatability.
 #define MR_TYPECTOR_REP_EQUIV_VAR_val			7
 #define MR_TYPECTOR_REP_INT_val		    		8
 #define MR_TYPECTOR_REP_CHAR_val		    	9
@@ -156,6 +158,9 @@
 #define MR_TYPECTOR_REP_TUPLE_val			30
 #define MR_TYPECTOR_REP_RESERVED_ADDR_val		31
 #define MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ_val	32
+#define MR_TYPECTOR_REP_TYPECTORINFO_val		33
+#define MR_TYPECTOR_REP_BASETYPECLASSINFO_val		34
+#define MR_TYPECTOR_REP_UNKNOWN_val			35
 
 // XXX we should integrate this macro in with the version in 
 // mercury_typeinfo.h
Index: runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.10
diff -u -b -r1.10 mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h	2002/01/28 07:00:54	1.10
+++ runtime/mercury_ml_expand_body.h	2002/01/28 07:01:37
@@ -711,10 +711,24 @@
             handle_zero_arity_args();
             break;
 
+        case MR_TYPECTOR_REP_TYPECTORINFO:
+            /* XXX expand_info->non_canonical_type = TRUE; */
+            /* XXX should we return the arguments here? */
+            handle_functor_name("<<typectorinfo>>");
+            handle_zero_arity_args();
+            break;
+
         case MR_TYPECTOR_REP_TYPECLASSINFO:
             /* XXX expand_info->non_canonical_type = TRUE; */
             /* XXX should we return the arguments here? */
             handle_functor_name("<<typeclassinfo>>");
+            handle_zero_arity_args();
+            break;
+
+        case MR_TYPECTOR_REP_BASETYPECLASSINFO:
+            /* XXX expand_info->non_canonical_type = TRUE; */
+            /* XXX should we return the arguments here? */
+            handle_functor_name("<<basetypeclassinfo>>");
             handle_zero_arity_args();
             break;
 
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.46
diff -u -b -r1.46 mercury_tabling.c
--- runtime/mercury_tabling.c	2002/01/25 08:23:23	1.46
+++ runtime/mercury_tabling.c	2002/01/25 08:59:33
@@ -911,8 +911,16 @@
             MR_DEBUG_TABLE_TYPEINFO(table, (MR_TypeInfo) data);
             break;
 
+        case MR_TYPECTOR_REP_TYPECTORINFO:
+            MR_fatal_error("Attempt to table a type_ctor_info");
+            break;
+
         case MR_TYPECTOR_REP_TYPECLASSINFO:
             MR_fatal_error("Attempt to table a type_class_info");
+            break;
+
+        case MR_TYPECTOR_REP_BASETYPECLASSINFO:
+            MR_fatal_error("Attempt to table a base_type_class_info");
             break;
 
         case MR_TYPECTOR_REP_ARRAY:
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.45
diff -u -b -r1.45 mercury_type_info.c
--- runtime/mercury_type_info.c	2002/01/25 08:23:23	1.45
+++ runtime/mercury_type_info.c	2002/01/28 02:28:40
@@ -110,28 +110,16 @@
 	}
 }
 
-/*
-** MR_compare_type_info(type_info_1, type_info_2):
-**
-** Compare two type_info structures, using an arbitrary ordering
-** (based on the addresses of the type_ctor_infos, or in
-** the case of higher order types, the arity).
-**
-** You need to wrap MR_{save/restore}_transient_hp() around
-** calls to this function.
-*/
-
 int
-MR_compare_type_info(MR_TypeInfo t1, MR_TypeInfo t2)
+MR_compare_type_info(MR_TypeInfo ti1, MR_TypeInfo ti2)
 {
-	MR_TypeInfo	type_info_1;
-	MR_TypeInfo	type_info_2;
-	MR_TypeCtorInfo	type_ctor_info_1;
-	MR_TypeCtorInfo	type_ctor_info_2;
+	MR_TypeCtorInfo	tci1;
+	MR_TypeCtorInfo	tci2;
 	MR_TypeInfo	*arg_vector_1;
 	MR_TypeInfo	*arg_vector_2;
 	int		num_arg_types;
 	int		i;
+	int		comp;
 
 	/* 
 	** Try to optimize a common case:
@@ -139,7 +127,7 @@
 	** same type.
 	*/
 
-	if (t1 == t2) {
+	if (ti1 == ti2) {
 		return MR_COMPARE_EQUAL;
 	}
 
@@ -147,57 +135,42 @@
 	** Otherwise, we need to expand equivalence types, if any.
 	*/
 
-	type_info_1 = MR_collapse_equivalences(t1);
-	type_info_2 = MR_collapse_equivalences(t2);
+	ti1 = MR_collapse_equivalences(ti1);
+	ti2 = MR_collapse_equivalences(ti2);
 
 	/* 
 	** Perhaps they are equal now...
 	*/
 
-	if (type_info_1 == type_info_2) {
+	if (ti1 == ti2) {
 		return MR_COMPARE_EQUAL;
 	}
 
 	/*
-	** Otherwise find the addresses of the type_ctor_infos,
-	** and compare those.
-	**
-	** Note: this is an arbitrary ordering. It doesn't matter
-	** what the ordering is, just so long as it is consistent.
-	** ANSI C doesn't guarantee much about pointer comparisons,
-	** so it is possible that this might not do the right thing
-	** on some obscure systems.
-	** The casts to (MR_Word) here are in the hope of increasing
-	** the chance that this will work on a segmented architecture.
+	** Otherwise find the type_ctor_infos, and compare those.
 	*/
 
-	type_ctor_info_1 = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info_1);
-	type_ctor_info_2 = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info_2);
+	tci1 = MR_TYPEINFO_GET_TYPE_CTOR_INFO(ti1);
+	tci2 = MR_TYPEINFO_GET_TYPE_CTOR_INFO(ti2);
 
-	if ((MR_Unsigned) type_ctor_info_1 < (MR_Unsigned) type_ctor_info_2) {
-		return MR_COMPARE_LESS;
-	} else if ((MR_Unsigned) type_ctor_info_1 > (MR_Unsigned) type_ctor_info_2) {
-		return MR_COMPARE_GREATER;
+	comp = MR_compare_type_ctor_info(tci1, tci2);
+	if (comp != MR_COMPARE_EQUAL) {
+		return comp;
 	}
 
 	/*
-	** If the type_ctor_info addresses are equal, we don't need to
-	** compare the arity of the types - they must be the same -
-	** unless they are higher-order (which are all mapped to
-	** pred/0) or tuples (which are all mapped to tuple/0). 
-	** But we need to recursively compare the argument types, if any.
-	*/
-		/* Check for higher order or tuples */
-	if (MR_type_ctor_rep_is_variable_arity(
-		MR_type_ctor_rep(type_ctor_info_1)))
-	{
+	** If the type_ctor_infos are equal, we don't need to compare
+	** the arity of the types - they must be the same - unless they are
+	** higher-order (which are all mapped to pred/0 or func/0) or tuples
+	** (which are all mapped to tuple/0), in which cases we must compare
+	** the arities before we can check the argument types.
+	*/
+
+	if (MR_type_ctor_rep_is_variable_arity(MR_type_ctor_rep(tci1))) {
 		int	num_arg_types_2;
 
-			/* Get number of arguments from type_info */
-		num_arg_types = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(
-				type_info_1);
-		num_arg_types_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(
-				type_info_2);
+		num_arg_types = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(ti1);
+		num_arg_types_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(ti2);
 
 			/* Check arity */
 		if (num_arg_types < num_arg_types_2) {
@@ -206,26 +179,17 @@
 			return MR_COMPARE_GREATER;
 		}
 
-			/*
-			** Increment, so arguments are at the
-			** expected offset.
-			*/
-		arg_vector_1 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(
-				type_info_1);
-		arg_vector_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(
-				type_info_2);
+		arg_vector_1 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(ti1);
+		arg_vector_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(ti2);
 	} else {
-		num_arg_types = type_ctor_info_1->MR_type_ctor_arity;
-		arg_vector_1 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
-				type_info_1);
-		arg_vector_2 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
-				type_info_2);
+		num_arg_types = tci1->MR_type_ctor_arity;
+		arg_vector_1 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(ti1);
+		arg_vector_2 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(ti2);
 	}
 
 		/* compare the argument types */
 	for (i = 1; i <= num_arg_types; i++) {
-		int comp = MR_compare_type_info(
-				arg_vector_1[i], arg_vector_2[i]);
+		comp = MR_compare_type_info(arg_vector_1[i], arg_vector_2[i]);
 		if (comp != MR_COMPARE_EQUAL)
 			return comp;
 	}
@@ -233,10 +197,36 @@
 	return MR_COMPARE_EQUAL;
 }
 
+int
+MR_compare_type_ctor_info(MR_TypeCtorInfo tci1, MR_TypeCtorInfo tci2)
+{
+	int		i;
+
+	/*
+	** Note: this is an arbitrary ordering. It doesn't matter
+	** what the ordering is, just so long as it is consistent.
+	** For consistency, we are relying on the fact that type_ctor_infos
+	** are always statically allocated.
+	** ANSI C doesn't guarantee much about pointer comparisons,
+	** so it is possible that this might not do the right thing
+	** on some obscure systems.
+	** The casts to (MR_Unsigned) here are in the hope of increasing
+	** the chance that this will work on a segmented architecture.
+	*/
+
+	if ((MR_Unsigned) tci1 < (MR_Unsigned) tci1) {
+		return MR_COMPARE_LESS;
+	} else if ((MR_Unsigned) tci1 > (MR_Unsigned) tci1) {
+		return MR_COMPARE_GREATER;
+	}
+
+	return MR_COMPARE_EQUAL;
+}
+
 	/*
 	** MR_collapse_equivalences:
 	**
-	** Keep looking past equivalences until the there are no more.
+	** Keep looking past equivalences until there are no more.
 	** This only looks past equivalences of the top level type, not
 	** the argument typeinfos.
 	** 
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.82
diff -u -b -r1.82 mercury_type_info.h
--- runtime/mercury_type_info.h	2002/01/28 07:00:54	1.82
+++ runtime/mercury_type_info.h	2002/01/28 07:04:39
@@ -464,8 +464,9 @@
 ** constructor.
 **
 ** Any changes in this definition will also require changes in
-** MR_CTOR_REP_NAMES below, and may also require changes in
-** library/rtti_implementation.m and runtime/mercury_mcpp.{h,cpp}
+** MR_CTOR_REP_NAMES below, in runtime/mercury_mcpp.{h,cpp}, in
+** library/rtti_implementation.m and in library/private_builtin.m.
+**
 ** Additions to the end of this enum can be handled naturally,
 ** but changes in the meanings of already assigned values
 ** require bootstrapping with RTTI-version-dependent code.
@@ -505,6 +506,8 @@
     MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_TUPLE),
     MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_RESERVED_ADDR),
     MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ),
+    MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_TYPECTORINFO),
+    MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_BASETYPECLASSINFO),
     /*
     ** MR_TYPECTOR_REP_UNKNOWN should remain the last alternative;
     ** MR_TYPE_CTOR_STATS depends on this.
@@ -560,6 +563,8 @@
     "TUPLE",                                    \
     "RESERVED_ADDR",                            \
     "RESERVED_ADDR_USEREQ",                     \
+    "TYPECTORINFO",                     	\
+    "BASETYPECLASSINFO",                     	\
     "UNKNOWN"
 
 #define MR_type_ctor_rep_is_basically_du(rep)               \
@@ -1220,13 +1225,30 @@
 
 /*---------------------------------------------------------------------------*/
 
+/*
+** Compare two type_info structures, using an arbitrary ordering based on
+** the addresses of the type_ctor_infos, or in the case of higher order types,
+** the arity). Return MR_COMPARE_GREATER, MR_COMPARE_EQUAL, or MR_COMPARE_LESS,
+** depending on whether ti1 is greater than, equal to, or less than ti2.
+**
+** You need to wrap MR_{save/restore}_transient_hp() around
+** calls to this function.
+*/
+
+extern  int     MR_compare_type_info(MR_TypeInfo ti1, MR_TypeInfo ti2);
+
 /*
-** MR_compare_type_info returns MR_COMPARE_GREATER, MR_COMPARE_EQUAL, or
-** MR_COMPARE_LESS, depending on whether t1 is greater than , equal to,
-** or less than t2.
+** Compare two type_ctor_info structures, using an arbitrary ordering based on
+** the addresses of the type_ctor_infos, or in the case of higher order types,
+** the arity). Return MR_COMPARE_GREATER, MR_COMPARE_EQUAL, or MR_COMPARE_LESS,
+** depending on whether tci1 is greater than, equal to, or less than tci2.
+**
+** You need to wrap MR_{save/restore}_transient_hp() around
+** calls to this function.
 */
 
-extern  int     MR_compare_type_info(MR_TypeInfo t1, MR_TypeInfo t2);
+extern  int     MR_compare_type_ctor_info(MR_TypeCtorInfo tci1,
+			MR_TypeCtorInfo tci2);
 
 /*
 ** MR_collapse_equivalences expands out all the top-level equivalences in
@@ -1235,6 +1257,9 @@
 ** However, since it only works on the top level type constructor,
 ** this is not guaranteed for the typeinfos of the type constructor's
 ** arguments.
+**
+** You need to wrap MR_{save/restore}_transient_hp() around
+** calls to this function.
 */
 
 extern  MR_TypeInfo MR_collapse_equivalences(MR_TypeInfo type_info);
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.14
diff -u -b -r1.14 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h	2002/01/25 08:23:24	1.14
+++ runtime/mercury_unify_compare_body.h	2002/01/26 03:11:32
@@ -554,6 +554,34 @@
 #endif
             }
 
+        case MR_TYPECTOR_REP_TYPECTORINFO:
+            {
+                int result;
+
+                MR_save_transient_registers();
+                result = MR_compare_type_ctor_info(
+                    (MR_TypeCtorInfo) x, (MR_TypeCtorInfo) y);
+                MR_restore_transient_registers();
+#ifdef	select_compare_code
+  #if defined(MR_DEEP_PROFILING) && defined(entry_point_is_mercury)
+                compare_call_exit_code(typectorinfo_compare);
+  #endif
+                return_answer(result);
+#else
+  #if defined(MR_DEEP_PROFILING) && defined(entry_point_is_mercury)
+                if (result == MR_COMPARE_EQUAL) {
+                    unify_call_exit_code(typectorinfo_unify);
+                    return_answer(TRUE);
+                } else {
+                    unify_call_fail_code(typectorinfo_unify);
+                    return_answer(FALSE);
+                }
+  #else
+                return_answer(result == MR_COMPARE_EQUAL);
+  #endif
+#endif
+            }
+
         case MR_TYPECTOR_REP_VOID:
             MR_fatal_error(attempt_msg "terms of type `void'");
 
@@ -562,6 +590,9 @@
 
         case MR_TYPECTOR_REP_TYPECLASSINFO:
             MR_fatal_error(attempt_msg "typeclass_infos");
+
+        case MR_TYPECTOR_REP_BASETYPECLASSINFO:
+            MR_fatal_error(attempt_msg "base_typeclass_infos");
 
         case MR_TYPECTOR_REP_UNKNOWN:
             MR_fatal_error(attempt_msg "terms of unknown type");
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/structure_reuse
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/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
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list