[m-rev.] for review: minor tweaks to type error messages

[Fergus Henderson]

Estimated hours taken: 1
Branches: main

compiler/typecheck.m:
compiler/mercury_to_mercury.m:
	Improve the output for higher-order terms.

Workspace: /home/mars/fjh/ws1/mercury
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.185
diff -u -d -r1.185 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	2001/05/02 17:34:38	1.185
+++ compiler/mercury_to_mercury.m	2001/05/10 18:02:09
@@ -2602,6 +2602,16 @@
 mercury_output_term(term__functor(Functor, Args, _), VarSet, AppendVarnums,
 		NextToGraphicToken) -->
 	(
+	    	{ Functor = term__atom("") },
+		{ Args = [F, X | Xs] }
+	->
+		mercury_output_term(F, VarSet, AppendVarnums,
+			NextToGraphicToken),
+		io__write_string("("),
+		mercury_output_term(X, VarSet, AppendVarnums),
+		mercury_output_remaining_terms(Xs, VarSet, AppendVarnums),
+		io__write_string(")")
+	;
 	    	{ Functor = term__atom(".") },
 		{ Args = [X, Xs] }
 	->
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.301
diff -u -d -r1.301 typecheck.m
--- compiler/typecheck.m	2001/04/30 10:59:07	1.301
+++ compiler/typecheck.m	2001/05/10 18:28:30
@@ -4852,7 +4852,8 @@
 			Mismatches) },
 		{ Mismatches = [_|_] }
 	->
-		report_mismatched_args(Mismatches, yes, VarSet, Context)
+		report_mismatched_args(Mismatches, yes, VarSet, Functor,
+			Context)
 	;
 
 		{ conv_args_type_assign_set(ArgsTypeAssignSet,
@@ -4930,20 +4931,40 @@
 				TVarSet) | Mismatched1]
 	).
 
-:- pred report_mismatched_args(list(mismatch_info), bool, prog_varset,
+:- pred report_mismatched_args(list(mismatch_info), bool, prog_varset, cons_id,
 		prog_context, io__state, io__state).
-:- mode report_mismatched_args(in, in, in, in, di, uo) is det.
+:- mode report_mismatched_args(in, in, in, in, in, di, uo) is det.
 
-report_mismatched_args([], _, _, _) --> [].
-report_mismatched_args([Mismatch | Mismatches], First, VarSet, Context) -->
+report_mismatched_args([], _, _, _, _) --> [].
+report_mismatched_args([Mismatch | Mismatches], First, VarSet, Functor,
+		Context) -->
 	{ Mismatch = mismatch(ArgNum, Var, ActType, ExpType, TVarSet) },
 	prog_out__write_context(Context),
-	( { First = yes } ->
-		io__write_string("  Argument ")
+	(
+		% Handle higher-order syntax such as ''(F, A) specially:
+		% output 
+		%	Functor (F) has type ...;
+		%	argument 1 (A) has type ...
+		% instead of
+		%	Argument 1 (F) has type ...;
+		%	argument 2 (A) has type ...
+		{ Functor = cons(unqualified(""), Arity) },
+		{ Arity > 0 }
+	->
+		( { First = yes } ->
+			io__write_string("  Functor")
+		;
+			io__write_string("  argument "),
+			io__write_int(ArgNum - 1)
+		)
 	;
-		io__write_string("  argument ")
+		( { First = yes } ->
+			io__write_string("  Argument ")
+		;
+			io__write_string("  argument ")
+		),
+		io__write_int(ArgNum)
 	),
-	io__write_int(ArgNum),
 	( { varset__search_name(VarSet, Var, _) } ->
 		io__write_string(" ("),
 		mercury_output_var(Var, VarSet, no),
@@ -4961,7 +4982,7 @@
 		io__write_string("'.\n")
 	;
 		io__write_string("';\n"),
-		report_mismatched_args(Mismatches, no, VarSet, Context)
+		report_mismatched_args(Mismatches, no, VarSet, Functor, Context)
 	).
 
 :- pred write_types_of_vars(list(prog_var), prog_varset, prog_context,
@@ -5003,12 +5024,17 @@
 			prog_out__write_sym_name(Name)
 		;
 			hlds_out__write_cons_id(Functor1)
-		)
+		),
+		io__write_string("'")
+	; { Functor = cons(unqualified(""), _) } ->
+		io__write_string("higher-order term (with arity "),
+		io__write_int(Arity - 1),
+		io__write_string(")")
 	;
 		io__write_string("functor `"),
-		hlds_out__write_cons_id(Functor1)
-	),
-	io__write_string("'").
+		hlds_out__write_cons_id(Functor1),
+		io__write_string("'")
+	).
 
 :- pred write_type_of_var(typecheck_info, type_assign_set, prog_var,
 				io__state, io__state).

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------