[m-dev.] for review, MR_TypeInfo cleanup, part 2
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Mar 22 20:38:54 AEDT 2000
Index: library/store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.19
diff -u -b -r1.19 store.m
--- library/store.m 2000/03/10 01:21:34 1.19
+++ library/store.m 2000/03/20 15:17:46
@@ -123,7 +123,7 @@
:- mode store__ref_functor(in, out, out, di, uo) is det.
% arg_ref(Ref, ArgNum, ArgRef):
- % /* Psuedo-C code: ArgRef = &Ref[ArgNum]; */
+ % /* Pseudo-C code: ArgRef = &Ref[ArgNum]; */
% Given a reference to a term, return a reference to
% the specified argument (field) of that term
% (argument numbers start from zero).
@@ -133,7 +133,7 @@
:- mode store__arg_ref(in, in, out, di, uo) is det.
% new_arg_ref(Val, ArgNum, ArgRef):
- % /* Psuedo-C code: ArgRef = &Val[ArgNum]; */
+ % /* Pseudo-C code: ArgRef = &Val[ArgNum]; */
% Equivalent to `new_ref(Val, Ref), arg_ref(Ref, ArgNum, ArgRef)',
% except that it is more efficient.
% It is an error if the argument number is out of range,
@@ -308,26 +308,31 @@
#include ""mercury_misc.h"" /* for fatal_error() */
/* ML_arg() is defined in std_util.m */
- bool ML_arg(Word term_type_info, Word *term, Word argument_index,
- Word *arg_type_info, Word **argument_ptr);
+ bool ML_arg(MR_TypeInfo term_type_info, Word *term, int arg_index,
+ MR_TypeInfo *arg_type_info_ptr, Word **arg_ptr);
").
:- pragma c_code(arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::di, S::uo),
will_not_call_mercury,
"{
- Word arg_type_info;
- Word* arg_ref;
+ MR_TypeInfo type_info;
+ MR_TypeInfo arg_type_info;
+ MR_TypeInfo exp_arg_type_info;
+ Word *arg_ref;
+ type_info = (MR_TypeInfo) TypeInfo_for_T;
+ exp_arg_type_info = (MR_TypeInfo) TypeInfo_for_ArgT;
+
save_transient_registers();
- if (!ML_arg(TypeInfo_for_T, (Word *) Ref, ArgNum,
+ if (!ML_arg(type_info, (Word *) Ref, ArgNum,
&arg_type_info, &arg_ref))
{
fatal_error(""store__arg_ref: argument number out of range"");
}
- if (MR_compare_type_info(arg_type_info, TypeInfo_for_ArgT) !=
+ if (MR_compare_type_info(arg_type_info, exp_arg_type_info) !=
MR_COMPARE_EQUAL)
{
fatal_error(""store__arg_ref: argument has wrong type"");
@@ -342,18 +347,23 @@
:- pragma c_code(new_arg_ref(Val::di, ArgNum::in, ArgRef::out, S0::di, S::uo),
will_not_call_mercury,
"{
- Word arg_type_info;
- Word* arg_ref;
+ MR_TypeInfo type_info;
+ MR_TypeInfo arg_type_info;
+ MR_TypeInfo exp_arg_type_info;
+ Word *arg_ref;
+
+ type_info = (MR_TypeInfo) TypeInfo_for_T;
+ exp_arg_type_info = (MR_TypeInfo) TypeInfo_for_ArgT;
save_transient_registers();
- if (!ML_arg(TypeInfo_for_T, (Word *) &Val, ArgNum,
+ if (!ML_arg(type_info, (Word *) &Val, ArgNum,
&arg_type_info, &arg_ref))
{
fatal_error(""store__new_arg_ref: argument number out of range"");
}
- if (MR_compare_type_info(arg_type_info, TypeInfo_for_ArgT) !=
+ if (MR_compare_type_info(arg_type_info, exp_arg_type_info) !=
MR_COMPARE_EQUAL)
{
fatal_error(""store__new_arg_ref: argument has wrong type"");
@@ -367,9 +377,10 @@
** return a pointer to it; so if that is the case, then we need
** to copy it to the heap before returning.
*/
+
if (arg_ref == &Val) {
incr_hp_msg(ArgRef, 1, MR_PROC_LABEL, ""store:ref/2"");
- *(Word *)ArgRef = Val;
+ * (Word *) ArgRef = Val;
} else {
ArgRef = (Word) arg_ref;
}
@@ -379,21 +390,21 @@
:- pragma c_code(set_ref(Ref::in, ValRef::in, S0::di, S::uo),
will_not_call_mercury,
"
- *(Word *)Ref = *(Word *)ValRef;
+ * (Word *) Ref = * (Word *) ValRef;
S = S0;
").
:- pragma c_code(set_ref_value(Ref::in, Val::di, S0::di, S::uo),
will_not_call_mercury,
"
- *(Word *)Ref = Val;
+ * (Word *) Ref = Val;
S = S0;
").
:- pragma c_code(extract_ref_value(_S::di, Ref::in, Val::out),
will_not_call_mercury,
"
- Val = *(Word *)Ref;
+ Val = * (Word *) Ref;
").
%-----------------------------------------------------------------------------%
Index: library/term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.92
diff -u -b -r1.92 term.m
--- library/term.m 1999/10/30 04:16:11 1.92
+++ library/term.m 2000/03/20 04:52:39
@@ -72,7 +72,7 @@
% to the offending subterm.
:- type term_to_type_error(T)
- ---> type_error(term(T), type_info, term__context,
+ ---> type_error(term(T), type_desc, term__context,
term_to_type_context)
; mode_error(var(T), term_to_type_context).
@@ -371,13 +371,13 @@
Result = error(Error)
).
-:- pred term__try_term_to_univ(term(T)::in, type_info::in,
+:- pred term__try_term_to_univ(term(T)::in, type_desc::in,
term_to_type_result(univ, T)::out) is det.
term__try_term_to_univ(Term, Type, Result) :-
term__try_term_to_univ_2(Term, Type, [], Result).
-:- pred term__try_term_to_univ_2(term(T)::in, type_info::in,
+:- pred term__try_term_to_univ_2(term(T)::in, type_desc::in,
term_to_type_context::in,
term_to_type_result(univ, T)::out) is det.
@@ -419,9 +419,9 @@
).
:- pred term__term_to_univ_special_case(string::in, string::in,
- list(type_info)::in,
+ list(type_desc)::in,
term(T)::in(bound(term__functor(ground, ground, ground))),
- type_info::in, term_to_type_context::in,
+ type_desc::in, term_to_type_context::in,
term_to_type_result(univ, T)::out) is semidet.
term__term_to_univ_special_case("builtin", "character", [],
@@ -500,7 +500,7 @@
% ditto
fail.
-:- pred term__term_list_to_univ_list(list(term(T))::in, list(type_info)::in,
+:- pred term__term_list_to_univ_list(list(term(T))::in, list(type_desc)::in,
term__const::in, int::in, term_to_type_context::in,
term__context::in, term_to_type_result(list(univ), T)::out)
is semidet.
@@ -526,14 +526,14 @@
Result = error(Error)
).
-:- pred term__find_functor(type_info::in, string::in, int::in, int::out,
- list(type_info)::out) is semidet.
+:- pred term__find_functor(type_desc::in, string::in, int::in, int::out,
+ list(type_desc)::out) is semidet.
term__find_functor(Type, Functor, Arity, FunctorNumber, ArgTypes) :-
N = num_functors(Type),
term__find_functor_2(Type, Functor, Arity, N, FunctorNumber, ArgTypes).
-:- pred term__find_functor_2(type_info::in, string::in, int::in, int::in,
- int::out, list(type_info)::out) is semidet.
+:- pred term__find_functor_2(type_desc::in, string::in, int::in, int::in,
+ int::out, list(type_desc)::out) is semidet.
term__find_functor_2(TypeInfo, Functor, Arity, Num, FunctorNumber, ArgTypes) :-
Num >= 0,
Num1 = Num - 1,
@@ -595,7 +595,7 @@
).
:- pred term__univ_to_term_special_case(string::in, string::in,
- list(type_info)::in, univ::in, term__context::in,
+ list(type_desc)::in, univ::in, term__context::in,
term(T)::out) is semidet.
term__univ_to_term_special_case("builtin", "int", [], Univ, Context,
@@ -647,7 +647,7 @@
term__univ_list_to_term_list(Values, Terms).
% given a type_info, return a term that represents the name of that type.
-:- pred type_info_to_term(term__context::in, type_info::in,
+:- pred type_info_to_term(term__context::in, type_desc::in,
term(T)::out) is det.
type_info_to_term(Context, TypeInfo, Term) :-
type_ctor_and_args(TypeInfo, TypeCtor, ArgTypes),
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.52
diff -u -b -r1.52 Mmakefile
--- runtime/Mmakefile 2000/03/21 06:52:45 1.52
+++ runtime/Mmakefile 2000/03/22 05:21:23
@@ -55,6 +55,7 @@
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 \
@@ -80,6 +81,7 @@
mercury_trail.h \
mercury_types.h \
mercury_type_info.h \
+ mercury_unify_compare_body.h \
mercury_wrapper.h \
$(LIB_DLL_H)
Index: runtime/mercury_deep_copy.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.h,v
retrieving revision 1.7
diff -u -b -r1.7 mercury_deep_copy.h
--- runtime/mercury_deep_copy.h 1999/03/10 22:05:22 1.7
+++ runtime/mercury_deep_copy.h 2000/03/22 01:59:20
@@ -63,7 +63,7 @@
** deep_copy to do both.
*/
-Word deep_copy(const Word *data_ptr, const Word *type_info,
+Word deep_copy(const Word *data_ptr, MR_TypeInfo type_info,
const Word *lower_limit, const Word *upper_limit);
/*
@@ -90,7 +90,7 @@
** Note: You cannot pass NULL as the lower_limit to agc_deep_copy
** (which is possible with normal deep_copy).
*/
-Word agc_deep_copy(Word *data_ptr, const Word *type_info,
+Word agc_deep_copy(Word *data_ptr, MR_TypeInfo type_info,
const Word *lower_limit, const Word *upper_limit);
/*
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.20
diff -u -b -r1.20 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 2000/03/18 08:10:29 1.20
+++ runtime/mercury_deep_copy_body.h 2000/03/22 01:59:20
@@ -15,18 +15,19 @@
/*
** Prototypes.
*/
-static Word copy_arg(maybeconst Word *data_ptr,
- maybeconst Word *parent_data_ptr, int rtti_version,
+static Word copy_arg(maybeconst Word *parent_data_ptr,
+ maybeconst Word *data_ptr,
const MR_DuFunctorDesc *functor_descriptor,
- const Word *type_info, const Word *arg_type_info,
+ const MR_TypeInfoParams type_params,
+ const MR_PseudoTypeInfo arg_pseudotype_info,
const Word *lower_limit, const Word *upper_limit);
-static Word *copy_type_info(maybeconst Word *type_info,
+static MR_TypeInfo copy_type_info(maybeconst MR_TypeInfo *type_info_ptr,
const Word *lower_limit, const Word *upper_limit);
static Word copy_typeclass_info(maybeconst Word *typeclass_info_ptr,
const Word *lower_limit, const Word *upper_limit);
Word
-copy(maybeconst Word *data_ptr, const Word *type_info,
+copy(maybeconst Word *data_ptr, MR_TypeInfo type_info,
const Word *lower_limit, const Word *upper_limit)
{
Word data;
@@ -47,161 +48,7 @@
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- Word layout_entry;
- Word *entry_value;
- Word *data_value;
- int data_tag;
-
- data_tag = MR_tag(data);
- data_value = (Word *) MR_body(data, data_tag);
-
- layout_entry = type_ctor_info->type_ctor_layout[data_tag];
- entry_value = (Word *) MR_strip_tag(layout_entry);
- switch (MR_get_tag_representation(layout_entry)) {
-
- case MR_DISCUNIONTAG_SHARED_LOCAL:
- new_data = data; /* just a copy of the actual item */
- break;
-
- case MR_DISCUNIONTAG_SHARED_REMOTE: {
- Word secondary_tag;
- Word *functor_descriptor;
- Word *argument_vector, *type_info_vector;
- int arity, i;
- int num_extra_args, num_extra_typeinfos,
- num_extra_typeclassinfos;
-
- /*
- ** if the vector containing the secondary tags and the
- ** arguments is in range, copy it.
- */
- if (in_range(data_value)) {
- secondary_tag = *data_value;
- argument_vector = data_value + 1;
-
- functor_descriptor = MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_GET_FUNCTOR_DESCRIPTOR(
- entry_value, secondary_tag);
- arity = functor_descriptor[TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET];
- type_info_vector = functor_descriptor +
- TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET;
-
- num_extra_typeinfos = MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_TYPEINFO_VARCOUNT(functor_descriptor);
-
- num_extra_typeclassinfos = MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_TYPECLASSINFO_VARCOUNT(functor_descriptor);
-
- num_extra_args = num_extra_typeinfos +
- num_extra_typeclassinfos;
-
- /* allocate space for new args, and secondary tag */
- incr_saved_hp(new_data, arity + num_extra_args + 1);
-
- /* copy secondary tag */
- MR_field(0, new_data, 0) = secondary_tag;
-
- /* copy typeinfo arguments */
- for (i = 0; i < num_extra_typeinfos; i++) {
- MR_field(0, new_data, i + 1) = (Word) copy_type_info(
- &argument_vector[i],
- lower_limit, upper_limit);
- }
-
- /* copy typeclassinfo arguments */
- for (i = num_extra_typeinfos;
- i < num_extra_args; i++) {
- MR_field(0, new_data, i + 1) = copy_typeclass_info(
- &argument_vector[i], lower_limit, upper_limit);
- }
-
- /* copy arguments */
- for (i = 0; i < arity; i++) {
- MR_field(0, new_data, i + num_extra_args + 1)
- = copy_arg(data_value,
- &argument_vector[i + num_extra_args],
- type_ctor_info->type_ctor_version,
- (const MR_DuFunctorDesc *)
- functor_descriptor, type_info,
- (Word *) type_info_vector[i], lower_limit,
- upper_limit);
- }
-
- /* tag this pointer */
- new_data = (Word) MR_mkword(data_tag, new_data);
- leave_forwarding_pointer(data_ptr, new_data);
- } else {
- new_data = data;
- found_forwarding_pointer(data);
- }
-
- break;
- }
-
- case MR_DISCUNIONTAG_UNSHARED: {
- int arity, i;
- int num_extra_args, num_extra_typeinfos,
- num_extra_typeclassinfos;
- Word *argument_vector, *type_info_vector;
- Word *functor_descriptor;
- argument_vector = data_value;
-
- /* If the argument vector is in range, copy the arguments */
- if (in_range(argument_vector)) {
-
- functor_descriptor = entry_value;
-
- arity = entry_value[TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET];
-
- type_info_vector = entry_value +
- TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET;
- num_extra_typeinfos = MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_TYPEINFO_VARCOUNT(functor_descriptor);
-
- num_extra_typeclassinfos = MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_EXIST_TYPECLASSINFO_VARCOUNT(functor_descriptor);
-
- num_extra_args = num_extra_typeinfos +
- num_extra_typeclassinfos;
-
- /* allocate space for new args. */
- incr_saved_hp(new_data, arity + num_extra_args);
-
- /* copy typeinfo arguments */
- for (i = 0; i < num_extra_typeinfos; i++) {
- MR_field(0, new_data, i) = (Word)copy_type_info(
- &argument_vector[i],
- lower_limit, upper_limit);
- }
-
- /* copy typeclassinfo arguments */
- for (i = num_extra_typeinfos;
- i < num_extra_args; i++) {
- MR_field(0, new_data, i) = copy_typeclass_info(
- &argument_vector[i], lower_limit, upper_limit);
- }
-
- /* copy arguments */
- for (i = 0; i < arity; i++) {
- MR_field(0, new_data, i + num_extra_args)
- = copy_arg(data_value,
- &argument_vector[i + num_extra_args],
- type_ctor_info->type_ctor_version,
- (const MR_DuFunctorDesc *)
- functor_descriptor, type_info,
- (Word *) type_info_vector[i],
- lower_limit, upper_limit);
- }
- /* tag this pointer */
- new_data = (Word) MR_mkword(data_tag, new_data);
- leave_forwarding_pointer(data_ptr, new_data);
- } else {
- new_data = data;
- found_forwarding_pointer(data);
- }
-
- break;
- }
- default:
- fatal_error("copy(): unknown tag representation");
- } /* end switch */
- } else {
+ {
MR_DuPtagLayout *ptag_layout;
int ptag;
Word *data_value;
@@ -277,7 +124,8 @@
**
** for (i = 0; i < num_ti_plain; i++) {
** MR_field(0, new_data, cur_slot) = (Word)
-** copy_type_info(&data_value[cur_slot],
+** copy_type_info((MR_TypeInfo *)
+** &data_value[cur_slot],
** lower_limit, upper_limit);
** cur_slot++;
** }
@@ -293,14 +141,16 @@
** if (MR_arg_type_may_contain_var(functor_desc, i)) {
** MR_field(0, new_data, cur_slot) =
** copy_arg(data_value, &data_value[cur_slot],
-** type_ctor_info->type_ctor_version,
-** functor_desc, type_info, (const Word *)
+** functor_desc,
+** MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+** type_info),
** functor_desc->MR_du_functor_arg_types[i],
** lower_limit, upper_limit);
** } else {
** MR_field(0, new_data, cur_slot) =
-** copy(&data_value[cur_slot], (const Word *)
-** functor_desc->MR_du_functor_arg_types[i],
+** copy(&data_value[cur_slot],
+** MR_pseudo_type_info_is_ground(
+** functor_desc->MR_du_functor_arg_types[i]),
** lower_limit, upper_limit);
** }
** cur_slot++;
@@ -344,7 +194,8 @@
#define MR_DC_copy_exist_info \
for (i = 0; i < num_ti_plain; i++) { \
MR_field(0, new_data, cur_slot) = (Word) \
- copy_type_info(&data_value[cur_slot], \
+ copy_type_info((MR_TypeInfo *) \
+ &data_value[cur_slot], \
lower_limit, upper_limit); \
cur_slot++; \
} \
@@ -361,14 +212,16 @@
if (MR_arg_type_may_contain_var(functor_desc, i)) { \
MR_field(0, new_data, cur_slot) = \
copy_arg(data_value, &data_value[cur_slot], \
- type_ctor_info->type_ctor_version, \
- functor_desc, type_info, (const Word *) \
+ functor_desc, \
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR( \
+ type_info), \
functor_desc->MR_du_functor_arg_types[i],\
lower_limit, upper_limit); \
} else { \
MR_field(0, new_data, cur_slot) = \
- copy(&data_value[cur_slot], (const Word *) \
- functor_desc->MR_du_functor_arg_types[i],\
+ copy(&data_value[cur_slot], \
+ MR_pseudo_type_info_is_ground( \
+ functor_desc->MR_du_functor_arg_types[i]),\
lower_limit, upper_limit); \
} \
cur_slot++; \
@@ -447,87 +300,38 @@
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- Word layout_entry;
- Word *entry_value;
- Word *data_value;
- int data_tag;
-
- data_tag = MR_tag(data);
- data_value = (Word *) MR_body(data, data_tag);
-
- layout_entry = type_ctor_info->type_ctor_layout[data_tag];
- entry_value = (Word *) MR_strip_tag(layout_entry);
- new_data = copy_arg(NULL, data_ptr,
- type_ctor_info->type_ctor_version, NULL, type_info,
- (Word *) *MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(
- entry_value), lower_limit, upper_limit);
- } else {
- new_data = copy_arg(NULL, data_ptr,
- type_ctor_info->type_ctor_version, NULL, type_info,
- (const Word *) type_ctor_info->type_layout.layout_notag->
+ new_data = copy_arg(NULL, data_ptr, NULL,
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ type_ctor_info->type_layout.layout_notag->
MR_notag_functor_arg_type, lower_limit, upper_limit);
- }
break;
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- type_info = (const Word *) type_ctor_info->type_layout.layout_notag->
- MR_notag_functor_arg_type;
+ type_info = MR_pseudo_type_info_is_ground(type_ctor_info->
+ type_layout.layout_notag->MR_notag_functor_arg_type);
goto try_again;
break;
case MR_TYPECTOR_REP_EQUIV:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- Word layout_entry;
- Word *entry_value;
- Word *data_value;
- int data_tag;
-
- data_tag = MR_tag(data);
- data_value = (Word *) MR_body(data, data_tag);
-
- layout_entry = type_ctor_info->type_ctor_layout[data_tag];
- entry_value = (Word *) MR_strip_tag(layout_entry);
- new_data = copy_arg(NULL, data_ptr,
- type_ctor_info->type_ctor_version, NULL, type_info,
- (const Word *) MR_TYPE_CTOR_LAYOUT_EQUIV_TYPE((Word *)
- entry_value), lower_limit, upper_limit);
- } else {
- new_data = copy_arg(NULL, data_ptr,
- type_ctor_info->type_ctor_version, NULL, type_info,
- (const Word *) type_ctor_info->type_layout.layout_equiv,
+ new_data = copy_arg(NULL, data_ptr, NULL,
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ type_ctor_info->type_layout.layout_equiv,
lower_limit, upper_limit);
- }
break;
case MR_TYPECTOR_REP_EQUIV_GROUND:
- type_info = (const Word *) type_ctor_info->type_layout.layout_equiv;
+ type_info = MR_pseudo_type_info_is_ground(type_ctor_info->
+ type_layout.layout_equiv);
goto try_again;
break;
case MR_TYPECTOR_REP_EQUIV_VAR:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- Word layout_entry;
- Word *entry_value;
- Word *data_value;
- int data_tag;
-
- data_tag = MR_tag(data);
- data_value = (Word *) MR_body(data, data_tag);
-
- layout_entry = type_ctor_info->type_ctor_layout[data_tag];
- entry_value = (Word *) MR_strip_tag(layout_entry);
- new_data = copy(data_ptr,
- (Word *) type_info[(Word) entry_value],
- lower_limit, upper_limit);
- } else {
/*
** The current version of the RTTI gives all equivalence types
** the EQUIV type_ctor_rep, not EQUIV_VAR.
*/
fatal_error("unexpected EQUIV_VAR type_ctor_rep");
- }
break;
case MR_TYPECTOR_REP_INT: /* fallthru */
@@ -598,6 +402,7 @@
MR_Closure *old_closure;
MR_Closure *new_closure;
MR_Closure_Layout *closure_layout;
+ MR_TypeInfo *type_info_arg_vector;
old_closure = (MR_Closure *) data_value;
closure_layout = old_closure->MR_closure_layout;
@@ -611,18 +416,19 @@
new_closure->MR_closure_num_hidden_args = args;
new_closure->MR_closure_code = old_closure->MR_closure_code;
+ type_info_arg_vector =
+ MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info);
/* copy the arguments */
for (i = 0; i < args; i++) {
- Word *arg_pseudo_type_info =
- (Word *) closure_layout->arg_pseudo_type_info[i];
+ MR_PseudoTypeInfo arg_pseudo_type_info;
+
+ arg_pseudo_type_info =
+ closure_layout->arg_pseudo_type_info[i];
new_closure->MR_closure_hidden_args_0[i] =
copy_arg(NULL,
- &old_closure->MR_closure_hidden_args_0[i],
- type_ctor_info->type_ctor_version, NULL,
- type_info + TYPEINFO_OFFSET_FOR_PRED_ARGS - 1,
- arg_pseudo_type_info,
- lower_limit, upper_limit
- );
+ &old_closure->MR_closure_hidden_args_0[i], NULL,
+ type_info_arg_vector, arg_pseudo_type_info,
+ lower_limit, upper_limit);
}
new_data = (Word) new_closure;
@@ -657,11 +463,12 @@
*/
new_data_ptr[UNIV_OFFSET_FOR_DATA] = copy(
&data_value[UNIV_OFFSET_FOR_DATA],
- (const Word *) data_value[UNIV_OFFSET_FOR_TYPEINFO],
+ (const MR_TypeInfo)
+ data_value[UNIV_OFFSET_FOR_TYPEINFO],
lower_limit, upper_limit);
new_data_ptr[UNIV_OFFSET_FOR_TYPEINFO] =
(Word) copy_type_info(
- &data_value[UNIV_OFFSET_FOR_TYPEINFO],
+ (MR_TypeInfo *) &data_value[UNIV_OFFSET_FOR_TYPEINFO],
lower_limit, upper_limit);
leave_forwarding_pointer(data_ptr, new_data);
} else {
@@ -694,9 +501,9 @@
new_array->size = array_size;
for (i = 0; i < array_size; i++) {
new_array->elements[i] = copy_arg(NULL,
- &old_array->elements[i],
- type_ctor_info->type_ctor_version, NULL, type_info,
- (const Word *) 1, lower_limit, upper_limit);
+ &old_array->elements[i], NULL,
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ (const MR_PseudoTypeInfo) 1, lower_limit, upper_limit);
}
new_data = (Word) new_array;
leave_forwarding_pointer(data_ptr, new_data);
@@ -708,7 +515,7 @@
break;
case MR_TYPECTOR_REP_TYPEINFO:
- new_data = (Word) copy_type_info(data_ptr,
+ new_data = (Word) copy_type_info((MR_TypeInfo *) data_ptr,
lower_limit, upper_limit);
break;
@@ -782,17 +589,18 @@
static Word
copy_arg(maybeconst Word *parent_data_ptr, maybeconst Word *data_ptr,
- int rtti_version, const MR_DuFunctorDesc *functor_descriptor,
- const Word *term_type_info, const Word *arg_pseudo_type_info,
+ const MR_DuFunctorDesc *functor_descriptor,
+ const MR_TypeInfoParams type_params,
+ const MR_PseudoTypeInfo arg_pseudo_type_info,
const Word *lower_limit, const Word *upper_limit)
{
MR_MemoryList allocated_memory_cells;
- Word *new_type_info;
+ MR_TypeInfo new_type_info;
Word new_data;
allocated_memory_cells = NULL;
- new_type_info = MR_make_type_info_maybe_existq(term_type_info,
- arg_pseudo_type_info, parent_data_ptr, rtti_version,
+ new_type_info = MR_make_type_info_maybe_existq(type_params,
+ arg_pseudo_type_info, parent_data_ptr,
functor_descriptor, &allocated_memory_cells);
new_data = copy(data_ptr, new_type_info, lower_limit, upper_limit);
@@ -801,52 +609,60 @@
return new_data;
}
-static Word *
-copy_type_info(maybeconst Word *type_info_ptr, const Word *lower_limit,
+static MR_TypeInfo
+copy_type_info(maybeconst MR_TypeInfo *type_info_ptr, const Word *lower_limit,
const Word *upper_limit)
{
- Word *type_info = (Word *) *type_info_ptr;
+ MR_TypeInfo type_info = *type_info_ptr;
- if (in_range(type_info)) {
+ if (in_range((Word *) type_info)) {
MR_TypeCtorInfo type_ctor_info;
- Word *new_type_info;
- Integer arity, offset, i;
+ Word *new_type_info_arena;
+ MR_TypeInfo *type_info_args;
+ MR_TypeInfo *new_type_info_args;
+ int arity;
+ int i;
/*
** Note that we assume type_ctor_infos will always be
** allocated statically, so we never copy them.
*/
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *)
- type_info);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+
/*
- ** optimize special case: if there's no arguments,
+ ** Optimize a special case: if there are no arguments,
** we don't need to construct a type_info; instead,
** we can just return the type_ctor_info.
*/
+
if ((Word) type_info == (Word) type_ctor_info) {
- return (Word *) type_ctor_info;
+ return (MR_TypeInfo) type_ctor_info;
}
- if (MR_TYPE_CTOR_INFO_IS_HO(type_ctor_info)) {
- arity = MR_TYPEINFO_GET_HIGHER_ARITY(type_info);
- incr_saved_hp(LVALUE_CAST(Word, new_type_info),
- arity + 2);
- new_type_info[0] = (Word) type_ctor_info;
- new_type_info[1] = arity;
- offset = 2;
+
+ if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+ arity = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info);
+ type_info_args =
+ MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info);
+ incr_saved_hp(LVALUE_CAST(Word, new_type_info_arena),
+ MR_higher_order_type_info_size(arity));
+ MR_fill_in_higher_order_type_info(new_type_info_arena,
+ type_ctor_info, arity, new_type_info_args);
} else {
arity = type_ctor_info->arity;
- incr_saved_hp(LVALUE_CAST(Word, new_type_info),
- arity + 1);
- new_type_info[0] = (Word) type_ctor_info;
- offset = 1;
- }
- for (i = offset; i < arity + offset; i++) {
- new_type_info[i] = (Word) copy_type_info(&type_info[i],
+ type_info_args = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ incr_saved_hp(LVALUE_CAST(Word, new_type_info_arena),
+ MR_first_order_type_info_size(arity));
+ MR_fill_in_first_order_type_info(new_type_info_arena,
+ type_ctor_info, new_type_info_args);
+ }
+ for (i = 1; i <= arity; i++) {
+ new_type_info_args[i] = copy_type_info(&type_info_args[i],
lower_limit, upper_limit);
}
- leave_forwarding_pointer(type_info_ptr, (Word) new_type_info);
- return new_type_info;
+ leave_forwarding_pointer((Word *) type_info_ptr,
+ (Word) new_type_info_arena);
+ return (MR_TypeInfo) new_type_info_arena;
} else {
found_forwarding_pointer(type_info);
return type_info;
@@ -862,7 +678,10 @@
if (in_range(typeclass_info)) {
Word *base_typeclass_info;
Word *new_typeclass_info;
- Integer arity, num_super, num_arg_typeinfos, i;
+ int num_arg_typeinfos;
+ int num_super;
+ int arity;
+ int i;
/*
** Note that we assume base_typeclass_infos will always be
@@ -873,8 +692,7 @@
arity = MR_typeclass_info_instance_arity(typeclass_info);
num_super = MR_typeclass_info_num_superclasses(typeclass_info);
- num_arg_typeinfos =
- MR_typeclass_info_num_type_infos(typeclass_info);
+ num_arg_typeinfos = MR_typeclass_info_num_type_infos(typeclass_info);
incr_saved_hp(LVALUE_CAST(Word, new_typeclass_info),
arity + num_super + num_arg_typeinfos + 1);
@@ -882,17 +700,16 @@
/* First, copy all the typeclass infos */
for (i = 1; i < arity + num_super + 1; i++) {
- new_typeclass_info[i] = (Word)
- copy_typeclass_info(&typeclass_info[i],
- lower_limit, upper_limit);
+ new_typeclass_info[i] = (Word) copy_typeclass_info(
+ &typeclass_info[i], lower_limit, upper_limit);
}
/* Then, copy all the type infos */
for (i = arity + num_super + 1;
i < arity + num_super + num_arg_typeinfos + 1;
- i++) {
- new_typeclass_info[i] = (Word)
- copy_type_info(&typeclass_info[i],
- lower_limit, upper_limit);
+ i++)
+ {
+ new_typeclass_info[i] = (Word) copy_type_info(
+ (MR_TypeInfo *) &typeclass_info[i], lower_limit, upper_limit);
}
leave_forwarding_pointer(typeclass_info_ptr,
(Word) new_typeclass_info);
Index: runtime/mercury_grade.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_grade.h,v
retrieving revision 1.26
diff -u -b -r1.26 mercury_grade.h
--- runtime/mercury_grade.h 2000/01/19 09:45:21 1.26
+++ runtime/mercury_grade.h 2000/03/22 02:04:14
@@ -52,7 +52,11 @@
** RTTI version number.
*/
-#define MR_GRADE_PART_0 v2_
+#ifdef MR_OLD_GRADE_FOR_BOOTSTRAP
+ #define MR_GRADE_PART_0 v2_
+#else
+ #define MR_GRADE_PART_0 v3_
+#endif
#ifdef MR_HIGHLEVEL_CODE
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.30
diff -u -b -r1.30 mercury_ho_call.c
--- runtime/mercury_ho_call.c 2000/03/10 13:38:11 1.30
+++ runtime/mercury_ho_call.c 2000/03/22 05:16:32
@@ -22,6 +22,8 @@
#include "mercury_imp.h"
#include "mercury_ho_call.h"
+static Word MR_generic_compare(MR_TypeInfo type_info, Word x, Word y);
+
/*
** The called closure may contain only input arguments. The extra arguments
** provided by the higher-order call may be input or output, and may appear
@@ -176,187 +178,44 @@
Define_entry(mercury__unify_2_0);
{
- Word type_info;
- MR_TypeCtorInfo type_ctor_info;
- Word x, y;
-
- type_info = r1;
- x = r2;
- y = r3;
-
-unify_start:
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
-
-#ifdef MR_CTOR_REP_STATS
- MR_ctor_rep_unify[type_ctor_info->type_ctor_rep]++;
-#endif
-
- switch (type_ctor_info->type_ctor_rep) {
-
- /*
- ** For notag and equiv types, we should probably
- ** set type_info to refer to the appropriate type
- ** and then goto start. However, the code that we
- ** have here now works, even though it could be
- ** improved.
- */
-
- case MR_TYPECTOR_REP_ENUM_USEREQ:
- case MR_TYPECTOR_REP_DU:
- case MR_TYPECTOR_REP_DU_USEREQ:
- case MR_TYPECTOR_REP_ARRAY:
- case MR_TYPECTOR_REP_NOTAG:
- case MR_TYPECTOR_REP_NOTAG_USEREQ:
- case MR_TYPECTOR_REP_NOTAG_GROUND:
- case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- case MR_TYPECTOR_REP_EQUIV:
- case MR_TYPECTOR_REP_EQUIV_GROUND:
- case MR_TYPECTOR_REP_EQUIV_VAR:
- /*
- ** We call the type-specific unify routine as
- ** `UnifyPred(...ArgTypeInfos..., X, Y)' is semidet.
- ** The ArgTypeInfo arguments are input, and are passed
- ** in r1, r2, ... rN. The X and Y arguments are also
- ** input, and are passed in rN+1 and rN+2.
- ** The success indication is output in r1.
- **
- ** We specialize the case where the type_ctor arity
- ** is zero, since in this case we don't need the loop.
- ** We could also specialize other arities; 1 and 2
- ** may be worthwhile.
- */
-
- if (type_ctor_info->arity == 0) {
- r1 = x;
- r2 = y;
- }
-#ifdef MR_UNIFY_COMPARE_BY_CTOR_REP_SPEC_1
- else if (type_ctor_info->arity == 1) {
- Word *args_base;
-
- args_base = (Word *) type_info;
- r1 = args_base[1];
- r2 = x;
- r3 = y;
- }
-#endif
-#ifdef MR_UNIFY_COMPARE_BY_CTOR_REP_SPEC_2
- else if (type_ctor_info->arity == 2) {
- Word *args_base;
-
- args_base = (Word *) type_info;
- r1 = args_base[1];
- r2 = args_base[2];
- r3 = x;
- r4 = y;
- }
-#endif
- else {
- int i;
- int type_arity;
- Word *args_base;
-
- type_arity = type_ctor_info->arity;
- args_base = (Word *) type_info;
- save_registers();
-
- /* CompPred(...ArgTypeInfos..., Res, X, Y) * */
- for (i = 1; i <= type_arity; i++) {
- virtual_reg(i) = args_base[i];
- }
- virtual_reg(type_arity + 1) = x;
- virtual_reg(type_arity + 2) = y;
-
- restore_registers();
- }
-
- tailcall(type_ctor_info->unify_pred,
- LABEL(mercury__unify_2_0));
-
- case MR_TYPECTOR_REP_ENUM:
- case MR_TYPECTOR_REP_INT:
- case MR_TYPECTOR_REP_CHAR:
- r1 = ((Integer) x == (Integer) y);
- proceed();
-
- case MR_TYPECTOR_REP_FLOAT:
- {
- Float fx, fy;
-
- fx = word_to_float(x);
- fy = word_to_float(y);
- r1 = (fx == fy);
- proceed();
- }
-
- case MR_TYPECTOR_REP_STRING:
- r1 = (strcmp((char *) x, (char *) y) == 0);
- proceed();
-
- case MR_TYPECTOR_REP_UNIV:
- {
- Word type_info_x, type_info_y;
- int result;
-
- /* First compare the type_infos */
- type_info_x = MR_field(MR_mktag(0), x,
- UNIV_OFFSET_FOR_TYPEINFO);
- type_info_y = MR_field(MR_mktag(0), y,
- UNIV_OFFSET_FOR_TYPEINFO);
- save_transient_registers();
- result = MR_compare_type_info(
- type_info_x, type_info_y);
- restore_transient_registers();
- if (result != MR_COMPARE_EQUAL) {
- r1 = FALSE;
- proceed();
- }
-
- /*
- ** If the types are the same, then unify
- ** the unwrapped args.
- */
-
- type_info = type_info_x;
- x = MR_field(MR_mktag(0), x,
- UNIV_OFFSET_FOR_DATA);
- y = MR_field(MR_mktag(0), y,
- UNIV_OFFSET_FOR_DATA);
- goto unify_start;
- }
-
- case MR_TYPECTOR_REP_C_POINTER:
- r1 = ((void *) x == (void *) y);
- proceed();
-
- case MR_TYPECTOR_REP_TYPEINFO:
- {
- int result;
-
- save_transient_registers();
- result = MR_compare_type_info(x, y);
- restore_transient_registers();
- r1 = (result == MR_COMPARE_EQUAL);
- proceed();
- }
-
- case MR_TYPECTOR_REP_VOID:
- fatal_error("attempt to unify terms of type `void'");
-
- case MR_TYPECTOR_REP_PRED:
- fatal_error("attempt to unify higher-order terms");
-
- case MR_TYPECTOR_REP_TYPECLASSINFO:
- fatal_error("attempt to unify typeclass_infos");
+#define DECLARE_LOCALS \
+ MR_TypeCtorInfo type_ctor_info; \
+ MR_TypeInfo type_info; \
+ Word x, y;
- case MR_TYPECTOR_REP_UNKNOWN:
- fatal_error("attempt to unify terms of unknown type");
+#define initialize() \
+ do { \
+ type_info = (MR_TypeInfo) r1; \
+ x = r2; \
+ y = r3; \
+ } while(0)
+
+#define return_answer(answer) \
+ do { \
+ r1 = (answer); \
+ proceed(); \
+ } while(0)
+
+#define tailcall_user_pred() \
+ tailcall(type_ctor_info->unify_pred, LABEL(mercury__unify_2_0))
+
+#define start_label unify_start
+#define call_user_code_label call_unify_in_proc
+#define ctor_rep_stats_array MR_ctor_rep_unify
+#define attempt_msg "attempt to unify "
+
+#include "mercury_unify_compare_body.h"
+
+#undef DECLARE_LOCALS
+#undef initialize
+#undef return_answer
+#undef tailcall_user_pred
+#undef start_label
+#undef call_user_code_label
+#undef ctor_rep_stats_array
+#undef attempt_msg
- default:
- fatal_error("attempt to unify terms "
- "of unknown representation");
- }
}
/*
@@ -371,14 +230,14 @@
Define_entry(mercury__index_2_0);
{
- Word type_info;
+ MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
Word x;
- type_info = r1;
+ type_info = (MR_TypeInfo) r1;
x = r2;
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
#ifdef MR_CTOR_REP_STATS
MR_ctor_rep_index[type_ctor_info->type_ctor_rep]++;
@@ -426,7 +285,8 @@
else if (type_ctor_info->arity == 1) {
Word *args_base;
- args_base = (Word *) type_info;
+ args_base = (Word *)
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
r1 = args_base[1];
r2 = x;
}
@@ -435,7 +295,8 @@
else if (type_ctor_info->arity == 2) {
Word *args_base;
- args_base = (Word *) type_info;
+ args_base = (Word *)
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
r1 = args_base[1];
r2 = args_base[2];
r3 = x;
@@ -447,7 +308,8 @@
Word *args_base;
type_arity = type_ctor_info->arity;
- args_base = (Word *) type_info;
+ args_base = (Word *)
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
save_registers();
/* IndexPred(...ArgTypeInfos..., X, Index) */
@@ -530,222 +392,90 @@
#endif
Define_entry(mercury__compare_3_3);
{
- Word type_info;
- MR_TypeCtorInfo type_ctor_info;
- Word x, y;
-
- type_info = r1;
- x = r2;
- y = r3;
-
-compare_start:
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
-#ifdef MR_CTOR_REP_STATS
- MR_ctor_rep_compare[type_ctor_info->type_ctor_rep]++;
-#endif
-
- switch (type_ctor_info->type_ctor_rep) {
-
- /*
- ** For notag and equiv types, we should probably
- ** set type_info to refer to the appropriate type
- ** and then goto start. However, the code that we
- ** have here now works, even though it could be
- ** improved.
- */
-
- case MR_TYPECTOR_REP_DU:
- case MR_TYPECTOR_REP_ENUM_USEREQ:
- case MR_TYPECTOR_REP_DU_USEREQ:
- case MR_TYPECTOR_REP_NOTAG:
- case MR_TYPECTOR_REP_NOTAG_USEREQ:
- case MR_TYPECTOR_REP_NOTAG_GROUND:
- case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- case MR_TYPECTOR_REP_EQUIV:
- case MR_TYPECTOR_REP_EQUIV_GROUND:
- case MR_TYPECTOR_REP_EQUIV_VAR:
- case MR_TYPECTOR_REP_ARRAY:
-
- /*
- ** We call the type-specific compare routine as
- ** `CompPred(...ArgTypeInfos..., Result, X, Y)' is det.
- ** The ArgTypeInfo arguments are input, and are passed
- ** in r1, r2, ... rN. The X and Y arguments are also
- ** input, and are passed in rN+1 and rN+2.
- ** The Result argument is output in r1.
- **
- ** We specialize the case where the type_ctor arity
- ** is zero, since in this case we don't need the loop.
- ** We could also specialize other arities; 1 and 2
- ** may be worthwhile.
- */
-
- if (type_ctor_info->arity == 0) {
- r1 = x;
- r2 = y;
- }
-#ifdef MR_UNIFY_COMPARE_BY_CTOR_REP_SPEC_1
- else if (type_ctor_info->arity == 1) {
- Word *args_base;
-
- args_base = (Word *) type_info;
- r1 = args_base[1];
- r2 = x;
- r3 = y;
- }
-#endif
-#ifdef MR_UNIFY_COMPARE_BY_CTOR_REP_SPEC_2
- else if (type_ctor_info->arity == 2) {
- Word *args_base;
-
- args_base = (Word *) type_info;
- r1 = args_base[1];
- r2 = args_base[2];
- r3 = x;
- r4 = y;
- }
-#endif
- else {
- int i;
- int type_arity;
- Word *args_base;
-
- type_arity = type_ctor_info->arity;
- args_base = (Word *) type_info;
- save_registers();
-
- /* CompPred(...ArgTypeInfos..., Res, X, Y) * */
- for (i = 1; i <= type_arity; i++) {
- virtual_reg(i) = args_base[i];
- }
- virtual_reg(type_arity + 1) = x;
- virtual_reg(type_arity + 2) = y;
-
- restore_registers();
- }
-
- tailcall(type_ctor_info->compare_pred,
- LABEL(mercury__compare_3_3));
-
- case MR_TYPECTOR_REP_ENUM:
- case MR_TYPECTOR_REP_INT:
- case MR_TYPECTOR_REP_CHAR:
- if ((Integer) x == (Integer) y) {
- r1 = MR_COMPARE_EQUAL;
- } else if ((Integer) x < (Integer) y) {
- r1 = MR_COMPARE_LESS;
- } else {
- r1 = MR_COMPARE_GREATER;
- }
-
- proceed();
-
- case MR_TYPECTOR_REP_FLOAT:
- {
- Float fx, fy;
-
- fx = word_to_float(x);
- fy = word_to_float(y);
- if (fx == fy) {
- r1 = MR_COMPARE_EQUAL;
- } else if (fx < fy) {
- r1 = MR_COMPARE_LESS;
- } else {
- r1 = MR_COMPARE_GREATER;
- }
-
- proceed();
- }
-
- case MR_TYPECTOR_REP_STRING:
- {
- int result;
-
- result = strcmp((char *) x, (char *) y);
- if (result == 0) {
- r1 = MR_COMPARE_EQUAL;
- } else if (result < 0) {
- r1 = MR_COMPARE_LESS;
- } else {
- r1 = MR_COMPARE_GREATER;
- }
-
- proceed();
- }
-
- case MR_TYPECTOR_REP_UNIV:
- {
- Word type_info_x, type_info_y;
- int result;
-
- /* First compare the type_infos */
- type_info_x = MR_field(MR_mktag(0), x,
- UNIV_OFFSET_FOR_TYPEINFO);
- type_info_y = MR_field(MR_mktag(0), y,
- UNIV_OFFSET_FOR_TYPEINFO);
- save_transient_registers();
- result = MR_compare_type_info(
- type_info_x, type_info_y);
- restore_transient_registers();
- if (result != MR_COMPARE_EQUAL) {
- r1 = result;
- proceed();
- }
-
- /*
- ** If the types are the same, then compare
- ** the unwrapped args.
- */
-
- type_info = type_info_x;
- x = MR_field(MR_mktag(0), x,
- UNIV_OFFSET_FOR_DATA);
- y = MR_field(MR_mktag(0), y,
- UNIV_OFFSET_FOR_DATA);
- goto compare_start;
- }
-
- case MR_TYPECTOR_REP_C_POINTER:
- if ((void *) x == (void *) y) {
- r1 = MR_COMPARE_EQUAL;
- } else if ((void *) x < (void *) y) {
- r1 = MR_COMPARE_LESS;
- } else {
- r1 = MR_COMPARE_GREATER;
- }
-
- proceed();
-
- case MR_TYPECTOR_REP_TYPEINFO:
- {
- int result;
-
- save_transient_registers();
- result = MR_compare_type_info(x, y);
- restore_transient_registers();
- r1 = result;
- proceed();
- }
+#define DECLARE_LOCALS \
+ MR_TypeCtorInfo type_ctor_info; \
+ MR_TypeInfo type_info; \
+ Word x, y;
- case MR_TYPECTOR_REP_VOID:
- fatal_error("attempt to compare terms of type `void'");
+#define initialize() \
+ do { \
+ type_info = (MR_TypeInfo) r1; \
+ x = r2; \
+ y = r3; \
+ } while(0)
+
+#define return_answer(answer) \
+ do { \
+ r1 = (answer); \
+ proceed(); \
+ } while(0)
+
+#define tailcall_user_pred() \
+ tailcall(type_ctor_info->compare_pred, LABEL(mercury__compare_3_3))
+
+#define start_label compare_start
+#define call_user_code_label call_compare_in_proc
+#define ctor_rep_stats_array MR_ctor_rep_compare
+#define attempt_msg "attempt to compare "
+#define select_compare_code
+
+#include "mercury_unify_compare_body.h"
+
+#undef DECLARE_LOCALS
+#undef initialize
+#undef return_answer
+#undef tailcall_user_pred
+#undef start_label
+#undef call_user_code_label
+#undef ctor_rep_stats_array
+#undef attempt_msg
+#undef select_compare_code
- case MR_TYPECTOR_REP_PRED:
- fatal_error("attempt to compare higher-order terms");
+}
+END_MODULE
- case MR_TYPECTOR_REP_TYPECLASSINFO:
- fatal_error("attempt to compare typeclass_infos");
+static Word
+MR_generic_compare(MR_TypeInfo type_info, Word x, Word y)
+{
- case MR_TYPECTOR_REP_UNKNOWN:
- fatal_error("attempt to compare terms of unknown type");
+#define DECLARE_LOCALS \
+ MR_TypeCtorInfo type_ctor_info;
- default:
- fatal_error("attempt to compare terms "
- "of unknown representation");
- }
+#define initialize() \
+ do { \
+ (void) 0; /* do nothing */ \
+ } while(0)
+
+#define return_answer(answer) \
+ return (answer)
+
+#define tailcall_user_pred() \
+ do { \
+ save_transient_registers(); \
+ (void) MR_call_engine(type_ctor_info->compare_pred, FALSE);\
+ restore_transient_registers(); \
+ return (r1); \
+ } while (0)
+
+#define start_label compare_func_start
+#define call_user_code_label call_compare_in_func
+#define ctor_rep_stats_array MR_ctor_rep_compare
+#define attempt_msg "attempt to compare "
+#define select_compare_code
+
+#include "mercury_unify_compare_body.h"
+
+#undef DECLARE_LOCALS
+#undef initialize
+#undef return_answer
+#undef tailcall_user_pred
+#undef start_label
+#undef call_user_code_label
+#undef ctor_rep_stats_array
+#undef attempt_msg
+#undef select_compare_code
}
-END_MODULE
void mercury_sys_init_call(void); /* suppress gcc warning */
void mercury_sys_init_call(void) {
Index: runtime/mercury_layout_util.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_layout_util.c,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_layout_util.c
--- runtime/mercury_layout_util.c 2000/01/13 03:57:15 1.16
+++ runtime/mercury_layout_util.c 2000/03/19 08:08:14
@@ -63,7 +63,7 @@
save_transient_registers();
}
-Word *
+MR_TypeInfoParams
MR_materialize_typeinfos(const MR_Stack_Layout_Vars *vars,
Word *saved_regs)
{
@@ -71,29 +71,28 @@
MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs));
}
-Word *
+MR_TypeInfoParams
MR_materialize_typeinfos_base(const MR_Stack_Layout_Vars *vars,
Word *saved_regs, Word *base_sp, Word *base_curfr)
{
- Word *type_params;
+ MR_TypeInfoParams type_params;
bool succeeded;
Integer count;
int i;
if (vars->MR_slvs_tvars != NULL) {
count = vars->MR_slvs_tvars->MR_tp_param_count;
- type_params = MR_NEW_ARRAY(Word, count + 1);
+ type_params = (MR_TypeInfoParams)
+ MR_NEW_ARRAY(Word, count + 1);
- /*
- ** type_params should look like a typeinfo;
- ** type_params[0] is empty and will not be referred to
- */
for (i = 0; i < count; i++) {
if (vars->MR_slvs_tvars->MR_tp_param_locns[i] != 0) {
- type_params[i + 1] = MR_lookup_long_lval_base(
+ type_params[i + 1] = (MR_TypeInfo)
+ MR_lookup_long_lval_base(
vars->MR_slvs_tvars->
MR_tp_param_locns[i],
- saved_regs, base_sp, base_curfr,
+ saved_regs,
+ base_sp, base_curfr,
&succeeded);
if (! succeeded) {
fatal_error("missing type param in "
@@ -345,7 +344,8 @@
bool
MR_get_type_and_value(const MR_Stack_Layout_Vars *vars, int i,
- Word *saved_regs, Word *type_params, Word *type_info, Word *value)
+ Word *saved_regs, MR_TypeInfo *type_params, MR_TypeInfo *type_info,
+ Word *value)
{
return MR_get_type_and_value_base(vars, i, saved_regs,
MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
@@ -355,13 +355,13 @@
bool
MR_get_type_and_value_base(const MR_Stack_Layout_Vars *vars, int i,
Word *saved_regs, Word *base_sp, Word *base_curfr,
- Word *type_params, Word *type_info, Word *value)
+ MR_TypeInfo *type_params, MR_TypeInfo *type_info, Word *value)
{
+ MR_PseudoTypeInfo pseudo_type_info;
bool succeeded;
- Word *pseudo_type_info;
pseudo_type_info = MR_var_pti(vars, i);
- *type_info = (Word) MR_create_type_info(type_params, pseudo_type_info);
+ *type_info = MR_create_type_info(type_params, pseudo_type_info);
if (i < MR_long_desc_var_count(vars)) {
*value = MR_lookup_long_lval_base(
@@ -378,7 +378,7 @@
bool
MR_get_type(const MR_Stack_Layout_Vars *vars, int i, Word *saved_regs,
- Word *type_params, Word *type_info)
+ MR_TypeInfo *type_params, MR_TypeInfo *type_info)
{
return MR_get_type_base(vars, i, saved_regs,
MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
@@ -388,12 +388,12 @@
bool
MR_get_type_base(const MR_Stack_Layout_Vars *vars, int i,
Word *saved_regs, Word *base_sp, Word *base_curfr,
- Word *type_params, Word *type_info)
+ MR_TypeInfo *type_params, MR_TypeInfo *type_info)
{
- Word *pseudo_type_info;
+ MR_PseudoTypeInfo pseudo_type_info;
pseudo_type_info = MR_var_pti(vars, i);
- *type_info = (Word) MR_create_type_info(type_params, pseudo_type_info);
+ *type_info = MR_create_type_info(type_params, pseudo_type_info);
return TRUE;
}
Index: runtime/mercury_layout_util.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_layout_util.h,v
retrieving revision 1.8
diff -u -b -r1.8 mercury_layout_util.h
--- runtime/mercury_layout_util.h 1999/12/13 14:03:40 1.8
+++ runtime/mercury_layout_util.h 2000/03/22 01:59:20
@@ -47,10 +47,12 @@
** is non-null.
*/
-extern Word *MR_materialize_typeinfos(
- const MR_Stack_Layout_Vars *vars, Word *saved_regs);
-extern Word *MR_materialize_typeinfos_base(
- const MR_Stack_Layout_Vars *vars, Word *saved_regs,
+extern MR_TypeInfoParams MR_materialize_typeinfos(
+ const MR_Stack_Layout_Vars *vars,
+ Word *saved_regs);
+extern MR_TypeInfoParams MR_materialize_typeinfos_base(
+ const MR_Stack_Layout_Vars *vars,
+ Word *saved_regs,
Word *base_sp, Word *base_curfr);
/*
@@ -111,17 +113,19 @@
*/
extern bool MR_get_type_and_value(const MR_Stack_Layout_Vars *vars,
- int var, Word *saved_regs,
- Word *type_params, Word *type_info, Word *value);
+ int var, Word *saved_regs, MR_TypeInfo *type_params,
+ MR_TypeInfo *type_info, Word *value);
extern bool MR_get_type_and_value_base(const MR_Stack_Layout_Vars *vars,
int var, Word *saved_regs,
Word *base_sp, Word *base_curfr,
- Word *type_params, Word *type_info, Word *value);
+ MR_TypeInfo *type_params, MR_TypeInfo *type_info,
+ Word *value);
extern bool MR_get_type(const MR_Stack_Layout_Vars *vars, int var,
- Word *saved_regs, Word *type_params, Word *type_info);
+ Word *saved_regs, MR_TypeInfo *type_params,
+ MR_TypeInfo *type_info);
extern bool MR_get_type_base(const MR_Stack_Layout_Vars *vars, int var,
Word *saved_regs, Word *base_sp, Word *base_curfr,
- Word *type_params, Word *type_info);
+ MR_TypeInfo *type_params, MR_TypeInfo *type_info);
/*
** MR_write_variable:
Index: runtime/mercury_make_type_info_body.h
===================================================================
RCS file: mercury_make_type_info_body.h
diff -N mercury_make_type_info_body.h
--- /dev/null Thu Sep 2 15:00:04 1999
+++ mercury_make_type_info_body.h Wed Mar 22 19:05:30 2000
@@ -0,0 +1,117 @@
+/*
+** Copyright (C) 2000 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This file is intended to be #included in mercury_type_info.c to provide
+** the definitions of MR_create_type_info and MR_make_type_info, and their
+** helper functions MR_create_type_info_maybe_existq and
+** MR_make_type_info_maybe_existq.
+*/
+
+MR_TypeInfo
+usual_func(const MR_TypeInfoParams type_info_params,
+ const MR_PseudoTypeInfo pseudo_type_info
+ MAYBE_DECLARE_ALLOC_ARG)
+{
+ return exist_func(type_info_params,
+ pseudo_type_info, NULL, NULL
+ MAYBE_PASS_ALLOC_ARG);
+}
+
+MR_TypeInfo
+exist_func(const MR_TypeInfoParams type_info_params,
+ const MR_PseudoTypeInfo pseudo_type_info, const Word *data_value,
+ const MR_DuFunctorDesc *functor_desc
+ MAYBE_DECLARE_ALLOC_ARG)
+{
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TypeInfo expanded_type_info;
+ Word *type_info_arena;
+ MR_PseudoTypeInfo *pseudo_type_info_arena;
+ int arity;
+ int start_region_size;
+ int i;
+
+ /*
+ ** The pseudo_type_info might be a polymorphic variable.
+ ** If so, then substitute it's value, and then we're done.
+ */
+ if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pseudo_type_info)) {
+
+ expanded_type_info = MR_get_arg_type_info(type_info_params,
+ pseudo_type_info, data_value, functor_desc);
+
+ if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(expanded_type_info)) {
+ fatal_error(exist_func_string
+ ": unbound type variable");
+ }
+
+ return expanded_type_info;
+ }
+
+ type_ctor_info = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(
+ pseudo_type_info);
+
+ /* no arguments - optimise common case */
+ if ((Word) type_ctor_info == (Word) pseudo_type_info) {
+ return MR_pseudo_type_info_is_ground(pseudo_type_info);
+ }
+
+ if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+ arity = MR_PSEUDO_TYPEINFO_GET_HIGHER_ORDER_ARITY(
+ pseudo_type_info);
+ start_region_size = 2;
+ } else {
+ arity = type_ctor_info->arity;
+ start_region_size = 1;
+ }
+
+ /*
+ ** Iterate over the arguments, figuring out whether we
+ ** need to make any substitutions.
+ ** If so, copy the resulting argument type-infos into
+ ** a new type_info.
+ */
+
+ type_info_arena = NULL;
+ pseudo_type_info_arena = (MR_PseudoTypeInfo *) pseudo_type_info;
+ for (i = start_region_size; i < arity + start_region_size; i++) {
+ expanded_type_info = exist_func(type_info_params,
+ pseudo_type_info_arena[i],
+ data_value, functor_desc
+ MAYBE_PASS_ALLOC_ARG);
+
+ if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(expanded_type_info)) {
+ fatal_error(exist_func_string
+ ": unbound type variable");
+ }
+
+ if (expanded_type_info !=
+ (MR_TypeInfo) pseudo_type_info_arena[i])
+ {
+ /*
+ ** We made a substitution.
+ ** We need to allocate a new type_info,
+ ** if we haven't done so already.
+ */
+ if (type_info_arena == NULL) {
+ ALLOCATE_WORDS(type_info_arena,
+ arity + start_region_size);
+ memcpy(type_info_arena,
+ (Word *) pseudo_type_info,
+ (arity + start_region_size)
+ * sizeof(Word));
+ }
+ type_info_arena[i] = (Word) expanded_type_info;
+ }
+ }
+
+ if (type_info_arena == NULL) {
+ return (MR_TypeInfo) pseudo_type_info;
+ } else {
+ return (MR_TypeInfo) type_info_arena;
+ }
+}
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.35
diff -u -b -r1.35 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 1999/12/16 11:39:22 1.35
+++ runtime/mercury_stack_layout.h 2000/03/22 01:59:20
@@ -279,7 +279,7 @@
(MR_long_desc_var_count(slvs) + MR_short_desc_var_count(slvs))
#define MR_var_pti(slvs, i) \
- (((MR_PseudoTypeInfo **) ((slvs)->MR_slvs_locns_types))[(i)])
+ (((MR_PseudoTypeInfo *) ((slvs)->MR_slvs_locns_types))[(i)])
#define MR_end_of_var_ptis(slvs) \
(&MR_var_pti((slvs), MR_all_desc_var_count(slvs)))
#define MR_long_desc_var_locn(slvs, i) \
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.23
diff -u -b -r1.23 mercury_tabling.c
--- runtime/mercury_tabling.c 2000/03/18 08:10:29 1.23
+++ runtime/mercury_tabling.c 2000/03/21 10:04:55
@@ -550,19 +550,18 @@
/*---------------------------------------------------------------------------*/
MR_TrieNode
-MR_type_info_lookup_or_add(MR_TrieNode table, Word *type_info)
+MR_type_info_lookup_or_add(MR_TrieNode table, MR_TypeInfo type_info)
{
- MR_TypeInfo collapsed_type_info;
MR_TypeCtorInfo type_ctor_info;
MR_TrieNode node;
- Word **type_info_args;
+ MR_TypeInfo *arg_vector;
+ int arity;
int i;
/* XXX memory allocation here should be optimized */
- collapsed_type_info = MR_collapse_equivalences((Word) type_info);
+ type_info = MR_collapse_equivalences(type_info);
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(
- (Word *) collapsed_type_info);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
node = MR_int_hash_lookup_or_add(table, (Integer) type_ctor_info);
/*
@@ -571,15 +570,23 @@
** being tabled. They must therefore also agree on its arity.
** This is why looping over all the arguments works.
**
- ** If collapsed_type_info has a zero-arity type_ctor, then it may be
- ** stored using a one-cell type_info, and type_info_args does not make
+ ** If type_info has a zero-arity type_ctor, then it may be stored
+ ** using a one-cell type_info, and type_info_args does not make
** sense. This is OK, because in that case it will never be used.
*/
- type_info_args = (Word **) collapsed_type_info;
+ if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+ arity = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info);
+ arg_vector = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(
+ type_info);
+ node = MR_int_hash_lookup_or_add(node, arity);
+ } else {
+ arity = type_ctor_info->arity;
+ arg_vector = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ }
- for (i = 1; i <= type_ctor_info->arity; i++) {
- node = MR_type_info_lookup_or_add(node, type_info_args[i]);
+ for (i = 1; i <= arity; i++) {
+ node = MR_type_info_lookup_or_add(node, arg_vector[i]);
}
return node;
@@ -609,7 +616,7 @@
*/
MR_TrieNode
-MR_table_type(MR_TrieNode table, Word *type_info, Word data)
+MR_table_type(MR_TrieNode table, MR_TypeInfo type_info, Word data)
{
MR_TypeCtorInfo type_ctor_info;
@@ -625,122 +632,18 @@
switch (type_ctor_info->type_ctor_rep) {
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- Word layout_for_tag;
- Word *layout_vector_for_tag;
- int data_tag;
- int functors;
-
- data_tag = MR_tag(data);
- layout_for_tag = type_ctor_info->type_ctor_layout[data_tag];
- layout_vector_for_tag = (Word *) MR_strip_tag(layout_for_tag);
- functors = MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_NUM_FUNCTORS(
- layout_vector_for_tag);
- MR_DEBUG_TABLE_ENUM(table, functors, data);
- } else {
MR_DEBUG_TABLE_ENUM(table,
type_ctor_info->type_ctor_num_functors, data);
- }
break;
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- MR_DiscUnionTagRepresentation tag_rep;
- MR_MemoryList allocated_memory_cells = NULL;
- Word layout_for_tag;
- Word *layout_vector_for_tag;
- int data_tag;
-
- data_tag = MR_tag(data);
- layout_for_tag = type_ctor_info->type_ctor_layout[data_tag];
- layout_vector_for_tag = (Word *) MR_strip_tag(layout_for_tag);
- tag_rep = MR_get_tag_representation((Word) layout_for_tag);
-
- switch(tag_rep) {
- case MR_DISCUNIONTAG_SHARED_LOCAL: {
- int functors =
- MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_NUM_FUNCTORS(
- layout_vector_for_tag);
- MR_DEBUG_TABLE_TAG(table, data_tag);
- MR_DEBUG_TABLE_ENUM(table, functors, MR_unmkbody(data));
- break;
- }
- case MR_DISCUNIONTAG_UNSHARED: {
- Word *argument_vector;
- Word *type_info_vector;
- Word *new_type_info;
- int arity;
- int i;
-
- argument_vector = (Word *) MR_body(data, data_tag);
-
- arity = layout_vector_for_tag[
- TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET];
- type_info_vector = &layout_vector_for_tag[
- TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET];
-
- MR_DEBUG_TABLE_TAG(table, data_tag);
-
- /* copy arguments */
- for (i = 0; i < arity; i++) {
- new_type_info = MR_make_type_info(type_info,
- (Word *) type_info_vector[i],
- &allocated_memory_cells);
-
- MR_DEBUG_TABLE_ANY(table, new_type_info,
- argument_vector[i]);
- }
- break;
- }
- case MR_DISCUNIONTAG_SHARED_REMOTE: {
- int arity, i;
- Word *argument_vector;
- Word *type_info_vector;
- Word *new_type_info;
- Word secondary_tag;
- Word num_sharers;
- Word *new_layout_vector;
- Word *data_value;
-
- data_value = (Word *) MR_body(data, data_tag);
- secondary_tag = *data_value;
- argument_vector = data_value + 1;
-
- num_sharers =
- MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_NUM_SHARERS(
- layout_vector_for_tag);
- new_layout_vector =
- MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_GET_FUNCTOR_DESCRIPTOR(
- layout_vector_for_tag, secondary_tag);
- arity = new_layout_vector[
- TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET];
- type_info_vector = &new_layout_vector[
- TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET];
-
- MR_DEBUG_TABLE_TAG(table, data_tag);
- MR_DEBUG_TABLE_ENUM(table, num_sharers, secondary_tag);
-
- for (i = 0; i < arity; i++) {
- new_type_info = MR_make_type_info(type_info,
- (Word *) type_info_vector[i],
- &allocated_memory_cells);
-
- MR_DEBUG_TABLE_ANY(table, new_type_info,
- argument_vector[i]);
- }
- break;
- }
- } /* end switch(tag_rep) */
-
- MR_deallocate(allocated_memory_cells);
-
- } else {
+ {
MR_MemoryList allocated_memory_cells = NULL;
const MR_DuPtagLayout *ptag_layout;
const MR_DuFunctorDesc *functor_desc;
const MR_DuExistInfo *exist_info;
- Word *arg_type_info;
+ MR_TypeInfo arg_type_info;
int ptag;
Word sectag;
Word *arg_vector;
@@ -777,16 +680,28 @@
exist_info = functor_desc->MR_du_functor_exist_info;
if (exist_info != NULL) {
- for (i = 0; i < exist_info->MR_exist_typeinfos_plain; i++)
- {
- MR_DEBUG_TABLE_TYPEINFO(table, (Word *) arg_vector[i]);
+ int num_ti_plain;
+ int num_ti_in_tci;
+ int num_tci;
+ const MR_DuExistLocn *locns;
+
+ num_ti_plain = exist_info->MR_exist_typeinfos_plain;
+ num_ti_in_tci = exist_info->MR_exist_typeinfos_in_tci;
+ num_tci = exist_info->MR_exist_tcis;
+ locns = exist_info->MR_exist_typeinfo_locns;
+
+ for (i = 0; i < num_ti_plain + num_ti_in_tci; i++) {
+ if (locns[i].MR_exist_offset_in_tci < 0) {
+ MR_DEBUG_TABLE_TYPEINFO(table, (MR_TypeInfo)
+ arg_vector[locns[i].MR_exist_arg_num]);
+ } else {
+ MR_DEBUG_TABLE_TYPEINFO(table, (MR_TypeInfo)
+ MR_typeclass_info_type_info(
+ arg_vector[locns[i].MR_exist_arg_num],
+ locns[i].MR_exist_offset_in_tci));
}
- meta_args = exist_info->MR_exist_typeinfos_plain;
- for (i = 0; i < exist_info->MR_exist_tcis; i++) {
- MR_DEBUG_TABLE_TYPECLASSINFO(table,
- (Word *) arg_vector[meta_args + i]);
}
- meta_args += exist_info->MR_exist_tcis;
+ meta_args = num_ti_plain + num_tci;
} else {
meta_args = 0;
}
@@ -794,14 +709,13 @@
for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
if (MR_arg_type_may_contain_var(functor_desc, i)) {
arg_type_info = MR_make_type_info_maybe_existq(
- type_info,
- (Word *) functor_desc->MR_du_functor_arg_types[i],
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ functor_desc->MR_du_functor_arg_types[i],
(Word *) MR_body(data, ptag),
- type_ctor_info->type_ctor_version,
functor_desc, &allocated_memory_cells);
} else {
- arg_type_info = (Word *)
- functor_desc->MR_du_functor_arg_types[i];
+ arg_type_info = MR_pseudo_type_info_is_ground(
+ functor_desc->MR_du_functor_arg_types[i]);
}
MR_DEBUG_TABLE_ANY(table, arg_type_info,
@@ -814,28 +728,13 @@
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- MR_MemoryList allocated_memory_cells = NULL;
- Word layout_for_tag;
- Word *layout_vector_for_tag;
- int data_tag;
- Word *new_type_info;
-
- data_tag = MR_tag(data);
- layout_for_tag = type_ctor_info->type_ctor_layout[data_tag];
- layout_vector_for_tag = (Word *) MR_strip_tag(layout_for_tag);
- new_type_info = MR_make_type_info(type_info,
- (Word *) *MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(
- layout_vector_for_tag),
- &allocated_memory_cells);
- MR_DEBUG_TABLE_ANY(table, new_type_info, data);
- MR_deallocate(allocated_memory_cells);
- } else {
+ {
MR_MemoryList allocated_memory_cells = NULL;
- Word *eqv_type_info;
+ MR_TypeInfo eqv_type_info;
- eqv_type_info = MR_make_type_info(type_info,
- (Word *) type_ctor_info->type_layout.layout_notag->
+ eqv_type_info = MR_make_type_info(
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ type_ctor_info->type_layout.layout_notag->
MR_notag_functor_arg_type, &allocated_memory_cells);
MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
MR_deallocate(allocated_memory_cells);
@@ -844,32 +743,19 @@
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- MR_DEBUG_TABLE_ANY(table, (Word *) type_ctor_info->type_layout.
- layout_notag->MR_notag_functor_arg_type, data);
+ MR_DEBUG_TABLE_ANY(table, MR_pseudo_type_info_is_ground(
+ type_ctor_info->type_layout.layout_notag->
+ MR_notag_functor_arg_type), data);
break;
case MR_TYPECTOR_REP_EQUIV:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- MR_MemoryList allocated_memory_cells = NULL;
- Word layout_for_tag;
- Word *layout_vector_for_tag;
- int data_tag;
- Word *new_type_info;
-
- data_tag = MR_tag(data);
- layout_for_tag = type_ctor_info->type_ctor_layout[data_tag];
- layout_vector_for_tag = (Word *) MR_strip_tag(layout_for_tag);
- new_type_info = MR_make_type_info(type_info, (Word *)
- MR_TYPE_CTOR_LAYOUT_EQUIV_TYPE(layout_vector_for_tag),
- &allocated_memory_cells);
- MR_DEBUG_TABLE_ANY(table, new_type_info, data);
- MR_deallocate(allocated_memory_cells);
- } else {
+ {
MR_MemoryList allocated_memory_cells = NULL;
- Word *eqv_type_info;
+ MR_TypeInfo eqv_type_info;
- eqv_type_info = MR_make_type_info(type_info,
- (Word *) type_ctor_info->type_layout.layout_equiv,
+ eqv_type_info = MR_make_type_info(
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ type_ctor_info->type_layout.layout_equiv,
&allocated_memory_cells);
MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
MR_deallocate(allocated_memory_cells);
@@ -877,28 +763,16 @@
break;
case MR_TYPECTOR_REP_EQUIV_GROUND:
- MR_DEBUG_TABLE_ANY(table, (Word *) type_ctor_info->type_layout.
- layout_equiv, data);
+ MR_DEBUG_TABLE_ANY(table, MR_pseudo_type_info_is_ground(
+ type_ctor_info->type_layout.layout_equiv), data);
break;
case MR_TYPECTOR_REP_EQUIV_VAR:
- if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
- Word layout_for_tag;
- Word *layout_vector_for_tag;
- int data_tag;
-
- data_tag = MR_tag(data);
- layout_for_tag = type_ctor_info->type_ctor_layout[data_tag];
- layout_vector_for_tag = (Word *) MR_strip_tag(layout_for_tag);
- MR_DEBUG_TABLE_ANY(table,
- (Word *) type_info[(Word) layout_vector_for_tag], data);
- } else {
/*
** The current version of the RTTI gives all equivalence types
** the EQUIV type_ctor_rep, not EQUIV_VAR.
*/
fatal_error("unexpected EQUIV_VAR type_ctor_rep");
- }
break;
case MR_TYPECTOR_REP_INT:
@@ -917,17 +791,20 @@
MR_DEBUG_TABLE_STRING(table, (String) data);
break;
- case MR_TYPECTOR_REP_PRED: {
+ case MR_TYPECTOR_REP_PRED:
+ {
/*
** XXX tabling of the closures by tabling their code address
** and arguments is not yet implemented, due to the difficulty
** of figuring out the closure argument types.
*/
#if 0
- MR_closure closure = (MR_Closure *) data;
- Word num_hidden_args = closure->MR_closure_num_hidden_args;
+ MR_closure closure;
+ Word num_hidden_args;
int i;
+ closure = (MR_Closure *) data;
+ num_hidden_args = closure->MR_closure_num_hidden_args;
MR_DEBUG_TABLE_INT(table, closure->MR_closure_code);
for (i = 1; i <= num_hidden_args; i++) {
MR_DEBUG_TABLE_ANY(table,
@@ -943,14 +820,16 @@
#endif
break;
}
- case MR_TYPECTOR_REP_UNIV: {
+
+ case MR_TYPECTOR_REP_UNIV:
+ {
Word *data_value;
data_value = (Word *) data;
MR_DEBUG_TABLE_TYPEINFO(table,
- (Word *) data_value[UNIV_OFFSET_FOR_TYPEINFO]);
+ (MR_TypeInfo) data_value[UNIV_OFFSET_FOR_TYPEINFO]);
MR_DEBUG_TABLE_ANY(table,
- (Word *) data_value[UNIV_OFFSET_FOR_TYPEINFO],
+ (MR_TypeInfo) data_value[UNIV_OFFSET_FOR_TYPEINFO],
data_value[UNIV_OFFSET_FOR_DATA]);
break;
}
@@ -963,30 +842,32 @@
fatal_error("Attempt to table a C_POINTER");
break;
- case MR_TYPECTOR_REP_TYPEINFO: {
- MR_DEBUG_TABLE_TYPEINFO(table, (Word *) data);
+ case MR_TYPECTOR_REP_TYPEINFO:
+ MR_DEBUG_TABLE_TYPEINFO(table, (MR_TypeInfo) data);
break;
- }
case MR_TYPECTOR_REP_TYPECLASSINFO:
fatal_error("Attempt to table a type_class_info");
break;
- case MR_TYPECTOR_REP_ARRAY: {
+ case MR_TYPECTOR_REP_ARRAY:
+ {
+ MR_TypeInfo new_type_info;
MR_MemoryList allocated_memory_cells = NULL;
- int i;
MR_ArrayType *array;
- Word *new_type_info;
Integer array_size;
+ int i;
array = (MR_ArrayType *) data;
array_size = array->size;
- new_type_info = MR_make_type_info(type_info, (Word *) 1,
- &allocated_memory_cells);
+ new_type_info = MR_make_type_info(
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ (MR_PseudoTypeInfo) 1, &allocated_memory_cells);
for (i = 0; i < array_size; i++) {
- MR_DEBUG_TABLE_ANY(table, new_type_info, array->elements[i]);
+ MR_DEBUG_TABLE_ANY(table, new_type_info,
+ array->elements[i]);
}
MR_deallocate(allocated_memory_cells);
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.19
diff -u -b -r1.19 mercury_tabling.h
--- runtime/mercury_tabling.h 2000/03/13 02:32:46 1.19
+++ runtime/mercury_tabling.h 2000/03/22 01:59:20
@@ -305,7 +305,7 @@
*/
extern MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode table,
- Word *type_info);
+ MR_TypeInfo type_info);
/*
** This function tables typeclass_infos in a hash table.
@@ -320,7 +320,7 @@
*/
extern MR_TrieNode MR_table_type(MR_TrieNode table,
- Word *type_info, Word data_value);
+ MR_TypeInfo type_info, Word data_value);
/*
** This function prints statistics about the operation of tabling, if the
--------------------------------------------------------------------------
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