[m-dev.] for review: polymorphic unification not (in, in)

[Warwick Harvey]

Fergus wrote:
> As well as the inverted condition that dgj noticed, I think you should
> also fix the unnecessary code duplication.

OK, here's a revised diff which should address all the issues raised.


Estimated hours taken: 3

Include a context in the error message output when polymorphic
unification is attempted with a non-ground instantiation.

compiler/polymorphism.m:
	Include a context in the error message output when polymorphic
	unification is attempted with a non-ground instantiation.

compiler/prog_out.m:
	Add a context_to_string/2 predicate, which writes a context to a
	string (rather than writing it out directly).
	Rearranged and cleaned up some of the related predicates to make
	use of the new predicate, to avoid code duplication and unnecessary
	runtime calls.


Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.156
diff -u -r1.156 polymorphism.m
--- polymorphism.m	1998/11/20 04:08:48	1.156
+++ polymorphism.m	1998/12/03 00:47:23
@@ -949,10 +949,19 @@
 				error("polymorphism.m: can't find `builtin:unify/2'")
 			},
 			{ Mode = XMode - YMode },
-			{ require(mode_is_fully_input(ModuleInfo, XMode),
-				"Sorry, not implemented: polymorphic unification in mode other than (in, in)") },
-			{ require(mode_is_fully_input(ModuleInfo, YMode),
-				"Sorry, not implemented: polymorphic unification in mode other than (in, in)") },
+			{
+				mode_is_fully_input(ModuleInfo, XMode),
+				mode_is_fully_input(ModuleInfo, YMode)
+			->
+				true
+			;
+				goal_info_get_context(GoalInfo, GoalContext),
+				context_to_string(GoalContext, ContextMsg),
+				string__append(ContextMsg,
+"Sorry, not implemented: polymorphic unification in mode other than (in, in)",
+						ErrorMsg),
+				error(ErrorMsg)
+			},
 			{ hlds_pred__in_in_unification_proc_id(ProcId) },
 			{ map__lookup(TypeInfoMap, TypeVar, TypeInfoLocn) },
 			{ SymName = unqualified("unify") },
Index: compiler/prog_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_out.m,v
retrieving revision 1.39
diff -u -r1.39 prog_out.m
--- prog_out.m	1998/11/20 04:09:03	1.39
+++ prog_out.m	1998/12/03 00:39:24
@@ -27,6 +27,9 @@
 :- pred prog_out__write_context(prog_context, io__state, io__state).
 :- mode prog_out__write_context(in, di, uo) is det.
 
+:- pred prog_out__context_to_string(prog_context, string).
+:- mode prog_out__context_to_string(in, out) is det.
+
 	% XXX This pred should be deleted, and all uses replaced with
 	% XXX error_util:write_error_pieces, once zs has committed that
 	% XXX error_util.m.
@@ -107,39 +110,46 @@
 	% error message.
 
 prog_out__write_context(Context) -->
-	prog_out__write_context_2(Context, _).
+	{ prog_out__context_to_string(Context, ContextMessage) },
+	io__write_string(ContextMessage).
+
+%-----------------------------------------------------------------------------%
 
-:- pred prog_out__write_context_2(prog_context, int, io__state, io__state).
-:- mode prog_out__write_context_2(in, out, di, uo) is det.
+	% Write to a string the information in term context (at the moment,
+	% just the line number) in a form suitable for the beginning of an
+	% error message.
 
-prog_out__write_context_2(Context, Length) -->
-	{ term__context_file(Context, FileName) },
-	{ term__context_line(Context, LineNumber) },
-	( { FileName = "" } ->
-		{ Length = 0 }
+prog_out__context_to_string(Context, ContextMessage) :-
+	term__context_file(Context, FileName),
+	term__context_line(Context, LineNumber),
+	( FileName = "" ->
+		ContextMessage = ""
 	;
-		{ string__format("%s:%03d: ", [s(FileName), i(LineNumber)],
-			ContextMessage) }, 
-		io__write_string(ContextMessage),
-		{ string__length(ContextMessage, Length) }
+		string__format("%s:%03d: ", [s(FileName), i(LineNumber)],
+			ContextMessage)
 	).
 
 %-----------------------------------------------------------------------------%
 
 prog_out__write_strings_with_context(Context, Strings) -->
-	prog_out__write_strings_with_context_2(Context, Strings, 0).
+	{ prog_out__context_to_string(Context, ContextMessage) },
+	{ string__length(ContextMessage, ContextLength) },
+	prog_out__write_strings_with_context_2(ContextMessage,
+			ContextLength, Strings, 0).
 
-:- pred prog_out__write_strings_with_context_2(prog_context, list(string), int,
+:- pred prog_out__write_strings_with_context_2(string, int, list(string), int,
 	io__state, io__state).
-:- mode prog_out__write_strings_with_context_2(in, in, in, di, uo) is det.
+:- mode prog_out__write_strings_with_context_2(in, in, in, in, di, uo) is det.
 
-prog_out__write_strings_with_context_2(_Context, [], _) --> [].
-prog_out__write_strings_with_context_2(Context, [S|Ss], N0) -->
+prog_out__write_strings_with_context_2(_ContextMessage, _ContextLength,
+		[], _) --> [].
+prog_out__write_strings_with_context_2(ContextMessage, ContextLength,
+		[S|Ss], N0) -->
 	{ string__length(S, MessageLength) },
 	(
 		{ N0 = 0 }
 	->
-		prog_out__write_context_2(Context, ContextLength),
+		io__write_string(ContextMessage),
 		io__write_string("  "),
 		io__write_string(S),
 		{ N is ContextLength + MessageLength },
@@ -157,7 +167,8 @@
 		{ N = 0 },
 		{ Rest = [S|Ss] }
 	),
-	prog_out__write_strings_with_context_2(Context, Rest, N).
+	prog_out__write_strings_with_context_2(ContextMessage,
+			ContextLength, Rest, N).
 
 
 :- pred num_columns(int::out) is det.