[m-dev.] diff: bug fixes for the existential_types_2 branch

[Fergus Henderson]

Estimated hours taken: 8

Various changes to fix test case failures in the existential_types_2
branch.

compiler/simplify.m:
	Delete a bogus sanity check that I had added, since the check
	was failing even in cases which made perfect sense.
	(This one was stopping the compiler from bootstrapping.)

	Delete an obsolete XXX comment about something that has already
	been fixed.

	When converting polymorphic complicated unifications into
	calls to unification procedures, we need to insert the
	type_info variables into the goal_info non-locals set.

compiler/simplify.m:
compiler/det_report.m:
	Fix a couple of old XXXs: issue warnings when optimizing away
	goals with determinism failure or det goals that have no outputs.
	This is needed to ensure that we still issue a warning for several
	of the goals in tests/warnings/simple_code.m.  The previous
	warnings were no longer being issued because this optimization was
	optimization away the relevant code before it could be warned about.

tests/warnings/simple_code.exp:
	Update to reflect the new warnings.

compiler/dependency_graph.m:
	Don't include imported modes of pseudo_imported predicates
	(i.e. (in,in) modes of unification predicates) in the dependency
	graph.  The treatment of pseudo_imported predicates in
	dependency_graph.m needs to match the way they are treated
	by polymorphism.m and other parts of the compiler.

compiler/polymorphism.m:
	Update the headvars field of the proc_info for imported procedures
	to include the type_info variables.  This is necessary because
	some parts of the compiler (e.g. unused_args.m) depend on the
	headvars field being valid even for imported procedures.

	Also fix a bug introduced in my changes to polymorphism.m -- I was
	passing down the wrong HeadVars to polymorphism__produce_existq_tvars.

compiler/post_typecheck.m:
compiler/purity.m:
	Ensure that we always bind any unbound type variables to `void'
	before running polymorphism, even if there were type errors.
	This avoids some internal errors in polymorphism.m.

compiler/mercury_compile.m:
	Fix a formatting error in one of the progress messages.

compiler/modes.m:
compiler/unique_modes.m:
	Ensure that mode analysis always stops analysing things once the
	instmap becomes unreachable.  It already did this for conjunctions,
	most of the time, but there were several other cases
	(if-then-elses and switches) where it did not.
	The aim of this change is to stop mode inference from creating
	modes for procedures with initial insts `not_reached'.
	
compiler/modecheck_unify.m:
	Handle the case where an unification is initially inferred as
	a non-complicated unification, and then gets re-modechecked
	with the instmap being unreachable.  The code here was assuming
	that a non-complicated unification can never get turned into
	a complicated unification on re-modechecking, but `not_reached'
	unifications where being classified as complicated.
	The above change to modes.m and unique_modes.m should avoid this
	situation, but I thought it was safest to fix the code here too,
	just in case.

compiler/modes.m:
compiler/modecheck_call.m:
compiler/mode_util.m:
	Pass the type down to normalise_inst and ensure that for type_info
	types, it never return a unique inst.  The aim is to stop mode
	inference from inferring unique modes for the type_info arguments
	introduce by polymorphism.m, since unique modes are never useful
	for those arguments, and allowing mode inference to infer
	unique modes for them leads to it inferring unnecessarily many modes.

	(Without this change, the test case tests/valid/uniq_mode_inf_bug.m
	fails, due to a bug in the existing mode inference stuff unrelated 
	to my polymorphism / existential types changes.  The bug is that
	modecheck_queued_procs needs to run ordinary mode analysis to a
	fixpoint before running determinism analysis, etc.)

tests/hard_coded/Mmakefile:
	Fix a bug: compile lp.m with the same options as bigtest.m.
	Without this, bigtest was getting link errors due to unsatisfied
	symbols in lp.m.  The problem was due to bigtest.m being compiled
	with intermodule optimization, and lp.m being compiled without
	intermodule optimization.  This lead to bigtest.o containing
	inlined references to local routines in lp.m, but lp.o not exporting
	those symbols because intermodule optimization had not been enabled
	when it was compiled.

Workspace: /home/mercury0/fjh/mercury-other
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.40.2.1
diff -u -r1.40.2.1 dependency_graph.m
--- dependency_graph.m	1999/06/10 16:10:13	1.40.2.1
+++ dependency_graph.m	1999/06/12 00:42:26
@@ -10,6 +10,8 @@
 % The dependency_graph records which procedures depend on which other
 % procedures.  It is defined as a relation (see hlds_module.m) R where xRy
 % means that the definition of x depends on the definition of y.
+% Note that imported procedures are not included in the dependency_graph
+% (although opt_imported procedures are included).
 %
 % The other important structure is the dependency_ordering which is
 % a list of the cliques (strongly-connected components) of this relation,
@@ -119,19 +121,14 @@
                                         DepGraph0, DepGraph) :-
         module_info_preds(ModuleInfo, PredTable),
         map__lookup(PredTable, PredId, PredInfo),
-	(
-		% Don't bother adding nodes (or arcs) for predicates
-		% which which are imported (ie we don't have any `clauses'
-		% for).
-		pred_info_is_imported(PredInfo)
-	->
-		DepGraph1 = DepGraph0
-	;
-		pred_info_procids(PredInfo, ProcIds),
-		dependency_graph__add_proc_nodes(ProcIds, PredId, ModuleInfo,
-			DepGraph0, DepGraph1)
-	),
-        dependency_graph__add_pred_nodes(PredIds, ModuleInfo, DepGraph1, DepGraph).
+	% Don't bother adding nodes (or arcs) for procedures
+	% which which are imported (ie we don't have any `clauses'
+	% for).
+	pred_info_non_imported_procids(PredInfo, ProcIds),
+	dependency_graph__add_proc_nodes(ProcIds, PredId, ModuleInfo,
+		DepGraph0, DepGraph1),
+        dependency_graph__add_pred_nodes(PredIds, ModuleInfo,
+		DepGraph1, DepGraph).
 
 :- pred dependency_graph__add_proc_nodes(list(proc_id), pred_id, module_info,
                         dependency_graph, dependency_graph).
@@ -156,16 +153,11 @@
 					DepGraph0, DepGraph) :-
 	module_info_preds(ModuleInfo, PredTable),
 	map__lookup(PredTable, PredId, PredInfo),
-	(
-		pred_info_is_imported(PredInfo)
-	->
-		DepGraph1 = DepGraph0
-	;
-		pred_info_procids(PredInfo, ProcIds),
-		dependency_graph__add_proc_arcs(ProcIds, PredId, ModuleInfo,
-			DepGraph0, DepGraph1)
-	),
-	dependency_graph__add_pred_arcs(PredIds, ModuleInfo, DepGraph1, DepGraph).
+	pred_info_non_imported_procids(PredInfo, ProcIds),
+	dependency_graph__add_proc_arcs(ProcIds, PredId, ModuleInfo,
+			DepGraph0, DepGraph1),
+	dependency_graph__add_pred_arcs(PredIds, ModuleInfo,
+			DepGraph1, DepGraph).
 
 :- pred dependency_graph__add_proc_arcs(list(proc_id), pred_id, module_info,
 			dependency_graph, dependency_graph).
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.54
diff -u -r1.54 det_report.m
--- det_report.m	1998/11/20 04:07:27	1.54
+++ det_report.m	1999/06/12 00:42:26
@@ -29,6 +29,8 @@
 		;	ite_cond_cannot_succeed(prog_context)
 		;	negated_goal_cannot_fail(prog_context)
 		;	negated_goal_cannot_succeed(prog_context)
+		;	goal_cannot_succeed(prog_context)
+		;	det_goal_has_no_outputs(prog_context)
 		;	warn_obsolete(pred_id, prog_context)
 				% warning about calls to predicates
 				% for which there is a `:- pragma obsolete'
@@ -997,7 +999,9 @@
 det_msg_get_type(ite_cond_cannot_succeed(_), simple_code_warning).
 det_msg_get_type(negated_goal_cannot_fail(_), simple_code_warning).
 det_msg_get_type(negated_goal_cannot_succeed(_), simple_code_warning).
-	% XXX this isn't really a simple code warning.
+det_msg_get_type(goal_cannot_succeed(_), simple_code_warning).
+det_msg_get_type(det_goal_has_no_outputs(_), simple_code_warning).
+	% XXX warn_obsolete isn't really a simple code warning.
 	% We should add a separate warning type for this.
 det_msg_get_type(warn_obsolete(_, _), simple_code_warning).
 det_msg_get_type(warn_infinite_recursion(_), simple_code_warning).
@@ -1019,6 +1023,8 @@
 det_msg_is_any_mode_msg(ite_cond_cannot_succeed(_), all_modes).
 det_msg_is_any_mode_msg(negated_goal_cannot_fail(_), all_modes).
 det_msg_is_any_mode_msg(negated_goal_cannot_succeed(_), all_modes).
+det_msg_is_any_mode_msg(goal_cannot_succeed(_), all_modes).
+det_msg_is_any_mode_msg(det_goal_has_no_outputs(_), all_modes).
 det_msg_is_any_mode_msg(warn_obsolete(_, _), all_modes).
 det_msg_is_any_mode_msg(warn_infinite_recursion(_), any_mode).
 det_msg_is_any_mode_msg(duplicate_call(_, _, _), any_mode).
@@ -1076,6 +1082,28 @@
 det_report_msg(negated_goal_cannot_succeed(Context), _) -->
 	prog_out__write_context(Context),
 	io__write_string("Warning: the negated goal cannot succeed.\n").
+det_report_msg(goal_cannot_succeed(Context), _) -->
+	prog_out__write_context(Context),
+	io__write_string("Warning: this goal cannot succeed.\n"),
+	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+	( { VerboseErrors = yes } ->
+		io__write_string(
+"\tThe compiler will optimize away this goal, replacing it with `fail'.
+\tTo disable this optimization, use the `--fully-strict' option.\n")
+	;
+		[]
+	).
+det_report_msg(det_goal_has_no_outputs(Context), _) -->
+	prog_out__write_context(Context),
+	io__write_string("Warning: det goal has no outputs.\n"),
+	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+	( { VerboseErrors = yes } ->
+		io__write_string(
+"\tThe compiler will optimize away this goal, replacing it with `true'.
+\tTo disable this optimization, use the `--fully-strict' option.\n")
+	;
+		[]
+	).
 det_report_msg(warn_obsolete(PredId, Context), ModuleInfo) -->
 	prog_out__write_context(Context),
 	io__write_string("Warning: call to obsolete "),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.128.2.1
diff -u -r1.128.2.1 mercury_compile.m
--- mercury_compile.m	1999/06/10 16:10:35	1.128.2.1
+++ mercury_compile.m	1999/06/12 00:42:26
@@ -1700,7 +1700,7 @@
 		maybe_write_string(Verbose, "% Deforestation...\n"),
 		maybe_flush_output(Verbose),
 		deforestation(HLDS0, HLDS),
-		maybe_write_string(Verbose, " done.\n"),
+		maybe_write_string(Verbose, "% done.\n"),
 		maybe_report_stats(Stats)
 	;
 		{ HLDS0 = HLDS }
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.114
diff -u -r1.114 mode_util.m
--- mode_util.m	1998/12/06 23:43:52	1.114
+++ mode_util.m	1999/06/12 00:42:26
@@ -157,11 +157,11 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred normalise_insts(list(inst), module_info, list(inst)).
-:- mode normalise_insts(in, in, out) is det.
+:- pred normalise_insts(list(inst), list(type), module_info, list(inst)).
+:- mode normalise_insts(in, in, in, out) is det.
 
-:- pred normalise_inst(inst, module_info, inst).
-:- mode normalise_inst(in, in, out) is det.
+:- pred normalise_inst(inst, (type), module_info, inst).
+:- mode normalise_inst(in, in, in, out) is det.
 
 %-----------------------------------------------------------------------------%
 
@@ -182,7 +182,7 @@
 
 :- implementation.
 :- import_module require, int, map, set, std_util, assoc_list.
-:- import_module prog_util, type_util.
+:- import_module prog_util, prog_io, type_util.
 :- import_module inst_match, inst_util, term.
 
 %-----------------------------------------------------------------------------%
@@ -1509,27 +1509,39 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-normalise_insts([], _, []).
-normalise_insts([Inst0|Insts0], ModuleInfo, [Inst|Insts]) :-
-	normalise_inst(Inst0, ModuleInfo, Inst),
-	normalise_insts(Insts0, ModuleInfo, Insts).
+normalise_insts([], [], _, []).
+normalise_insts([Inst0|Insts0], [Type|Types], ModuleInfo, [Inst|Insts]) :-
+	normalise_inst(Inst0, Type, ModuleInfo, Inst),
+	normalise_insts(Insts0, Types, ModuleInfo, Insts).
+normalise_insts([], [_|_], _, _) :-
+	error("normalise_insts: length mismatch").
+normalise_insts([_|_], [], _, _) :-
+	error("normalise_insts: length mismatch").
 
 	% This is a bit of a hack.
 	% The aim is to avoid non-termination due to the creation
 	% of ever-expanding insts.
 	% XXX should also normalise partially instantiated insts.
 
-normalise_inst(Inst0, ModuleInfo, NormalisedInst) :-
+normalise_inst(Inst0, Type, ModuleInfo, NormalisedInst) :-
 	inst_expand(ModuleInfo, Inst0, Inst),
 	( Inst = bound(_, _) ->
 		(
 			inst_is_ground(ModuleInfo, Inst),
-			inst_is_unique(ModuleInfo, Inst)
+			inst_is_unique(ModuleInfo, Inst),
+			% don't infer unique modes for introduced type_infos
+			% arguments, because that leads to an increase
+			% in the number of inferred modes without any benefit
+			\+ is_introduced_type_info_type(Type)
 		->
 			NormalisedInst = ground(unique, no)
 		;
 			inst_is_ground(ModuleInfo, Inst),
-			inst_is_mostly_unique(ModuleInfo, Inst)
+			inst_is_mostly_unique(ModuleInfo, Inst),
+			% don't infer unique modes for introduced type_infos
+			% arguments, because that leads to an increase
+			% in the number of inferred modes without any benefit
+			\+ is_introduced_type_info_type(Type)
 		->
 			NormalisedInst = ground(mostly_unique, no)
 		;
@@ -1546,6 +1558,19 @@
 	;
 		NormalisedInst = Inst
 	).
+
+:- pred is_introduced_type_info_type(type).
+:- mode is_introduced_type_info_type(in) is semidet.
+
+is_introduced_type_info_type(Type) :-
+	sym_name_and_args(Type, TypeName, _),
+	TypeName = qualified(PrivateBuiltin, Name),
+	( Name = "type_info"
+	; Name = "type_ctor_info"
+	; Name = "typeclass_info"
+	; Name = "base_typeclass_info"
+	),
+	mercury_private_builtin_module(PrivateBuiltin).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.29
diff -u -r1.29 modecheck_call.m
--- modecheck_call.m	1999/06/01 09:44:07	1.29
+++ modecheck_call.m	1999/06/12 00:42:26
@@ -437,8 +437,10 @@
 		[Inst | Insts], [IsLive | IsLives]) :-
 	mode_info_get_module_info(ModeInfo, ModuleInfo),
 	mode_info_get_instmap(ModeInfo, InstMap),
+	mode_info_get_var_types(ModeInfo, VarTypes),
 	instmap__lookup_var(InstMap, Var, Inst0),
-	normalise_inst(Inst0, ModuleInfo, Inst),
+	map__lookup(VarTypes, Var, Type),
+	normalise_inst(Inst0, Type, ModuleInfo, Inst),
 
 	mode_info_var_is_live(ModeInfo, Var, IsLive0),
 
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.37.2.1
diff -u -r1.37.2.1 modecheck_unify.m
--- modecheck_unify.m	1999/06/10 16:10:37	1.37.2.1
+++ modecheck_unify.m	1999/06/12 00:42:26
@@ -696,6 +696,21 @@
 		),
 		ModeInfo = ModeInfo0
 	;
+		%
+		% Check for unreachable unifications
+		%
+		( mode_get_insts(ModuleInfo0, ModeOfX, not_reached, _)
+		; mode_get_insts(ModuleInfo0, ModeOfY, not_reached, _)
+		)
+	->
+		%
+		% For these, we can generate any old junk here --
+		% we just need to avoid calling modecheck_complicated_unify,
+		% since that might abort.
+		%
+		Unification = simple_test(X, Y),
+		ModeInfo = ModeInfo0
+	;
 		map__lookup(VarTypes, X, Type),
 		(
 			type_is_atomic(Type, ModuleInfo0)
@@ -770,7 +785,7 @@
 	( Unification0 = complicated_unify(_, _, UnifyTypeInfoVars0) ->
 		UnifyTypeInfoVars = UnifyTypeInfoVars0
 	;
-		error("categorize_unify_var_var")
+		error("modecheck_complicated_unify")
 	),
 	Unification = complicated_unify(UniMode, CanFail, UnifyTypeInfoVars),
 
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.230.2.1
diff -u -r1.230.2.1 modes.m
--- modes.m	1999/06/10 16:10:38	1.230.2.1
+++ modes.m	1999/06/12 00:42:26
@@ -814,10 +814,13 @@
 			FinalInsts, ModeInfo) :-
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
 	mode_info_get_instmap(ModeInfo0, InstMap),
+	mode_info_get_var_types(ModeInfo0, VarTypes),
 	instmap__lookup_vars(HeadVars, InstMap, VarFinalInsts1),
+	map__apply_to_list(HeadVars, VarTypes, ArgTypes),
 
 	( InferModes = yes ->
-		normalise_insts(VarFinalInsts1, ModuleInfo, VarFinalInsts2),
+		normalise_insts(VarFinalInsts1, ArgTypes, ModuleInfo,
+			VarFinalInsts2),
 		%
 		% make sure we set the final insts of any variables which
 		% we assumed were dead to `clobbered'.
@@ -1009,10 +1012,19 @@
 	mode_info_lock_vars(if_then_else, NonLocals),
 	mode_info_add_live_vars(B_Vars),
 	modecheck_goal(A0, A),
+	mode_info_dcg_get_instmap(InstMapA),
 	mode_info_remove_live_vars(B_Vars),
 	mode_info_unlock_vars(if_then_else, NonLocals),
-	modecheck_goal(B0, B),
-	mode_info_dcg_get_instmap(InstMapB),
+	( { instmap__is_reachable(InstMapA) } ->
+		modecheck_goal(B0, B),
+		mode_info_dcg_get_instmap(InstMapB)
+	;
+		% We should not mode-analyse the goal, since it is unreachable.
+		% Instead we optimize the goal away, so that later passes
+		% won't complain about it not having mode information.
+		{ true_goal(B) },
+		{ InstMapB = InstMapA }
+	),
 	mode_info_set_instmap(InstMap0),
 	modecheck_goal(C0, C),
 	mode_info_dcg_get_instmap(InstMapC),
@@ -1038,7 +1050,10 @@
 
 modecheck_goal_expr(call(PredId, ProcId0, Args0, _, Context, PredName),
 		GoalInfo0, Goal) -->
-	mode_checkpoint(enter, "call"),
+	/*** CallString = "call" ***/
+	{ prog_out__sym_name_to_string(PredName, PredNameString) },
+	{ string__append("call ", PredNameString, CallString) },
+	mode_checkpoint(enter, CallString),
 	mode_info_set_call_context(call(PredId)),
 	=(ModeInfo0),
 	{ mode_info_get_instmap(ModeInfo0, InstMap0) },
@@ -1055,7 +1070,7 @@
 				InstMap0, Goal),
 
 	mode_info_unset_call_context,
-	mode_checkpoint(exit, "call").
+	mode_checkpoint(exit, CallString).
 
 modecheck_goal_expr(higher_order_call(PredVar, Args0, _, _, _, PredOrFunc),
 		GoalInfo0, Goal) -->
@@ -1247,7 +1262,17 @@
 	{ goal_get_nonlocals(Goal0, NonLocals) },
 	mode_info_remove_live_vars(NonLocals),
 	modecheck_goal(Goal0, Goal),
-	modecheck_conj_list_no_delay(Goals0, Goals).
+	mode_info_dcg_get_instmap(InstMap),
+	( { instmap__is_unreachable(InstMap) } ->
+		% We should not mode-analyse the remaining goals, since they
+		% are unreachable.  Instead we optimize them away, so that
+		% later passes won't complain about them not having mode
+		% information.
+		mode_info_remove_goals_live_vars(Goals0),
+		{ Goals  = [] }
+	;
+		modecheck_conj_list_no_delay(Goals0, Goals)
+	).
 
 %-----------------------------------------------------------------------------%
 
@@ -1405,6 +1430,10 @@
 	mode_info_set_delay_info(DelayInfo),
 	mode_info_dcg_get_instmap(InstMap),
 	( { instmap__is_unreachable(InstMap) } ->
+		% We should not mode-analyse the remaining goals, since they
+		% are unreachable.  Instead we optimize them away, so that
+		% later passes won't complain about them not having mode
+		% information.
 		mode_info_remove_goals_live_vars(Goals1),
 		{ Goals2  = [] },
 		{ ImpurityErrors = ImpurityErrors2 }
@@ -1535,10 +1564,22 @@
 	modecheck_set_var_inst(Var,
 		bound(unique, [functor(ConsId, ArgInsts)])),
 
-	modecheck_goal(Goal0, Goal1),
-	mode_info_dcg_get_instmap(InstMap),
+		% modecheck this case (if it is reachable)
+	mode_info_dcg_get_instmap(InstMap1),
+	( { instmap__is_reachable(InstMap1) } ->
+		modecheck_goal(Goal0, Goal1),
+		mode_info_dcg_get_instmap(InstMap)
+	;
+		% We should not mode-analyse the goal, since it is unreachable.
+		% Instead we optimize the goal away, so that later passes
+		% won't complain about it not having mode information.
+		{ true_goal(Goal1) },
+		{ InstMap = InstMap1 }
+	),
+
 	% Don't lose the information added by the functor test above.
 	{ fixup_switch_var(Var, InstMap0, InstMap, Goal1, Goal) },
+
 	mode_info_set_instmap(InstMap0),
 	modecheck_case_list(Cases0, Var, Cases, InstMaps).
 
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.163.2.1
diff -u -r1.163.2.1 polymorphism.m
--- polymorphism.m	1999/06/10 16:10:42	1.163.2.1
+++ polymorphism.m	1999/06/12 00:42:26
@@ -610,7 +610,7 @@
 
 	clauses_info_clauses(ClausesInfo0, Clauses0),
 	list__map_foldl(polymorphism__process_clause(PredInfo0,
-				HeadVars, UnconstrainedTVars,
+				HeadVars0, HeadVars, UnconstrainedTVars,
 				ExtraTypeInfoHeadVars,
 				ExistTypeClassInfoHeadVars),
 			Clauses0, Clauses, PolyInfo1, PolyInfo),
@@ -627,17 +627,17 @@
 				HeadVars, Clauses,
 				TypeInfoMap, TypeClassInfoMap).
 
-:- pred polymorphism__process_clause(pred_info, list(prog_var), list(tvar),
-		list(prog_var), list(prog_var),
+:- pred polymorphism__process_clause(pred_info, list(prog_var), list(prog_var),
+		list(tvar), list(prog_var), list(prog_var),
 		clause, clause,	poly_info, poly_info).
-:- mode polymorphism__process_clause(in, in, in, in, in,
+:- mode polymorphism__process_clause(in, in, in, in, in, in,
 		in, out, in, out) is det.
 
-polymorphism__process_clause(PredInfo, HeadVars, UnconstrainedTVars,
+polymorphism__process_clause(PredInfo0, HeadVars0, HeadVars, UnconstrainedTVars,
 			ExtraTypeInfoHeadVars, ExistTypeClassInfoHeadVars,
 			Clause0, Clause) -->
 	(
-		{ pred_info_is_imported(PredInfo) }
+		{ pred_info_is_imported(PredInfo0) }
 	->
 		{ Clause = Clause0 }
 	;
@@ -652,12 +652,12 @@
 		% and type-infos for existentially quantified type vars
 		%
 		polymorphism__produce_existq_tvars(
-			PredInfo, HeadVars,
+			PredInfo0, HeadVars0,
 			UnconstrainedTVars, ExtraTypeInfoHeadVars,
 			ExistTypeClassInfoHeadVars,
 			Goal1, Goal2),
 
-		{ pred_info_get_exist_quant_tvars(PredInfo, ExistQVars) },
+		{ pred_info_get_exist_quant_tvars(PredInfo0, ExistQVars) },
 		polymorphism__fixup_quantification(HeadVars, ExistQVars,
 			Goal2, Goal),
 		{ Clause = clause(ProcIds, Goal, Context) }
@@ -692,9 +692,13 @@
 		  hlds_pred__in_in_unification_proc_id(ProcId)
 		)
 	->
-		% XXX is this right?
-		ProcInfo1 = ProcInfo0
-		/* proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo1) */
+		% 
+		% We need to set the headvars in the proc_info here, because
+		% some parts of the compiler (e.g. unused_args.m) depend on the
+		% headvars field being valid even for imported procedures.
+		%
+		clauses_info_headvars(ClausesInfo, HeadVars),
+		proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo1)
 	;
 		copy_clauses_to_proc(ProcId, ClausesInfo, ProcInfo0, ProcInfo1)
 	),
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.6.2.1
diff -u -r1.6.2.1 post_typecheck.m
--- post_typecheck.m	1999/06/10 16:10:44	1.6.2.1
+++ post_typecheck.m	1999/06/12 00:42:26
@@ -37,18 +37,23 @@
 
 :- module post_typecheck.
 :- interface.
-:- import_module hlds_module, hlds_pred, io.
-:- import_module list, prog_data.
+:- import_module hlds_module, hlds_pred, prog_data.
+:- import_module list, io, bool.
 
+	% check_type_bindings(PredId, PredInfo, ModuleInfo, ReportErrors):
+	%
+	% Check that all Aditi predicates have an `aditi__state' argument.
 	% Check that the all of the types which have been inferred
 	% for the variables in the clause do not contain any unbound type
 	% variables other than those that occur in the types of head
 	% variables, and that there are no unsatisfied type class
-	% constraints.
+	% constraints, and if ReportErrors = yes, print appropriate
+	% warning/error messages.
+	% Also bind any unbound type variables to the type `void'.
 	%
-:- pred post_typecheck__check_type_bindings(pred_id, pred_info, pred_info,
-		module_info, int, io__state, io__state).
-:- mode post_typecheck__check_type_bindings(in, in, out, in, out, di, uo)
+:- pred post_typecheck__check_type_bindings(pred_id, pred_info, module_info,
+		bool, pred_info, int, io__state, io__state).
+:- mode post_typecheck__check_type_bindings(in, in, in, in, out, out, di, uo)
 		is det.
 
 	% Handle any unresolved overloading for a predicate call.
@@ -93,11 +98,14 @@
 %  variables other than those that occur in the types of head
 %  variables, and that there are no unsatisfied type class constraints.
 
-post_typecheck__check_type_bindings(PredId, PredInfo0, PredInfo, ModuleInfo,
-		NumErrors, IOState0, IOState) :-
-	pred_info_get_unproven_body_constraints(PredInfo0,
-		UnprovenConstraints0),
-	( UnprovenConstraints0 \= [] ->
+post_typecheck__check_type_bindings(PredId, PredInfo0, ModuleInfo, ReportErrs,
+		PredInfo, NumErrors, IOState0, IOState) :-
+	(
+		ReportErrs = yes,
+		pred_info_get_unproven_body_constraints(PredInfo0,
+			UnprovenConstraints0),
+		UnprovenConstraints0 \= []
+	->
 		list__sort_and_remove_dups(UnprovenConstraints0,
 			UnprovenConstraints),
 		report_unsatisfied_constraints(UnprovenConstraints,
@@ -120,11 +128,15 @@
 		PredInfo = PredInfo0,
 		IOState2 = IOState1
 	;
-		%
-		% report the warning
-		%
-		report_unresolved_type_warning(Errs, PredId, PredInfo0,
-				ModuleInfo, VarSet, IOState1, IOState2),
+		( ReportErrs = yes ->
+			%
+			% report the warning
+			%
+			report_unresolved_type_warning(Errs, PredId, PredInfo0,
+				ModuleInfo, VarSet, IOState1, IOState2)
+		;
+			IOState2 = IOState1
+		),
 
 		%
 		% bind all the type variables in `Set' to `void' ...
@@ -145,7 +157,7 @@
 	pred_info_arg_types(PredInfo, ArgTypes),
 	( check_marker(Markers, aditi) ->
 		list__filter(type_is_aditi_state, ArgTypes, AditiStateTypes),
-		( AditiStateTypes = [] ->
+		( AditiStateTypes = [], ReportErrs = yes ->
 			report_no_aditi_state(PredInfo, IOState2, IOState)
 		; AditiStateTypes = [_, _ | _] ->
 			report_multiple_aditi_states(PredInfo,
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.13.2.1
diff -u -r1.13.2.1 purity.m
--- purity.m	1999/06/10 16:10:45	1.13.2.1
+++ purity.m	1999/06/12 00:42:27
@@ -270,18 +270,14 @@
 		write_pred_progress_message("% Purity-checking ", PredId,
 					    ModuleInfo0),
 		%
-		% Only check the type bindings if we didn't get any
-		% type errors already; this avoids a lot of spurious
-		% diagnostics.
+		% Only report error messages for unbound type variables
+		% if we didn't get any type errors already; this avoids
+		% a lot of spurious diagnostics.
 		%
-		( { FoundTypeError = no } ->
-			post_typecheck__check_type_bindings(PredId, PredInfo0,
-					PredInfo1, ModuleInfo0,
-					UnboundTypeErrsInThisPred)
-		;
-			{ PredInfo1 = PredInfo0 },
-			{ UnboundTypeErrsInThisPred = 0 }
-		),
+		{ bool_not(FoundTypeError, ReportErrs) },
+		post_typecheck__check_type_bindings(PredId, PredInfo0,
+				ModuleInfo0, ReportErrs,
+				PredInfo1, UnboundTypeErrsInThisPred),
 		puritycheck_pred(PredId, PredInfo1, PredInfo2, ModuleInfo0,
 				PurityErrsInThisPred),
 		post_typecheck__finish_pred(ModuleInfo0, PredId, PredInfo2,
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.66.2.1
diff -u -r1.66.2.1 simplify.m
--- simplify.m	1999/06/10 16:10:50	1.66.2.1
+++ simplify.m	1999/06/12 00:42:27
@@ -310,7 +310,6 @@
 		%
 		% if --no-fully-strict,
 		% replace goals with determinism failure with `fail'.
-		% XXX we should warn about this (if the goal wasn't `fail')
 		%
 		Detism = failure,
 		% ensure goal is pure or semipure
@@ -319,16 +318,27 @@
 		; code_aux__goal_cannot_loop(ModuleInfo, Goal0)
 		)
 	->
+		% warn about this (if the goal wasn't `fail')
+		goal_info_get_context(GoalInfo0, Context),
+		(
+			simplify_do_warn(Info0),
+			Goal0 \= disj([], _) - _
+		->
+			simplify_info_add_msg(Info0,
+				goal_cannot_succeed(Context), Info1)
+		;
+			Info1 = Info0
+		),
+		
 		% If the goal had any non-locals we should requantify. 
 		goal_info_get_nonlocals(GoalInfo0, NonLocals0),
 		( set__empty(NonLocals0) ->
-			Info1 = Info0
+			Info2 = Info1
 		;
-			simplify_info_set_requantify(Info0, Info1)
+			simplify_info_set_requantify(Info1, Info2)
 		),
 		pd_cost__goal(Goal0, CostDelta),
-		simplify_info_incr_cost_delta(Info1, CostDelta, Info2),
-		goal_info_get_context(GoalInfo0, Context),
+		simplify_info_incr_cost_delta(Info2, CostDelta, Info3),
 		fail_goal(Context, Goal1)
 	;
 		%
@@ -339,7 +349,6 @@
 		% since these may occur in conjunctions where there
 		% are no producers for some variables, and the
 		% code generator would fail for these.
-		% XXX we should warn about this (if the goal wasn't `true')
 		%
 		determinism_components(Detism, cannot_fail, MaxSoln),
 		MaxSoln \= at_most_zero,
@@ -354,27 +363,47 @@
 		; code_aux__goal_cannot_loop(ModuleInfo, Goal0)
 		)
 	->
+		% warn about this, if the goal wasn't `true'
+		% and wasn't a deconstruction unification.
+		% (We don't warn about deconstruction unifications
+		% with no outputs that always succeed, because that
+		% would result in bogus warnings, since switch detection
+		% converts deconstruction unifications that can fail
+		% into ones that always succeed by moving the test into
+		% the switch.)
+		goal_info_get_context(GoalInfo0, Context),
+		(
+			simplify_do_warn(Info0),
+			Goal0 \= conj([]) - _,
+			\+ (Goal0 = unify(_, _, _, Unification, _) - _,
+			    Unification = deconstruct(_, _, _, _, _))
+		->
+			simplify_info_add_msg(Info0,
+				det_goal_has_no_outputs(Context), Info1)
+		;
+			Info1 = Info0
+		),
+		
 		% If the goal had any non-locals we should requantify. 
 		goal_info_get_nonlocals(GoalInfo0, NonLocals0),
 		( set__empty(NonLocals0) ->
-			Info1 = Info0
+			Info2 = Info1
 		;
-			simplify_info_set_requantify(Info0, Info1)
+			simplify_info_set_requantify(Info1, Info2)
 		),
 		pd_cost__goal(Goal0, CostDelta),
-		simplify_info_incr_cost_delta(Info1, CostDelta, Info2),
-		goal_info_get_context(GoalInfo0, Context),
+		simplify_info_incr_cost_delta(Info2, CostDelta, Info3),
 		true_goal(Context, Goal1)
 	;
 		Goal1 = Goal0,
-		Info2 = Info0
+		Info3 = Info0
 	),
-	simplify_info_maybe_clear_structs(before, Goal1, Info2, Info3),
+	simplify_info_maybe_clear_structs(before, Goal1, Info3, Info4),
 	Goal1 = GoalExpr1 - GoalInfo1,
-	simplify__goal_2(GoalExpr1, GoalInfo1, Goal, GoalInfo2, Info3, Info4),
+	simplify__goal_2(GoalExpr1, GoalInfo1, Goal, GoalInfo2, Info4, Info5),
 	simplify_info_maybe_clear_structs(after, Goal - GoalInfo2,
-		Info4, Info5),
-	simplify__enforce_invariant(GoalInfo2, GoalInfo, Info5, Info).
+		Info5, Info6),
+	simplify__enforce_invariant(GoalInfo2, GoalInfo, Info6, Info).
 
 :- pred simplify__enforce_invariant(hlds_goal_info, hlds_goal_info,
 		simplify_info, simplify_info).
@@ -1013,10 +1042,6 @@
 
 simplify__process_compl_unify(XVar, YVar, UniMode, CanFail, OldTypeInfoVars,
 		Context, GoalInfo0, Goal) -->
-	%
-	% XXX FIXME change mode analysis to check modes of typeinfos for
-	%	    complicated unifications
-	%
 	=(Info0),
 	{ simplify_info_get_module_info(Info0, ModuleInfo) },
 	{ simplify_info_get_var_types(Info0, VarTypes) },
@@ -1096,15 +1121,13 @@
 		% calls to specific unification predicates,
 		% inserting extra typeinfo arguments if necessary.
 		%
+
+		% generate code to construct the new type_info arguments
 		simplify__make_type_info_vars(TypeArgs, TypeInfoVars,
 			ExtraGoals),
-		{ list__append(TypeInfoVars, [XVar, YVar], ArgVars) },
-		
-		% sanity check: the TypeInfoVars we computed here should
-		% match with what was stored in the complicated_unify struct
-		{ require(unify(OldTypeInfoVars, TypeInfoVars),
-		  "simplify__process_compl_unify: mismatched type_info vars") },
 
+		% create the new call goal
+		{ list__append(TypeInfoVars, [XVar, YVar], ArgVars) },
 		{ module_info_get_special_pred_map(ModuleInfo,
 			SpecialPredMap) },
 		{ map__lookup(SpecialPredMap, unify - TypeId, PredId) },
@@ -1115,8 +1138,16 @@
 		{ CallContext = call_unify_context(XVar, var(YVar), Context) },
 		{ Call0 = call(PredId, ProcId, ArgVars, not_builtin,
 			yes(CallContext), SymName) },
-		simplify__goal_2(Call0, GoalInfo0, Call1, GoalInfo),
-		{ Call = Call1 - GoalInfo }
+
+		% add the extra type_info vars to the nonlocals for the call
+		{ goal_info_get_nonlocals(GoalInfo0, NonLocals0) },
+		{ set__insert_list(NonLocals0, TypeInfoVars, NonLocals) },
+		{ goal_info_set_nonlocals(GoalInfo0, NonLocals,
+			CallGoalInfo0) },
+
+		% recursively simplify the call goal
+		simplify__goal_2(Call0, CallGoalInfo0, Call1, CallGoalInfo1),
+		{ Call = Call1 - CallGoalInfo1 }
 	;
 		{ error("simplify: type_to_type_id failed") }
 	),
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.52
diff -u -r1.52 unique_modes.m
--- unique_modes.m	1999/05/18 03:09:05	1.52
+++ unique_modes.m	1999/06/12 00:42:27
@@ -62,7 +62,7 @@
 :- import_module modes, prog_data, mode_errors, llds, unify_proc.
 :- import_module (inst), instmap, inst_match, inst_util.
 :- import_module term, varset.
-:- import_module int, list, map, set, std_util, require, assoc_list.
+:- import_module int, list, map, set, std_util, require, assoc_list, string.
 
 %-----------------------------------------------------------------------------%
 
@@ -347,9 +347,17 @@
 	unique_modes__check_goal(A0, A),
 	mode_info_remove_live_vars(B_Vars),
 	mode_info_unlock_vars(if_then_else, NonLocals),
-	% mode_info_dcg_get_instmap(InstMapA),
-	unique_modes__check_goal(B0, B),
-	mode_info_dcg_get_instmap(InstMapB),
+	mode_info_dcg_get_instmap(InstMapA),
+	( { instmap__is_reachable(InstMapA) } ->
+		unique_modes__check_goal(B0, B),
+		mode_info_dcg_get_instmap(InstMapB)
+	;
+		% We should not mode-analyse the goal, since it is unreachable.
+		% Instead we optimize the goal away, so that later passes
+		% won't complain about it not having unique mode information.
+		{ true_goal(B) },
+		{ InstMapB = InstMapA }
+	),
 	mode_info_set_instmap(InstMap0),
 	unique_modes__check_goal(C0, C),
 	mode_info_dcg_get_instmap(InstMapC),
@@ -415,7 +423,10 @@
 
 unique_modes__check_goal_2(call(PredId, ProcId0, Args, Builtin, CallContext,
 		PredName), _GoalInfo0, Goal) -->
-	mode_checkpoint(enter, "call"),
+	/*** CallString = "call" ***/
+	{ prog_out__sym_name_to_string(PredName, PredNameString) },
+	{ string__append("call ", PredNameString, CallString) },
+	mode_checkpoint(enter, CallString),
 	mode_info_set_call_context(call(PredId)),
 	unique_modes__check_call(PredId, ProcId0, Args, ProcId),
 	{ Goal = call(PredId, ProcId, Args, Builtin, CallContext, PredName) },
@@ -592,7 +603,17 @@
 	{ unique_modes__goal_get_nonlocals(Goal0, NonLocals) },
 	mode_info_remove_live_vars(NonLocals),
 	unique_modes__check_goal(Goal0, Goal),
-	unique_modes__check_conj(Goals0, Goals).
+	mode_info_dcg_get_instmap(InstMap),
+	( { instmap__is_unreachable(InstMap) } ->
+		% We should not mode-analyse the remaining goals, since they
+		% are unreachable.  Instead we optimize them away, so that
+		% later passes won't complain about them not having
+		% unique mode information.
+		mode_info_remove_goals_live_vars(Goals0),
+		{ Goals  = [] }
+	;
+		unique_modes__check_conj(Goals0, Goals)
+	).
 
 %-----------------------------------------------------------------------------%
 
@@ -657,9 +678,19 @@
 	modecheck_set_var_inst(Var,
 		bound(unique, [functor(ConsId, ArgInsts)])),
 
-	unique_modes__check_goal(Goal0, Goal1),
+	mode_info_dcg_get_instmap(InstMap1),
+	( { instmap__is_reachable(InstMap1) } ->
+		unique_modes__check_goal(Goal0, Goal1)
+	;
+		% We should not mode-analyse the goal, since it is unreachable.
+		% Instead we optimize the goal away, so that later passes
+		% won't complain about it not having unique mode information.
+		{ true_goal(Goal1) }
+	),
+
 	mode_info_dcg_get_instmap(InstMap),
 	{ fixup_switch_var(Var, InstMap0, InstMap, Goal1, Goal) },
+
 	mode_info_set_instmap(InstMap0),
 	unique_modes__check_case_list(Cases0, Var, Cases, InstMaps).
 
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.58
diff -u -r1.58 Mmakefile
--- Mmakefile	1999/04/23 01:03:34	1.58
+++ Mmakefile	1999/06/11 23:00:33
@@ -102,6 +102,7 @@
 # some tests need to be compiled with particular options
 
 MCFLAGS-bigtest		=	--intermodule-optimization -O3
+MCFLAGS-lp		=	--intermodule-optimization -O3
 MCFLAGS-boyer		=	--infer-all
 MCFLAGS-func_test	=	--infer-all
 MCFLAGS-ho_order	=	--optimize-higher-order
Index: tests/warnings/simple_code.exp
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/simple_code.exp,v
retrieving revision 1.5
diff -u -r1.5 simple_code.exp
--- simple_code.exp	1999/04/20 14:53:38	1.5
+++ simple_code.exp	1999/06/12 00:42:32
@@ -5,9 +5,9 @@
 simple_code.m:020: Warning: the condition of this if-then-else cannot succeed.
 simple_code.m:025: Warning: the condition of this if-then-else cannot succeed.
 simple_code.m:030: Warning: the condition of this if-then-else cannot succeed.
-simple_code.m:018: Warning: the negated goal cannot succeed.
-simple_code.m:023: Warning: the negated goal cannot succeed.
 simple_code.m:033: Warning: the negated goal cannot succeed.
-simple_code.m:038: Warning: the negated goal cannot succeed.
+simple_code.m:018: Warning: det goal has no outputs.
+simple_code.m:023: Warning: det goal has no outputs.
+simple_code.m:038: Warning: det goal has no outputs.
 simple_code.m:039: Warning: call to obsolete predicate `simple_code:obsolete/0'.
 simple_code.m:099: Warning: recursive call will lead to infinite recursion.

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