for review: better messages for some type errors

[Zoltan Somogyi]

Estimated hours taken: 4

compiler/typecheck.m:
	Emit better error messages when the type of a function symbol is known
	and some of the arguments have the wrong type.

tests/invalid/type_mismatch.{m,err_exp}:
	A new test case to exercise the new error messages.

tests/invalid/Mmakefile:
	Enable the new test case.

Zoltan.

Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.215
diff -u -r1.215 typecheck.m
--- typecheck.m	1997/09/29 06:12:40	1.215
+++ typecheck.m	1997/10/13 08:30:43
@@ -3112,15 +3112,95 @@
 
 	% XXX we should print type pairs (one type from each side)
 	% only for the arguments in which the two types differ.
-	prog_out__write_context(Context),
-	io__write_string("  "),
-	write_functor_name(Functor, Arity),
-	write_type_of_functor(Functor, Arity, Context, ConsDefnList),
+	(
+		{ ConsDefnList = [SingleDefn] },
+		{ SingleDefn = cons_type_info(ConsTVarSet, _ResultType,
+			ConsArgTypes) },
+		{ assoc_list__from_corresponding_lists(Args, ConsArgTypes,
+			ArgExpTypes) },
+		{ find_mismatched_args(ArgExpTypes, TypeAssignSet, ConsTVarSet,
+			1, Mismatches) },
+		{ Mismatches = [_ | _] }
+	->
+		prog_out__write_context(Context),
+		io__write_string("  The types of the relevant arguments are\n"),
+		report_mismatched_args(Mismatches, VarSet, Context)
+	;
+		prog_out__write_context(Context),
+		io__write_string("  "),
+		write_functor_name(Functor, Arity),
+		write_type_of_functor(Functor, Arity, Context, ConsDefnList),
+
+		write_types_of_vars(Args, VarSet, Context, TypeCheckInfo, 
+			TypeAssignSet),
+
+		write_type_assign_set_msg(TypeAssignSet, VarSet)
+	).
+
+:- type mismatch_info
+	--->	mismatch(
+			int,		% argument number, starting from 1
+			var,		% variable in that position
+			type,		% actual type of that variable
+			tvarset,	% the type vars in the actual type
+			type,		% expected type of that variable
+			tvarset		% the type vars in the expected type
+		).
 
-	write_types_of_vars(Args, VarSet, Context, TypeCheckInfo, 
-		TypeAssignSet),
+:- pred find_mismatched_args(assoc_list(var, type), type_assign_set, tvarset,
+	int, list(mismatch_info)).
+:- mode find_mismatched_args(in, in, in, in, out) is semidet.
 
-	write_type_assign_set_msg(TypeAssignSet, VarSet).
+find_mismatched_args([], _, _, _, []).
+find_mismatched_args([Arg - ExpType | ArgExpTypes], TypeAssignSet, ExpTVarSet,
+		ArgNum0, Mismatched) :-
+	ArgNum1 is ArgNum0 + 1,
+	find_mismatched_args(ArgExpTypes, TypeAssignSet, ExpTVarSet,
+		ArgNum1, Mismatched1),
+	get_type_stuff(TypeAssignSet, Arg, TypeStuffList),
+	TypeStuffList = [type_stuff(ArgType, ArgVarSet, ArgBinding)],
+	term__apply_rec_substitution(ArgType, ArgBinding, FullArgType),
+	(
+		(
+			FullArgType = ExpType
+		;
+			FullArgType = term__functor(term__atom("<any>"), [], _)
+		)
+	->
+		Mismatched = Mismatched1
+	;
+		Mismatched = [mismatch(ArgNum0, Arg, FullArgType, ArgVarSet,
+			ExpType, ExpTVarSet) | Mismatched1]
+	).
+
+:- pred report_mismatched_args(list(mismatch_info), varset, term__context,
+	io__state, io__state).
+:- mode report_mismatched_args(in, in, in, di, uo) is det.
+
+report_mismatched_args([], _, _) --> [].
+report_mismatched_args([Mismatch | Mismatches], VarSet, Context) -->
+	{ Mismatch = mismatch(ArgNum, Var, ActType, ActTVarSet,
+		ExpType, ExpTVarSet) },
+	prog_out__write_context(Context),
+	io__write_string("  argument "),
+	io__write_int(ArgNum),
+	( { varset__search_name(VarSet, Var, _) } ->
+		io__write_string(" ("),
+		mercury_output_var(Var, VarSet, no),
+		io__write_string(")")
+	;
+		[]
+	),
+	io__write_string(": actual `"),
+	mercury_output_term(ActType, ActTVarSet, no),
+	io__write_string("', expected `"),
+	mercury_output_term(ExpType, ExpTVarSet, no),
+	( { Mismatches = [] } ->
+		io__write_string("'.\n")
+	;
+		io__write_string("';\n"),
+		report_mismatched_args(Mismatches, VarSet, Context)
+	).
 
 :- pred write_types_of_vars(list(var), varset, term__context, typecheck_info,
 				type_assign_set, io__state, io__state).
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.1
diff -u -r1.1 Mmakefile
--- Mmakefile	1997/09/29 18:04:49	1.1
+++ Mmakefile	1997/10/13 07:31:52
@@ -32,6 +32,7 @@
 	pragma_c_code_and_clauses2.m \
 	qual_basic_test2.m \
 	type_loop.m \
+	type_mismatch.m \
 	unbound_inst_var.m \
 	undef_lambda_mode.m \
 	undef_mode.m \

New File: tests/invalid/type_mismatch.err_exp
===================================================================
type_mismatch.m:019: In clause for predicate `type_mismatch:p1/2':
type_mismatch.m:019:   in unification of variable `Tuple'
type_mismatch.m:019:   and term `f1(V_5, Field, V_6)':
type_mismatch.m:019:   type error in argument(s) of functor `f1/3'.
type_mismatch.m:019:   The types of the relevant arguments are
type_mismatch.m:019:   argument 2 (Field): actual `float', expected `int'.
type_mismatch.m:022: In clause for predicate `type_mismatch:p2/2':
type_mismatch.m:022:   in unification of variable `Tuple'
type_mismatch.m:022:   and term `f2(V_5, Field, V_6)':
type_mismatch.m:022:   type error in argument(s) of functor `f2/3'.
type_mismatch.m:022:   The types of the relevant arguments are
type_mismatch.m:022:   argument 2 (Field): actual `float', expected `int'.
type_mismatch.m:025: In clause for predicate `type_mismatch:p3/2':
type_mismatch.m:025:   in unification of variable `Tuple'
type_mismatch.m:025:   and term `f3(V_5, Field, V_6)':
type_mismatch.m:025:   type error in argument(s) of functor `f3/3'.
type_mismatch.m:025:   The types of the relevant arguments are
type_mismatch.m:025:   argument 2 (Field): actual `F3c', expected `T3b'.
type_mismatch.m:032: In clause for predicate `type_mismatch:p4a/2':
type_mismatch.m:032:   in unification of variable `Tuple'
type_mismatch.m:032:   and term `f4(Field, V_5, V_6)':
type_mismatch.m:032:   type error in argument(s) of functor `f4/3'.
type_mismatch.m:032:   The types of the relevant arguments are
type_mismatch.m:032:   argument 1 (Field): actual `float', expected `T4'.
type_mismatch.m:035: In clause for predicate `type_mismatch:p4b/3':
type_mismatch.m:035:   in unification of variable `Tuple'
type_mismatch.m:035:   and term `f4(Field1, Field2, V_7)':
type_mismatch.m:035:   type error in argument(s) of functor `f4/3'.
type_mismatch.m:035:   The types of the relevant arguments are
type_mismatch.m:035:   argument 1 (Field1): actual `float', expected `T4';
type_mismatch.m:035:   argument 2 (Field2): actual `float', expected `int'.
For more information, try recompiling with `-E'.

New File: tests/invalid/type_mismatch.m
===================================================================
:- module type_mismatch.

:- interface.

:- type t1		--->	f1(int, int, int).
:- type t2(T2)		--->	f2(T2, int, int).
:- type t3(T3a, T3b)	--->	f3(T3a, T3b, int).
:- type t4(T4)		--->	f4(T4, int, int).

:- pred p1(t1::in, float::out) is semidet.
:- pred p2(t2(F2)::in, float::out) is semidet.
:- pred p3(t3(F3a, F3b)::in, F3c::out) is semidet.
:- pred p4a(t4(F4)::in, float::out) is semidet.
:- pred p4b(t4(F4)::in, float::out, float::out) is semidet.

:- implementation.

p1(Tuple, Field) :-
	Tuple = f1(_, Field, 5).

p2(Tuple, Field) :-
	Tuple = f2(_, Field, 5).

p3(Tuple, Field) :-
	Tuple = f3(_, Field, 5).

% The error message for p4a could be improved. At the moment we only get
% an error for argument 1, since the transformation to superhomogeneous form
% replaces the second occurrence of Field inside f4 with another variable.

p4a(Tuple, Field) :-
	Tuple = f4(Field, Field, 5).

p4b(Tuple, Field1, Field2) :-
	Tuple = f4(Field1, Field2, 5).