[m-dev.] for review: add type_ctor_reps
Tyson Dowd
trd at cs.mu.OZ.AU
Tue Jun 29 06:46:42 AEST 1999
Hi,
Zoltan, here is the change to use type_ctor_reps (at last).
===================================================================
Estimated hours taken: 30 (including debugging)
Add MR_TYPECTOR_REP_* to the type_ctor_info to describe the
representation of this type.
Use this representation in code that uses RTTI.
compiler/base_type_info.m:
Add a missing alternative to the type_ctor_rep (this was a
bug).
library/array.m:
library/builtin.m:
library/private_builtin.m:
runtime/mercury_bootstrap.c:
Use MR_TYPECTOR_REP_* in the type_ctor_infos for builtin types.
library/std_util.m:
runtime/mercury_deep_copy_body.h:
runtime/mercury_tabling.c:
Use MR_TYPECTOR_REP_* and MR_DISCUNION_TAG_* to dispatch on
data representations.
Also, fix a bug in deep_copy when copying floating point values.
I'm not sure when this stopped working, or if this is exactly
the right fix, but it is more correct than the previous code.
runtime/mercury_type_info.c:
runtime/mercury_type_info.h:
Update code to use MR_TYPECTOR_REP_*.
Use a struct for type_ctor_info.
tests/hard_coded/Mmakefile:
tests/hard_coded/deep_copy.m:
tests/hard_coded/deep_copy.exp:
Add a test case for deep_copy.
Index: compiler/base_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_type_info.m,v
retrieving revision 1.25
diff -u -r1.25 base_type_info.m
--- base_type_info.m 1999/04/30 06:19:04 1.25
+++ base_type_info.m 1999/05/31 11:04:20
@@ -245,6 +245,7 @@
; du
; notag
; equiv
+ ; equiv_var
; int
; char
; float
@@ -264,18 +265,19 @@
base_type_info__type_ctor_rep_to_int(du, 1).
base_type_info__type_ctor_rep_to_int(notag, 2).
base_type_info__type_ctor_rep_to_int(equiv, 3).
-base_type_info__type_ctor_rep_to_int(int, 4).
-base_type_info__type_ctor_rep_to_int(char, 5).
-base_type_info__type_ctor_rep_to_int(float, 6).
-base_type_info__type_ctor_rep_to_int(string, 7).
-base_type_info__type_ctor_rep_to_int(pred, 8).
-base_type_info__type_ctor_rep_to_int(univ, 9).
-base_type_info__type_ctor_rep_to_int(void, 10).
-base_type_info__type_ctor_rep_to_int(c_pointer, 11).
-base_type_info__type_ctor_rep_to_int(typeinfo, 12).
-base_type_info__type_ctor_rep_to_int(typeclassinfo, 13).
-base_type_info__type_ctor_rep_to_int(array, 14).
-base_type_info__type_ctor_rep_to_int(unknown, 15).
+base_type_info__type_ctor_rep_to_int(equiv_var, 4).
+base_type_info__type_ctor_rep_to_int(int, 5).
+base_type_info__type_ctor_rep_to_int(char, 6).
+base_type_info__type_ctor_rep_to_int(float, 7).
+base_type_info__type_ctor_rep_to_int(string, 8).
+base_type_info__type_ctor_rep_to_int(pred, 9).
+base_type_info__type_ctor_rep_to_int(univ, 10).
+base_type_info__type_ctor_rep_to_int(void, 11).
+base_type_info__type_ctor_rep_to_int(c_pointer, 12).
+base_type_info__type_ctor_rep_to_int(typeinfo, 13).
+base_type_info__type_ctor_rep_to_int(typeclassinfo, 14).
+base_type_info__type_ctor_rep_to_int(array, 15).
+base_type_info__type_ctor_rep_to_int(unknown, 16).
:- pred base_type_info__construct_type_ctor_representation(hlds_type_defn,
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.55
diff -u -r1.55 array.m
--- array.m 1999/06/02 10:04:58 1.55
+++ array.m 1999/06/04 06:08:08
@@ -281,7 +281,7 @@
Code * f2;
Code * f3;
Code * f4;
- Code * f5;
+ Word f5;
Word * f6;
Word * f7;
Word * f8;
@@ -291,7 +291,7 @@
ENTRY(mercury____Unify___array__array_1_0),
ENTRY(mercury____Index___array__array_1_0),
ENTRY(mercury____Compare___array__array_1_0),
- (Word *) &mercury_data_array__type_ctor_layout_array_1,
+ MR_TYPECTOR_REP_ARRAY,
(Word *) &mercury_data_array__type_ctor_functors_array_1,
(Word *) &mercury_data_array__type_ctor_layout_array_1,
string_const(""array"", 5),
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.16
diff -u -r1.16 builtin.m
--- builtin.m 1999/06/24 04:32:05 1.16
+++ builtin.m 1999/06/24 04:33:33
@@ -480,7 +480,7 @@
Code *f3;
Code *f4;
#ifdef USE_TYPE_LAYOUT
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -492,7 +492,7 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_int_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_int_3_0)),
#ifdef USE_TYPE_LAYOUT
- (const Word *) & mercury_data___type_ctor_layout_int_0,
+ MR_TYPECTOR_REP_INT,
(const Word *) & mercury_data___type_ctor_functors_int_0,
(const Word *) & mercury_data___type_ctor_layout_int_0,
(const Word *) string_const(""builtin"", 7),
@@ -512,7 +512,7 @@
Code *f3;
Code *f4;
#ifdef USE_TYPE_LAYOUT
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -524,7 +524,7 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_character_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_character_3_0)),
#ifdef USE_TYPE_LAYOUT
- (const Word *) & mercury_data___type_ctor_layout_character_0,
+ MR_TYPECTOR_REP_CHAR,
(const Word *) & mercury_data___type_ctor_functors_character_0,
(const Word *) & mercury_data___type_ctor_layout_character_0,
(const Word *) string_const(""builtin"", 7),
@@ -543,7 +543,7 @@
Code *f3;
Code *f4;
#ifdef USE_TYPE_LAYOUT
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -555,7 +555,7 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_string_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_string_3_0)),
#ifdef USE_TYPE_LAYOUT
- (const Word *) & mercury_data___type_ctor_layout_string_0,
+ MR_TYPECTOR_REP_STRING,
(const Word *) & mercury_data___type_ctor_functors_string_0,
(const Word *) & mercury_data___type_ctor_layout_string_0,
(const Word *) string_const(""builtin"", 7),
@@ -574,7 +574,7 @@
Code *f3;
Code *f4;
#ifdef USE_TYPE_LAYOUT
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -586,7 +586,7 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_float_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_float_3_0)),
#ifdef USE_TYPE_LAYOUT
- (const Word *) & mercury_data___type_ctor_layout_float_0,
+ MR_TYPECTOR_REP_FLOAT,
(const Word *) & mercury_data___type_ctor_functors_float_0,
(const Word *) & mercury_data___type_ctor_layout_float_0,
(const Word *) string_const(""builtin"", 7),
@@ -603,7 +603,7 @@
Code *f3;
Code *f4;
#ifdef USE_TYPE_LAYOUT
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -615,7 +615,7 @@
MR_MAYBE_STATIC_CODE(ENTRY(mercury__unused_0_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__unused_0_0)),
#ifdef USE_TYPE_LAYOUT
- (const Word *) & mercury_data___type_ctor_layout_void_0,
+ MR_TYPECTOR_REP_VOID,
(const Word *) & mercury_data___type_ctor_functors_void_0,
(const Word *) & mercury_data___type_ctor_layout_void_0,
(const Word *) string_const(""builtin"", 7),
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.25
diff -u -r1.25 private_builtin.m
--- private_builtin.m 1999/06/01 09:45:45 1.25
+++ private_builtin.m 1999/06/04 05:44:56
@@ -291,7 +291,7 @@
Code *f2;
Code *f3;
Code *f4;
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -304,10 +304,9 @@
mercury____Index___private_builtin__type_info_1_0)),
MR_MAYBE_STATIC_CODE(ENTRY(
mercury____Compare___private_builtin__type_info_1_0)),
+ MR_TYPECTOR_REP_TYPEINFO,
(const Word *) &
- mercury_data_private_builtin__type_ctor_layout_type_info_1,
- (const Word *) &
- mercury_data_private_builtin__type_ctor_functors_type_info_1,
+ mercury_data_private_builtin__type_ctor_functors_type_info_1,
(const Word *) &
mercury_data_private_builtin__type_ctor_layout_type_info_1,
(const Word *) string_const(""private_builtin"", 15),
@@ -320,7 +319,7 @@
Code *f2;
Code *f3;
Code *f4;
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -333,8 +332,7 @@
mercury____Index___private_builtin__type_info_1_0)),
MR_MAYBE_STATIC_CODE(ENTRY(
mercury____Compare___private_builtin__type_info_1_0)),
- (const Word *) &
- mercury_data_private_builtin__type_ctor_layout_type_info_1,
+ MR_TYPECTOR_REP_TYPEINFO,
(const Word *) &
mercury_data_private_builtin__type_ctor_functors_type_info_1,
(const Word *) &
@@ -374,7 +372,7 @@
Code *f2;
Code *f3;
Code *f4;
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -387,9 +385,8 @@
mercury____Index___private_builtin__typeclass_info_1_0)),
MR_MAYBE_STATIC_CODE(ENTRY(
mercury____Compare___private_builtin__typeclass_info_1_0)),
+ MR_TYPECTOR_REP_TYPECLASSINFO,
(const Word *) &
- mercury_data_private_builtin__type_ctor_layout_typeclass_info_1,
- (const Word *) &
mercury_data_private_builtin__type_ctor_functors_typeclass_info_1,
(const Word *) &
mercury_data_private_builtin__type_ctor_layout_typeclass_info_1,
@@ -403,7 +400,7 @@
Code *f2;
Code *f3;
Code *f4;
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
@@ -416,8 +413,7 @@
mercury____Index___private_builtin__typeclass_info_1_0)),
MR_MAYBE_STATIC_CODE(ENTRY(
mercury____Compare___private_builtin__typeclass_info_1_0)),
- (const Word *) &
- mercury_data_private_builtin__type_ctor_layout_typeclass_info_1,
+ MR_TYPECTOR_REP_TYPECLASSINFO,
(const Word *) &
mercury_data_private_builtin__type_ctor_functors_typeclass_info_1,
(const Word *) &
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.149
diff -u -r1.149 std_util.m
--- std_util.m 1999/06/02 10:05:00 1.149
+++ std_util.m 1999/06/22 06:10:51
@@ -1073,7 +1073,7 @@
Code * f2;
Code * f3;
Code * f4;
- Word * f5;
+ Word f5;
Word * f6;
Word * f7;
Word * f8;
@@ -1083,7 +1083,7 @@
ENTRY(mercury____Unify___std_util__univ_0_0),
ENTRY(mercury____Index___std_util__univ_0_0),
ENTRY(mercury____Compare___std_util__univ_0_0),
- (Word *) &mercury_data_std_util__type_ctor_layout_univ_0,
+ MR_TYPECTOR_REP_UNIV,
(Word *) &mercury_data_std_util__type_ctor_functors_univ_0,
(Word *) &mercury_data_std_util__type_ctor_layout_univ_0,
string_const(""std_util"", 8),
@@ -1313,7 +1313,8 @@
Word term_vector);
bool ML_typecheck_arguments(Word type_info, int arity,
Word arg_list, Word* arg_vector);
-Word ML_make_type(int arity, Word *type_ctor_info, Word arg_type_list);
+Word ML_make_type(int arity, MR_TypeCtorInfo type_ctor_info,
+ Word arg_type_list);
").
@@ -1426,13 +1427,14 @@
:- pragma c_code(type_ctor(TypeInfo::in) = (TypeCtor::out),
will_not_call_mercury, "
{
- Word *type_info, *type_ctor_info;
+ MR_TypeCtorInfo type_ctor_info;
+ Word *type_info;
save_transient_registers();
type_info = (Word *) MR_collapse_equivalences(TypeInfo);
restore_transient_registers();
- type_ctor_info = (Word *) MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
TypeCtor = ML_make_ctor_info(type_info, type_ctor_info);
}
@@ -1440,7 +1442,7 @@
:- pragma c_header_code("
-Word ML_make_ctor_info(Word *type_info, Word *type_ctor_info);
+Word ML_make_ctor_info(Word *type_info, MR_TypeCtorInfo type_ctor_info);
/*
** Several predicates use these (the MR_TYPE_CTOR_INFO_IS_HO_*
@@ -1455,7 +1457,7 @@
:- pragma c_code("
-Word ML_make_ctor_info(Word *type_info, Word *type_ctor_info)
+Word ML_make_ctor_info(Word *type_info, MR_TypeCtorInfo type_ctor_info)
{
Word ctor_info = (Word) type_ctor_info;
@@ -1483,7 +1485,8 @@
:- pragma c_code(type_ctor_and_args(TypeInfo::in,
TypeCtor::out, TypeArgs::out), will_not_call_mercury, "
{
- Word *type_info, *type_ctor_info;
+ MR_TypeCtorInfo type_ctor_info;
+ Word *type_info;
Integer arity;
save_transient_registers();
@@ -1519,9 +1522,9 @@
{
int list_length, arity;
Word arg_type;
- Word *type_ctor_info;
+ MR_TypeCtorInfo type_ctor_info;
- type_ctor_info = (Word *) TypeCtor;
+ type_ctor_info = (MR_TypeCtorInfo) TypeCtor;
if (MR_TYPECTOR_IS_HIGHER_ORDER(type_ctor_info)) {
arity = MR_TYPECTOR_GET_HOT_ARITY(type_ctor_info);
@@ -1555,7 +1558,8 @@
will_not_call_mercury, "
{
Word *type_info = (Word *) TypeInfo;
- Word *type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ MR_TypeCtorInfo type_ctor_info =
+ MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
Integer arity;
TypeCtor = ML_make_ctor_info(type_info, type_ctor_info);
@@ -1579,7 +1583,7 @@
TypeCtorModuleName::out, TypeCtorName::out,
TypeCtorArity::out), will_not_call_mercury, "
{
- Word *type_ctor = (Word *) TypeCtor;
+ MR_TypeCtorInfo type_ctor = (MR_TypeCtorInfo) TypeCtor;
if (MR_TYPECTOR_IS_HIGHER_ORDER(type_ctor)) {
TypeCtorName = (String) (Word)
@@ -1938,7 +1942,7 @@
*/
Word
-ML_make_type(int arity, Word *type_ctor, Word arg_types_list)
+ML_make_type(int arity, MR_TypeCtorInfo type_ctor, Word arg_types_list)
{
int i, extra_args;
Word type_ctor_info;
@@ -2205,105 +2209,109 @@
void
ML_expand(Word* type_info, Word *data_word_ptr, ML_Expand_Info *info)
{
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TypeCtorLayout type_ctor_layout;
+ MR_TypeCtorFunctors type_ctor_functors;
Code *compare_pred;
- Word *type_ctor_info, *type_ctor_functors;
- Word data_value, entry_value, type_ctor_layout_entry, functors_indicator;
- int data_tag, entry_tag;
- Word data_word;
- enum MR_DataRepresentation data_rep;
+ Word layout_for_tag, layout_vector_for_tag;
+ Word data_value, data_word;
+ int data_tag;
+ MR_DiscUnionTagRepresentation tag_rep;
+
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ type_ctor_layout = MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_LAYOUT(type_ctor_info);
+ type_ctor_functors = MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_FUNCTORS(
+ type_ctor_info);
- compare_pred = (Code *) type_ctor_info[OFFSET_FOR_COMPARE_PRED];
+ compare_pred = type_ctor_info->compare_pred;
info->non_canonical_type = ( compare_pred ==
ENTRY(mercury__builtin_compare_non_canonical_type_3_0) );
data_word = *data_word_ptr;
data_tag = tag(data_word);
data_value = body(data_word, data_tag);
-
- type_ctor_layout_entry = MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_LAYOUT_ENTRY(
- type_ctor_info, data_tag);
- type_ctor_functors = MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_FUNCTORS(type_ctor_info);
- functors_indicator = MR_TYPE_CTOR_FUNCTORS_INDICATOR(type_ctor_functors);
-
- data_rep = MR_categorize_data(functors_indicator, type_ctor_layout_entry);
-
- entry_value = strip_tag(type_ctor_layout_entry);
-
- switch(data_rep) {
+ layout_for_tag = type_ctor_layout[data_tag];
+ layout_vector_for_tag = (Word *) strip_tag(layout_for_tag);
+
+ switch(type_ctor_info->type_ctor_rep) {
- case MR_DATAREP_ENUM:
+ case MR_TYPECTOR_REP_ENUM:
info->functor = MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
- entry_value, data_word);
+ layout_vector_for_tag, data_word);
info->arity = 0;
info->argument_vector = NULL;
info->type_info_vector = NULL;
break;
- case MR_DATAREP_SHARED_LOCAL:
- data_value = unmkbody(data_value);
- info->functor = MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
- entry_value, data_value);
- info->arity = 0;
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- break;
+ case MR_TYPECTOR_REP_DU:
+ tag_rep = MR_get_tag_representation((Word) layout_for_tag);
+ switch(tag_rep) {
+ case MR_DISCUNIONTAG_SHARED_LOCAL:
+ data_value = unmkbody(data_value);
+ info->functor = MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
+ layout_vector_for_tag, data_value);
+ info->arity = 0;
+ info->argument_vector = NULL;
+ info->type_info_vector = NULL;
+ break;
- case MR_DATAREP_SHARED_REMOTE: {
- Word secondary_tag;
+ case MR_DISCUNIONTAG_SHARED_REMOTE: {
+ Word secondary_tag;
- secondary_tag = ((Word *) data_value)[0];
+ secondary_tag = ((Word *) data_value)[0];
/*
** Look past the secondary tag, and get the functor
** descriptor, then we can just use the code for
** unshared tags.
*/
- data_value = (Word) ((Word *) data_value + 1);
- entry_value = (Word)
- MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_GET_FUNCTOR_DESCRIPTOR(
- entry_value, secondary_tag);
- entry_value = strip_tag(entry_value);
- } /* fallthru */
-
- case MR_DATAREP_UNSHARED: /* fallthru */
- {
- int i;
- Word * functor_descriptor = (Word *) entry_value;
-
- info->arity =
- MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(functor_descriptor);
+ data_value = (Word) ((Word *) data_value + 1);
+ layout_for_tag = (Word)
+ MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_GET_FUNCTOR_DESCRIPTOR(
+ layout_vector_for_tag, secondary_tag);
+ layout_vector_for_tag = strip_tag(layout_for_tag);
+ } /* fallthru */
+
+ case MR_DISCUNIONTAG_UNSHARED: /* fallthru */
+ {
+ int i;
+ Word * functor_descriptor = (Word *) layout_vector_for_tag;
+
+ info->arity =
+ MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(functor_descriptor);
- if (info->need_functor) {
- make_aligned_string(info->functor,
- MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_FUNCTOR_NAME(
- functor_descriptor));
- }
-
- if (info->need_args) {
- info->argument_vector = (Word *) data_value;
+ if (info->need_functor) {
+ make_aligned_string(info->functor,
+ MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_FUNCTOR_NAME(
+ functor_descriptor));
+ }
- info->type_info_vector = newmem(info->arity * sizeof(Word));
+ if (info->need_args) {
+ info->argument_vector = (Word *) data_value;
+
+ info->type_info_vector = newmem(info->arity * sizeof(Word));
- for (i = 0; i < info->arity ; i++) {
- Word *arg_pseudo_type_info;
+ for (i = 0; i < info->arity ; i++) {
+ Word *arg_pseudo_type_info;
- arg_pseudo_type_info = (Word *)
- MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARGS(
- functor_descriptor)[i];
- info->type_info_vector[i] = (Word) MR_create_type_info(
- type_info, arg_pseudo_type_info);
+ arg_pseudo_type_info = (Word *)
+ MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARGS(
+ functor_descriptor)[i];
+ info->type_info_vector[i] = (Word) MR_create_type_info(
+ type_info, arg_pseudo_type_info);
+ }
}
+ break;
}
- break;
- }
+ }
+ break;
- case MR_DATAREP_NOTAG:
+ case MR_TYPECTOR_REP_NOTAG:
{
int i;
- Word * functor_descriptor = (Word *) entry_value;
+ Word * functor_descriptor = (Word *) layout_vector_for_tag;
data_value = (Word) data_word_ptr;
@@ -2338,24 +2346,24 @@
}
break;
}
- case MR_DATAREP_EQUIV: {
+ case MR_TYPECTOR_REP_EQUIV: {
Word *equiv_type_info;
equiv_type_info = MR_create_type_info(type_info,
(Word *) MR_TYPE_CTOR_LAYOUT_EQUIV_TYPE(
- entry_value));
+ layout_vector_for_tag));
ML_expand(equiv_type_info, data_word_ptr, info);
break;
}
- case MR_DATAREP_EQUIV_VAR: {
+ case MR_TYPECTOR_REP_EQUIV_VAR: {
Word *equiv_type_info;
equiv_type_info = MR_create_type_info(type_info,
- (Word *) entry_value);
+ (Word *) layout_vector_for_tag);
ML_expand(equiv_type_info, data_word_ptr, info);
break;
}
- case MR_DATAREP_INT:
+ case MR_TYPECTOR_REP_INT:
if (info->need_functor) {
char buf[500];
char *str;
@@ -2372,7 +2380,7 @@
info->arity = 0;
break;
- case MR_DATAREP_CHAR:
+ case MR_TYPECTOR_REP_CHAR:
/* XXX should escape characters correctly */
if (info->need_functor) {
char *str;
@@ -2387,7 +2395,7 @@
info->arity = 0;
break;
- case MR_DATAREP_FLOAT:
+ case MR_TYPECTOR_REP_FLOAT:
if (info->need_functor) {
char buf[500];
Float f;
@@ -2405,7 +2413,7 @@
info->arity = 0;
break;
- case MR_DATAREP_STRING:
+ case MR_TYPECTOR_REP_STRING:
/* XXX should escape characters correctly */
if (info->need_functor) {
char *str;
@@ -2421,7 +2429,7 @@
info->arity = 0;
break;
- case MR_DATAREP_PRED:
+ case MR_TYPECTOR_REP_PRED:
if (info->need_functor) {
make_aligned_string(info->functor, ""<<predicate>>"");
}
@@ -2430,7 +2438,7 @@
info->arity = 0;
break;
- case MR_DATAREP_UNIV:
+ case MR_TYPECTOR_REP_UNIV:
/*
* Univ is a two word structure, containing
* type_info and data.
@@ -2440,14 +2448,14 @@
&((Word *) data_word)[UNIV_OFFSET_FOR_DATA], info);
break;
- case MR_DATAREP_VOID:
+ case MR_TYPECTOR_REP_VOID:
/*
** There's no way to create values of type `void',
** so this should never happen.
*/
fatal_error(""ML_expand: cannot expand void types"");
- case MR_DATAREP_ARRAY:
+ case MR_TYPECTOR_REP_ARRAY:
if (info->need_functor) {
make_aligned_string(info->functor, ""<<array>>"");
}
@@ -2457,7 +2465,7 @@
info->arity = 0;
break;
- case MR_DATAREP_TYPEINFO:
+ case MR_TYPECTOR_REP_TYPEINFO:
if (info->need_functor) {
make_aligned_string(info->functor, ""<<typeinfo>>"");
}
@@ -2467,7 +2475,7 @@
info->arity = 0;
break;
- case MR_DATAREP_C_POINTER:
+ case MR_TYPECTOR_REP_C_POINTER:
if (info->need_functor) {
make_aligned_string(info->functor, ""<<c_pointer>>"");
}
@@ -2476,7 +2484,7 @@
info->arity = 0;
break;
- case MR_DATAREP_UNKNOWN: /* fallthru */
+ case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
default:
fatal_error(""ML_expand: cannot expand -- unknown data type"");
break;
Index: runtime/mercury_bootstrap.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_bootstrap.c,v
retrieving revision 1.12
diff -u -r1.12 mercury_bootstrap.c
--- mercury_bootstrap.c 1999/06/24 04:32:17 1.12
+++ mercury_bootstrap.c 1999/06/24 06:41:24
@@ -55,7 +55,7 @@
ENTRY(mercury____Unify___builtin__c_pointer_0_0_bootstrap),
ENTRY(mercury____Index___builtin__c_pointer_0_0_bootstrap),
ENTRY(mercury____Compare___builtin__c_pointer_0_0_bootstrap),
- MR_TYPE_CTOR_REP_C_POINTER,
+ MR_TYPECTOR_REP_C_POINTER,
(Word *) &mercury_data_builtin__type_ctor_functors_c_pointer_0_bootstrap,
(Word *) &mercury_data_builtin__type_ctor_layout_c_pointer_0_bootstrap,
string_const("builtin", 7),
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.9
diff -u -r1.9 mercury_deep_copy_body.h
--- mercury_deep_copy_body.h 1999/04/22 01:04:29 1.9
+++ mercury_deep_copy_body.h 1999/06/22 22:06:49
@@ -26,10 +26,14 @@
copy(maybeconst Word *data_ptr, const Word *type_info,
const Word *lower_limit, const Word *upper_limit)
{
- Word *type_ctor_info, *type_ctor_layout, *type_ctor_functors;
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TypeCtorLayout type_ctor_layout;
+ MR_TypeCtorFunctors type_ctor_functors;
+
Word functors_indicator;
Word layout_entry, *entry_value, *data_value;
- enum MR_DataRepresentation data_rep;
+ MR_TypeCtorRepresentation type_ctor_rep;
+ MR_DiscUnionTagRepresentation tag_rep;
int data_tag;
Word new_data, data;
@@ -39,123 +43,125 @@
data_value = (Word *) body(data, data_tag);
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
- type_ctor_layout = MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_LAYOUT(type_ctor_info);
- layout_entry = type_ctor_layout[data_tag];
-
- type_ctor_functors = MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_FUNCTORS(type_ctor_info);
- functors_indicator = MR_TYPE_CTOR_FUNCTORS_INDICATOR(type_ctor_functors);
-
+ layout_entry = type_ctor_info->type_ctor_layout[data_tag];
entry_value = (Word *) strip_tag(layout_entry);
- data_rep = MR_categorize_data(functors_indicator, layout_entry);
-
- switch (data_rep) {
- case MR_DATAREP_ENUM: /* fallthru */
- case MR_DATAREP_SHARED_LOCAL:
+ switch (type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_ENUM:
new_data = data; /* just a copy of the actual item */
- break;
+ break;
- case MR_DATAREP_SHARED_REMOTE: {
- Word secondary_tag;
- Word *new_entry;
- Word *argument_vector, *type_info_vector;
- int arity, i;
+ case MR_TYPECTOR_REP_DU:
+ tag_rep = MR_get_tag_representation(layout_entry);
+ switch (tag_rep) {
- /*
- ** 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;
+ case MR_DISCUNIONTAG_SHARED_LOCAL:
+ new_data = data; /* just a copy of the actual item */
+ break;
- new_entry = MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_GET_FUNCTOR_DESCRIPTOR(
- entry_value, secondary_tag);
- arity = new_entry[TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET];
- type_info_vector = new_entry +
- TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET;
+ case MR_DISCUNIONTAG_SHARED_REMOTE: {
+ Word secondary_tag;
+ Word *new_entry;
+ Word *argument_vector, *type_info_vector;
+ int arity, i;
- /* allocate space for new args, and secondary tag */
- incr_saved_hp(new_data, arity + 1);
+ /*
+ ** 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;
- /* copy secondary tag */
- field(0, new_data, 0) = secondary_tag;
+ new_entry = MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_GET_FUNCTOR_DESCRIPTOR(
+ entry_value, secondary_tag);
+ arity = new_entry[TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET];
+ type_info_vector = new_entry +
+ TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET;
+
+ /* allocate space for new args, and secondary tag */
+ incr_saved_hp(new_data, arity + 1);
+
+ /* copy secondary tag */
+ field(0, new_data, 0) = secondary_tag;
+
+ /* copy arguments */
+ for (i = 0; i < arity; i++) {
+ field(0, new_data, i + 1) = copy_arg(
+ &argument_vector[i], type_info,
+ (Word *) type_info_vector[i], lower_limit,
+ upper_limit);
+ }
- /* copy arguments */
- for (i = 0; i < arity; i++) {
- field(0, new_data, i + 1) = copy_arg(
- &argument_vector[i], type_info,
- (Word *) type_info_vector[i], lower_limit,
- upper_limit);
+ /* tag this pointer */
+ new_data = (Word) mkword(data_tag, new_data);
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
}
-
- /* tag this pointer */
- new_data = (Word) mkword(data_tag, new_data);
- leave_forwarding_pointer(data_ptr, new_data);
- } else {
- new_data = data;
- found_forwarding_pointer(data);
- }
break;
- }
-
- case MR_DATAREP_UNSHARED: {
- int arity, i;
- Word *argument_vector, *type_info_vector;
- argument_vector = data_value;
-
- /* If the argument vector is in range, copy the arguments */
- if (in_range(argument_vector)) {
- arity = entry_value[TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET];
- type_info_vector = entry_value +
- TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET;
-
- /* allocate space for new args. */
- incr_saved_hp(new_data, arity);
+ }
- /* copy arguments */
- for (i = 0; i < arity; i++) {
- field(0, new_data, i) = copy_arg(&argument_vector[i],
- type_info, (Word *) type_info_vector[i], lower_limit,
- upper_limit);
+ case MR_DISCUNIONTAG_UNSHARED: {
+ int arity, i;
+ Word *argument_vector, *type_info_vector;
+ argument_vector = data_value;
+
+ /* If the argument vector is in range, copy the arguments */
+ if (in_range(argument_vector)) {
+ arity = entry_value[TYPE_CTOR_LAYOUT_UNSHARED_ARITY_OFFSET];
+ type_info_vector = entry_value +
+ TYPE_CTOR_LAYOUT_UNSHARED_ARGS_OFFSET;
+
+ /* allocate space for new args. */
+ incr_saved_hp(new_data, arity);
+
+ /* copy arguments */
+ for (i = 0; i < arity; i++) {
+ field(0, new_data, i) = copy_arg(&argument_vector[i],
+ type_info, (Word *) type_info_vector[i], lower_limit,
+ upper_limit);
+ }
+ /* tag this pointer */
+ new_data = (Word) mkword(data_tag, new_data);
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
}
- /* tag this pointer */
- new_data = (Word) mkword(data_tag, new_data);
- leave_forwarding_pointer(data_ptr, new_data);
- } else {
- new_data = data;
- found_forwarding_pointer(data);
+ break;
}
- break;
- }
-
- case MR_DATAREP_NOTAG:
+ }
+ break;
+ case MR_TYPECTOR_REP_NOTAG:
new_data = copy_arg(data_ptr, type_info,
- (Word *) *MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(entry_value),
- lower_limit, upper_limit);
+ (Word *) *MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(
+ entry_value), lower_limit, upper_limit);
break;
- case MR_DATAREP_EQUIV:
+ case MR_TYPECTOR_REP_EQUIV:
new_data = copy_arg(data_ptr, type_info,
(const Word *) MR_TYPE_CTOR_LAYOUT_EQUIV_TYPE((Word *)
entry_value), lower_limit, upper_limit);
break;
- case MR_DATAREP_EQUIV_VAR:
+ case MR_TYPECTOR_REP_EQUIV_VAR:
new_data = copy(data_ptr, (Word *) type_info[(Word) entry_value],
lower_limit, upper_limit);
break;
- case MR_DATAREP_INT:
- case MR_DATAREP_CHAR:
+ case MR_TYPECTOR_REP_INT:
+ case MR_TYPECTOR_REP_CHAR:
new_data = data;
break;
- case MR_DATAREP_FLOAT:
+ case MR_TYPECTOR_REP_FLOAT:
#ifdef BOXED_FLOAT
if (in_range(data_value)) {
- incr_saved_hp(new_data, FLOAT_WORDS);
- field(0, new_data, 0) = *data_value;
+ new_data = word_to_float(float_to_word(data));
+// incr_saved_hp(new_data, FLOAT_WORDS);
+// field(0, new_data, 0) = *data_value;
leave_forwarding_pointer(data_ptr, new_data);
} else {
new_data = data;
@@ -166,7 +172,7 @@
#endif
break;
- case MR_DATAREP_STRING:
+ case MR_TYPECTOR_REP_STRING:
if (in_range(data_value)) {
incr_saved_hp_atomic(new_data,
(strlen((String) data) + sizeof(Word)) / sizeof(Word));
@@ -178,7 +184,7 @@
}
break;
- case MR_DATAREP_PRED: {
+ case MR_TYPECTOR_REP_PRED: {
/*
** predicate closures store the number of curried arguments
** as their first argument, the Code * as their second, and
@@ -230,7 +236,7 @@
}
break;
- case MR_DATAREP_UNIV:
+ case MR_TYPECTOR_REP_UNIV:
/* if the univ is stored in range, copy it */
if (in_range(data_value)) {
Word *new_data_ptr;
@@ -260,11 +266,11 @@
}
break;
- case MR_DATAREP_VOID:
+ case MR_TYPECTOR_REP_VOID:
fatal_error("Cannot copy a void type");
break;
- case MR_DATAREP_ARRAY: {
+ case MR_TYPECTOR_REP_ARRAY: {
int i;
if (in_range(data_value)) {
@@ -290,12 +296,12 @@
break;
}
- case MR_DATAREP_TYPEINFO:
+ case MR_TYPECTOR_REP_TYPEINFO:
new_data = (Word) copy_type_info(data_ptr,
lower_limit, upper_limit);
break;
- case MR_DATAREP_C_POINTER:
+ case MR_TYPECTOR_REP_C_POINTER:
if (in_range(data_value)) {
/*
** This error occurs if we try to copy() a
@@ -308,7 +314,7 @@
}
break;
- case MR_DATAREP_UNKNOWN: /* fallthru */
+ case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
default:
fatal_error("Unknown layout type in deep copy");
break;
@@ -349,7 +355,7 @@
Word *type_info = (Word *) *type_info_ptr;
if (in_range(type_info)) {
- Word *type_ctor_info;
+ MR_TypeCtorInfo type_ctor_info;
Word *new_type_info;
Integer arity, offset, i;
@@ -365,8 +371,8 @@
** we don't need to construct a type_info; instead,
** we can just return the type_ctor_info.
*/
- if (type_info == type_ctor_info) {
- return type_ctor_info;
+ if ((Word) type_info == (Word) type_ctor_info) {
+ return (Word *) type_ctor_info;
}
if (MR_TYPE_CTOR_INFO_IS_HO(type_ctor_info)) {
arity = MR_TYPEINFO_GET_HIGHER_ARITY(type_info);
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.5
diff -u -r1.5 mercury_tabling.c
--- mercury_tabling.c 1999/06/01 09:46:07 1.5
+++ mercury_tabling.c 1999/06/28 01:09:14
@@ -460,11 +460,15 @@
MR_TrieNode
MR_table_type(MR_TrieNode table, Word *type_info, Word data)
{
- Word *type_ctor_info, *type_ctor_layout, *type_ctor_functors;
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TypeCtorLayout type_ctor_layout;
+ MR_TypeCtorFunctors type_ctor_functors;
+
Word layout_for_tag, *layout_vector_for_tag, *data_value;
- enum MR_DataRepresentation data_rep;
int data_tag, entry_tag;
+ MR_DiscUnionTagRepresentation tag_rep;
+
MR_MemoryList allocated_memory_cells = NULL;
data_tag = tag(data);
@@ -477,80 +481,83 @@
layout_for_tag = type_ctor_layout[data_tag];
layout_vector_for_tag = (Word *) strip_tag(layout_for_tag);
- data_rep = MR_categorize_data(MR_TYPE_CTOR_FUNCTORS_INDICATOR(type_ctor_functors),
- layout_for_tag);
-
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
printf("ENTRY %p %x, data rep: %d\n", table, data, data_rep);
}
#endif /* MR_TABLE_DEBUG */
- switch (data_rep) {
- case MR_DATAREP_ENUM: {
+ switch (type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_ENUM: {
int functors = MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_NUM_FUNCTORS(
layout_vector_for_tag);
MR_DEBUG_TABLE_ENUM(table, functors, data);
break;
}
- case MR_DATAREP_SHARED_LOCAL: {
- int functors = MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_NUM_FUNCTORS(
+ case MR_TYPECTOR_REP_DU: {
+ 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, unmkbody(data));
- break;
- }
- case MR_DATAREP_UNSHARED: {
- int arity, i;
- Word *argument_vector, *type_info_vector, *new_type_info;
-
- argument_vector = data_value;
-
- 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]);
+ MR_DEBUG_TABLE_TAG(table, data_tag);
+ MR_DEBUG_TABLE_ENUM(table, functors, unmkbody(data));
+ break;
}
- break;
- }
- case MR_DATAREP_SHARED_REMOTE: {
- int arity, i;
- Word *argument_vector, *type_info_vector, *new_type_info;
- Word secondary_tag, num_sharers, *new_layout_vector;
+ case MR_DISCUNIONTAG_UNSHARED: {
+ int arity, i;
+ Word *argument_vector, *type_info_vector, *new_type_info;
+
+ argument_vector = data_value;
+
+ 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, *type_info_vector, *new_type_info;
+ Word secondary_tag, num_sharers, *new_layout_vector;
- secondary_tag = *data_value;
- argument_vector = data_value + 1;
+ secondary_tag = *data_value;
+ argument_vector = data_value + 1;
- num_sharers = MR_TYPE_CTOR_LAYOUT_SHARED_REMOTE_VECTOR_NUM_SHARERS(
+ 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(
+ 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 =
+ 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);
+ 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]);
+ 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;
}
- break;
- }
- case MR_DATAREP_NOTAG: {
+ }
+ break;
+ }
+ case MR_TYPECTOR_REP_NOTAG: {
Word *new_type_info;
new_type_info = MR_make_type_info(type_info,
(Word *) *MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(
@@ -559,7 +566,7 @@
MR_DEBUG_TABLE_ANY(table, new_type_info, data);
break;
}
- case MR_DATAREP_EQUIV: {
+ case MR_TYPECTOR_REP_EQUIV: {
Word *new_type_info;
new_type_info = MR_make_type_info(type_info,
(Word *) MR_TYPE_CTOR_LAYOUT_EQUIV_TYPE(layout_vector_for_tag),
@@ -567,28 +574,28 @@
MR_DEBUG_TABLE_ANY(table, new_type_info, data);
break;
}
- case MR_DATAREP_EQUIV_VAR:
+ case MR_TYPECTOR_REP_EQUIV_VAR:
MR_DEBUG_TABLE_ANY(table,
(Word *) type_info[(Word) layout_vector_for_tag], data);
break;
- case MR_DATAREP_INT:
+ case MR_TYPECTOR_REP_INT:
MR_DEBUG_TABLE_INT(table, data);
break;
- case MR_DATAREP_CHAR:
+ case MR_TYPECTOR_REP_CHAR:
MR_DEBUG_TABLE_CHAR(table, data);
break;
- case MR_DATAREP_FLOAT:
+ case MR_TYPECTOR_REP_FLOAT:
MR_DEBUG_TABLE_FLOAT(table, data);
break;
- case MR_DATAREP_STRING:
+ case MR_TYPECTOR_REP_STRING:
MR_DEBUG_TABLE_STRING(table, data);
break;
- case MR_DATAREP_PRED: {
+ case MR_TYPECTOR_REP_PRED: {
int i;
Word args = data_value[0];
@@ -602,7 +609,7 @@
}
break;
}
- case MR_DATAREP_UNIV:
+ case MR_TYPECTOR_REP_UNIV:
MR_DEBUG_TABLE_TYPEINFO(table,
(Word *) data_value[UNIV_OFFSET_FOR_TYPEINFO]);
MR_DEBUG_TABLE_ANY(table,
@@ -610,11 +617,11 @@
data_value[UNIV_OFFSET_FOR_DATA]);
break;
- case MR_DATAREP_VOID:
+ case MR_TYPECTOR_REP_VOID:
fatal_error("Cannot table a void type");
break;
- case MR_DATAREP_ARRAY: {
+ case MR_TYPECTOR_REP_ARRAY: {
int i;
MR_ArrayType *array;
Word *new_type_info;
@@ -631,15 +638,15 @@
}
break;
}
- case MR_DATAREP_TYPEINFO:
+ case MR_TYPECTOR_REP_TYPEINFO:
MR_DEBUG_TABLE_TYPEINFO(table, (Word *) data_value);
break;
- case MR_DATAREP_C_POINTER:
+ case MR_TYPECTOR_REP_C_POINTER:
fatal_error("Attempt to use a C_POINTER tag in table");
break;
- case MR_DATAREP_UNKNOWN: /* fallthru */
+ case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
default:
fatal_error("Unknown layout tag in table_any");
break;
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.19
diff -u -r1.19 mercury_type_info.c
--- mercury_type_info.c 1999/04/22 01:04:31 1.19
+++ mercury_type_info.c 1999/06/22 06:50:43
@@ -55,25 +55,21 @@
Code *f2;
Code *f3;
Code *f4;
-#ifdef USE_TYPE_LAYOUT
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
const Word *f9;
-#endif
} mercury_data___type_ctor_info_func_0 = {
((Integer) 0),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_pred_3_0)),
-#ifdef USE_TYPE_LAYOUT
- (const Word *) & mercury_data___type_ctor_layout_pred_0,
+ MR_TYPECTOR_REP_PRED,
(const Word *) & mercury_data___type_ctor_functors_pred_0,
(const Word *) & mercury_data___type_ctor_layout_pred_0,
(const Word *) string_const("builtin", 7),
(const Word *) string_const("func", 4)
-#endif
};
/*
@@ -89,25 +85,21 @@
Code *f2;
Code *f3;
Code *f4;
-#ifdef USE_TYPE_LAYOUT
- const Word *f5;
+ Word f5;
const Word *f6;
const Word *f7;
const Word *f8;
const Word *f9;
-#endif
} mercury_data___type_ctor_info_pred_0 = {
((Integer) 0),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_pred_2_0)),
MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_pred_3_0)),
-#ifdef USE_TYPE_LAYOUT
- (const Word *) & mercury_data___type_ctor_layout_pred_0,
+ MR_TYPECTOR_REP_PRED,
(const Word *) & mercury_data___type_ctor_functors_pred_0,
(const Word *) & mercury_data___type_ctor_layout_pred_0,
(const Word *) string_const("builtin", 7),
(const Word *) string_const("pred", 4)
-#endif
};
Define_extern_entry(mercury__builtin_unify_pred_2_0);
@@ -184,7 +176,7 @@
MR_create_type_info(Word *term_type_info, Word *arg_pseudo_type_info)
{
int i, arity, extra_args;
- Word *type_ctor_info;
+ MR_TypeCtorInfo type_ctor_info;
Word *arg_type_info;
Word *type_info;
@@ -207,7 +199,7 @@
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(arg_pseudo_type_info);
/* no arguments - optimise common case */
- if (type_ctor_info == arg_pseudo_type_info) {
+ if ((Word) type_ctor_info == (Word) arg_pseudo_type_info) {
return arg_pseudo_type_info;
}
@@ -270,7 +262,7 @@
MR_compare_type_info(Word t1, Word t2)
{
Word *type_info_1, *type_info_2;
- Word *type_ctor_info_1, *type_ctor_info_2;
+ MR_TypeCtorInfo type_ctor_info_1, type_ctor_info_2;
int num_arg_types;
int i;
@@ -456,7 +448,7 @@
MR_MemoryList *allocated)
{
int i, arity, extra_args;
- Word *type_ctor_info;
+ MR_TypeCtorInfo type_ctor_info;
Word *arg_type_info;
Word *type_info;
@@ -477,8 +469,8 @@
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(arg_pseudo_type_info);
/* no arguments - optimise common case */
- if (type_ctor_info == arg_pseudo_type_info) {
- return type_ctor_info;
+ if ((Word) type_ctor_info == (Word) arg_pseudo_type_info) {
+ return (Word *) type_ctor_info;
}
if (MR_TYPE_CTOR_INFO_IS_HO(type_ctor_info)) {
@@ -542,72 +534,20 @@
/*---------------------------------------------------------------------------*/
-enum MR_DataRepresentation
-MR_categorize_data(Word functors_indicator, Word layout_entry)
+enum MR_DiscUnionTagRepresentation
+MR_get_tag_representation(Word layout_entry)
{
- switch ((int) functors_indicator) {
- case MR_TYPE_CTOR_FUNCTORS_ENUM:
- return MR_DATAREP_ENUM;
- case MR_TYPE_CTOR_FUNCTORS_DU:
- switch ((int) tag(layout_entry)) {
- case TYPE_CTOR_LAYOUT_UNSHARED_TAG:
- return MR_DATAREP_UNSHARED;
- case TYPE_CTOR_LAYOUT_SHARED_REMOTE_TAG:
- return MR_DATAREP_SHARED_REMOTE;
- case TYPE_CTOR_LAYOUT_CONST_TAG:
- return MR_DATAREP_SHARED_LOCAL;
- default:
- return MR_DATAREP_UNKNOWN;
- }
- case MR_TYPE_CTOR_FUNCTORS_NO_TAG:
- return MR_DATAREP_NOTAG;
- case MR_TYPE_CTOR_FUNCTORS_EQUIV:
- if (TYPEINFO_IS_VARIABLE(strip_tag(layout_entry))) {
- return MR_DATAREP_EQUIV_VAR;
- } else {
- return MR_DATAREP_EQUIV;
- }
- case MR_TYPE_CTOR_FUNCTORS_SPECIAL:
- {
- int builtin_type = unmkbody(strip_tag(layout_entry));
-
- switch (builtin_type) {
- case MR_TYPE_CTOR_LAYOUT_UNASSIGNED_VALUE:
- return MR_DATAREP_UNKNOWN;
- case MR_TYPE_CTOR_LAYOUT_UNUSED_VALUE:
- return MR_DATAREP_UNKNOWN;
- case MR_TYPE_CTOR_LAYOUT_STRING_VALUE:
- return MR_DATAREP_STRING;
- case MR_TYPE_CTOR_LAYOUT_FLOAT_VALUE:
- return MR_DATAREP_FLOAT;
- case MR_TYPE_CTOR_LAYOUT_INT_VALUE:
- return MR_DATAREP_INT;
- case MR_TYPE_CTOR_LAYOUT_CHARACTER_VALUE:
- return MR_DATAREP_CHAR;
- case MR_TYPE_CTOR_LAYOUT_PREDICATE_VALUE:
- return MR_DATAREP_PRED;
- case MR_TYPE_CTOR_LAYOUT_VOID_VALUE:
- return MR_DATAREP_VOID;
- case MR_TYPE_CTOR_LAYOUT_ARRAY_VALUE:
- return MR_DATAREP_ARRAY;
- case MR_TYPE_CTOR_LAYOUT_TYPEINFO_VALUE:
- return MR_DATAREP_TYPEINFO;
- case MR_TYPE_CTOR_LAYOUT_C_POINTER_VALUE:
- return MR_DATAREP_C_POINTER;
- case MR_TYPE_CTOR_LAYOUT_TYPECLASSINFO_VALUE:
- return MR_DATAREP_TYPECLASSINFO;
- default:
- return MR_DATAREP_UNKNOWN;
- }
- }
- case MR_TYPE_CTOR_FUNCTORS_UNIV:
- return MR_DATAREP_UNIV;
+ switch ((int) tag(layout_entry)) {
+ case TYPE_CTOR_LAYOUT_UNSHARED_TAG:
+ return MR_DISCUNIONTAG_UNSHARED;
+ case TYPE_CTOR_LAYOUT_SHARED_REMOTE_TAG:
+ return MR_DISCUNIONTAG_SHARED_REMOTE;
+ case TYPE_CTOR_LAYOUT_CONST_TAG:
+ return MR_DISCUNIONTAG_SHARED_LOCAL;
default:
- return MR_DATAREP_UNKNOWN;
+ fatal_error("MR_get_tag_representation: unknown tag representation");
}
}
-
-
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.22
diff -u -r1.22 mercury_type_info.h
--- mercury_type_info.h 1999/06/01 09:46:08 1.22
+++ mercury_type_info.h 1999/06/22 17:31:00
@@ -250,9 +250,9 @@
*/
#define MR_TYPE_CTOR_INFO_HO_PRED \
- ((const Word *) &mercury_data___type_ctor_info_pred_0)
+ ((MR_TypeCtorInfo) (const Word *) &mercury_data___type_ctor_info_pred_0)
#define MR_TYPE_CTOR_INFO_HO_FUNC \
- ((const Word *) &mercury_data___type_ctor_info_func_0)
+ ((MR_TypeCtorInfo) (const Word *) &mercury_data___type_ctor_info_func_0)
#define MR_TYPE_CTOR_INFO_IS_HO_PRED(T) \
(T == MR_TYPE_CTOR_INFO_HO_PRED)
#define MR_TYPE_CTOR_INFO_IS_HO_FUNC(T) \
@@ -668,116 +668,19 @@
/*---------------------------------------------------------------------------*/
-
/*
- ** Macros for retreiving things from type_infos and
- ** type_ctor_infos
+ ** Macros for retreiving things from type_infos.
*/
#define MR_TYPEINFO_GET_TYPE_CTOR_INFO(TypeInfo) \
- ((*TypeInfo) ? (Word *) *TypeInfo : (Word *) (Word) TypeInfo)
+ ((MR_TypeCtorInfo) ((*TypeInfo) ? *TypeInfo : (Word) TypeInfo))
#define MR_TYPEINFO_GET_HIGHER_ARITY(TypeInfo) \
- ((Integer) (Word *) (TypeInfo)[TYPEINFO_OFFSET_FOR_PRED_ARITY])
-
-#define MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_FUNCTORS(BaseTypeInfo) \
- ((Word *) (BaseTypeInfo)[OFFSET_FOR_BASE_TYPE_FUNCTORS])
-
-#define MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_LAYOUT(BaseTypeInfo) \
- ((Word *) (BaseTypeInfo)[OFFSET_FOR_BASE_TYPE_LAYOUT])
-
-#define MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_LAYOUT_ENTRY(BaseTypeInfo, Tag) \
- (MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_LAYOUT(BaseTypeInfo)[(Tag)])
+ ((Integer) (Word *) (TypeInfo)[TYPEINFO_OFFSET_FOR_PRED_ARITY])
-#define MR_TYPE_CTOR_INFO_GET_TYPE_ARITY(BaseTypeInfo) \
- (((Word *) (BaseTypeInfo))[OFFSET_FOR_COUNT])
-#define MR_TYPE_CTOR_INFO_GET_TYPE_NAME(BaseTypeInfo) \
- (((String *) (BaseTypeInfo))[OFFSET_FOR_TYPE_NAME])
-
-#define MR_TYPE_CTOR_INFO_GET_TYPE_MODULE_NAME(BaseTypeInfo) \
- (((String *) (BaseTypeInfo))[OFFSET_FOR_TYPE_MODULE_NAME])
-
/*---------------------------------------------------------------------------*/
-#if 0
-
- /* XXX: We should use structs to represent the various
- ** data structures in the type_ctor_*
- **
- ** To implement this:
- ** 1. The code that uses the data in the library and
- ** runtime should be modified to use the above access
- ** macros
- ** 2. Then we can simplify the ordering of the data
- ** structures (for example, put variable length fields
- ** last)
- ** 3. Then we can create structs for them.
- **
- ** Some examples are below, (no guarantees of correctness).
- **
- ** Note that enum_vectors have already been handled in this way.
- */
-
- /*
- ** ** IMPORTANT: the layout in memory of the following
- ** structs must match the way that the Mercury compiler
- ** generates code for them.
- */
-
-
- /*
- ** Structs defining the structure of type_ctor_infos.
- ** A type_ctor_info describes the structure of a particular
- ** type constructor. One of these is generated for every
- ** `:- type' declaration.
- **
- ** XXX this is not used yet but we are aiming towards
- ** this structure.
- */
-
-typedef struct {
- int arity;
- Code *unify_pred;
- Code *index_pred;
- Code *compare_pred;
- /*
- ** The representation that is used for this
- ** constructor -- e.g. an enumeration, or a builtin
- ** type, or a no-tag type, etc.
- */
- MR_TypeCtorRepresentation type_ctor_rep;
- /*
- ** The names, arity and argument types of all the
- ** functors of this type if it is some sort of
- ** discriminated union.
- */
- MR_TypeCtorFunctors type_ctor_functors;
- /*
- ** The meanings of the primary tags of this type,
- ** if it is a discriminated union.
- */
- MR_TypeCtorLayout type_ctor_layout;
- String type_ctor_name;
- String type_ctor_module_name;
-} MR_TypeCtorInfo;
-
-typedef struct {
- Word arity;
- Word arg_pseudo_type_infos[1]; /* variable-sized array */
- /* actualy length is `arity', not 1 */
-} MR_TypeLayout_part1;
-
-typedef struct {
- ConstString name;
- Word arg_layouts[1]; /* variable-sized array */
- /* actualy length is `arity', not 1 */
-} MR_TypeLayout_part2;
-typedef MR_TypeLayout_part1 MR_TypeLayout;
-
-#endif
-
-
/*
** definitions for accessing the representation of the
** Mercury typeclass_info
@@ -835,85 +738,102 @@
**
**
*/
-enum MR_TypeCtorRepresentation {
- MR_TYPE_CTOR_REP_ENUM,
- MR_TYPE_CTOR_REP_DU,
- MR_TYPE_CTOR_REP_NOTAG,
- MR_TYPE_CTOR_REP_EQUIV,
- MR_TYPE_CTOR_REP_EQUIV_VAR,
- MR_TYPE_CTOR_REP_INT,
- MR_TYPE_CTOR_REP_CHAR,
- MR_TYPE_CTOR_REP_FLOAT,
- MR_TYPE_CTOR_REP_STRING,
- MR_TYPE_CTOR_REP_PRED,
- MR_TYPE_CTOR_REP_UNIV,
- MR_TYPE_CTOR_REP_VOID,
- MR_TYPE_CTOR_REP_C_POINTER,
- MR_TYPE_CTOR_REP_TYPEINFO,
- MR_TYPE_CTOR_REP_TYPECLASSINFO,
- MR_TYPE_CTOR_REP_ARRAY,
- MR_TYPE_CTOR_REP_UNKNOWN
-};
+typedef enum MR_TypeCtorRepresentation {
+ MR_TYPECTOR_REP_ENUM,
+ MR_TYPECTOR_REP_DU,
+ MR_TYPECTOR_REP_NOTAG,
+ MR_TYPECTOR_REP_EQUIV,
+ MR_TYPECTOR_REP_EQUIV_VAR,
+ MR_TYPECTOR_REP_INT,
+ MR_TYPECTOR_REP_CHAR,
+ MR_TYPECTOR_REP_FLOAT,
+ MR_TYPECTOR_REP_STRING,
+ MR_TYPECTOR_REP_PRED,
+ MR_TYPECTOR_REP_UNIV,
+ MR_TYPECTOR_REP_VOID,
+ MR_TYPECTOR_REP_C_POINTER,
+ MR_TYPECTOR_REP_TYPEINFO,
+ MR_TYPECTOR_REP_TYPECLASSINFO,
+ MR_TYPECTOR_REP_ARRAY,
+ MR_TYPECTOR_REP_UNKNOWN
+} MR_TypeCtorRepresentation;
/*
** If the MR_TypeCtorRepresentation is MR_TYPE_CTOR_REP_DU, we have a
** discriminated union type (other than a no-tag or enumeration). Each
** tag may have a different representation.
*/
-enum MR_DiscUnionTagRepresentation {
+typedef enum MR_DiscUnionTagRepresentation {
MR_DISCUNIONTAG_SHARED_LOCAL,
MR_DISCUNIONTAG_UNSHARED,
MR_DISCUNIONTAG_SHARED_REMOTE
-};
+} MR_DiscUnionTagRepresentation;
/*
-** MR_DataRepresentation is the representation for a particular value
-** of a type with this constructor. It is similar to the
-** MR_TypeCtorRepresentaion but you need to know the primary tag value
-** (and, therefore, must have the data around to examine) to tell the
-** different cases for discriminated unions apart.
-**
-** These have been ordered so that the most similar cases are next
-** to each other, so a switch on this type can exploit fallthrough
-** to cut down on code duplication.
-**
-** XXX this type will be replaced by a combination of MR_TypeCtorRepresentaion
-** and MR_DiscUnionTagRepresentation.
+** Return the tag representation used by the data with the given
+** entry in the type_ctor_layout table.
*/
-enum MR_DataRepresentation {
- MR_DATAREP_ENUM,
- MR_DATAREP_SHARED_LOCAL,
- MR_DATAREP_SHARED_REMOTE,
- MR_DATAREP_UNSHARED,
- MR_DATAREP_NOTAG,
- MR_DATAREP_EQUIV,
- MR_DATAREP_EQUIV_VAR,
- MR_DATAREP_INT,
- MR_DATAREP_CHAR,
- MR_DATAREP_FLOAT,
- MR_DATAREP_STRING,
- MR_DATAREP_PRED,
- MR_DATAREP_UNIV,
- MR_DATAREP_VOID,
- MR_DATAREP_ARRAY,
- MR_DATAREP_TYPEINFO,
- MR_DATAREP_C_POINTER,
- MR_DATAREP_UNKNOWN,
- MR_DATAREP_TYPECLASSINFO
-};
+MR_DiscUnionTagRepresentation MR_get_tag_representation(Word layout_entry);
-/*
-** Return the data representation used by the data with the given
-** functors_indicator and layout_entry.
-**
-** functors_indicator is part of the type_ctor_functors data structure.
-** layout_entry is the type_ctor_layout entry corresponding to the
-** primary tag of the data.
-**
-*/
-enum MR_DataRepresentation MR_categorize_data(Word functors_indicator,
- Word layout_entry);
+/*---------------------------------------------------------------------------*/
+
+typedef Word * MR_TypeCtorFunctors;
+typedef Word * MR_TypeCtorLayout;
+
+ /*
+ ** Structs defining the structure of type_ctor_infos.
+ ** A type_ctor_info describes the structure of a particular
+ ** type constructor. One of these is generated for every
+ ** `:- type' declaration.
+ */
+
+typedef struct {
+ int arity;
+ Code *unify_pred;
+ Code *index_pred;
+ Code *compare_pred;
+ /*
+ ** The representation that is used for this
+ ** constructor -- e.g. an enumeration, or a builtin
+ ** type, or a no-tag type, etc.
+ */
+ MR_TypeCtorRepresentation type_ctor_rep;
+ /*
+ ** The names, arity and argument types of all the
+ ** functors of this type if it is some sort of
+ ** discriminated union.
+ */
+ MR_TypeCtorFunctors type_ctor_functors;
+ /*
+ ** The meanings of the primary tags of this type,
+ ** if it is a discriminated union.
+ */
+ MR_TypeCtorLayout type_ctor_layout;
+ String type_ctor_module_name;
+ String type_ctor_name;
+} *MR_TypeCtorInfo;
+
+ /*
+ ** Macros for retreiving things from type_ctor_infos.
+ */
+#define MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_FUNCTORS(TypeCtorInfo) \
+ ((TypeCtorInfo)->type_ctor_functors)
+
+#define MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_LAYOUT(TypeCtorInfo) \
+ ((TypeCtorInfo)->type_ctor_layout)
+
+#define MR_TYPE_CTOR_INFO_GET_TYPE_CTOR_LAYOUT_ENTRY(TypeCtorInfo, Tag) \
+ ((TypeCtorInfo)->type_ctor_layout[(Tag)])
+
+#define MR_TYPE_CTOR_INFO_GET_TYPE_ARITY(TypeCtorInfo) \
+ ((TypeCtorInfo)->arity)
+
+#define MR_TYPE_CTOR_INFO_GET_TYPE_NAME(TypeCtorInfo) \
+ ((TypeCtorInfo)->type_ctor_name)
+
+#define MR_TYPE_CTOR_INFO_GET_TYPE_MODULE_NAME(TypeCtorInfo) \
+ ((TypeCtorInfo)->type_ctor_module_name)
/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_TYPEINFO_H */
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.59
diff -u -r1.59 Mmakefile
--- Mmakefile 1999/06/12 00:50:53 1.59
+++ Mmakefile 1999/06/28 17:57:29
@@ -24,6 +24,7 @@
cut_test \
cycles \
cycles2 \
+ deep_copy \
deep_copy_bug \
det_in_semidet_cntxt \
division_test \
Index: tests/hard_coded/deep_copy.m
===================================================================
RCS file: deep_copy.m
diff -N deep_copy.m
--- /dev/null Thu Mar 4 04:20:11 1999
+++ deep_copy.m Wed Jun 23 07:42:22 1999
@@ -0,0 +1,151 @@
+% Test case for deep_copy
+%
+% Author: trd
+
+:- module deep_copy.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, int, std_util, term, map, string, require.
+
+:- pred test_builtins(io__state::di, io__state::uo) is det.
+:- pred test_discriminated(io__state::di, io__state::uo) is det.
+:- pred test_polymorphism(io__state::di, io__state::uo) is det.
+:- pred test_other(io__state::di, io__state::uo) is det.
+
+:- pred newline(io__state::di, io__state::uo) is det.
+
+:- pred test_all(T::in, io__state::di, io__state::uo) is det.
+
+:- type enum ---> one ; two ; three.
+
+:- type fruit ---> apple(list(int))
+ ; banana(list(enum)).
+
+:- type thingie ---> foo ; bar(int) ; bar(int, int) ; qux(int) ;
+ quux(int) ; quuux(int, int) ; wombat ;
+ zoom(int) ; zap(int, float) ; zip(int, int) ;
+ zop(float, float).
+
+:- type poly(A, B) ---> poly_one(A) ; poly_two(B) ;
+ poly_three(B, A, poly(B, A));
+ poly_four(A, B).
+
+:- type no_tag ---> qwerty(int).
+
+%----------------------------------------------------------------------------%
+
+main -->
+ test_discriminated,
+ test_polymorphism,
+ test_builtins,
+ test_other.
+
+%----------------------------------------------------------------------------%
+
+test_all(T) -->
+ io__write(T),
+ io__write_string("\n"),
+ { copy(T, T1) },
+ io__write(T),
+ io__write_string("\n"),
+ io__write(T1).
+
+%----------------------------------------------------------------------------%
+
+test_discriminated -->
+ io__write_string("TESTING DISCRIMINATED UNIONS\n"),
+
+ % test enumerations
+ test_all(two), newline,
+ test_all(one), newline,
+ test_all(three), newline,
+
+ % test simple tags
+ test_all(apple([9,5,1])), newline,
+ test_all(banana([three, one, two])), newline,
+
+
+ % test complicated tags
+ test_all(zop(3.3, 2.03)), newline,
+ test_all(zip(3, 2)), newline,
+ test_all(zap(3, -2.111)), newline,
+
+ % test complicated constant
+
+ test_all(wombat), newline,
+ test_all(foo), newline,
+
+ newline.
+
+test_polymorphism -->
+ io__write_string("TESTING POLYMORPHISM\n"),
+ test_all(poly_three(3.33, 4, poly_one(9.11))), newline,
+ test_all(poly_two(3)), newline,
+ test_all(poly_one([2399.3])), newline,
+
+ newline.
+
+
+test_builtins -->
+ io__write_string("TESTING BUILTINS\n"),
+
+ % test strings
+ test_all(""), newline,
+ test_all("Hello, world\n"), newline,
+ test_all("Foo%sFoo"), newline,
+ test_all(""""), newline,
+
+ % test characters
+ test_all('a'), newline,
+ test_all('&'), newline,
+
+ % test floats
+ test_all(3.14159), newline,
+ test_all(11.28324983E-22), newline,
+ test_all(22.3954899E22), newline,
+
+ % test integers
+ test_all(-65), newline,
+ test_all(4), newline,
+
+ % test univ.
+ { type_to_univ(["hi! I'm a univ!"], Univ) },
+ test_all(Univ), newline,
+
+ % test predicates
+ % XXX we don't deep copy predicates correctly yet
+ %test_all(newline), newline,
+
+ newline.
+
+ % Note: testing abstract types is always going to have results
+ % that are dependent on the implementation. If someone changes
+ % the implementation, the results of this test can change.
+
+test_other -->
+ io__write_string("TESTING OTHER TYPES\n"),
+ { term__init_var_supply(VarSupply) },
+ { term__create_var(VarSupply, Var, NewVarSupply) },
+ test_all(Var), newline,
+ test_all(VarSupply), newline,
+ test_all(NewVarSupply), newline,
+
+ % presently, at least, map is an equivalence and
+ % an abstract type.
+ { map__init(Map) },
+ test_all(Map), newline,
+
+ % a no tag type
+ test_all(qwerty(4)), newline,
+
+ newline.
+
+newline -->
+ io__write_char('\n').
+
+
--
Tyson Dowd #
# Surreal humour isn't eveyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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