[m-dev.] diff: fix flow-on error with unsatisfied type class constraints

[Fergus Henderson]

Estimated hours taken: 1

Fix a bug reported by Ralph Becket <rbeck at microsoft.com>.

compiler/mercury_compile.m:
compiler/purity.m:
	If we find any unsatisfied type class constraints, then stop
	compilation before running polymorphism.m, because polymorphism.m
	gets internal errors if you run it on code which has unsatisfied
	type class constraints.

Workspace: /home/mercury0/fjh/mercury
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.140
diff -u -d -r1.140 mercury_compile.m
--- mercury_compile.m	1999/10/19 03:16:18	1.140
+++ mercury_compile.m	1999/11/03 04:05:09
@@ -713,7 +713,7 @@
 	        % Run purity checking
 	        %
 		mercury_compile__puritycheck(FoundTypeError, HLDS3,
-			Verbose, Stats, HLDS4),
+			Verbose, Stats, HLDS4, FoundPostTypecheckError),
 		mercury_compile__maybe_dump_hlds(HLDS4, "04", "puritycheck"),
 
 	        %
@@ -724,7 +724,7 @@
 		    { HLDS = HLDS4 },
 		    { bool__or(FoundTypeError, FoundTypeclassError,
 		    	FoundError) }
-	        ; { FoundTypeError = yes } ->
+	        ; { FoundTypeError = yes ; FoundPostTypecheckError = yes } ->
 		    %
 		    % XXX it would be nice if we could go on and mode-check
 		    % the predicates which didn't have type errors, but
@@ -1284,12 +1284,13 @@
 %-----------------------------------------------------------------------------%
 
 :- pred mercury_compile__puritycheck(bool, module_info, bool, bool,
-				module_info, io__state, io__state).
-:- mode mercury_compile__puritycheck(in, in, in, in, out, di, uo) is det.
+				module_info, bool, io__state, io__state).
+:- mode mercury_compile__puritycheck(in, in, in, in, out, out, di, uo) is det.
 
-mercury_compile__puritycheck(FoundTypeError, HLDS0, Verbose, Stats, HLDS) -->
+mercury_compile__puritycheck(FoundTypeError, HLDS0, Verbose, Stats,
+		HLDS, FoundPostTypecheckError) -->
 	{ module_info_num_errors(HLDS0, NumErrors0) },
-	puritycheck(FoundTypeError, HLDS0, HLDS),
+	puritycheck(FoundTypeError, HLDS0, FoundPostTypecheckError, HLDS),
 	{ module_info_num_errors(HLDS, NumErrors) },
 	( { NumErrors \= NumErrors0 } ->
 		maybe_write_string(Verbose,
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.20
diff -u -d -r1.20 purity.m
--- purity.m	1999/10/25 03:49:34	1.20
+++ purity.m	1999/11/03 04:03:09
@@ -20,7 +20,9 @@
 %	  HLDS call instructions, but currently that is done
 %	  in polymorphism.m)
 %	- it checks for unbound type variables and if there are any,
-%	  it reports an error (or a warning, binding them to the type `void').
+%	  it reports an error (or a warning, binding them to the type `void');
+%	  similarly it checks for unsatisfied type class constraints.
+%
 %  These actions cannot be done until after type inference is complete,
 %  so they need to be a separate "post-typecheck pass"; they are done
 %  here in combination with the purity-analysis pass for efficiency reasons.
@@ -91,12 +93,16 @@
 % 			;	(semipure)
 % 			;	(impure).
 
-%  Purity check a whole module.
+%  Purity check a whole module.  Also do the post-typecheck stuff
+%  described above, and eliminate double negations.
 %  The first argument specifies whether there were any type
 %  errors (if so, we suppress some diagnostics in post_typecheck.m
 %  because they are usually spurious).
-:- pred puritycheck(bool, module_info, module_info, io__state, io__state).
-:- mode puritycheck(in, in, out, di, uo) is det.
+%  The third argument specifies whether post_typecheck.m detected
+%  any errors that would cause problems for later passes
+%  (if so, we stop compilation after this pass).
+:- pred puritycheck(bool, module_info, bool, module_info, io__state, io__state).
+:- mode puritycheck(in, in, out, out, di, uo) is det.
 
 %  Sort of a "maximum" for impurity.
 :- pred worst_purity(purity, purity, purity).
@@ -153,14 +159,14 @@
 %				Public Predicates
 
 
-puritycheck(FoundTypeError, HLDS0, HLDS) -->
+puritycheck(FoundTypeError, HLDS0, PostTypecheckError, HLDS) -->
 	globals__io_lookup_bool_option(statistics, Statistics),
 	globals__io_lookup_bool_option(verbose, Verbose),
 	io__stderr_stream(StdErr),
 	io__set_output_stream(StdErr, OldStream),
 
 	maybe_write_string(Verbose, "% Purity-checking clauses...\n"),
-	check_preds_purity(FoundTypeError, HLDS0, HLDS),
+	check_preds_purity(FoundTypeError, HLDS0, PostTypecheckError, HLDS),
 	maybe_report_stats(Statistics),
 
 	io__set_output_stream(OldStream, _).
@@ -240,27 +246,29 @@
 %-----------------------------------------------------------------------------%
 %	 Purity-check the code for all the predicates in a module
 
-:- pred check_preds_purity(bool, module_info, module_info,
+:- pred check_preds_purity(bool, module_info, bool, module_info,
 			io__state, io__state).
-:- mode check_preds_purity(in, in, out, di, uo) is det.
+:- mode check_preds_purity(in, in, out, out, di, uo) is det.
 
-check_preds_purity(FoundTypeError, ModuleInfo0, ModuleInfo) -->
+check_preds_purity(FoundTypeError, ModuleInfo0,
+		PostTypecheckError, ModuleInfo) -->
 	{ module_info_predids(ModuleInfo0, PredIds) },
 	check_preds_purity_2(PredIds, FoundTypeError, ModuleInfo0,
-		ModuleInfo1, 0, NumErrors),
+		ModuleInfo1, 0, NumErrors, no, PostTypecheckError),
 	{ module_info_num_errors(ModuleInfo1, Errs0) },
 	{ Errs is Errs0 + NumErrors },
 	{ module_info_set_num_errors(ModuleInfo1, Errs, ModuleInfo) }.
 
 
 :- pred check_preds_purity_2(list(pred_id), bool, module_info, module_info,
-			int, int, io__state, io__state).
-:- mode check_preds_purity_2(in, in, in, out, in, out, di, uo) is det.
+			int, int, bool, bool, io__state, io__state).
+:- mode check_preds_purity_2(in, in, in, out, in, out, in, out, di, uo) is det.
 
-check_preds_purity_2([], _, ModuleInfo, ModuleInfo,
-		NumErrors, NumErrors) --> [].
+check_preds_purity_2([], _, ModuleInfo, ModuleInfo, NumErrors, NumErrors,
+		PostTypecheckError, PostTypecheckError) --> [].
 check_preds_purity_2([PredId | PredIds], FoundTypeError, ModuleInfo0,
-		ModuleInfo, NumErrors0, NumErrors) -->
+		ModuleInfo, NumErrors0, NumErrors,
+		PostTypecheckError0, PostTypecheckError) -->
 	{ module_info_preds(ModuleInfo0, Preds0) },
 	{ map__lookup(Preds0, PredId, PredInfo0) },
 	(	
@@ -269,7 +277,8 @@
 	->
 		post_typecheck__finish_imported_pred(ModuleInfo0, PredId,
 				PredInfo0, PredInfo),
-		{ NumErrors1 = NumErrors0 }
+		{ NumErrors1 = NumErrors0 },
+		{ PostTypecheckError1 = PostTypecheckError0 }
 	;
 		write_pred_progress_message("% Purity-checking ", PredId,
 					    ModuleInfo0),
@@ -282,6 +291,17 @@
 		post_typecheck__check_type_bindings(PredId, PredInfo0,
 				ModuleInfo0, ReportErrs,
 				PredInfo1, UnboundTypeErrsInThisPred),
+		%
+		% if there were any unsatisfied type class constraints,
+		% then that can cause internal errors in polymorphism.m
+		% if we try to continue, so we need to halt compilation
+		% after this pass.
+		%
+		{ UnboundTypeErrsInThisPred \= 0 ->
+			PostTypecheckError1 = yes
+		;
+			PostTypecheckError1 = PostTypecheckError0
+		},
 		puritycheck_pred(PredId, PredInfo1, PredInfo2, ModuleInfo0,
 				PurityErrsInThisPred),
 		post_typecheck__finish_pred(ModuleInfo0, PredId, PredInfo2,
@@ -304,7 +324,8 @@
 		{ ModuleInfo2 = ModuleInfo1 }
 	),
 	check_preds_purity_2(PredIds, FoundTypeError, ModuleInfo2, ModuleInfo,
-				  NumErrors1, NumErrors).
+				  NumErrors1, NumErrors,
+				  PostTypecheckError1, PostTypecheckError).
 
 	% Purity-check the code for single predicate, reporting any errors.
 

-- 
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.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------