for review: typecheck bug fix

[Fergus Henderson]

DJ, could you please review this one?

--------------------

Estimated hours taken: 4

compiler/typecheck.m:
	Fix a bug which resulted in the compiler aborting with a
	map_lookup failure for certain (ill-typed) code.

tests/invalid/Mmakefile:
tests/invalid/ext_type_bug.m:
tests/invalid/ext_type_bug.err_exp:
	Regression test for the above-mention bug.

Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.250
diff -u -r1.250 typecheck.m
--- typecheck.m	1998/09/29 18:14:57	1.250
+++ typecheck.m	1998/10/01 06:23:11
@@ -2880,12 +2880,21 @@
 		% in the inferred types, plus any existentially typed
 		% variables that will remain in the declaration.
 		%
+		% There may also be some types in the HeadTypeParams
+		% which do not occur in the type of any variable (e.g. this
+		% can happen in the case of code containing type errors).
+		% We'd better keep those, too, to avoid errors
+		% when we apply the TSubst to the HeadTypeParams.
+		% (XXX should we do the same for TypeConstraints and
+		% ConstraintProofs too?)
+		%
 		map__values(VarTypes, Types),
 		term__vars_list(Types, TypeVars0),
 		map__keys(ExistTypeRenaming, ExistQVarsToBeRenamed),
 		list__delete_elems(OldExistQVars, ExistQVarsToBeRenamed,
 			ExistQVarsToRemain),
-		list__append(ExistQVarsToRemain, TypeVars0, TypeVars1),
+		list__condense([ExistQVarsToRemain, HeadTypeParams, TypeVars0],
+			TypeVars1),
 		list__sort_and_remove_dups(TypeVars1, TypeVars),
 		%
 		% Next, create a new typevarset with the same number of
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.27
diff -u -r1.27 Mmakefile
--- Mmakefile	1998/09/24 19:11:37	1.27
+++ Mmakefile	1998/10/01 06:30:18
@@ -18,6 +18,7 @@
 	errors1.m \
 	errors2.m \
 	external.m \
+	ext_type_bug.m \
 	func_errors.m \
 	funcs_as_preds.m \
 	ho_type_mode_bug.m \
Index: tests/invalid/ext_type_bug.err_exp
===================================================================
RCS file: ext_type_bug.err_exp
diff -N ext_type_bug.err_exp
--- /dev/null	Thu Oct  1 16:25:22 1998
+++ ext_type_bug.err_exp	Thu Oct  1 16:29:10 1998
@@ -0,0 +1,5 @@
+ext_type_bug.m:011: In clause for predicate `ext_type_bug:foo/1':
+ext_type_bug.m:011:   in argument 1 of call to pred `make_bar/1':
+ext_type_bug.m:011:   type error: variable `Bar' has type `(ext_type_bug:bar(int))',
+ext_type_bug.m:011:   expected type was `(ext_type_bug:bar(T))'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/ext_type_bug.m
===================================================================
RCS file: ext_type_bug.m
diff -N ext_type_bug.m
--- /dev/null	Thu Oct  1 16:25:22 1998
+++ ext_type_bug.m	Thu Oct  1 16:28:38 1998
@@ -0,0 +1,14 @@
+:- module ext_type_bug.
+:- interface.
+:- import_module int.
+
+:- type bar(T) ---> bar(T).
+
+:- pred foo(bar(int) :: out) is det.
+
+:- implementation.
+
+foo(Bar) :- make_bar(Bar).
+
+:- some[T] pred make_bar(bar(T) :: out) is det.
+make_bar(bar(42)).

-- 
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.