diff: Use MR_categorize_data in other places.
Tyson Dowd
trd at cs.mu.OZ.AU
Wed Jun 10 15:41:50 AEST 1998
===================================================================
Estimated hours taken: 4
Use MR_categorize_data to simplify control flow.
library/std_util.m:
runtime/mercury_table_any.c:
Change ML_expand to use MR_categorize_data.
runtime/mercury_deep_copy.h:
Add a comment about deep_copy and sharing.
runtime/mercury_type_info.h:
runtime/mercury_deep_copy.c:
Change the order of simple and complicated cases, (sometimes
you can reduce a complicated case into a simple case, so
fall-through can be used to reduce code duplication).
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.119
diff -u -t -r1.119 std_util.m
--- std_util.m 1998/05/25 21:47:44 1.119
+++ std_util.m 1998/06/04 06:01:53
@@ -2126,17 +2126,6 @@
:- pragma c_code("
-static void ML_expand_const(Word data_value, Word entry_value,
- ML_Expand_Info *info);
-static void ML_expand_enum(Word data_value, Word entry_value,
- ML_Expand_Info *info);
-static void ML_expand_simple(Word data_value, Word* arg_type_infos,
- Word * type_info, ML_Expand_Info *info);
-static void ML_expand_builtin(Word data_value, Word entry_value,
- ML_Expand_Info *info);
-static void ML_expand_complicated(Word data_value, Word entry_value,
- Word * type_info, ML_Expand_Info *info);
-
Declare_entry(mercury__builtin_compare_pred_3_0);
Declare_entry(mercury__builtin_compare_non_canonical_type_3_0);
@@ -2165,343 +2154,260 @@
**
** If you change this code you will also have reflect any changes in
** runtime/mercury_deep_copy.c and runtime/mercury_table_any.c
+**
+** We use 4 space tabs here because of the level of indenting.
*/
void
ML_expand(Word* type_info, Word *data_word_ptr, ML_Expand_Info *info)
{
- Code *compare_pred;
- Word *base_type_info, *arg_type_info;
- Word data_value, entry_value, base_type_layout_entry;
- int entry_tag, data_tag;
- Word data_word;
-
- base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info);
-
- compare_pred = (Code *) base_type_info[OFFSET_FOR_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);
+ Code *compare_pred;
+ Word *base_type_info, *base_type_functors;
+ Word data_value, entry_value, base_type_layout_entry, functors_indicator;
+ int data_tag, entry_tag;
+ Word data_word;
+ enum MR_DataRepresentation data_rep;
+
+ base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info);
+
+ compare_pred = (Code *) base_type_info[OFFSET_FOR_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);
- base_type_layout_entry = MR_BASE_TYPEINFO_GET_TYPELAYOUT_ENTRY(
- base_type_info, data_tag);
+ base_type_layout_entry = MR_BASE_TYPEINFO_GET_TYPELAYOUT_ENTRY(
+ base_type_info, data_tag);
+ base_type_functors = MR_BASE_TYPEINFO_GET_TYPEFUNCTORS(base_type_info);
+
+ entry_value = body(base_type_layout_entry, entry_tag);
+
+ data_rep = MR_categorize_data(functors_indicator,
+ base_type_layout_entry);
+
+ switch(data_rep) {
+
+ case MR_DATAREP_ENUM:
+ info->functor = MR_TYPELAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
+ entry_value, data_value);
+ info->arity = 0;
+ info->argument_vector = NULL;
+ break;
+
+ case MR_DATAREP_COMPLICATED_CONST:
+ data_value = unmkbody(data_value);
+ info->functor = MR_TYPELAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
+ entry_value, data_value);
+ info->arity = 0;
+ info->argument_vector = NULL;
+ info->type_info_vector = NULL;
+ break;
+
+ case MR_DATAREP_COMPLICATED: {
+ Word secondary_tag;
+
+ secondary_tag = ((Word *) data_value)[0];
+
+ /*
+ * Look past the secondary tag, and get the simple vector,
+ * then we can just use the code for simple tags.
+ */
+ data_value = (Word) ((Word *) data_value + 1);
+ entry_value = MR_TYPELAYOUT_COMPLICATED_VECTOR_GET_SIMPLE_VECTOR(
+ entry_value, secondary_tag);
+ entry_value = strip_tag(entry_value);
+ } /* fallthru */
+
+ case MR_DATAREP_SIMPLE: /* fallthru */
+ {
+ int i;
+ Word * simple_vector = (Word *) entry_value;
- entry_tag = tag(base_type_layout_entry);
- entry_value = body(base_type_layout_entry, entry_tag);
+ info->arity =
+ MR_TYPELAYOUT_SIMPLE_VECTOR_ARITY(simple_vector);
- switch(entry_tag) {
-
- case TYPELAYOUT_CONST_TAG: /* case TYPELAYOUT_COMP_CONST_TAG: */
+ if (info->need_functor) {
+ make_aligned_string(info->functor,
+ MR_TYPELAYOUT_SIMPLE_VECTOR_FUNCTOR_NAME(
+ simple_vector));
+ }
+
+ if (info->need_args) {
+ info->argument_vector = (Word *) data_value;
+
+ info->type_info_vector = checked_malloc(
+ info->arity * sizeof(Word));
+
+ for (i = 0; i < info->arity ; i++) {
+ Word *arg_pseudo_type_info;
+
+ arg_pseudo_type_info = (Word *)
+ MR_TYPELAYOUT_SIMPLE_VECTOR_ARGS(simple_vector)[i];
+ info->type_info_vector[i] = (Word) MR_create_type_info(
+ type_info, arg_pseudo_type_info);
+ }
+ }
+ break;
+ }
+
+ case MR_DATAREP_NOTAG:
+ {
+ int i;
+ Word * simple_vector = (Word *) entry_value;
- /*
- ** This tag represents builtins, enums or complicated
- ** constants.
- */
-
- if (TYPEINFO_IS_VARIABLE(entry_value)) {
-
- /*
- ** It's a builtin, the rest of the layout
- ** entry value represents the type of builtin.
- */
- entry_value = unmkbody(entry_value);
- ML_expand_builtin(data_word, entry_value,
- info);
- } else {
- /* It's a complicated constant or enum */
- if (MR_TYPELAYOUT_ENUM_VECTOR_IS_ENUM(entry_value)) {
- ML_expand_enum(data_word, entry_value,
- info);
- } else {
- data_value = unmkbody(data_value);
- ML_expand_const(data_value, entry_value,
- info);
- }
- }
- break;
-
- case TYPELAYOUT_SIMPLE_TAG:
- ML_expand_simple(data_value, (Word *) entry_value,
- type_info, info);
- break;
-
- case TYPELAYOUT_COMPLICATED_TAG:
- ML_expand_complicated(data_value, entry_value, type_info,
- info);
- break;
-
- case TYPELAYOUT_EQUIV_TAG: /* case TYPELAYOUT_NO_TAG: */
-
- /*
- ** Is it a type variable?
- */
- if (TYPEINFO_IS_VARIABLE(entry_value)) {
- arg_type_info = MR_create_type_info(type_info,
- (Word *) entry_value);
- ML_expand(arg_type_info, data_word_ptr, info);
- }
- /*
- ** is it a no_tag type?
- */
- else if (MR_TYPELAYOUT_NO_TAG_VECTOR_IS_NO_TAG(entry_value)) {
- ML_expand_simple((Word) data_word_ptr,
- (Word *) entry_value, type_info, info);
- }
- /*
- ** It must be an equivalent type.
- */
- else {
- arg_type_info = MR_create_type_info(type_info,
- (Word *) MR_TYPELAYOUT_EQUIV_TYPE(
- entry_value));
- ML_expand(arg_type_info, data_word_ptr, info);
- }
+ data_value = (Word) data_word_ptr;
- break;
-
- default:
- /* If this happens, the layout data is corrupt */
-
- fatal_error(""ML_expand: found unused tag value"");
- }
-}
-
-/*
- * Expand a constant value.
- */
-
-void
-ML_expand_const(Word data_value, Word entry_value, ML_Expand_Info *info)
-{
-
- /* the functors are stored after the enum_indicator and
- * the number of functors
- */
- info->functor = MR_TYPELAYOUT_ENUM_VECTOR_FUNCTOR_NAME(entry_value,
- data_value);
- info->arity = 0;
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
-}
-
-
-/*
- * Expand an enum.
- */
-
-void
-ML_expand_enum(Word data_value, Word enum_vector, ML_Expand_Info *info)
-{
- info->functor = MR_TYPELAYOUT_ENUM_VECTOR_FUNCTOR_NAME(enum_vector,
- data_value);
- info->arity = 0;
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
-}
-
-
-/*
- * Expand a functor with arguments, which has a simple tag.
- *
- * Simple tags - type_layout points to an array containing
- * the arity, then a pseudo-typeinfo for each argument, and type_info is
- * the current type_info (the type of this data item).
- *
- * Data word points to an array of argument data.
- *
- */
-void
-ML_expand_simple(Word data_value, Word* simple_vector, Word * type_info,
- ML_Expand_Info *info)
-{
- int i;
-
- info->arity = MR_TYPELAYOUT_SIMPLE_VECTOR_ARITY(simple_vector);
+ info->arity = MR_TYPELAYOUT_SIMPLE_VECTOR_ARITY(simple_vector);
- if (info->need_functor) {
- make_aligned_string(info->functor,
- MR_TYPELAYOUT_SIMPLE_VECTOR_FUNCTOR_NAME(
- simple_vector));
- }
-
- if (info->need_args) {
- info->argument_vector = (Word *) data_value;
-
- info->type_info_vector =
- checked_malloc(info->arity * sizeof(Word));
-
- for (i = 0; i < info->arity ; i++) {
- Word *arg_pseudo_type_info;
-
- arg_pseudo_type_info = (Word *)
- MR_TYPELAYOUT_SIMPLE_VECTOR_ARGS(
- simple_vector)[i];
- info->type_info_vector[i] = (Word)
- MR_create_type_info(type_info,
- arg_pseudo_type_info);
- }
- }
-}
-
-/*
- * Complicated tags - entry_value points to a vector containing:
- * The number of sharers of this tag
- * A pointer to a simple tag structure (see mercury_print_simple)
- * for each sharer.
- *
- * The data_value points to the actual sharer of this tag,
- * which should be used as an index into the vector of pointers
- * into simple tag structures. The next n words the data_value
- * points to are the arguments of the functor.
- */
-
-void
-ML_expand_complicated(Word data_value, Word entry_value, Word * type_info,
- ML_Expand_Info *info)
-{
- Word new_data_value, simple_vector, simple_vector_tag, secondary_tag;
+ if (info->need_functor) {
+ make_aligned_string(info->functor,
+ MR_TYPELAYOUT_SIMPLE_VECTOR_FUNCTOR_NAME(
+ simple_vector));
+ }
+
+ if (info->need_args) {
+ /*
+ * A NO_TAG is much like SIMPLE, but we use the
+ * data_word_ptr here to simulate an argument
+ * vector.
+ */
+ info->argument_vector = (Word *) data_word_ptr;
+
+ info->type_info_vector = checked_malloc(
+ info->arity * sizeof(Word));
+
+ for (i = 0; i < info->arity ; i++) {
+ Word *arg_pseudo_type_info;
+
+ arg_pseudo_type_info = (Word *)
+ MR_TYPELAYOUT_SIMPLE_VECTOR_ARGS(simple_vector)[i];
+ info->type_info_vector[i] = (Word) MR_create_type_info(
+ type_info, arg_pseudo_type_info);
+ }
+ }
+ break;
+ }
+ case MR_DATAREP_EQUIV: {
+ Word *equiv_type_info;
- secondary_tag = ((Word *) data_value)[0];
- new_data_value = (Word) ((Word *) data_value + 1);
-
- simple_vector = MR_TYPELAYOUT_COMPLICATED_VECTOR_GET_SIMPLE_VECTOR(
- entry_value, secondary_tag);
- simple_vector_tag = tag(simple_vector);
- simple_vector = body(simple_vector, simple_vector_tag);
-
- ML_expand_simple(new_data_value, (Word *) simple_vector,
- type_info, info);
-}
+ equiv_type_info = MR_create_type_info(type_info,
+ (Word *) MR_TYPELAYOUT_EQUIV_TYPE(
+ entry_value));
+ ML_expand(equiv_type_info, data_word_ptr, info);
+ break;
+ }
+ case MR_DATAREP_EQUIV_VAR: {
+ Word *equiv_type_info;
-void
-ML_expand_builtin(Word data_value, Word entry_value, ML_Expand_Info *info)
-{
- switch ((int) entry_value) {
-
- case TYPELAYOUT_UNASSIGNED_VALUE:
- fatal_error(""ML_expand: attempt to use an UNASSIGNED tag"");
- break;
-
- case TYPELAYOUT_UNUSED_VALUE:
- fatal_error(""ML_expand: attempt to use an UNUSED tag"");
- break;
-
- case TYPELAYOUT_STRING_VALUE:
- /* XXX should escape characters correctly */
-
- if (info->need_functor) {
- char *str;
-
- incr_saved_hp_atomic(LVALUE_CAST(Word, str),
- (strlen((String) data_value) + 2 +
- sizeof(Word)) / sizeof(Word));
- sprintf(str, ""%c%s%c"", '""',
- (String) data_value, '""');
- info->functor = str;
- }
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- break;
-
- case TYPELAYOUT_FLOAT_VALUE:
- if (info->need_functor) {
- char buf[500];
- Float f;
- char *str;
-
- f = word_to_float(data_value);
- sprintf(buf, ""%#.15g"", f);
- incr_saved_hp_atomic(LVALUE_CAST(Word, str),
- (strlen(buf) + sizeof(Word)) / sizeof(Word));
- strcpy(str, buf);
- info->functor = str;
- }
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- break;
-
- case TYPELAYOUT_INT_VALUE:
- if (info->need_functor) {
- char buf[500];
- char *str;
-
- sprintf(buf, ""%ld"", (long) data_value);
- incr_saved_hp_atomic(LVALUE_CAST(Word, str),
- (strlen(buf) + sizeof(Word)) / sizeof(Word));
- strcpy(str, buf);
- info->functor = str;
- }
-
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- break;
-
- case TYPELAYOUT_CHARACTER_VALUE:
- /* XXX should escape characters correctly */
-
- if (info->need_functor) {
- char *str;
-
- incr_saved_hp_atomic(LVALUE_CAST(Word, str),
- (3 + sizeof(Word)) / sizeof(Word));
- sprintf(str, ""\'%c\'"", (char) data_value);
- info->functor = str;
- }
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- break;
-
- case TYPELAYOUT_UNIV_VALUE:
-
- /* Univ is a two word structure, containing
- * type_info and data.
- */
-
- ML_expand((Word *)
- ((Word *) data_value)[UNIV_OFFSET_FOR_TYPEINFO],
- &((Word *) data_value)[UNIV_OFFSET_FOR_DATA], info);
- break;
-
- case TYPELAYOUT_PREDICATE_VALUE:
- if (info->need_functor) {
- make_aligned_string(info->functor, ""<<predicate>>"");
- }
- info->argument_vector = NULL;
- info->type_info_vector = NULL;
- info->arity = 0;
- break;
-
- case TYPELAYOUT_VOID_VALUE:
- fatal_error(""ML_expand: found void"");
- break;
-
- case TYPELAYOUT_ARRAY_VALUE:
- fatal_error(""ML_expand: found array"");
- break;
-
- case TYPELAYOUT_TYPEINFO_VALUE:
- fatal_error(""ML_expand: found type_info"");
- break;
-
- case TYPELAYOUT_C_POINTER_VALUE:
- fatal_error(""ML_expand: found c_pointer"");
- break;
-
-
- default:
- fatal_error(""ML_expand: invalid tag value"");
- break;
- }
+ equiv_type_info = MR_create_type_info(type_info,
+ (Word *) entry_value);
+ ML_expand(equiv_type_info, data_word_ptr, info);
+ break;
+ }
+ case MR_DATAREP_INT:
+ if (info->need_functor) {
+ char buf[500];
+ char *str;
+
+ sprintf(buf, ""%ld"", (long) data_value);
+ incr_saved_hp_atomic(LVALUE_CAST(Word, str),
+ (strlen(buf) + sizeof(Word)) / sizeof(Word));
+ strcpy(str, buf);
+ info->functor = str;
+ }
+
+ info->argument_vector = NULL;
+ info->type_info_vector = NULL;
+ info->arity = 0;
+ break;
+
+ case MR_DATAREP_CHAR:
+ /* XXX should escape characters correctly */
+ if (info->need_functor) {
+ char *str;
+
+ incr_saved_hp_atomic(LVALUE_CAST(Word, str),
+ (3 + sizeof(Word)) / sizeof(Word));
+ sprintf(str, ""\'%c\'"", (char) data_value);
+ info->functor = str;
+ }
+ info->argument_vector = NULL;
+ info->type_info_vector = NULL;
+ info->arity = 0;
+ break;
+
+ case MR_DATAREP_FLOAT:
+ if (info->need_functor) {
+ char buf[500];
+ Float f;
+ char *str;
+
+ f = word_to_float(data_value);
+ sprintf(buf, ""%#.15g"", f);
+ incr_saved_hp_atomic(LVALUE_CAST(Word, str),
+ (strlen(buf) + sizeof(Word)) / sizeof(Word));
+ strcpy(str, buf);
+ info->functor = str;
+ }
+ info->argument_vector = NULL;
+ info->type_info_vector = NULL;
+ info->arity = 0;
+ break;
+
+ case MR_DATAREP_STRING:
+ /* XXX should escape characters correctly */
+ if (info->need_functor) {
+ char *str;
+
+ incr_saved_hp_atomic(LVALUE_CAST(Word, str),
+ (strlen((String) data_value) + 2 + sizeof(Word))
+ / sizeof(Word));
+ sprintf(str, ""%c%s%c"", '""', (String) data_value, '""');
+ info->functor = str;
+ }
+ info->argument_vector = NULL;
+ info->type_info_vector = NULL;
+ info->arity = 0;
+ break;
+
+ case MR_DATAREP_PRED:
+ if (info->need_functor) {
+ make_aligned_string(info->functor, ""<<predicate>>"");
+ }
+ info->argument_vector = NULL;
+ info->type_info_vector = NULL;
+ info->arity = 0;
+ break;
+
+ case MR_DATAREP_UNIV:
+ /*
+ * Univ is a two word structure, containing
+ * type_info and data.
+ */
+ ML_expand((Word *)
+ ((Word *) data_value)[UNIV_OFFSET_FOR_TYPEINFO],
+ &((Word *) data_value)[UNIV_OFFSET_FOR_DATA], info);
+ break;
+ case MR_DATAREP_VOID:
+ fatal_error(""ML_expand: cannot expand void types"");
+ break;
+ case MR_DATAREP_ARRAY:
+ fatal_error(""ML_expand: cannot expand array types"");
+ break;
+ case MR_DATAREP_TYPEINFO:
+ fatal_error(""ML_expand: cannot expand typeinfo types"");
+ break;
+ case MR_DATAREP_C_POINTER:
+ fatal_error(""ML_expand: cannot expand c_pointer types"");
+ break;
+ case MR_DATAREP_UNKNOWN: /* fallthru */
+ default:
+ fatal_error(""ML_expand: cannot expand -- unknown data type"");
+ break;
+ }
}
-
-
/*
** ML_arg() is a subroutine used to implement arg/2, argument/2,
Index: runtime/mercury_deep_copy.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_deep_copy.c,v
retrieving revision 1.7
diff -u -t -r1.7 mercury_deep_copy.c
--- mercury_deep_copy.c 1998/06/02 05:34:24 1.7
+++ mercury_deep_copy.c 1998/06/03 08:24:11
@@ -63,33 +63,6 @@
new_data = data; /* just a copy of the actual item */
break;
- case MR_DATAREP_SIMPLE: {
- 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[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
- type_info_vector = entry_value + TYPELAYOUT_SIMPLE_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) = deep_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);
- } else {
- new_data = data;
- }
- break;
- }
-
case MR_DATAREP_COMPLICATED: {
Word secondary_tag;
Word *new_entry;
@@ -126,8 +99,35 @@
} else {
new_data = data;
}
+ break;
}
+
+ case MR_DATAREP_SIMPLE: {
+ 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[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
+ type_info_vector = entry_value + TYPELAYOUT_SIMPLE_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) = deep_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);
+ } else {
+ new_data = data;
+ }
break;
+ }
case MR_DATAREP_NOTAG:
new_data = deep_copy_arg(data, type_info,
@@ -285,13 +285,10 @@
}
break;
- case MR_DATAREP_UNKNOWN:
- fatal_error("Unknown layout type in deep copy");
- break;
-
+ case MR_DATAREP_UNKNOWN: /* fallthru */
default:
fatal_error("Unknown layout type in deep copy");
- break;
+ break;
}
return new_data;
Index: runtime/mercury_deep_copy.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_deep_copy.h,v
retrieving revision 1.3
diff -u -t -r1.3 mercury_deep_copy.h
--- mercury_deep_copy.h 1998/05/15 07:09:14 1.3
+++ mercury_deep_copy.h 1998/06/05 06:27:38
@@ -58,6 +58,12 @@
** save_transient_registers()/restore_transient_registers()
** need to be used.
**
+** Deep copy does not preserve sharing of subterms. Each
+** subterm is copied in full, except for data items that are
+** stored outside the heap.
+** XXX For some applications, sharing is useful. For others we
+** want a copy that is completely unique. We should modify
+** deep_copy to do both.
*/
Word deep_copy(Word data, Word *type_info, Word *lower_limit,
Index: runtime/mercury_table_any.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_table_any.c,v
retrieving revision 1.2
diff -u -t -r1.2 mercury_table_any.c
--- mercury_table_any.c 1998/05/16 15:30:54 1.2
+++ mercury_table_any.c 1998/06/03 07:41:46
@@ -14,10 +14,6 @@
#include "mercury_type_info.h"
#include <stdio.h>
-/*
-** Prototypes.
-*/
-static Word get_base_type_layout_entry(Word data, Word *type_info);
MR_DECLARE_STRUCT(mercury_data___base_type_info_pred_0);
MR_DECLARE_STRUCT(mercury_data___base_type_info_func_0);
@@ -32,132 +28,47 @@
TrieNode
MR_table_type(Word *type_info, Word data, TrieNode table)
{
+ Word *base_type_info, *base_type_layout, *base_type_functors;
+ Word functors_indicator;
Word layout_entry, *entry_value, *data_value;
+ enum MR_DataRepresentation data_rep;
int data_tag, entry_tag;
- int arity, i;
MR_MemoryList allocated_memory_cells = NULL;
- Word *argument_vector, *type_info_vector, *new_type_info;
- Word new_data;
-
data_tag = tag(data);
data_value = (Word *) body(data, data_tag);
-
- layout_entry = get_base_type_layout_entry(data_tag, type_info);
- entry_tag = tag(layout_entry);
- entry_value = (Word *) body(layout_entry, entry_tag);
+ base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info);
+ base_type_layout = MR_BASE_TYPEINFO_GET_TYPELAYOUT(base_type_info);
+ layout_entry = base_type_layout[data_tag];
- switch(entry_tag) {
+ base_type_functors = MR_BASE_TYPEINFO_GET_TYPEFUNCTORS(base_type_info);
+ functors_indicator = MR_TYPEFUNCTORS_INDICATOR(base_type_functors);
- case TYPELAYOUT_CONST_TAG: /* and COMP_CONST_TAG */
- /* Some builtins need special treatment */
- if ((Word) entry_value <= TYPELAYOUT_MAX_VARINT) {
- int builtin_type = unmkbody(entry_value);
-
- switch(builtin_type) {
-
- case TYPELAYOUT_UNASSIGNED_VALUE:
- fatal_error("Attempt to use an UNASSIGNED tag "
- "in table_any");
- break;
-
- case TYPELAYOUT_UNUSED_VALUE:
- fatal_error("Attempt to use an UNUSED tag "
- "in table_any");
- break;
-
- case TYPELAYOUT_STRING_VALUE:
- table = (Word**) MR_TABLE_STRING(table, data);
- break;
-
- case TYPELAYOUT_FLOAT_VALUE:
- table = (Word**) MR_TABLE_FLOAT(table, data);
- break;
-
- case TYPELAYOUT_INT_VALUE:
- table = (Word**) MR_TABLE_INT(table, data);
- break;
-
- case TYPELAYOUT_CHARACTER_VALUE:
- table = (Word**) MR_TABLE_CHAR(table, data);
- break;
-
- case TYPELAYOUT_UNIV_VALUE:
- table = (Word**) MR_TABLE_TYPE_INFO(table,
- data_value[UNIV_OFFSET_FOR_TYPEINFO]);
- table = (Word**) MR_TABLE_ANY(table,
- data_value[UNIV_OFFSET_FOR_TYPEINFO],
- data_value[UNIV_OFFSET_FOR_DATA]);
- break;
-
- case TYPELAYOUT_PREDICATE_VALUE:
- {
- Word args = data_value[0];
+ entry_value = (Word *) strip_tag(layout_entry);
- table = (Word **) MR_TABLE_WORD(table, args);
- table = (Word **) MR_TABLE_WORD(table, data_value[1]);
-
- for (i = 0; i < args; i++) {
- table = (Word **) MR_TABLE_ANY(table,
- (Word *) type_info[i +
- TYPEINFO_OFFSET_FOR_PRED_ARGS],
- data_value[i+2]);
- }
- }
- case TYPELAYOUT_VOID_VALUE:
- fatal_error("Attempt to use a VOID tag in table_any");
- break;
-
- case TYPELAYOUT_ARRAY_VALUE:
- {
- MR_ArrayType *array;
- Integer array_size;
-
- array = (MR_ArrayType *) data_value;
- array_size = array->size;
-
- new_type_info = MR_make_type_info(type_info,
- (Word *) 1, &allocated_memory_cells);
-
- for (i = 0; i < array_size; i++) {
- table = (Word**) MR_TABLE_ANY(table,
- new_type_info,
- array->elements[i]);
- }
- break;
- }
- case TYPELAYOUT_TYPEINFO_VALUE:
- table = (Word**) MR_TABLE_TYPE_INFO(table, data_value);
- break;
-
- case TYPELAYOUT_C_POINTER_VALUE:
- fatal_error("Attempt to use a C_POINTER tag "
- "in table");
- break;
-
- default:
- fatal_error("Invalid tag value in table_any");
- break;
- }
- } else {
- if (MR_TYPELAYOUT_ENUM_VECTOR_IS_ENUM(entry_value)) {
- Word functors =
- MR_TYPELAYOUT_ENUM_VECTOR_NUM_FUNCTORS(entry_value);
- table = (Word**) MR_TABLE_ENUM(table, functors, data);
- } else {
- Word functors =
- MR_TYPELAYOUT_ENUM_VECTOR_NUM_FUNCTORS(entry_value);
- table = (Word**) MR_TABLE_TAG(table, data_tag);
- table = (Word**) MR_TABLE_ENUM(table, functors,
- (Word) data_value);
- }
- }
- break;
+ data_rep = MR_categorize_data(functors_indicator, layout_entry);
- case TYPELAYOUT_SIMPLE_TAG:
+ switch (data_rep) {
+ case MR_DATAREP_ENUM: {
+ Word functors =
+ MR_TYPELAYOUT_ENUM_VECTOR_NUM_FUNCTORS(entry_value);
+ table = (Word**) MR_TABLE_ENUM(table, functors, data);
+ break;
+ }
+ case MR_DATAREP_COMPLICATED_CONST: {
+ Word functors =
+ MR_TYPELAYOUT_ENUM_VECTOR_NUM_FUNCTORS(entry_value);
+ table = (Word**) MR_TABLE_TAG(table, data_tag);
+ table = (Word**) MR_TABLE_ENUM(table, functors, (Word) data_value);
+ break;
+ }
+ case MR_DATAREP_SIMPLE: {
+ int arity, i;
+ Word *argument_vector, *type_info_vector, *new_type_info;
+
argument_vector = data_value;
arity = entry_value[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
@@ -174,12 +85,11 @@
argument_vector[i]);
}
break;
-
- case TYPELAYOUT_COMPLICATED_TAG:
- {
- Word secondary_tag;
- Word num_sharers;
- Word *new_entry;
+ }
+ case MR_DATAREP_COMPLICATED: {
+ int arity, i;
+ Word *argument_vector, *type_info_vector, *new_type_info;
+ Word secondary_tag, num_sharers, *new_entry;
secondary_tag = *data_value;
argument_vector = data_value + 1;
@@ -203,25 +113,96 @@
}
break;
}
- case TYPELAYOUT_EQUIV_TAG:
- /* note: we treat no_tag types just like equivalences */
- if ((Word) entry_value < TYPELAYOUT_MAX_VARINT) {
- table = (Word**) MR_TABLE_ANY(table,
- (Word *) type_info[(Word) entry_value], data);
- } else {
- /*
- ** offset 0 is no-tag indicator
- ** offset 1 is the pseudo-typeinfo
- ** (as per comments in base_type_layout.m)
- ** XXX should avoid use of hard-coded offset `1' here
- */
- new_type_info = MR_make_type_info(type_info,
- (Word *) entry_value[1], &allocated_memory_cells);
-
- table = (Word**) MR_TABLE_ANY(table, new_type_info, data);
+ case MR_DATAREP_NOTAG: {
+ Word *new_type_info;
+ new_type_info = MR_make_type_info(type_info,
+ (Word *) *MR_TYPELAYOUT_NO_TAG_VECTOR_ARGS(entry_value),
+ &allocated_memory_cells);
+ table = (Word**) MR_TABLE_ANY(table, new_type_info, data);
+ break;
+ }
+ case MR_DATAREP_EQUIV: {
+ Word *new_type_info;
+ new_type_info = MR_make_type_info(type_info,
+ (Word *) MR_TYPELAYOUT_EQUIV_TYPE(entry_value),
+ &allocated_memory_cells);
+ table = (Word**) MR_TABLE_ANY(table, new_type_info, data);
+ break;
+ }
+ case MR_DATAREP_EQUIV_VAR:
+ table = (Word**) MR_TABLE_ANY(table,
+ (Word *) type_info[(Word) entry_value], data);
+ break;
+
+ case MR_DATAREP_INT:
+ table = (Word**) MR_TABLE_INT(table, data);
+ break;
+
+ case MR_DATAREP_CHAR:
+ table = (Word**) MR_TABLE_CHAR(table, data);
+ break;
+
+ case MR_DATAREP_FLOAT:
+ table = (Word**) MR_TABLE_FLOAT(table, data);
+ break;
+
+ case MR_DATAREP_STRING:
+ table = (Word**) MR_TABLE_STRING(table, data);
+ break;
+
+ case MR_DATAREP_PRED: {
+ int i;
+ Word args = data_value[0];
+
+ table = (Word **) MR_TABLE_WORD(table, args);
+ table = (Word **) MR_TABLE_WORD(table, data_value[1]);
+
+ for (i = 0; i < args; i++) {
+ table = (Word **) MR_TABLE_ANY(table,
+ (Word *) type_info[i + TYPEINFO_OFFSET_FOR_PRED_ARGS],
+ data_value[i+2]);
+ }
+ break;
+ }
+ case MR_DATAREP_UNIV:
+ table = (Word**) MR_TABLE_TYPE_INFO(table,
+ data_value[UNIV_OFFSET_FOR_TYPEINFO]);
+ table = (Word**) MR_TABLE_ANY(table,
+ data_value[UNIV_OFFSET_FOR_TYPEINFO],
+ data_value[UNIV_OFFSET_FOR_DATA]);
+ break;
+
+ case MR_DATAREP_VOID:
+ fatal_error("Cannot table a void type");
+ break;
+
+ case MR_DATAREP_ARRAY: {
+ int i;
+ MR_ArrayType *array;
+ Word *new_type_info;
+ Integer array_size;
+
+ array = (MR_ArrayType *) data_value;
+ array_size = array->size;
+
+ new_type_info = MR_make_type_info(type_info, (Word *) 1,
+ &allocated_memory_cells);
+
+ for (i = 0; i < array_size; i++) {
+ table = (Word**) MR_TABLE_ANY(table, new_type_info,
+ array->elements[i]);
}
break;
+ }
+ case MR_DATAREP_TYPEINFO:
+ table = (Word**) MR_TABLE_TYPE_INFO(table, data_value);
+ break;
+
+ case MR_DATAREP_C_POINTER:
+ fatal_error("Attempt to use a C_POINTER tag in table");
+ break;
+ case MR_DATAREP_UNKNOWN: /* fallthru */
default:
fatal_error("Unknown layout tag in table_any");
break;
@@ -231,20 +212,4 @@
return table;
} /* end table_any() */
-
-static Word
-get_base_type_layout_entry(Word data_tag, Word *type_info)
-{
- Word *base_type_info, *base_type_layout;
-
- base_type_info = (Word *) type_info[0];
-
- if (base_type_info == 0) {
- base_type_info = type_info;
- }
-
- base_type_layout = (Word *) base_type_info[OFFSET_FOR_BASE_TYPE_LAYOUT];
-
- return base_type_layout[data_tag];
-}
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.8
diff -u -t -r1.8 mercury_type_info.h
--- mercury_type_info.h 1998/06/02 05:34:46 1.8
+++ mercury_type_info.h 1998/06/03 08:23:06
@@ -814,8 +814,8 @@
enum MR_DataRepresentation {
MR_DATAREP_ENUM,
MR_DATAREP_COMPLICATED_CONST,
- MR_DATAREP_SIMPLE,
MR_DATAREP_COMPLICATED,
+ MR_DATAREP_SIMPLE,
MR_DATAREP_NOTAG,
MR_DATAREP_EQUIV,
MR_DATAREP_EQUIV_VAR,
--
Tyson Dowd # There isn't any reason why Linux can't be
# implemented as an enterprise computing solution.
trd at cs.mu.oz.au # Find out what you've been missing while you've
http://www.cs.mu.oz.au/~trd # been rebooting Windows NT. -- InfoWorld, 1998.
More information about the developers
mailing list