for review: fix for spurious mode errors

[Fergus Henderson]

On 02-Oct-1998, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> On 21-Apr-1998, Thomas Charles CONWAY <conway at hydra.cs.mu.oz.au> wrote:
> > 
> > The following module reports a mode error in main when you try to compile it.
> > It also has an undefined predicate foobie called from foldit.
> > If you fix the undefined predicate error in foldit, the mode error in main
> > goes away.
> 
> After much debugging, I have figured out the cause of this error.
> Basically what happens is that since foldit has a type error,
> typecheck.m deletes it from the list of predicates.
> This means that purity.m does not call post_typecheck__finish_pred
> for that predicate, which means that the mode declaration for that
> predicate does not get module-qualified.  This then leads to
> a spurious mode error in main/2 where it calls foldit.

Here's the fix.  Tom, could you please review this one?

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

Estimated hours taken: 6

Fix a bug where type errors were causing spurious mode errors,

compiler/post_typecheck.m:
	Add new predicate post_typecheck__ill_typed_pred,
	which just module-qualifies the pred declaration for that pred.
	This is necessary to avoid spurious mode errors in predicates
	that call the ill-typed pred.

compiler/typecheck.m:
	Call post_typecheck__ill_typed_pred on ill-typed predicates
	before calling module_info_remove_pred.  We need to call it
	here because later passes won't process the pred once it
	has been removed.

tests/invalid/Mmakefile:
tests/invalid/spurious_mode_error.m:
tests/invalid/spurious_mode_error.err_exp:
	Regression test for the above-mentioned bug.

Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.2
diff -u -r1.2 post_typecheck.m
--- post_typecheck.m	1998/07/08 20:57:07	1.2
+++ post_typecheck.m	1998/10/07 05:21:27
@@ -70,6 +70,10 @@
 		pred_info, pred_info, io__state, io__state).
 :- mode post_typecheck__finish_imported_pred(in, in, in, out, di, uo) is det.
 
+:- pred post_typecheck__finish_ill_typed_pred(module_info, pred_id,
+		pred_info, pred_info, io__state, io__state).
+:- mode post_typecheck__finish_ill_typed_pred(in, in, in, out, di, uo) is det.
+
 %-----------------------------------------------------------------------------%
 :- implementation.
 
@@ -301,15 +305,40 @@
 post_typecheck__finish_pred(ModuleInfo, PredId, PredInfo1, PredInfo) -->
 	{ maybe_add_default_mode(ModuleInfo, PredInfo1, PredInfo2, _) },
 	{ copy_clauses_to_procs(PredInfo2, PredInfo3) },
-	post_typecheck__finish_imported_pred(ModuleInfo, PredId,
+	post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
 			PredInfo3, PredInfo).
 
+	%
+	% For ill-typed preds, we just need to set the modes up correctly
+	% so that any calls to that pred from correctly-typed predicates
+	% won't result in spurious mode errors.
+	%
+post_typecheck__finish_ill_typed_pred(ModuleInfo, PredId,
+		PredInfo0, PredInfo) -->
+	{ maybe_add_default_mode(ModuleInfo, PredInfo0, PredInfo1, _) },
+	post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
+		PredInfo1, PredInfo).
+
+	% 
+	% For imported preds, we just need to ensure that all
+	% constructors occurring in predicate mode declarations are
+	% module qualified.
+	% 
+post_typecheck__finish_imported_pred(ModuleInfo, PredId,
+		PredInfo0, PredInfo) -->
+	post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
+		PredInfo0, PredInfo).
+
 	% 
 	% Ensure that all constructors occurring in predicate mode
 	% declarations are module qualified.
 	% 
-post_typecheck__finish_imported_pred(ModuleInfo, PredId, PredInfo0, PredInfo)
-		-->
+:- pred post_typecheck__propagate_types_into_modes(module_info, pred_id,
+		pred_info, pred_info, io__state, io__state).
+:- mode post_typecheck__propagate_types_into_modes(in, in, in, out, di, uo)
+		is det.
+post_typecheck__propagate_types_into_modes(ModuleInfo, PredId, PredInfo0,
+		PredInfo) -->
 	{ pred_info_arg_types(PredInfo0, ArgTypes) },
 	{ pred_info_procedures(PredInfo0, Procs0) },
 	{ pred_info_procids(PredInfo0, ProcIds) },
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.252
diff -u -r1.252 typecheck.m
--- typecheck.m	1998/10/02 06:23:55	1.252
+++ typecheck.m	1998/10/28 10:18:45
@@ -159,6 +159,7 @@
 
 :- implementation.
 
+:- import_module post_typecheck.
 :- import_module hlds_goal, prog_util, type_util, modules, code_util.
 :- import_module prog_data, prog_io, prog_io_util, prog_out, hlds_out.
 :- import_module mercury_to_mercury, mode_util, options, getopt, globals.
@@ -263,33 +264,47 @@
 	(
 		{ pred_info_is_imported(PredInfo0) }
 	->
-		{ Error1 = Error0 },
-		{ ModuleInfo1 = ModuleInfo0 },
+		{ Error2 = Error0 },
+		{ ModuleInfo2 = ModuleInfo0 },
 		{ Changed2 = Changed0 }
 	;
 		typecheck_pred_type(PredId, PredInfo0, ModuleInfo0, 
-			MaybePredInfo, Changed1),
-		{
-			MaybePredInfo = yes(PredInfo),
-			Error1 = Error0,
-			map__det_update(Preds0, PredId, PredInfo, Preds),
-			module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1)
+			PredInfo1, Error1, Changed1),
+		(
+			{ Error1 = no },
+			{ map__det_update(Preds0, PredId, PredInfo1, Preds) },
+			{ module_info_set_preds(ModuleInfo0, Preds,
+				ModuleInfo2) }
 		;
-			MaybePredInfo = no,
-			Error1 = yes,
-			module_info_remove_predid(ModuleInfo0, PredId,
-				ModuleInfo1)
-		},
+			{ Error1 = yes },
+			%
+			% if we get an error, we need to call
+			% post_typecheck__finish_ill_typed_pred on the
+			% pred, to ensure that its mode declaration gets
+			% properly module qualified; then we call
+			% `remove_predid', so that the predicate's definition
+			% will be ignored by later passes (the declaration
+			% will still be used to check any calls to it).
+			%
+			post_typecheck__finish_ill_typed_pred(ModuleInfo0,
+				PredId, PredInfo1, PredInfo),
+			{ map__det_update(Preds0, PredId, PredInfo, Preds) },
+			{ module_info_set_preds(ModuleInfo0, Preds,
+				ModuleInfo1) },
+			{ module_info_remove_predid(ModuleInfo1, PredId,
+				ModuleInfo2) }
+		),
+		{ bool__or(Error0, Error1, Error2) },
 		{ bool__or(Changed0, Changed1, Changed2) }
 	),
-	typecheck_pred_types_2(PredIds, ModuleInfo1, ModuleInfo, 
-		Error1, Error, Changed2, Changed).
+	typecheck_pred_types_2(PredIds, ModuleInfo2, ModuleInfo, 
+		Error2, Error, Changed2, Changed).
 
 :- pred typecheck_pred_type(pred_id, pred_info, module_info,
-	maybe(pred_info), bool, io__state, io__state).
-:- mode typecheck_pred_type(in, in, in, out, out, di, uo) is det.
+		pred_info, bool, bool, io__state, io__state).
+:- mode typecheck_pred_type(in, in, in, out, out, out, di, uo) is det.
 
-typecheck_pred_type(PredId, PredInfo0, ModuleInfo, MaybePredInfo, Changed,
+typecheck_pred_type(PredId, PredInfo0, ModuleInfo, PredInfo, Error, Changed,
 		IOState0, IOState) :-
 	(
 	    % Compiler-generated predicates are created already type-correct,
@@ -308,7 +323,7 @@
 	    ;
 	        PredInfo = PredInfo0
 	    ),
-	    MaybePredInfo = yes(PredInfo),
+	    Error = no,
 	    Changed = no,
 	    IOState = IOState0
 	;
@@ -334,12 +349,13 @@
 				VarTypes, HeadVars, Clauses0),
 			pred_info_set_clauses_info(PredInfo0, ClausesInfo,
 				PredInfo),
-			MaybePredInfo = yes(PredInfo),
+			Error = no,
 			Changed = no
 		;
 			report_error_no_clauses(PredId, PredInfo0, ModuleInfo,
 			    IOState0, IOState),
-			MaybePredInfo = no,
+			PredInfo = PredInfo0,
+			Error = yes,
 			Changed = no
 		)
 	    ;
@@ -513,13 +529,6 @@
 			Changed = no
 		),
 		typecheck_info_get_found_error(TypeCheckInfo4, Error),
-		(
-			Error = yes,
-			MaybePredInfo = no
-		;
-			Error = no,
-			MaybePredInfo = yes(PredInfo)
-		),
 		typecheck_info_get_io_state(TypeCheckInfo4, IOState)
 	    )
 	).
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.30
diff -u -r1.30 Mmakefile
--- Mmakefile	1998/10/28 06:15:19	1.30
+++ Mmakefile	1998/10/28 10:23:28
@@ -41,6 +41,7 @@
 	prog_io_erroneous.m \
 	qual_basic_test2.m \
 	qualified_cons_id2.m \
+	spurious_mode_error.m \
 	test_nested.m \
 	type_inf_loop.m \
 	type_loop.m \
Index: tests/invalid/spurious_mode_error.err_exp
===================================================================
RCS file: spurious_mode_error.err_exp
diff -N spurious_mode_error.err_exp
--- /dev/null	Wed Oct 28 21:24:31 1998
+++ spurious_mode_error.err_exp	Wed Oct 28 21:24:04 1998
@@ -0,0 +1,3 @@
+spurious_mode_error.m:079: In clause for predicate `spurious_mode_error:foldit/4':
+spurious_mode_error.m:079:   error: undefined predicate `foobie/3'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/spurious_mode_error.m
===================================================================
RCS file: spurious_mode_error.m
diff -N spurious_mode_error.m
--- /dev/null	Wed Oct 28 21:24:31 1998
+++ spurious_mode_error.m	Wed Oct 28 21:23:44 1998
@@ -0,0 +1,126 @@
+:- module spurious_mode_error.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module char, float, int, list, string, std_util.
+
+:- type opt(T)
+	--->	a(pred(int, T, T))
+	;	b(pred(string, T, T))
+	;	c(pred(float, T, T))
+	.
+
+:- inst opt = bound((
+		a(pred(in, in, out) is det)
+	;	b(pred(in, in, out) is det)
+	;	c(pred(in, in, out) is det)
+)).
+
+:- type f(T)
+	--->	f(
+			maybe(pred(int, T, T)),
+			maybe(pred(string, T, T)),
+			maybe(pred(float, T, T))
+		).
+
+:- inst m(I) = bound((no ; yes(I))).
+
+:- inst f = bound(f(
+		m(pred(in, in, out) is det),
+		m(pred(in, in, out) is det),
+		m(pred(in, in, out) is det)
+	)).
+
+main -->
+	{ makeit([a(foo), b(bar), c(baz)], f(no, no, no), Thing) },
+	{ foldit([i(23), s("42"), f(4.2)], Thing, 0, Stuff) },
+	write(Stuff).
+
+:- pred foldit(list(string__poly_type), f(T), T, T).
+:- mode foldit(in, in(f), in, out) is det.
+
+foldit([], _F, T, T).
+foldit([X|Xs], F, T0, T) :-
+	(
+		X = i(I),
+		(
+			F = f(no, _, _),
+			T1 = T0
+		;
+			F = f(yes(Z), _, _),
+			call(Z, I, T0, T1)
+		)
+	;
+		X = s(S),
+		(
+			F = f(_, no, _),
+			T1 = T0
+		;
+			F = f(_, yes(Z), _),
+			call(Z, S, T0, T1)
+		)
+	;
+		X = f(W),
+		(
+			F = f(_, _, no),
+			T1 = T0
+		;
+			F = f(_, _, yes(Z)),
+			call(Z, W, T0, T1)
+		)
+	;
+		X = c(J),
+		foobie(J, T0, T1)
+	),
+	foldit(Xs, F, T1, T).
+
+:- pred makeit(list(opt(T)), f(T), f(T)).
+:- mode makeit(in(list_skel(opt)), in(f), out(f)) is det.
+
+makeit([], F, F).
+makeit([Opt|Opts], F0, F) :-
+	add_opt(Opt, F0, F1),
+	makeit(Opts, F1, F).
+
+:- pred add_opt(opt(T), f(T), f(T)).
+:- mode add_opt(in(opt), in(f), out(f)) is det.
+
+add_opt(a(Z), F0, F) :-
+	F0 = f(_, B, C),
+	F = f(yes(Z), B, C).
+add_opt(b(Z), F0, F) :-
+	F0 = f(A, _, C),
+	F = f(A, yes(Z), C).
+add_opt(c(Z), F0, F) :-
+	F0 = f(A, B, _),
+	F = f(A, B, yes(Z)).
+
+:- pred foo(int, T, T).
+:- mode foo(in, in, out) is det.
+
+foo(_, T, T).
+
+:- pred bar(string, T, T).
+:- mode bar(in, in, out) is det.
+
+bar(_, T, T).
+
+:- pred baz(float, T, T).
+:- mode baz(in, in, out) is det.
+
+baz(_, T, T).
+
+/* XXX to make the bug go away, uncomment this predicate!
+:- pred foobie(char, T, T).
+:- mode foobie(in, in, out) is det.
+
+foobie(_, T, T).
+*/
+
+

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