ML_expand: attempt to use UNUSED tag!

[Fergus Henderson]

On 22-Dec-1997, Thomas Charles CONWAY <conway at cs.mu.oz.au>
reported a bug with a test case similar to the following (paraphrased):

	% module_1
	:- interface.
	:- type cqueue(T) == pair(list(T)).

	% module_2
	:- import_module module_1.
	:- pred p(cqueue(int)::in, io__state::di, io__state::uo) is det.
	p(X) --> write(X).

The problem occurs when ML_expand() calls ML_create_type_info() to
expand the equivalence type.  The problem is that when ML_create_type_info()
is substituting out the values of the type parameters, it only looks at the
top two levels of the type.  Thus it handles

	:- type foo(T) == T.

or
	:- type bar(T) == baz(T).

fine, but for

	:- type cqueue(T) == pair(list(T)).

the result of expanding the equivalence type `cqueue(int)' is
`pair(list(T))' rather than `pair(list(int))'.
`T' here is an unbound type parameter.

The obvious solution seems to be to do a deep traversal of the type.
Tyson, could you please review this?

library/std_util.m:
	Fix a bug in make_type_info() and ML_create_type_info():
	when searching for type parameters to substituting with their
	corresponding values, they were only looking at the top level
	of the type.  To get correct results, it is necessary to
	traverse recursively through all levels of the type.

I think make_type_info() in runtime/mercury_type_info.c has the
same bug.  But the fix there is harder, due to the memory management
issue; off-hand I don't see any simple and obvious way of solving it.
Perhaps it needs to allocate the type_infos on a separate heap
(organized using stack-like allocation).

Index: std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.111
diff -u -u -r1.111 std_util.m
--- std_util.m	1997/12/03 07:05:11	1.111
+++ std_util.m	1997/12/29 07:37:17
@@ -2653,27 +2653,30 @@
 Word * 
 ML_create_type_info(Word *term_type_info, Word *arg_pseudo_type_info)
 {
-	int i, arity, extra_args;
+	int i, j, arity, extra_args;
 	Word *base_type_info;
+	Word *arg_type_info;
 	Word *type_info;
 
-		/* 
-		** The arg_pseudo_type_info might be a polymorphic variable,
-		** if so - substitute.
-		*/
-
+	/* 
+	** The arg_pseudo_type_info might be a polymorphic variable.
+	** If so, then substitute it's value, and then we're done.
+	*/
 	if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
-		arg_pseudo_type_info = (Word *) 
+		arg_type_info = (Word *) 
 			term_type_info[(Word) arg_pseudo_type_info];
-	}
 
-	if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
-		fatal_error(""ML_create_type_info: unbound type variable"");
+		if (TYPEINFO_IS_VARIABLE(arg_type_info)) {
+			fatal_error(""ML_create_type_info: ""
+					""unbound type variable"");
+		}
+
+		return arg_type_info;
 	}
 
 	base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(arg_pseudo_type_info);
 
-		/* no arguments - optimise common case */
+	/* no arguments - optimise common case */
 	if (base_type_info == arg_pseudo_type_info) {
 		return arg_pseudo_type_info;
 	}
@@ -2686,52 +2689,40 @@
 		extra_args = 1;
 	}
 
-
-		/* 
-		** Check for type variables -- if there are none,
-		** we don't need to create a new type_info.
-		*/
-	for (i = arity + extra_args - 1; i >= extra_args; i--) {
-		if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info[i])) {
-			break;
-		}
-	}
-
-		/*
-		** Do we need to create a new type_info?
-		*/
-	if (i >= extra_args) {
-		incr_saved_hp(LVALUE_CAST(Word, type_info), arity + extra_args);
-
-			/* 
-			** Copy any preliminary arguments to the type_info 
-			** (this means the base_type_info and possibly
-			** arity for higher order terms).
-			*/ 
-		for (i = 0; i < extra_args; i++) {
-			type_info[i] = arg_pseudo_type_info[i];
+	/*
+	** Iterate over the arguments, figuring out whether we
+	** need to make any substitutions.
+	** If so, copy the resulting argument type-infos into
+	** a new type_info.
+	*/
+	type_info = NULL;
+	for (i = extra_args; i < arity + extra_args; i++) {
+		arg_type_info = ML_create_type_info(term_type_info,
+				(Word *) arg_pseudo_type_info[i]);
+		if (TYPEINFO_IS_VARIABLE(arg_type_info)) {
+			fatal_error(""ML_create_type_info: ""
+				""unbound type variable"");
 		}
-
+		if (arg_type_info != (Word *) arg_pseudo_type_info[i]) {
 			/*
-			** Copy type arguments, substituting for any 
-			** type variables.
+			** We made a substitution.
+			** We need to allocate a new type_info,
+			** if we haven't done so already.
 			*/
-		for (i = extra_args; i < arity + extra_args; i++) {
-			if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info[i])) {
-				type_info[i] = term_type_info[
-					arg_pseudo_type_info[i]];
-				if (TYPEINFO_IS_VARIABLE(type_info[i])) {
-					fatal_error(""ML_create_type_info: ""
-						""unbound type variable"");
+			if (type_info == NULL) {
+				incr_saved_hp(LVALUE_CAST(Word, type_info),
+					arity + extra_args);
+				for (j = 0; j < arity + extra_args; j++) {
+					type_info[j] = arg_pseudo_type_info[j];
 				}
-
-			} else {
-				type_info[i] = arg_pseudo_type_info[i];
 			}
+			type_info[i] = (Word) arg_type_info;
 		}
-		return type_info;
-	} else {
+	}
+	if (type_info == NULL) {
 		return arg_pseudo_type_info;
+	} else {
+		return type_info;
 	}
 }
 
-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.