[m-dev.] for review: bug fix for type_to_term
Tyson Dowd
trd at cs.mu.OZ.AU
Wed Feb 16 19:16:22 AEDT 2000
Hi,
This bug was causing Wim problems.
===================================================================
Estimated hours taken: 4
Fix a bug with type_to_term introduced recently, reported by Wim
Vanhoof.
Equivalent types were not being handled correctly when extracting
information about the functors.
It's not correct to simply test if a type is basically a du type,
unless you have expanded all equivalences first. In the code given
the case for equivalences was unreachable.
It's better to fix the code to use type_ctor_rep to handle all cases
anyway.
library/std_util.m:
Use type_ctor_rep instead of type_ctor_functors indicator.
tests/hard_coded/Mmakefile:
tests/hard_coded/type_to_term_bug.exp:
tests/hard_coded/type_to_term_bug.m:
Regression test for this bug.
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.178
diff -u -r1.178 std_util.m
--- library/std_util.m 2000/01/19 09:45:18 1.178
+++ library/std_util.m 2000/02/16 08:13:56
@@ -1653,35 +1653,17 @@
ML_Construct_Info *info)
{
MR_TypeCtorInfo type_ctor_info;
- Word *type_ctor_functors;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
- if (! MR_type_ctor_rep_is_basically_du(type_ctor_info->type_ctor_rep))
- {
- return FALSE;
- }
-
- type_ctor_functors = type_ctor_info->type_ctor_functors;
- info->vector_type = MR_TYPE_CTOR_FUNCTORS_INDICATOR(type_ctor_functors);
- switch (info->vector_type) {
+ switch(type_ctor_info->type_ctor_rep) {
- case MR_TYPE_CTOR_FUNCTORS_ENUM:
- info->functor_descriptor = MR_TYPE_CTOR_FUNCTORS_ENUM_VECTOR(
- type_ctor_functors);
- info->arity = 0;
- info->argument_vector = NULL;
- info->primary_tag = 0;
- info->secondary_tag = functor_number;
- info->functor_name =
- MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
- info->functor_descriptor, functor_number);
- break;
-
- case MR_TYPE_CTOR_FUNCTORS_DU:
+ case MR_TYPECTOR_REP_DU:
+ case MR_TYPECTOR_REP_DU_USEREQ:
info->functor_descriptor =
MR_TYPE_CTOR_FUNCTORS_DU_FUNCTOR_N(
- type_ctor_functors, functor_number);
+ type_ctor_info->type_ctor_functors,
+ functor_number);
info->arity = MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_ARITY(
info->functor_descriptor);
info->argument_vector =
@@ -1697,11 +1679,25 @@
MR_TYPE_CTOR_LAYOUT_FUNCTOR_DESCRIPTOR_FUNCTOR_NAME(
info->functor_descriptor);
break;
+
+ case MR_TYPECTOR_REP_ENUM:
+ case MR_TYPECTOR_REP_ENUM_USEREQ:
+ info->functor_descriptor = MR_TYPE_CTOR_FUNCTORS_ENUM_VECTOR(
+ type_ctor_info->type_ctor_functors);
+ info->arity = 0;
+ info->argument_vector = NULL;
+ info->primary_tag = 0;
+ info->secondary_tag = functor_number;
+ info->functor_name =
+ MR_TYPE_CTOR_LAYOUT_ENUM_VECTOR_FUNCTOR_NAME(
+ info->functor_descriptor, functor_number);
+ break;
- case MR_TYPE_CTOR_FUNCTORS_NO_TAG:
+ case MR_TYPECTOR_REP_NOTAG:
+ case MR_TYPECTOR_REP_NOTAG_USEREQ:
info->functor_descriptor =
MR_TYPE_CTOR_FUNCTORS_NO_TAG_FUNCTOR(
- type_ctor_functors);
+ type_ctor_info->type_ctor_functors);
info->arity = 1;
info->argument_vector = MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(
info->functor_descriptor);
@@ -1711,19 +1707,39 @@
info->functor_descriptor);
break;
- case MR_TYPE_CTOR_FUNCTORS_EQUIV: {
+ case MR_TYPECTOR_REP_EQUIV_VAR:
+ case MR_TYPECTOR_REP_EQUIV: {
Word *equiv_type;
equiv_type = (Word *) MR_TYPE_CTOR_FUNCTORS_EQUIV_TYPE(
- type_ctor_functors);
+ type_ctor_info->type_ctor_functors);
return ML_get_functor_info((Word)
MR_create_type_info((Word *) type_info,
equiv_type),
functor_number, info);
}
- case MR_TYPE_CTOR_FUNCTORS_SPECIAL:
- return FALSE;
- case MR_TYPE_CTOR_FUNCTORS_UNIV:
+
+ case MR_TYPECTOR_REP_INT:
+ case MR_TYPECTOR_REP_CHAR:
+ case MR_TYPECTOR_REP_FLOAT:
+ case MR_TYPECTOR_REP_STRING:
+ case MR_TYPECTOR_REP_PRED:
+ case MR_TYPECTOR_REP_UNIV:
+ case MR_TYPECTOR_REP_VOID:
+ case MR_TYPECTOR_REP_C_POINTER:
+ case MR_TYPECTOR_REP_TYPEINFO:
+ case MR_TYPECTOR_REP_TYPECLASSINFO:
+ case MR_TYPECTOR_REP_ARRAY:
+ case MR_TYPECTOR_REP_SUCCIP:
+ case MR_TYPECTOR_REP_HP:
+ case MR_TYPECTOR_REP_CURFR:
+ case MR_TYPECTOR_REP_MAXFR:
+ case MR_TYPECTOR_REP_REDOFR:
+ case MR_TYPECTOR_REP_REDOIP:
+ case MR_TYPECTOR_REP_TRAIL_PTR:
+ case MR_TYPECTOR_REP_TICKET:
return FALSE;
+
+ case MR_TYPECTOR_REP_UNKNOWN:
default:
fatal_error(""std_util:construct - unexpected type."");
}
@@ -1937,55 +1953,66 @@
ML_get_num_functors(Word type_info)
{
MR_TypeCtorInfo type_ctor_info;
- Word *type_ctor_functors;
int functors;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
- if (! MR_type_ctor_rep_is_basically_du(type_ctor_info->type_ctor_rep))
- {
- return -1;
- }
-
- type_ctor_functors = type_ctor_info->type_ctor_functors;
-
- switch ((int) MR_TYPE_CTOR_FUNCTORS_INDICATOR(type_ctor_functors)) {
- case MR_TYPE_CTOR_FUNCTORS_DU:
+ switch(type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_DU:
+ case MR_TYPECTOR_REP_DU_USEREQ:
functors = MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(
- type_ctor_functors);
+ type_ctor_info->type_ctor_functors);
break;
- case MR_TYPE_CTOR_FUNCTORS_ENUM:
+ case MR_TYPECTOR_REP_ENUM:
+ case MR_TYPECTOR_REP_ENUM_USEREQ:
functors = MR_TYPE_CTOR_FUNCTORS_ENUM_NUM_FUNCTORS(
- type_ctor_functors);
+ type_ctor_info->type_ctor_functors);
break;
- case MR_TYPE_CTOR_FUNCTORS_EQUIV: {
+ case MR_TYPECTOR_REP_NOTAG:
+ case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ functors = 1;
+ break;
+
+ case MR_TYPECTOR_REP_EQUIV_VAR:
+ case MR_TYPECTOR_REP_EQUIV: {
Word *equiv_type;
equiv_type = (Word *)
MR_TYPE_CTOR_FUNCTORS_EQUIV_TYPE(
- type_ctor_functors);
+ type_ctor_info->type_ctor_functors);
functors = ML_get_num_functors((Word)
MR_create_type_info((Word *)
type_info, equiv_type));
break;
}
-
- case MR_TYPE_CTOR_FUNCTORS_SPECIAL:
- functors = -1;
- break;
-
- case MR_TYPE_CTOR_FUNCTORS_NO_TAG:
- functors = 1;
- break;
- case MR_TYPE_CTOR_FUNCTORS_UNIV:
+ case MR_TYPECTOR_REP_INT:
+ case MR_TYPECTOR_REP_CHAR:
+ case MR_TYPECTOR_REP_FLOAT:
+ case MR_TYPECTOR_REP_STRING:
+ case MR_TYPECTOR_REP_PRED:
+ case MR_TYPECTOR_REP_UNIV:
+ case MR_TYPECTOR_REP_VOID:
+ case MR_TYPECTOR_REP_C_POINTER:
+ case MR_TYPECTOR_REP_TYPEINFO:
+ case MR_TYPECTOR_REP_TYPECLASSINFO:
+ case MR_TYPECTOR_REP_ARRAY:
+ case MR_TYPECTOR_REP_SUCCIP:
+ case MR_TYPECTOR_REP_HP:
+ case MR_TYPECTOR_REP_CURFR:
+ case MR_TYPECTOR_REP_MAXFR:
+ case MR_TYPECTOR_REP_REDOFR:
+ case MR_TYPECTOR_REP_REDOIP:
+ case MR_TYPECTOR_REP_TRAIL_PTR:
+ case MR_TYPECTOR_REP_TICKET:
functors = -1;
break;
+ case MR_TYPECTOR_REP_UNKNOWN:
default:
fatal_error(""std_util:ML_get_num_functors :""
- "" unknown indicator"");
+ "" unknown type_ctor_rep"");
}
return functors;
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.76
diff -u -r1.76 Mmakefile
--- tests/hard_coded/Mmakefile 2000/02/04 03:45:51 1.76
+++ tests/hard_coded/Mmakefile 2000/02/16 08:13:56
@@ -103,6 +103,7 @@
string_loop \
test_imported_no_tag \
term_io_test \
+ type_to_term_bug \
tim_qual1 \
type_spec \
user_defined_equality \
Index: tests/hard_coded/type_to_term_bug.exp
===================================================================
RCS file: type_to_term_bug.exp
diff -N type_to_term_bug.exp
--- /dev/null Thu Mar 4 04:20:11 1999
+++ type_to_term_bug.exp Wed Feb 16 19:13:56 2000
@@ -0,0 +1 @@
+functor(atom("-"), [functor(atom("[]"), [], context("", 0)), functor(atom("[]"), [], context("", 0))], context("", 0))
Index: tests/hard_coded/type_to_term_bug.m
===================================================================
RCS file: type_to_term_bug.m
diff -N type_to_term_bug.m
--- /dev/null Thu Mar 4 04:20:11 1999
+++ type_to_term_bug.m Wed Feb 16 19:13:56 2000
@@ -0,0 +1,22 @@
+:- module type_to_term_bug.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module term.
+
+:- import_module queue.
+
+main -->
+ { queue__init(Q1) },
+ { queue__put(Q1, 1, _Q2) },
+ { term__type_to_term(Q1, Term3) },
+ { term__generic_term(Term3) },
+ write(Term3),
+ nl.
+
+
--
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