[m-dev.] for review: support reordering conjunctions in mode inference

Fergus Henderson fjh at cs.mu.OZ.AU
Wed Dec 20 05:01:38 AEDT 2000


I talked with Peter Schacte and Adrian the other day, and Peter asked
(in relation to the issue of mode declarations for sequence
quantification) why mode inference didn't support reordering of
conjunctions.  After a bit of discussion we concluded that it probably
wasn't very hard to do, so here it is.

I don't intend to put this one in the Rudolph release.

The main potential problem that I see with this change is
performance problems, and possibly termination problems.

Currently the way we do the fixpoint calculation for mode inference is
quite naive, and this may lead to poor performance.  But that is
really an existing problem, not something introduced by this change.

Termination problems, if any, will all be caught by the mode inference
iteration limit, so that's not a big deal.  The programmer can always
fix things by adding explicit mode declarations if need be.

----------

Estimated hours taken: 12

Change mode inference so that it supports reordering of conjunctions.

For predicates with inferred modes, if we get a mode error, we don't
report it straight away; instead, we just store the mode error(s) in
the proc_info.  Any call to a procedure for which we have recorded a
mode error will itself result in a mode error, which will then
cause reordering of conjunctions as usual.

compiler/hlds_pred.m:
	Add a new `mode_errors' field to the proc_info.
	For predicates with inferred modes, this field records
	the mode errors that we detected for that procedure.

	Add a new predicate proc_info_is_invalid_mode that
	succeeds iff the list of mode errors is not empty.
	Change pred_info_procids and pred_info_non_imported_procids
	so that they skip invalid modes.  Add new predicates
	pred_info_all_procids and pred_info_all_non_imported_procids
	that are like those two but that do not skip invalid modes.

compiler/modes.m:
	For predicates with inferred modes, if we get a mode
	error, don't report it straight away; instead, just
	store the mode error in the proc_info.

compiler/modecheck_call.m:
compiler/unique_modes.m:
	When modechecking calls, check the mode_errors field in
	the callee's proc_info, and if it is non-empty, return
	a `mode_error_in_callee' mode error.

compiler/mode_errors.m:
	Add a new error `mode_error_in_callee', along with code to
	report such errors.

	Also change `write_inference_messages', which prints out the
	the "Inferred :- mode ..." messages when --infer-modes is set,
	so that if `--verbose-errors' is set, it also prints out lines
	of the form "Rejected :- mode ..." for each candidate mode
	that we added but got a mode error for.

compiler/mode_info.m:
	Add procedures `set_pred_id' and `set_proc_id'; these are used
	by mode_errors.m to print out

compiler/clause_to_proc.m:
compiler/hlds_module.m:
compiler/hlds_out.m:
compiler/make_hlds.m:
compiler/termination.m:
	Improve abstraction a little by using `pred_info_all_procids'
	or `pred_info_procids' rather than just using `map__keys' on
	the proc_table.

compiler/modes.m:
compiler/modecheck_unify.m:
compiler/modecheck_call.m:
compiler/unique_modes.m:
	Change modecheck_var_has_inst_list so that it takes an extra
	argument saying whether you want an exact match (rather than
	an implied mode).  This is needed to avoid matching implied
	versions of invalid modes: when matching against an invalid
	mode, we only allow exact matches; for calls that would be
	implied modes of the invalid mode, we'll generate a new
	inferred mode for the procedure.

Workspace: /home/pgrad/fjh/ws/hg3
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.28
diff -u -d -r1.28 clause_to_proc.m
--- compiler/clause_to_proc.m	2000/10/13 13:55:15	1.28
+++ compiler/clause_to_proc.m	2000/12/19 13:58:05
@@ -126,7 +126,7 @@
 copy_clauses_to_procs(PredInfo0, PredInfo) :-
 	pred_info_procedures(PredInfo0, Procs0),
 	pred_info_clauses_info(PredInfo0, ClausesInfo),
-	pred_info_non_imported_procids(PredInfo0, ProcIds),
+	pred_info_all_non_imported_procids(PredInfo0, ProcIds),
 	copy_clauses_to_procs_2(ProcIds, ClausesInfo, Procs0, Procs),
 	pred_info_set_procedures(PredInfo0, Procs, PredInfo).
 
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.63
diff -u -d -r1.63 hlds_module.m
--- compiler/hlds_module.m	2000/11/17 17:47:20	1.63
+++ compiler/hlds_module.m	2000/12/19 13:05:19
@@ -1762,8 +1762,7 @@
 get_proc_id(PredicateTable, PredId, ProcId) :-
 	predicate_table_get_preds(PredicateTable, Preds),
 	map__lookup(Preds, PredId, PredInfo),
-	pred_info_procedures(PredInfo, Procs),
-	map__keys(Procs, ProcIds),
+	pred_info_procids(PredInfo, ProcIds),
 	( ProcIds = [ProcId0] ->
 		ProcId = ProcId0
 	;
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.253
diff -u -d -r1.253 hlds_out.m
--- compiler/hlds_out.m	2000/12/11 04:52:27	1.253
+++ compiler/hlds_out.m	2000/12/19 13:05:36
@@ -746,7 +746,6 @@
 	{ pred_info_get_exist_quant_tvars(PredInfo, ExistQVars) },
 	{ pred_info_typevarset(PredInfo, TVarSet) },
 	{ pred_info_clauses_info(PredInfo, ClausesInfo) },
-	{ pred_info_procedures(PredInfo, ProcTable) },
 	{ pred_info_context(PredInfo, Context) },
 	{ pred_info_name(PredInfo, PredName) },
 	{ pred_info_import_status(PredInfo, ImportStatus) },
@@ -860,7 +859,7 @@
 		[]
 	),
 	hlds_out__write_procs(Indent, AppendVarnums, ModuleInfo, PredId,
-		ImportStatus, ProcTable),
+		ImportStatus, PredInfo),
 	io__write_string("\n").
 
 :- pred hlds_out__write_marker_list(list(marker), io__state, io__state).
@@ -2849,12 +2848,13 @@
 %-----------------------------------------------------------------------------%
 
 :- pred hlds_out__write_procs(int, bool, module_info, pred_id, import_status,
-	proc_table, io__state, io__state).
+	pred_info, io__state, io__state).
 :- mode hlds_out__write_procs(in, in, in, in, in, in, di, uo) is det.
 
 hlds_out__write_procs(Indent, AppendVarnums, ModuleInfo, PredId,
-		ImportStatus, ProcTable) -->
-	{ map__keys(ProcTable, ProcIds) },
+		ImportStatus, PredInfo) -->
+	{ pred_info_procedures(PredInfo, ProcTable) },
+	{ pred_info_procids(PredInfo, ProcIds) },
 	hlds_out__write_procs_2(ProcIds, AppendVarnums, ModuleInfo, Indent,
 		PredId, ImportStatus, ProcTable).
 
@@ -2867,7 +2867,8 @@
 hlds_out__write_procs_2([ProcId | ProcIds], AppendVarnums, ModuleInfo, Indent,
 		PredId, ImportStatus, ProcTable) -->
 	{ map__lookup(ProcTable, ProcId, ProcInfo) },
-	hlds_out__write_proc(Indent, AppendVarnums, ModuleInfo, PredId, ProcId, ImportStatus, ProcInfo),
+	hlds_out__write_proc(Indent, AppendVarnums, ModuleInfo, PredId, ProcId,
+		ImportStatus, ProcInfo),
 	hlds_out__write_procs_2(ProcIds, AppendVarnums, ModuleInfo, Indent,
 		PredId, ImportStatus, ProcTable).
 
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.90
diff -u -d -r1.90 hlds_pred.m
--- compiler/hlds_pred.m	2000/12/13 00:00:21	1.90
+++ compiler/hlds_pred.m	2000/12/19 14:11:56
@@ -15,6 +15,7 @@
 
 :- import_module prog_data.
 :- import_module hlds_data, hlds_goal, hlds_module, instmap, term_util.
+:- import_module mode_errors.
 :- import_module globals.
 
 :- import_module bool, list, set, map, std_util, term, varset.
@@ -530,17 +531,30 @@
 :- pred pred_info_arity(pred_info, arity).
 :- mode pred_info_arity(in, out) is det.
 
-	% Return a list of all the proc_ids for the different modes
-	% of this predicate.
+	% Return a list of all the proc_ids for the valid modes
+	% of this predicate.  This does not include candidate modes
+	% that were generated during mode inference but which mode
+	% inference found were not valid modes.
 :- pred pred_info_procids(pred_info, list(proc_id)).
 :- mode pred_info_procids(in, out) is det.
 
 	% Return a list of the proc_ids for all the modes
+	% of this predicate, including invalid modes.
+:- pred pred_info_all_procids(pred_info, list(proc_id)).
+:- mode pred_info_all_procids(in, out) is det.
+
+	% Return a list of the proc_ids for all the valid modes
 	% of this predicate that are not imported.
 :- pred pred_info_non_imported_procids(pred_info, list(proc_id)).
 :- mode pred_info_non_imported_procids(in, out) is det.
 
 	% Return a list of the proc_ids for all the modes
+	% of this predicate that are not imported
+	% (including invalid modes).
+:- pred pred_info_all_non_imported_procids(pred_info, list(proc_id)).
+:- mode pred_info_all_non_imported_procids(in, out) is det.
+
+	% Return a list of the proc_ids for all the valid modes
 	% of this predicate that are exported.
 :- pred pred_info_exported_procids(pred_info, list(proc_id)).
 :- mode pred_info_exported_procids(in, out) is det.
@@ -920,9 +934,18 @@
 		ExistQVars, HeadTypeParams, UnprovenBodyConstraints, User,
 		Indexes, Assertions).
 
-pred_info_procids(PredInfo, ProcIds) :-
-	map__keys(PredInfo^procedures, ProcIds).
+pred_info_all_procids(PredInfo, ProcIds) :-
+	ProcTable = PredInfo ^ procedures,
+	map__keys(ProcTable, ProcIds).
 
+pred_info_procids(PredInfo, ValidProcIds) :-
+	pred_info_all_procids(PredInfo, AllProcIds),
+	ProcTable = PredInfo ^ procedures,
+	IsValid = (pred(ProcId::in) is semidet :-
+		ProcInfo = map__lookup(ProcTable, ProcId),
+		proc_info_is_valid_mode(ProcInfo)),
+	list__filter(IsValid, AllProcIds, ValidProcIds).
+
 pred_info_non_imported_procids(PredInfo, ProcIds) :-
 	pred_info_import_status(PredInfo, ImportStatus),
 	( ImportStatus = imported(_) ->
@@ -937,6 +960,20 @@
 		pred_info_procids(PredInfo, ProcIds)
 	).
 
+pred_info_all_non_imported_procids(PredInfo, ProcIds) :-
+	pred_info_import_status(PredInfo, ImportStatus),
+	( ImportStatus = imported(_) ->
+		ProcIds = []
+	; ImportStatus = external(_) ->
+		ProcIds = []
+	; ImportStatus = pseudo_imported ->
+		pred_info_all_procids(PredInfo, ProcIds0),
+		% for pseduo_imported preds, procid 0 is imported
+		list__delete_all(ProcIds0, 0, ProcIds)
+	;
+		pred_info_all_procids(PredInfo, ProcIds)
+	).
+
 pred_info_exported_procids(PredInfo, ProcIds) :-
 	pred_info_import_status(PredInfo, ImportStatus),
 	(
@@ -1545,7 +1582,16 @@
 :- pred proc_info_has_io_state_pair(module_info::in, proc_info::in,
 	int::out, int::out) is semidet.
 
+	% When mode inference is enabled, we record for each inferred
+	% mode whether it is valid or not by keeping a list of error
+	% messages in the proc_info.  The mode is valid iff this list
+	% is empty.
+:- func mode_errors(proc_info) = list(mode_error_info).
+:- func 'mode_errors :='(proc_info, list(mode_error_info)) = proc_info.
+:- pred proc_info_is_valid_mode(proc_info::in) is semidet.
+
 :- implementation.
+:- import_module mode_errors.
 
 :- type proc_info
 	--->	procedure(
@@ -1553,6 +1599,7 @@
 			var_types	:: vartypes,
 			head_vars	:: list(prog_var),
 			actual_head_modes :: list(mode),
+			mode_errors	:: list(mode_error_info),
 			inst_varset :: inst_varset,
 			head_var_caller_liveness :: maybe(list(is_live)),
 					% Liveness (in the mode analysis sense)
@@ -1679,6 +1726,7 @@
 		HeadVars, BodyVarSet),
 	varset__init(InstVarSet),
 	map__from_corresponding_lists(HeadVars, Types, BodyTypes),
+	ModeErrors = [],
 	InferredDet = erroneous,
 	map__init(StackSlots),
 	set__init(InitialLiveness),
@@ -1690,7 +1738,7 @@
 	map__init(TCVarsMap),
 	RLExprn = no,
 	NewProc = procedure(
-		BodyVarSet, BodyTypes, HeadVars, Modes, InstVarSet,
+		BodyVarSet, BodyTypes, HeadVars, Modes, ModeErrors, InstVarSet,
 		MaybeArgLives, ClauseBody, MContext, StackSlots, MaybeDet,
 		InferredDet, CanProcess, ArgInfo, InitialLiveness, TVarsMap,
 		TCVarsMap, eval_normal, no, no, DeclaredModes, IsAddressTaken,
@@ -1703,9 +1751,10 @@
 		TCVarsMap, ArgSizes, Termination, IsAddressTaken,
 		ProcInfo) :-
 	RLExprn = no,
+	ModeErrors = [],
 	ProcInfo = procedure(
-		BodyVarSet, BodyTypes, HeadVars,
-		HeadModes, InstVarSet, HeadLives, Goal, Context,
+		BodyVarSet, BodyTypes, HeadVars, HeadModes, ModeErrors,
+		InstVarSet, HeadLives, Goal, Context,
 		StackSlots, DeclaredDetism, InferredDetism, CanProcess, ArgInfo,
 		Liveness, TVarMap, TCVarsMap, eval_normal, ArgSizes,
 		Termination, no, IsAddressTaken, RLExprn, no, no).
@@ -1716,7 +1765,8 @@
 	set__init(Liveness),
 	MaybeHeadLives = no,
 	RLExprn = no,
-	ProcInfo = procedure(VarSet, VarTypes, HeadVars, HeadModes,
+	ModeErrors = [],
+	ProcInfo = procedure(VarSet, VarTypes, HeadVars, HeadModes, ModeErrors,
 		InstVarSet, MaybeHeadLives, Goal, Context, StackSlots,
 		yes(Detism), Detism, yes, [], Liveness, TVarMap, TCVarsMap,
 		eval_normal, no, no, no, IsAddressTaken, RLExprn, no, no).
@@ -1729,6 +1779,9 @@
 				^body := Goal)
 				^proc_type_info_varmap := TI_VarMap)
 				^proc_typeclass_info_varmap := TCI_VarMap).
+
+proc_info_is_valid_mode(ProcInfo) :-
+	ProcInfo ^ mode_errors = [].
 
 proc_info_interface_determinism(ProcInfo, Determinism) :-
 	proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.362
diff -u -d -r1.362 make_hlds.m
--- compiler/make_hlds.m	2000/12/18 07:40:26	1.362
+++ compiler/make_hlds.m	2000/12/19 14:08:17
@@ -3607,9 +3607,8 @@
 		{ pred_info_clauses_info(PredInfo1, Clauses0) },
 		{ pred_info_typevarset(PredInfo1, TVarSet0) },
 		{ maybe_add_default_func_mode(PredInfo1, PredInfo2, _) },
-		{ pred_info_procedures(PredInfo2, Procs) },
-		{ map__keys(Procs, ModeIds) },
-		clauses_info_add_clause(Clauses0, ModeIds,
+		{ pred_info_all_procids(PredInfo2, ProcIds) },
+		clauses_info_add_clause(Clauses0, ProcIds,
 			ClauseVarSet, TVarSet0, Args, Body, Context,
 			PredOrFunc, Arity, IsAssertion, Goal,
 			VarSet, TVarSet, Clauses, Warnings,
@@ -3633,7 +3632,7 @@
 		% check if there are still no modes for the predicate,
 		% and if so, set the `infer_modes' flag for that predicate
 		%
-		( ModeIds = [] ->
+		( ProcIds = [] ->
 			pred_info_get_markers(PredInfo6, Markers0),
 			add_marker(Markers0, infer_modes, Markers),
 			pred_info_set_markers(PredInfo6, Markers, PredInfo)
@@ -3739,10 +3738,10 @@
 		% so it is set to a dummy value.
 		{ varset__init(TVarSet0) },
 
-		{ ModeIds = [] }, % means this clause applies to _every_
+		{ ProcIds = [] }, % means this clause applies to _every_
 				  % mode of the procedure
 		{ IsAssertion = no },
-		clauses_info_add_clause(ClausesInfo0, ModeIds,
+		clauses_info_add_clause(ClausesInfo0, ProcIds,
 			CVarSet, TVarSet0, HeadTerms, Body, Context,
 			PredOrFunc, Arity, IsAssertion, Goal,
 			VarSet, _TVarSet, ClausesInfo, Warnings,
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.37
diff -u -d -r1.37 modecheck_call.m
--- compiler/modecheck_call.m	2000/10/13 13:55:41	1.37
+++ compiler/modecheck_call.m	2000/12/19 14:10:45
@@ -157,8 +157,9 @@
 	%
 	mode_info_get_module_info(ModeInfo0, ModuleInfo0),
 	get_arg_lives(Modes, ModuleInfo0, ExpectedArgLives),
-	modecheck_var_list_is_live(Args0, ExpectedArgLives, ArgOffset,
-		ModeInfo0, ModeInfo1),
+	NeedExactMatch = no,
+	modecheck_var_list_is_live(Args0, ExpectedArgLives, NeedExactMatch,
+		ArgOffset, ModeInfo0, ModeInfo1),
 
 	%
 	% Check that `Args0' have insts which match the expected
@@ -166,8 +167,8 @@
 	% extra unifications for implied modes, if necessary).
 	%
 	mode_list_get_initial_insts(Modes, ModuleInfo0, InitialInsts),
-	modecheck_var_has_inst_list(Args0, InitialInsts, ArgOffset,
-		InstVarSub, ModeInfo1, ModeInfo2),
+	modecheck_var_has_inst_list(Args0, InitialInsts, NeedExactMatch,
+		ArgOffset, InstVarSub, ModeInfo1, ModeInfo2),
 	mode_list_get_final_insts(Modes, ModuleInfo0, FinalInsts0),
 	inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
 	modecheck_set_var_inst_list(Args0, InitialInsts, FinalInsts,
@@ -192,7 +193,7 @@
 	;
 			% Get the list of different possible
 			% modes for the called predicate
-		map__keys(Procs, ProcIds)
+		pred_info_all_procids(PredInfo, ProcIds)
 	),
 
 	compute_arg_offset(PredInfo, ArgOffset),
@@ -225,8 +226,9 @@
 		% expected livenesses.
 		%
 		proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
-		modecheck_var_list_is_live(ArgVars0, ProcArgLives0, ArgOffset,
-					ModeInfo0, ModeInfo1),
+		NeedExactMatch = no,
+		modecheck_var_list_is_live(ArgVars0, ProcArgLives0,
+			NeedExactMatch, ArgOffset, ModeInfo0, ModeInfo1),
 
 		%
 		% Check that `ArgsVars0' have insts which match the expected
@@ -239,9 +241,10 @@
 		rename_apart_inst_vars(InstVarSet, ProcInstVarSet,
 			ProcArgModes0, ProcArgModes),
 		mode_list_get_initial_insts(ProcArgModes, ModuleInfo,
-					InitialInsts),
-		modecheck_var_has_inst_list(ArgVars0, InitialInsts, ArgOffset,
-					InstVarSub, ModeInfo1, ModeInfo2),
+				InitialInsts),
+		modecheck_var_has_inst_list(ArgVars0, InitialInsts,
+				NeedExactMatch, ArgOffset, InstVarSub,
+				ModeInfo1, ModeInfo2),
 
 		modecheck_end_of_call(ProcInfo, ProcArgModes, ArgVars0,
 			ArgOffset, InstVarSub, ArgVars, ExtraGoals, ModeInfo2,
@@ -256,13 +259,13 @@
 
 		set__init(WaitingVars0),
 		modecheck_find_matching_modes(ProcIds, PredId, Procs, ArgVars0,
-			[], RevMatchingProcIds, WaitingVars0, WaitingVars,
+			[], RevMatchingProcIds, WaitingVars0, WaitingVars1,
 			ModeInfo1, ModeInfo2),
 
 		(	RevMatchingProcIds = [],
 			no_matching_modes(PredId, ArgVars0,
-				DeterminismKnown, WaitingVars,
-				TheProcId, ModeInfo2, ModeInfo3),
+				DeterminismKnown, WaitingVars1,
+				TheProcId, ModeInfo2, ModeInfo4),
 			ArgVars = ArgVars0,
 			ExtraGoals = no_extra_goals
 		;
@@ -272,15 +275,34 @@
 				ArgVars0, TheProcId, InstVarSub, ProcArgModes,
 				ModeInfo2),
 			map__lookup(Procs, TheProcId, ProcInfo),
-			modecheck_end_of_call(ProcInfo, ProcArgModes, ArgVars0,
-				ArgOffset, InstVarSub, ArgVars, ExtraGoals,
-				ModeInfo2, ModeInfo3)
+			CalleeModeErrors = ProcInfo ^ mode_errors,
+			( CalleeModeErrors = [_|_] ->
+				% mode error in callee for this mode
+				ArgVars = ArgVars0,
+				WaitingVars = set__list_to_set(ArgVars),
+				ExtraGoals = no_extra_goals,
+				mode_info_get_instmap(ModeInfo2, InstMap),
+				instmap__lookup_vars(ArgVars, InstMap,
+					ArgInsts),
+				mode_info_set_call_arg_context(0, ModeInfo2,
+					ModeInfo3),
+				mode_info_error(WaitingVars,
+					mode_error_in_callee(ArgVars, ArgInsts,
+						PredId, TheProcId,
+						CalleeModeErrors),
+					ModeInfo3, ModeInfo4)
+			;
+				modecheck_end_of_call(ProcInfo, ProcArgModes,
+					ArgVars0, ArgOffset, InstVarSub,
+					ArgVars, ExtraGoals,
+					ModeInfo2, ModeInfo4)
+			)
 		),
 
 			% restore the error list, appending any new error(s)
-		mode_info_get_errors(ModeInfo3, NewErrors),
+		mode_info_get_errors(ModeInfo4, NewErrors),
 		list__append(OldErrors, NewErrors, Errors),
-		mode_info_set_errors(Errors, ModeInfo3, ModeInfo)
+		mode_info_set_errors(Errors, ModeInfo4, ModeInfo)
 	).
 
 %--------------------------------------------------------------------------%
@@ -349,14 +371,32 @@
 
 		% check whether the livenesses of the args matches their
 		% expected liveness
-	modecheck_var_list_is_live(ArgVars0, ProcArgLives0, 0,
-				ModeInfo0, ModeInfo1),
+	NeedLivenessExactMatch = no,
+	modecheck_var_list_is_live(ArgVars0, ProcArgLives0,
+			NeedLivenessExactMatch, 0, ModeInfo0, ModeInfo1),
 
-		% check whether the insts of the args matches their expected
-		% initial insts
+		% If we're doing mode inference for the called
+		% procedure, and the called procedure has been inferred as
+		% an invalid mode, then don't use it unless it is an exact
+		% match.
+		%
+		% XXX Do we really want mode inference to use implied modes?
+		% Would it be better to always require an exact match when
+		% doing mode inference, to ensure that we add new inferred
+		% modes rather than using implied modes?
+	(
+		proc_info_is_valid_mode(ProcInfo)
+	->
+		NeedExactMatch = no
+	;
+		NeedExactMatch = yes
+	),
+
+		% Check whether the insts of the args matches their expected
+		% initial insts. 
 	mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
-	modecheck_var_has_inst_list(ArgVars0, InitialInsts, 0,
-				InstVarSub, ModeInfo1, ModeInfo2),
+	modecheck_var_has_inst_list(ArgVars0, InitialInsts, NeedExactMatch, 0,
+			InstVarSub, ModeInfo1, ModeInfo2),
 
 		% If we got an error, reset the error list
 		% and save the list of vars to wait on.
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.44
diff -u -d -r1.44 modecheck_unify.m
--- compiler/modecheck_unify.m	2000/10/13 13:55:42	1.44
+++ compiler/modecheck_unify.m	2000/12/19 13:13:21
@@ -882,9 +882,11 @@
 			ExpectedInsts),
 		mode_info_set_call_context(unify(UnifyContext),
 			ModeInfo0, ModeInfo1),
+		NeedExactMatch = no,
 		InitialArgNum = 0,
 		modecheck_var_has_inst_list(UnifyTypeInfoVars, ExpectedInsts,
-			InitialArgNum, _InstVarSub, ModeInfo1, ModeInfo2)
+			NeedExactMatch, InitialArgNum, _InstVarSub,
+			ModeInfo1, ModeInfo2)
 			% We can ignore _InstVarSub since type_info variables
 			% should not have variable insts.
 	),
@@ -1171,9 +1173,10 @@
 		{ is_introduced_type_info_type(ArgType) }
 	->
 		mode_info_set_call_context(unify(UnifyContext)),
+		{ NeedExactMatch = no },
 		{ InitialArgNum = 0 },
 		modecheck_var_has_inst_list([ArgVar], [ground(shared, none)],
-			InitialArgNum, _InstVarSub),
+			NeedExactMatch, InitialArgNum, _InstVarSub),
 		check_type_info_args_are_ground(ArgVars, VarTypes,
 			UnifyContext)
 	;
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.67
diff -u -d -r1.67 mode_errors.m
--- compiler/mode_errors.m	2000/11/03 03:11:52	1.67
+++ compiler/mode_errors.m	2000/12/19 17:49:58
@@ -71,10 +71,16 @@
 			% get rid of it.
 	;	mode_error_no_mode_decl
 			% a call to a predicate for which there are
-			% no mode declarations
+			% no mode declarations (and mode inference is
+			% not enabled)
 	;	mode_error_no_matching_mode(list(prog_var), list(inst))
 			% call to a predicate with an insufficiently
 			% instantiated variable (for preds with >1 mode)
+	;	mode_error_in_callee(list(prog_var), list(inst),
+			pred_id, proc_id, list(mode_error_info))
+			% call to a predicate with initial argument insts
+			% for which mode inference gave a mode error
+			% in the callee
 	;	mode_error_bind_var(var_lock_reason, prog_var, inst, inst)
 			% attempt to bind a non-local variable inside
 			% a negated context, or attempt to re-bind a variable
@@ -223,6 +229,10 @@
 	report_mode_error_conj(ModeInfo, Errors, Culprit).
 report_mode_error(mode_error_no_matching_mode(Vars, Insts), ModeInfo) -->
 	report_mode_error_no_matching_mode(ModeInfo, Vars, Insts).
+report_mode_error(mode_error_in_callee(Vars, Insts,
+		CalleePredId, CalleeProcId, CalleeErrors), ModeInfo) -->
+	report_mode_error_in_callee(ModeInfo, Vars, Insts,
+		CalleePredId, CalleeProcId, CalleeErrors).
 report_mode_error(mode_error_final_inst(ArgNum, Var, VarInst, Inst, Reason),
 		ModeInfo) -->
 	report_mode_error_final_inst(ModeInfo, ArgNum, Var, VarInst, Inst,
@@ -490,6 +500,54 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pred report_mode_error_in_callee(mode_info, list(prog_var),
+		list(inst), pred_id, proc_id, list(mode_error_info),
+		io__state, io__state).
+:- mode report_mode_error_in_callee(mode_info_ui, in, in, in, in, in,
+		di, uo) is det.
+
+report_mode_error_in_callee(ModeInfo, Vars, Insts,
+		CalleePredId, CalleeProcId, CalleeModeErrors) -->
+	{ mode_info_get_module_info(ModeInfo, ModuleInfo) },
+	{ mode_info_get_context(ModeInfo, Context) },
+	{ mode_info_get_varset(ModeInfo, VarSet) },
+	{ mode_info_get_instvarset(ModeInfo, InstVarSet) },
+	mode_info_write_context(ModeInfo),
+	prog_out__write_context(Context),
+	io__write_string("  mode error: arguments `"),
+	mercury_output_vars(Vars, VarSet, no),
+	io__write_string("'\n"),
+	prog_out__write_context(Context),
+	io__write_string("  have insts `"),
+	output_inst_list(Insts, InstVarSet),
+	io__write_string("',\n"),
+	prog_out__write_context(Context),
+	io__write_string("  which does not match any of the valid modes for "),
+	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+	( { VerboseErrors = yes } ->
+		prog_out__write_context(Context),
+		io__write_string("  the callee ("),
+		hlds_out__write_pred_id(ModuleInfo, CalleePredId),
+		io__write_string("),\n"),
+		prog_out__write_context(Context),
+		io__write_string("  because of the following error.\n")
+	;
+		prog_out__write_context(Context),
+		io__write_string("  the callee, because of the following error.\n")
+	),
+	( { CalleeModeErrors = [First | _] } ->
+		{ First = mode_error_info(_, CalleeModeError,
+			CalleeContext, CalleeModeContext) },
+		{ mode_info_set_predid(ModeInfo, CalleePredId, ModeInfo1) },
+		{ mode_info_set_procid(ModeInfo1, CalleeProcId, ModeInfo2) },
+		{ mode_info_set_context(CalleeContext, ModeInfo2, ModeInfo3) },
+		{ mode_info_set_mode_context(CalleeModeContext,
+			ModeInfo3, ModeInfo4) },
+		report_mode_error(CalleeModeError, ModeInfo4)
+	;
+		{ error("report_mode_error_in_callee: no error") }
+	).
+
 :- pred report_mode_error_no_matching_mode(mode_info, list(prog_var),
 		list(inst), io__state, io__state).
 :- mode report_mode_error_no_matching_mode(mode_info_ui, in, in, di, uo) is det.
@@ -945,10 +1003,10 @@
 	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
 	{ pred_info_get_markers(PredInfo, Markers) },
 	( { check_marker(Markers, infer_modes) } ->
+		{ pred_info_all_procids(PredInfo, ProcIds) },
 		{ pred_info_procedures(PredInfo, Procs) },
-		{ map__keys(Procs, ProcIds) },
 		write_mode_inference_messages_2(ProcIds, Procs, PredInfo,
-			OutputDetism)
+			OutputDetism, ModuleInfo)
 	;
 		[]
 	),
@@ -958,24 +1016,40 @@
 	% proc_ids
 
 :- pred write_mode_inference_messages_2(list(proc_id), proc_table, pred_info,
-				bool, io__state, io__state).
-:- mode write_mode_inference_messages_2(in, in, in, in, di, uo) is det.
+				bool, module_info, io__state, io__state).
+:- mode write_mode_inference_messages_2(in, in, in, in, in, di, uo) is det.
 
-write_mode_inference_messages_2([], _, _, _) --> [].
+write_mode_inference_messages_2([], _, _, _, _) --> [].
 write_mode_inference_messages_2([ProcId | ProcIds], Procs, PredInfo,
-		OutputDetism) -->
+		OutputDetism, ModuleInfo) -->
+	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
 	{ map__lookup(Procs, ProcId, ProcInfo) },
-	write_mode_inference_message(PredInfo, ProcInfo, OutputDetism),
-	write_mode_inference_messages_2(ProcIds, Procs, PredInfo, OutputDetism).
+	(
+		{
+			% We always output `Inferred :- mode ...'
+			proc_info_is_valid_mode(ProcInfo)
+		;
+			% We only output `REJECTED :- mode ...'
+			% if --verbose-errors is enabled
+			VerboseErrors = yes
+		}
+	->
+		write_mode_inference_message(PredInfo, ProcInfo, OutputDetism,
+			ModuleInfo)
+	;
+		[]
+	),
+	write_mode_inference_messages_2(ProcIds, Procs, PredInfo, OutputDetism,
+		ModuleInfo).
 
 	% write out the inferred `mode' declaration
 	% for a single function or predicate.
 
 :- pred write_mode_inference_message(pred_info, proc_info, bool,
-				io__state, io__state).
-:- mode write_mode_inference_message(in, in, in, di, uo) is det.
+		module_info, io__state, io__state).
+:- mode write_mode_inference_message(in, in, in, in, di, uo) is det.
 
-write_mode_inference_message(PredInfo, ProcInfo, OutputDetism) -->
+write_mode_inference_message(PredInfo, ProcInfo, OutputDetism, ModuleInfo) -->
 	{ pred_info_name(PredInfo, PredName) },
 	{ Name = unqualified(PredName) },
 	{ pred_info_context(PredInfo, Context) },
@@ -997,20 +1071,39 @@
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
 	( { OutputDetism = yes } ->
 		{ proc_info_inferred_determinism(ProcInfo, Detism) },
-		{ MaybeDet = yes(Detism) }
+		{ MaybeDet0 = yes(Detism) }
 	;
-		{ MaybeDet = no }
+		{ MaybeDet0 = no }
 	),
 	prog_out__write_context(Context),
-	{ strip_builtin_qualifiers_from_mode_list(ArgModes2, ArgModes3) },
-	io__write_string("Inferred "),
+	( { proc_info_is_valid_mode(ProcInfo) } ->
+		io__write_string("Inferred "),
+		{ ArgModes3 = ArgModes2 },
+		{ MaybeDet = MaybeDet0 }
+	;
+		io__write_string("REJECTED "),
+		% Replace the final insts with dummy insts '...',
+		% since they won't be valid anyway -- they are just
+		% the results of whatever partial inference we did
+		% before detecting the error.
+		{ mode_list_get_initial_insts(ArgModes2, ModuleInfo,
+			InitialInsts) }, 
+		{ DummyInst = defined_inst(user_inst(unqualified("..."), [])) },
+		{ list__duplicate(PredArity, DummyInst, FinalInsts) },
+		{ ArgModes3 = list__map(func(I - F) = (I -> F),
+			assoc_list__from_corresponding_lists(
+				InitialInsts, FinalInsts)) },
+		% Likewise delete the determinism.
+		{ MaybeDet = no }
+	),
+	{ strip_builtin_qualifiers_from_mode_list(ArgModes3, ArgModes) },
 	(	{ PredOrFunc = predicate },
-		mercury_output_pred_mode_decl(VarSet, Name, ArgModes3,
+		mercury_output_pred_mode_decl(VarSet, Name, ArgModes,
 				MaybeDet, Context)
 	;	{ PredOrFunc = function },
-		{ pred_args_to_func_args(ArgModes3, ArgModes, RetMode) },
-		mercury_output_func_mode_decl(VarSet, Name, ArgModes, RetMode,
-				MaybeDet, Context)
+		{ pred_args_to_func_args(ArgModes, FuncArgModes, RetMode) },
+		mercury_output_func_mode_decl(VarSet, Name, FuncArgModes,
+				RetMode, MaybeDet, Context)
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/mode_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_info.m,v
retrieving revision 1.58
diff -u -d -r1.58 mode_info.m
--- compiler/mode_info.m	2000/12/14 08:39:49	1.58
+++ compiler/mode_info.m	2000/12/19 02:53:33
@@ -112,9 +112,15 @@
 :- pred mode_info_get_predid(mode_info, pred_id).
 :- mode mode_info_get_predid(mode_info_ui, out) is det.
 
+:- pred mode_info_set_predid(mode_info, pred_id, mode_info).
+:- mode mode_info_set_predid(mode_info_ui, in, mode_info_uo) is det.
+
 :- pred mode_info_get_procid(mode_info, proc_id).
 :- mode mode_info_get_procid(mode_info_ui, out) is det.
 
+:- pred mode_info_set_procid(mode_info, proc_id, mode_info).
+:- mode mode_info_set_procid(mode_info_di, in, mode_info_uo) is det.
+
 :- pred mode_info_get_context(mode_info, prog_context).
 :- mode mode_info_get_context(mode_info_ui, out) is det.
 
@@ -505,6 +511,8 @@
 mode_info_get_may_change_called_proc(MI, MI^may_change_called_proc).
 
 mode_info_set_module_info(MI, ModuleInfo, MI^module_info := ModuleInfo).
+mode_info_set_predid(MI, PredId, MI^predid := PredId).
+mode_info_set_procid(MI, ProcId, MI^procid := ProcId).
 mode_info_set_varset(VarSet) --> ^varset := VarSet.
 mode_info_set_var_types(VTypes) --> ^var_types := VTypes.
 mode_info_set_context(Context) --> ^context := Context.
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.250
diff -u -d -r1.250 modes.m
--- compiler/modes.m	2000/11/17 17:48:07	1.250
+++ compiler/modes.m	2000/12/19 16:33:44
@@ -146,7 +146,8 @@
 
 	% Mode-check or unique-mode-check the code for all the predicates
 	% in a module.
-:- pred check_pred_modes(how_to_check_goal, may_change_called_proc,				module_info, module_info, bool, io__state, io__state).
+:- pred check_pred_modes(how_to_check_goal, may_change_called_proc,
+		module_info, module_info, bool, io__state, io__state).
 :- mode check_pred_modes(in, in, in, out, out, di, uo) is det.
 
 	% Mode-check or unique-mode-check the code for single predicate.
@@ -208,20 +209,23 @@
 
 	% Given a list of variables and a list of expected liveness, ensure
 	% that the inst of each variable satisfies the corresponding expected
-	% liveness.
+	% liveness.  If the bool argument is `yes', then require an exact
+	% match.
 	%
-:- pred modecheck_var_list_is_live(list(prog_var), list(is_live), int,
+:- pred modecheck_var_list_is_live(list(prog_var), list(is_live), bool, int,
 		mode_info, mode_info).
-:- mode modecheck_var_list_is_live(in, in, in, mode_info_di, mode_info_uo)
+:- mode modecheck_var_list_is_live(in, in, in, in, mode_info_di, mode_info_uo)
 	is det.
 
 	% Given a list of variables and a list of initial insts, ensure
 	% that the inst of each variable matches the corresponding initial
-	% inst.
+	% inst.  If the bool argument is `yes', then we require an exact
+	% match (using inst_matches_final), otherwise we allow the var
+	% to be more instantiated than the inst (using inst_matches_initial).
 	%
-:- pred modecheck_var_has_inst_list(list(prog_var), list(inst), int,
+:- pred modecheck_var_has_inst_list(list(prog_var), list(inst), bool, int,
 		inst_var_sub, mode_info, mode_info).
-:- mode modecheck_var_has_inst_list(in, in, in, out, mode_info_di, mode_info_uo)
+:- mode modecheck_var_has_inst_list(in, in, in, in, out, mode_info_di, mode_info_uo)
 	is det.
 
 :- pred modecheck_set_var_inst(prog_var, inst, mode_info, mode_info).
@@ -608,8 +612,11 @@
 
 modecheck_pred_mode_2(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc,
 		ModuleInfo0, ModuleInfo, Changed0, Changed, NumErrors) -->
-	{ pred_info_procedures(PredInfo0, Procs0) },
-	{ map__keys(Procs0, ProcIds) },
+	% Note that we use pred_info_procids rather than
+	% pred_info_all_procids here, which means that we
+	% don't process modes that have already been inferred
+	% as invalid.
+	{ pred_info_procids(PredInfo0, ProcIds) },
 	( { WhatToCheck = check_modes } ->
 		(
 			{ ProcIds = [] }
@@ -832,19 +839,33 @@
 	modecheck_final_insts_2(HeadVars, ArgFinalInsts0, ModeInfo2,
 			InferModes, ArgFinalInsts, ModeInfo3),
 
-		% report any errors we found, and save away the results
-	report_mode_errors(ModeInfo3, ModeInfo),
+	( InferModes = yes ->
+		% For inferred predicates, we don't report the
+		% error(s) here; instead we just save them in the
+		% proc_info, thus marking that procedure as invalid.
+		ModeInfo = ModeInfo3,
+		% This is sometimes handy for debugging:
+		% report_mode_errors(ModeInfo3, ModeInfo),
+		mode_info_get_errors(ModeInfo, ModeErrors),
+		ProcInfo1 = ProcInfo0 ^ mode_errors := ModeErrors,
+		NumErrors = 0
+	;
+		% report any errors we found
+		report_mode_errors(ModeInfo3, ModeInfo),
+		mode_info_get_num_errors(ModeInfo, NumErrors),
+		ProcInfo1 = ProcInfo0
+	),
+	% save away the results
 	inst_lists_to_mode_list(ArgInitialInsts, ArgFinalInsts, ArgModes),
 	mode_info_get_changed_flag(ModeInfo, Changed),
 	mode_info_get_module_info(ModeInfo, ModuleInfo),
-	mode_info_get_num_errors(ModeInfo, NumErrors),
 	mode_info_get_io_state(ModeInfo, IOState),
 	mode_info_get_varset(ModeInfo, VarSet),
 	mode_info_get_var_types(ModeInfo, VarTypes),
-	proc_info_set_goal(ProcInfo0, Body, ProcInfo1),
-	proc_info_set_varset(ProcInfo1, VarSet, ProcInfo2),
-	proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo3),
-	proc_info_set_argmodes(ProcInfo3, ArgModes, ProcInfo).
+	proc_info_set_goal(ProcInfo1, Body, ProcInfo2),
+	proc_info_set_varset(ProcInfo2, VarSet, ProcInfo3),
+	proc_info_set_vartypes(ProcInfo3, VarTypes, ProcInfo4),
+	proc_info_set_argmodes(ProcInfo4, ArgModes, ProcInfo).
 
 	% modecheck_final_insts for a lambda expression
 modecheck_final_insts(HeadVars, ArgFinalInsts, ModeInfo0, ModeInfo) :-
@@ -865,7 +886,24 @@
 modecheck_final_insts_2(HeadVars, FinalInsts0, ModeInfo0, InferModes,
 			FinalInsts, ModeInfo) :-
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
-	mode_info_get_instmap(ModeInfo0, InstMap),
+	mode_info_get_errors(ModeInfo0, Errors),
+	% If there were any mode errors, use an unreachable instmap.
+	% This ensures that we don't get unwanted flow-on errors.
+	% This is not strictly necessary, since we only report the
+	% first mode error anyway, and the resulting FinalInsts
+	% will not be used; but it improves the readability of the
+	% rejected modes.
+	( Errors \= [] ->
+		% If there were any mode errors, something must have
+		% changed, since if the procedure had mode errors
+		% in a previous pass then it wouldn't have been
+		% processed at all in this pass.
+		Changed0 = yes,
+		instmap__init_unreachable(InstMap)
+	;
+		Changed0 = no,
+		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),
@@ -888,8 +926,8 @@
 		check_final_insts(HeadVars, FinalInsts0, FinalInsts,
 			InferModes, 1, ModuleInfo, no, Changed1,
 			ModeInfo0, ModeInfo1),
-		mode_info_get_changed_flag(ModeInfo1, Changed0),
-		bool__or(Changed0, Changed1, Changed),
+		mode_info_get_changed_flag(ModeInfo1, Changed2),
+		bool__or_list([Changed0, Changed1, Changed2], Changed),
 		mode_info_set_changed_flag(Changed, ModeInfo1, ModeInfo)
 	;
 		check_final_insts(HeadVars, FinalInsts0, VarFinalInsts1,
@@ -1782,34 +1820,41 @@
 	% ensure the liveness of each variable satisfies the corresponding
 	% expected liveness.
 
-modecheck_var_list_is_live([_|_], [], _) -->
+modecheck_var_list_is_live([_|_], [], _, _) -->
 	{ error("modecheck_var_list_is_live: length mismatch") }.
-modecheck_var_list_is_live([], [_|_], _) -->
+modecheck_var_list_is_live([], [_|_], _, _) -->
 	{ error("modecheck_var_list_is_live: length mismatch") }.
-modecheck_var_list_is_live([], [], _ArgNum) --> [].
-modecheck_var_list_is_live([Var|Vars], [IsLive|IsLives], ArgNum0) -->
+modecheck_var_list_is_live([], [], _NeedExactMatch, _ArgNum) --> [].
+modecheck_var_list_is_live([Var|Vars], [IsLive|IsLives], NeedExactMatch,
+		ArgNum0) -->
 	{ ArgNum is ArgNum0 + 1 },
 	mode_info_set_call_arg_context(ArgNum),
-	modecheck_var_is_live(Var, IsLive),
-	modecheck_var_list_is_live(Vars, IsLives, ArgNum).
+	modecheck_var_is_live(Var, IsLive, NeedExactMatch),
+	modecheck_var_list_is_live(Vars, IsLives, NeedExactMatch, ArgNum).
 
-:- pred modecheck_var_is_live(prog_var, is_live, mode_info, mode_info).
-:- mode modecheck_var_is_live(in, in, mode_info_di, mode_info_uo) is det.
+:- pred modecheck_var_is_live(prog_var, is_live, bool, mode_info, mode_info).
+:- mode modecheck_var_is_live(in, in, in, mode_info_di, mode_info_uo) is det.
 
 	% `live' means possibly used later on, and
 	% `dead' means definitely not used later on.
-	% The only time you get an error is if you pass a variable
+	% If you don't need an exact match, then
+	% the only time you get an error is if you pass a variable
 	% which is live to a predicate that expects the variable to
 	% be dead; the predicate may use destructive update to clobber
 	% the variable, so we must be sure that it is dead after the call.
 
-modecheck_var_is_live(VarId, ExpectedIsLive, ModeInfo0, ModeInfo) :-
+modecheck_var_is_live(VarId, ExpectedIsLive, NeedExactMatch,
+		ModeInfo0, ModeInfo) :-
 	mode_info_var_is_live(ModeInfo0, VarId, VarIsLive),
-	( ExpectedIsLive = dead, VarIsLive = live ->
+	( 
+		( ExpectedIsLive = dead, VarIsLive = live
+		; NeedExactMatch = yes, VarIsLive \= ExpectedIsLive
+		)
+	->
 		set__singleton_set(WaitingVars, VarId),
 		mode_info_error(WaitingVars, mode_error_var_is_live(VarId),
 			ModeInfo0, ModeInfo)
-	;
+	; 
 		ModeInfo = ModeInfo0
 	).
 
@@ -1819,33 +1864,36 @@
 	% that the inst of each variable matches the corresponding initial
 	% inst.
 
-modecheck_var_has_inst_list(Vars, Insts, ArgNum, Subst) -->
+modecheck_var_has_inst_list(Vars, Insts, NeedEaxctMatch, ArgNum, Subst) -->
 	{ map__init(Subst0) },
-	modecheck_var_has_inst_list_2(Vars, Insts, ArgNum, Subst0, Subst).
+	modecheck_var_has_inst_list_2(Vars, Insts, NeedEaxctMatch, ArgNum,
+		Subst0, Subst).
 
-:- pred modecheck_var_has_inst_list_2(list(prog_var), list(inst), int,
+:- pred modecheck_var_has_inst_list_2(list(prog_var), list(inst), bool, int,
 		inst_var_sub, inst_var_sub, mode_info, mode_info).
-:- mode modecheck_var_has_inst_list_2(in, in, in, in, out,
+:- mode modecheck_var_has_inst_list_2(in, in, in, in, in, out,
 		mode_info_di, mode_info_uo) is det.
 
-modecheck_var_has_inst_list_2([_|_], [], _, _, _) -->
+modecheck_var_has_inst_list_2([_|_], [], _, _, _, _) -->
 	{ error("modecheck_var_has_inst_list: length mismatch") }.
-modecheck_var_has_inst_list_2([], [_|_], _, _, _) -->
+modecheck_var_has_inst_list_2([], [_|_], _, _, _, _) -->
 	{ error("modecheck_var_has_inst_list: length mismatch") }.
-modecheck_var_has_inst_list_2([], [], _ArgNum, Subst, Subst) --> [].
-modecheck_var_has_inst_list_2([Var|Vars], [Inst|Insts], ArgNum0, Subst0, Subst)
-		-->
+modecheck_var_has_inst_list_2([], [], _Exact, _ArgNum, Subst, Subst) --> [].
+modecheck_var_has_inst_list_2([Var|Vars], [Inst|Insts],
+		NeedExactMatch, ArgNum0, Subst0, Subst) -->
 	{ ArgNum is ArgNum0 + 1 },
 	mode_info_set_call_arg_context(ArgNum),
-	modecheck_var_has_inst(Var, Inst, Subst0, Subst1),
-	modecheck_var_has_inst_list_2(Vars, Insts, ArgNum, Subst1, Subst).
+	modecheck_var_has_inst(Var, Inst, NeedExactMatch, Subst0, Subst1),
+	modecheck_var_has_inst_list_2(Vars, Insts,
+		NeedExactMatch, ArgNum, Subst1, Subst).
 
-:- pred modecheck_var_has_inst(prog_var, inst, inst_var_sub, inst_var_sub,
-		mode_info, mode_info).
-:- mode modecheck_var_has_inst(in, in, in, out, mode_info_di, mode_info_uo)
-		is det.
+:- pred modecheck_var_has_inst(prog_var, inst, bool,
+		inst_var_sub, inst_var_sub, mode_info, mode_info).
+:- mode modecheck_var_has_inst(in, in, in,
+		in, out, mode_info_di, mode_info_uo) is det.
 
-modecheck_var_has_inst(VarId, Inst, Subst0, Subst, ModeInfo0, ModeInfo) :-
+modecheck_var_has_inst(VarId, Inst, NeedExactMatch, Subst0, Subst,
+		ModeInfo0, ModeInfo) :-
 	mode_info_get_instmap(ModeInfo0, InstMap),
 	instmap__lookup_var(InstMap, VarId, VarInst),
 	mode_info_get_var_types(ModeInfo0, VarTypes),
@@ -1853,8 +1901,16 @@
 
 	mode_info_get_module_info(ModeInfo0, ModuleInfo0),
 	(
-		inst_matches_initial(VarInst, Inst, Type, ModuleInfo0,
-			ModuleInfo, Subst0, Subst1)
+		(
+			NeedExactMatch = no,
+			inst_matches_initial(VarInst, Inst, Type, ModuleInfo0,
+				ModuleInfo, Subst0, Subst1)
+		;
+			NeedExactMatch = yes,
+			inst_matches_final(VarInst, Inst, Type, ModuleInfo0),
+			ModuleInfo = ModuleInfo0,
+			Subst1 = Subst0
+		)
 	->
 		Subst = Subst1,
 		mode_info_set_module_info(ModeInfo0, ModuleInfo, ModeInfo)
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.21
diff -u -d -r1.21 termination.m
--- compiler/termination.m	2000/09/20 12:12:10	1.21
+++ compiler/termination.m	2000/12/19 12:53:25
@@ -389,7 +389,7 @@
 	pred_info_context(PredInfo0, Context),
 	pred_info_procedures(PredInfo0, ProcTable0),
 	pred_info_get_markers(PredInfo0, Markers),
-	map__keys(ProcTable0, ProcIds),
+	pred_info_procids(PredInfo0, ProcIds),
 	( 
 		% It is possible for compiler generated/mercury builtin
 		% predicates to be imported or locally defined, so they
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.69
diff -u -d -r1.69 unique_modes.m
--- compiler/unique_modes.m	2000/11/23 04:32:51	1.69
+++ compiler/unique_modes.m	2000/12/19 14:43:51
@@ -545,7 +545,7 @@
 	%
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
 	module_info_pred_proc_info(ModuleInfo, PredId, ProcId0,
-		PredInfo, ProcInfo),
+			PredInfo, ProcInfo),
 	compute_arg_offset(PredInfo, ArgOffset),
 	proc_info_argmodes(ProcInfo, ProcArgModes0),
 	proc_info_interface_determinism(ProcInfo, InterfaceDeterminism),
@@ -553,23 +553,36 @@
 	unique_modes__check_call_modes(ArgVars, ProcArgModes0, ArgOffset,
 			InterfaceDeterminism, NeverSucceeds,
 			ModeInfo1, ModeInfo2),
+	( ProcInfo ^ mode_errors = [_|_] ->
+		% mode error in callee for this mode
+		WaitingVars = set__list_to_set(ArgVars),
+		mode_info_get_instmap(ModeInfo2, InstMap),
+		instmap__lookup_vars(ArgVars, InstMap, ArgInsts),
+		mode_info_error(WaitingVars,
+			mode_error_in_callee(ArgVars, ArgInsts,
+				PredId, ProcId0,
+				ProcInfo ^ mode_errors),
+			ModeInfo2, ModeInfo3)
+	;
+		ModeInfo3 = ModeInfo2
+	),
 
 	%
 	% see whether or not that worked
 	% (and restore the old error list)
 	%
-	mode_info_get_errors(ModeInfo2, Errors),
-	mode_info_set_errors(OldErrors, ModeInfo2, ModeInfo3),
-	mode_info_get_may_change_called_proc(ModeInfo3, MayChangeCalledProc),
+	mode_info_get_errors(ModeInfo3, Errors),
+	mode_info_set_errors(OldErrors, ModeInfo3, ModeInfo4),
+	mode_info_get_may_change_called_proc(ModeInfo4, MayChangeCalledProc),
 	( Errors = [] ->
 		ProcId = ProcId0,
-		ModeInfo = ModeInfo3
+		ModeInfo = ModeInfo4
 	; MayChangeCalledProc = may_not_change_called_proc ->
 		% We're not allowed to try a different procedure
 		% here, so just return all the errors.
 		ProcId = ProcId0,
 		list__append(OldErrors, Errors, AllErrors),
-		mode_info_set_errors(AllErrors, ModeInfo3, ModeInfo)
+		mode_info_set_errors(AllErrors, ModeInfo4, ModeInfo)
 	;
 		%
 		% If it didn't work, restore the original instmap,
@@ -585,10 +598,10 @@
 		% as a result of unique mode analysis.  That is OK,
 		% because uniqueness should not affect determinism.
 		%
-		mode_info_set_instmap(InstMap0, ModeInfo3, ModeInfo4),
+		mode_info_set_instmap(InstMap0, ModeInfo4, ModeInfo5),
 		proc_info_inferred_determinism(ProcInfo, Determinism),
 		modecheck_call_pred(PredId, ProcId0, ArgVars, yes(Determinism),
-			ProcId, NewArgVars, ExtraGoals, ModeInfo4, ModeInfo),
+			ProcId, NewArgVars, ExtraGoals, ModeInfo5, ModeInfo),
 		
 		( NewArgVars = ArgVars, ExtraGoals = no_extra_goals ->
 			true
@@ -616,9 +629,11 @@
 		Determinism, NeverSucceeds, ModeInfo0, ModeInfo) :-
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
 	mode_list_get_initial_insts(ProcArgModes, ModuleInfo,
-				InitialInsts),
-	modecheck_var_has_inst_list(ArgVars, InitialInsts, ArgOffset,
-				InstVarSub, ModeInfo0, ModeInfo1),
+			InitialInsts),
+	NeedExactMatch = no,
+	modecheck_var_has_inst_list(ArgVars, InitialInsts,
+			NeedExactMatch, ArgOffset, InstVarSub,
+			ModeInfo0, ModeInfo1),
 	mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts0),
 	inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
 	modecheck_set_var_inst_list(ArgVars, InitialInsts, FinalInsts,

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



More information about the developers mailing list