[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