for review: inference of mostly_unique modes

Fergus Henderson fjh at cs.mu.oz.au
Sun Jan 4 15:45:42 AEDT 1998


Hi,

Andrew Bromage, I guess you're the other expert on modes --
can you please review this one?

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

Estimated hours taken: 24

Handle inference of unique (not just mostly-unique) modes.

compiler/unique_modes.m:
	Change the handling of calls so that if the mode originally selected
	by ordinary mode analysis (modes.m) won't work, then it now calls
	modecheck_call_pred to introduce a new mode for the predicate.

compiler/unify_proc.m:
	Generalize the existing "unify request queue" so that
	it can handle requests for any kind of predicate, not
	just for unification predicates.

compiler/modecheck_call.m:
	When introducing new modes for predicates, do this by adding them
	to the request queue.  This ensures that when we do get around
	to processing predicates added in unique mode analysis, we will
	run mode analysis, switch detection, and determinism analysis
	before doing unique mode analysis.  To make this work, we
	need to pass down a `maybe(determinism)' argument indicating
	the determinism of the newly added procedure.  unique_modes.m
	sets this to the determinism inferred for the mode originally
	inferred by modes.m.  That should be OK, because uniqueness
	should not affect determinism.
	Also change modecheck_call_proc to return a `Changed' flag
	indicating whether we need to rerun fixpoint analysis.
	And change `get_var_insts_and_lives' to return `dead' for
	mostly_unique modes, not just for unique modes, so that
	we can infer `mdi' modes.

compiler/modes.m:
	Instead of analyzing everything to a fixpoint, and then
	analyzing the queued unification procedures, change it so
	that analysis of queued procedures is part of each fixpoint
	iteration.
	When doing ordinary mode analysis for calls, pass `no' as the
	new `maybe(determinism)' argument to modecheck_call_pred.

compiler/constraint.m:
compiler/cse_detection.m:
	Ignore the new output argument for modecheck_call_proc.

compiler/mode_util.m:
	Add code to insts_to_mode to recognize `muo', `mui', and `mdi'
	modes and use the corresponding abbreviations (previously this
	was done only for `uo', `ui', `di', `in' and `out').

tests/valid/mostly_uniq_mode_inf.m:
	A test case for the above change.

cvs diff  compiler/constraint.m compiler/cse_detection.m compiler/mode_util.m compiler/modecheck_call.m compiler/modes.m compiler/unify_proc.m compiler/unique_modes.m tests/valid/mostly_uniq_mode_inf.m
Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.37
diff -u -r1.37 constraint.m
--- constraint.m	1997/12/22 09:55:25	1.37
+++ constraint.m	1998/01/04 03:01:34
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1995-1997 The University of Melbourne.
+% Copyright (C) 1995-1998 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -67,7 +67,7 @@
 constraint_propagation3([], ModuleInfo, ModuleInfo) --> [].
 constraint_propagation3([proc(Pred, Proc) | Rest], ModuleInfo0, ModuleInfo) -->
 	constraint__propagate_in_proc(Pred, Proc, ModuleInfo0, ModuleInfo1),
-	modecheck_proc(Proc, Pred, ModuleInfo1, ModuleInfo2, Errs),
+	modecheck_proc(Proc, Pred, ModuleInfo1, ModuleInfo2, Errs, _Changed),
 	( { Errs \= 0 } ->
 	    { error("constraint_propagation3") }
 	;
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.50
diff -u -r1.50 cse_detection.m
--- cse_detection.m	1997/12/22 09:55:27	1.50
+++ cse_detection.m	1998/01/04 03:01:40
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1995-1997 The University of Melbourne.
+% Copyright (C) 1995-1998 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -91,7 +91,8 @@
 		;
 			[]
 		),
-		modecheck_proc(ProcId, PredId, ModuleInfo1, ModuleInfo2, Errs),
+		modecheck_proc(ProcId, PredId, ModuleInfo1,
+				ModuleInfo2, Errs, _Changed),
 		{ Errs > 0 ->
 			error("mode check fails when repeated")
 		;
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.102
diff -u -r1.102 mode_util.m
--- mode_util.m	1997/12/19 03:07:36	1.102
+++ mode_util.m	1998/01/04 04:25:13
@@ -206,12 +206,23 @@
 				qualified("mercury_builtin", "out"), [])
 	; Initial = free, Final = ground(unique, no) ->
 		Mode = user_defined_mode(qualified("mercury_builtin", "uo"), [])
+	; Initial = free, Final = ground(mostly_unique, no) ->
+		Mode = user_defined_mode(qualified("mercury_builtin", "muo"),
+								[])
 	; Initial = ground(shared, no), Final = ground(shared, no) ->
 		Mode = user_defined_mode(qualified("mercury_builtin", "in"), [])
 	; Initial = ground(unique, no), Final = ground(clobbered, no) ->
 		Mode = user_defined_mode(qualified("mercury_builtin", "di"), [])
+	; Initial = ground(mostly_unique, no),
+	  Final = ground(mostly_clobbered, no) ->
+		Mode = user_defined_mode(qualified("mercury_builtin", "mdi"),
+								[])
 	; Initial = ground(unique, no), Final = ground(unique, no) ->
 		Mode = user_defined_mode(qualified("mercury_builtin", "ui"), [])
+	; Initial = ground(mostly_unique, no),
+	  Final = ground(mostly_unique, no) ->
+		Mode = user_defined_mode(qualified("mercury_builtin", "mui"),
+								[])
 	; Initial = free ->
 		Mode = user_defined_mode(qualified("mercury_builtin", "out"),
 								[Final])
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.19
diff -u -r1.19 modecheck_call.m
--- modecheck_call.m	1997/11/24 07:26:54	1.19
+++ modecheck_call.m	1998/01/04 04:18:48
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1996-1997 The University of Melbourne.
+% Copyright (C) 1996-1998 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -24,9 +24,10 @@
 :- import_module hlds_goal, mode_info.
 :- import_module term.
 
-:- pred modecheck_call_pred(pred_id, list(var), proc_id, list(var),
-				extra_goals, mode_info, mode_info).
-:- mode modecheck_call_pred(in, in, out, out, out,
+:- pred modecheck_call_pred(pred_id, list(var), maybe(determinism),
+				proc_id, list(var), extra_goals,
+				mode_info, mode_info).
+:- mode modecheck_call_pred(in, in, in, out, out, out,
 				mode_info_di, mode_info_uo) is det.
 
 :- pred modecheck_higher_order_call(pred_or_func, var, list(var),
@@ -61,7 +62,7 @@
 :- import_module prog_data, hlds_pred, hlds_data, hlds_module, instmap, (inst).
 :- import_module mode_info, mode_debug, modes, mode_util, mode_errors.
 :- import_module clause_to_proc, inst_match, make_hlds.
-:- import_module det_report.
+:- import_module det_report, unify_proc.
 :- import_module map, list, bool, std_util, set, require.
 
 modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0, Goal)
@@ -164,8 +165,8 @@
 		ExtraGoals = no_extra_goals
 	).
 
-modecheck_call_pred(PredId, ArgVars0, TheProcId, ArgVars, ExtraGoals,
-		ModeInfo0, ModeInfo) :-
+modecheck_call_pred(PredId, ArgVars0, DeterminismKnown,
+		TheProcId, ArgVars, ExtraGoals, ModeInfo0, ModeInfo) :-
 
 		% Get the list of different possible modes for the called
 		% predicate
@@ -231,7 +232,8 @@
 			ModeInfo1, ModeInfo2),
 
 		(	RevMatchingProcIds = [],
-			no_matching_modes(PredId, ArgVars0, WaitingVars,
+			no_matching_modes(PredId, ArgVars0,
+				DeterminismKnown, WaitingVars,
 				TheProcId, ModeInfo2, ModeInfo3),
 			ArgVars = ArgVars0,
 			ExtraGoals = no_extra_goals
@@ -251,11 +253,12 @@
 		mode_info_set_errors(Errors, ModeInfo3, ModeInfo)
 	).
 
-:- pred no_matching_modes(pred_id, list(var), set(var), proc_id, 	
-				mode_info, mode_info).
-:- mode no_matching_modes(in, in, in, out, mode_info_di, mode_info_uo) is det.
+:- pred no_matching_modes(pred_id, list(var), maybe(determinism), set(var),
+				proc_id, mode_info, mode_info).
+:- mode no_matching_modes(in, in, in, in, out, mode_info_di, mode_info_uo)
+	is det.
 
-no_matching_modes(PredId, ArgVars, WaitingVars, TheProcId,
+no_matching_modes(PredId, ArgVars, DeterminismKnown, WaitingVars, TheProcId,
 		ModeInfo0, ModeInfo) :-
 	%
 	% There were no matching modes.
@@ -267,7 +270,7 @@
 	map__lookup(Preds, PredId, PredInfo),
 	pred_info_get_markers(PredInfo, Markers),
 	( check_marker(Markers, infer_modes) ->
-		insert_new_mode(PredId, ArgVars, TheProcId,
+		insert_new_mode(PredId, ArgVars, DeterminismKnown, TheProcId,
 			ModeInfo0, ModeInfo1),
 		% we don't yet know the final insts for the newly created mode
 		% of the called predicate, so we set the instmap to unreachable,
@@ -362,8 +365,9 @@
 		ModeInfo = ModeInfo1
 	).
 
-:- pred insert_new_mode(pred_id, list(var), proc_id, mode_info, mode_info).
-:- mode insert_new_mode(in, in, out, mode_info_di, mode_info_uo) is det.
+:- pred insert_new_mode(pred_id, list(var), maybe(determinism), proc_id,
+			mode_info, mode_info).
+:- mode insert_new_mode(in, in, in, out, mode_info_di, mode_info_uo) is det.
 
 	% Insert a new inferred mode for a predicate.
 	% The initial insts are determined by using a normalised
@@ -371,7 +375,7 @@
 	% The final insts are initially just assumed to be all `not_reached'.
 	% The determinism for this mode will be inferred.
 
-insert_new_mode(PredId, ArgVars, ProcId, ModeInfo0, ModeInfo) :-
+insert_new_mode(PredId, ArgVars, MaybeDet, ProcId, ModeInfo0, ModeInfo) :-
 	% figure out the values of all the variables we need to
 	% create a new mode for this predicate
 	get_var_insts_and_lives(ArgVars, ModeInfo0, InitialInsts, ArgLives),
@@ -382,26 +386,14 @@
 	list__length(ArgVars, Arity),
 	list__duplicate(Arity, not_reached, FinalInsts),
 	inst_lists_to_mode_list(InitialInsts, FinalInsts, Modes),
-	MaybeDeterminism = no,
 
-	% create the new mode
-	add_new_proc(PredInfo0, Arity, Modes, no, yes(ArgLives),
-		MaybeDeterminism, Context, PredInfo1, ProcId),
-
-	% copy the clauses for the predicate to this procedure,
-	% and then store the new proc_info and pred_info
-	% back in the module_info.
-
-	pred_info_procedures(PredInfo1, Procs1),
-	map__lookup(Procs1, ProcId, ProcInfo1),
-	pred_info_clauses_info(PredInfo1, ClausesInfo),
-
-	copy_clauses_to_proc(ProcId, ClausesInfo, ProcInfo1, ProcInfo),
-
-	map__det_update(Procs1, ProcId, ProcInfo, Procs),
-	pred_info_set_procedures(PredInfo1, Procs, PredInfo),
-	map__det_update(Preds0, PredId, PredInfo, Preds),
-	module_info_set_preds(ModuleInfo0, Preds, ModuleInfo),
+	%
+	% create the new procedure, set its "can-process" flag to `no',
+	% and insert it into the queue of requested procedures.
+	%
+	unify_proc__request_proc(PredId, Modes, yes(ArgLives), MaybeDet,
+		Context, ModuleInfo0, ProcId, ModuleInfo),
+
 	mode_info_set_module_info(ModeInfo0, ModuleInfo, ModeInfo1),
 
 	% Since we've created a new inferred mode for this predicate,
@@ -433,7 +425,7 @@
 		% a good chance of being able to do destructive update.
 		(
 			inst_is_ground(ModuleInfo, Inst),
-			inst_is_unique(ModuleInfo, Inst)
+			inst_is_mostly_unique(ModuleInfo, Inst)
 		->
 			IsLive = dead
 		;
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.212
diff -u -r1.212 modes.m
--- modes.m	1997/12/22 09:56:05	1.212
+++ modes.m	1998/01/04 02:59:42
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1994-1997 The University of Melbourne.
+% Copyright (C) 1994-1998 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -157,18 +157,24 @@
 :- mode modecheck_pred_mode(in, in, in, in, out, out, di, uo) is det.
 
 	% Mode-check the code for predicate in a given mode.
+	% Returns the number of errs found and a bool `Changed'
+	% which is true iff another pass of fixpoint analysis
+	% may be needed.
 
-:- pred modecheck_proc(proc_id, pred_id, module_info, module_info, int,
+:- pred modecheck_proc(proc_id, pred_id, module_info, module_info, int, bool,
 			io__state, io__state).
-:- mode modecheck_proc(in, in, in, out, out, di, uo) is det.
+:- mode modecheck_proc(in, in, in, out, out, out, di, uo) is det.
 
 	% Mode-check or unique-mode-check the code for predicate in a
 	% given mode.
+	% Returns the number of errs found and a bool `Changed'
+	% which is true iff another pass of fixpoint analysis
+	% may be needed.
 
 :- pred modecheck_proc(proc_id, pred_id, how_to_check_goal,
-			module_info, module_info, int,
+			module_info, module_info, int, bool,
 			io__state, io__state).
-:- mode modecheck_proc(in, in, in, in, out, out, di, uo) is det.
+:- mode modecheck_proc(in, in, in, in, out, out, out, di, uo) is det.
 
 	% Mode-check the code for predicate in a given mode.
 
@@ -319,17 +325,16 @@
 	globals__io_lookup_int_option(mode_inference_iteration_limit,
 		MaxIterations),
 	modecheck_to_fixpoint(PredIds, MaxIterations, WhatToCheck, ModuleInfo0,
-					ModuleInfo1, UnsafeToContinue),
+					ModuleInfo, UnsafeToContinue),
 	( { WhatToCheck = check_unique_modes },
-		write_mode_inference_messages(PredIds, yes, ModuleInfo1)
+		write_mode_inference_messages(PredIds, yes, ModuleInfo)
 	; { WhatToCheck = check_modes },
 		( { UnsafeToContinue = yes } ->
-			write_mode_inference_messages(PredIds, no, ModuleInfo1)
+			write_mode_inference_messages(PredIds, no, ModuleInfo)
 		;
 			[]
 		)
-	),
-	modecheck_unify_procs(check_modes, ModuleInfo1, ModuleInfo).
+	).
 
 	% Iterate over the list of pred_ids in a module.
 
@@ -345,29 +350,39 @@
 	;
 		{ ModuleInfo1 = ModuleInfo0 }
 	),
+
+	% analyze everything with the "can-process" flag set to `yes'
 	modecheck_pred_modes_2(PredIds, WhatToCheck, ModuleInfo1, ModuleInfo2,
-				no, Changed, 0, NumErrors),
+				no, Changed1, 0, NumErrors),
+
+	% analyze the procedures whose "can-process" flag was no;
+	% those procedures were inserted into the unify requests queue.
+	modecheck_queued_procs(WhatToCheck, ModuleInfo2, ModuleInfo3, Changed2),
+	io__get_exit_status(ExitStatus),
+
+	{ bool__or(Changed1, Changed2, Changed) },
+
 	% stop if we have reached a fixpoint or found any errors
-	( { Changed = no ; NumErrors > 0 } ->
-		{ ModuleInfo = ModuleInfo2 },
+	( { Changed = no ; NumErrors > 0 ; ExitStatus \= 0 } ->
+		{ ModuleInfo = ModuleInfo3 },
 		{ UnsafeToContinue = Changed }
 	;
 		% stop if we exceed the iteration limit
 		( { MaxIterations =< 1 } ->
 			report_max_iterations_exceeded,
-			{ ModuleInfo = ModuleInfo2 },
+			{ ModuleInfo = ModuleInfo3 },
 			{ UnsafeToContinue = yes }
 		;
 			globals__io_lookup_bool_option(debug_modes, DebugModes),
 			( { DebugModes = yes } ->
 				write_mode_inference_messages(PredIds, no,
-						ModuleInfo2)
+						ModuleInfo3)
 			;
 				[]
 			),
 			{ MaxIterations1 is MaxIterations - 1 },
 			modecheck_to_fixpoint(PredIds, MaxIterations1,
-				WhatToCheck, ModuleInfo2,
+				WhatToCheck, ModuleInfo3,
 				ModuleInfo, UnsafeToContinue)
 		)
 	).
@@ -558,14 +573,14 @@
 
 	% Mode-check the code for predicate in a given mode.
 
-modecheck_proc(ProcId, PredId, ModuleInfo0, ModuleInfo, NumErrors) -->
+modecheck_proc(ProcId, PredId, ModuleInfo0, ModuleInfo, NumErrors, Changed) -->
 	modecheck_proc(ProcId, PredId, check_modes,
-		ModuleInfo0, ModuleInfo, NumErrors).
+		ModuleInfo0, ModuleInfo, NumErrors, Changed).
 
 modecheck_proc(ProcId, PredId, WhatToCheck, ModuleInfo0,
-			ModuleInfo, NumErrors) -->
+			ModuleInfo, NumErrors, Changed) -->
 	modecheck_proc_2(ProcId, PredId, WhatToCheck, ModuleInfo0, no,
-			ModuleInfo, _Changed, NumErrors).
+			ModuleInfo, Changed, NumErrors).
 
 :- pred modecheck_proc_2(proc_id, pred_id, how_to_check_goal,
 			module_info, bool, module_info, bool, int,
@@ -908,7 +923,9 @@
 	=(ModeInfo0),
 	{ mode_info_get_instmap(ModeInfo0, InstMap0) },
 
-	modecheck_call_pred(PredId, Args0, Mode, Args, ExtraGoals),
+	{ DeterminismKnown = no },
+	modecheck_call_pred(PredId, Args0, DeterminismKnown,
+				Mode, Args, ExtraGoals),
 
 	=(ModeInfo),
 	{ mode_info_get_module_info(ModeInfo, ModuleInfo) },
@@ -963,7 +980,9 @@
 
 	=(ModeInfo0),
 	{ mode_info_get_instmap(ModeInfo0, InstMap0) },
-	modecheck_call_pred(PredId, Args0, ProcId, Args, ExtraGoals),
+	{ DeterminismKnown = no },
+	modecheck_call_pred(PredId, Args0, DeterminismKnown,
+				ProcId, Args, ExtraGoals),
 
 	=(ModeInfo),
 	{ Pragma = pragma_c_code(IsRecursive, C_Code, PredId, ProcId, Args0,
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.62
diff -u -r1.62 unify_proc.m
--- unify_proc.m	1997/09/15 13:47:09	1.62
+++ unify_proc.m	1998/01/04 02:59:35
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1994-1997 The University of Melbourne.
+% Copyright (C) 1994-1998 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -9,8 +9,11 @@
 %	This module encapsulates access to the unify_requests table,
 %	and constructs the clauses for out-of-line complicated
 %	unification procedures.
-%	It also generates the code for other compiler-generated type-specific
-%	predicates such as compare/3.
+%	(Note: calling it the "unify_requests" table is a bit of a misnomer,
+%	since the request queue is also used for any procedures added during
+%	mode inference and unique mode inference, not just for unifications.)
+%	This module also generates the code for other compiler-generated
+%	type-specific predicates such as compare/3.
 %
 % During mode analysis, we notice each different complicated unification
 % that occurs.  For each one we add a new mode to the out-of-line
@@ -25,6 +28,9 @@
 % unify_requests table.  We store the entries in a queue and continue the
 % process until the queue is empty.
 %
+% The same queuing mechanism is also used for procedures created by
+% mode inference during mode analysis and unique mode analysis.
+%
 % Currently if the same complicated unification procedure is called by
 % different modules, each module will end up with a copy of the code for
 % that procedure.  In the long run it would be desireable to either delay
@@ -56,20 +62,31 @@
 :- pred unify_proc__init_requests(unify_requests).
 :- mode unify_proc__init_requests(out) is det.
 
-	% Add a new request to the unify_requests table.
+	% Add a new request for a unification procedure to the
+	% unify_requests table.
 
 :- pred unify_proc__request_unify(unify_proc_id, determinism, term__context,
 				module_info, module_info).
 :- mode unify_proc__request_unify(in, in, in, in, out) is det.
 
-	% Modecheck the unification procedures which have been
-	% requested.  If the first argument is `unique_mode_check',
+	% Add a new request for a procedure (not necessarily a unification)
+	% to the request queue.  Return the procedure's newly allocated
+	% proc_id.  (This is used by unique_modes.m.)
+
+:- pred unify_proc__request_proc(pred_id, list(mode), maybe(list(is_live)),
+				maybe(determinism), term__context,
+				module_info, proc_id, module_info).
+:- mode unify_proc__request_proc(in, in, in, in, in, in, out, out) is det.
+
+	% Do mode analysis of the queued procedures.
+	% If the first argument is `unique_mode_check',
 	% then also go on and do full determinism analysis and unique mode
-	% checking on them as well.
+	% analysis on them as well.
 
-:- pred modecheck_unify_procs(how_to_check_goal, module_info, module_info,
+:- pred modecheck_queued_procs(how_to_check_goal, module_info, module_info,
+				bool,
 				io__state, io__state).
-:- mode modecheck_unify_procs(in, in, out, di, uo) is det.
+:- mode modecheck_queued_procs(in, in, out, out, di, uo) is det.
 
 	% Given the type and mode of a unification, look up the
 	% mode number for the unification proc.
@@ -106,7 +123,7 @@
 
 :- type req_map == map(unify_proc_id, proc_id).
 
-:- type req_queue == queue(unify_proc_id).
+:- type req_queue == queue(pred_proc_id).
 
 :- type unify_requests --->
 		unify_requests(
@@ -213,62 +230,73 @@
 		module_info_get_special_pred_map(ModuleInfo0, SpecialPredMap),
 		map__lookup(SpecialPredMap, unify - TypeId, PredId),
 
-		%
-		% create a new proc_info for this procedure
-		%
-		module_info_preds(ModuleInfo0, Preds0),
-		map__lookup(Preds0, PredId, PredInfo0),
-		Arity = 2,
 		% convert from `uni_mode' to `list(mode)'
 		UnifyMode = ((X_Initial - Y_Initial) -> (X_Final - Y_Final)),
 		ArgModes = [(X_Initial -> X_Final), (Y_Initial -> Y_Final)],
-		MaybeDet = yes(Determinism),
+
 		ArgLives = no,  % XXX ArgLives should be part of the UnifyId
-		add_new_proc(PredInfo0, Arity, ArgModes, no, ArgLives,
-				MaybeDet, Context, PredInfo1, ProcId),
 
-		%
-		% copy the clauses for the procedure from the pred_info to the
-		% proc_info, and mark the procedure as one that cannot
-		% be processed yet
-		%
-		pred_info_procedures(PredInfo1, Procs1),
-		pred_info_clauses_info(PredInfo1, ClausesInfo),
-		map__lookup(Procs1, ProcId, ProcInfo0),
-		proc_info_set_can_process(ProcInfo0, no, ProcInfo1),
-
-		copy_clauses_to_proc(ProcId, ClausesInfo, ProcInfo1, ProcInfo2),
-		map__det_update(Procs1, ProcId, ProcInfo2, Procs2),
-		pred_info_set_procedures(PredInfo1, Procs2, PredInfo2),
-		map__det_update(Preds0, PredId, PredInfo2, Preds2),
-		module_info_set_preds(ModuleInfo0, Preds2, ModuleInfo2),
+		unify_proc__request_proc(PredId, ArgModes, ArgLives,
+			yes(Determinism), Context, ModuleInfo0,
+			ProcId, ModuleInfo1),
 
 		%
-		% save the proc_id for this unify_proc_id, 
-		% and insert the unify_proc_id into the request queue
+		% save the proc_id for this unify_proc_id
 		%
-		module_info_get_unify_requests(ModuleInfo2, Requests0),
+		module_info_get_unify_requests(ModuleInfo1, Requests0),
 		unify_proc__get_req_map(Requests0, ReqMap0),
 		map__set(ReqMap0, UnifyId, ProcId, ReqMap),
-		unify_proc__set_req_map(Requests0, ReqMap, Requests1),
-
-		unify_proc__get_req_queue(Requests1, ReqQueue1),
-		queue__put(ReqQueue1, UnifyId, ReqQueue),
-		unify_proc__set_req_queue(Requests1, ReqQueue, Requests),
-
-		module_info_set_unify_requests(ModuleInfo2, Requests,
+		unify_proc__set_req_map(Requests0, ReqMap, Requests),
+		module_info_set_unify_requests(ModuleInfo1, Requests,
 			ModuleInfo)
 	).
 
+unify_proc__request_proc(PredId, ArgModes, ArgLives, MaybeDet, Context,
+		ModuleInfo0, ProcId, ModuleInfo) :-
+	%
+	% create a new proc_info for this procedure
+	%
+	module_info_preds(ModuleInfo0, Preds0),
+	map__lookup(Preds0, PredId, PredInfo0),
+	list__length(ArgModes, Arity),
+	DeclaredArgModes = no,
+	add_new_proc(PredInfo0, Arity, ArgModes, DeclaredArgModes,
+		ArgLives, MaybeDet, Context, PredInfo1, ProcId),
+
+	%
+	% copy the clauses for the procedure from the pred_info to the
+	% proc_info, and mark the procedure as one that cannot
+	% be processed yet
+	%
+	pred_info_procedures(PredInfo1, Procs1),
+	pred_info_clauses_info(PredInfo1, ClausesInfo),
+	map__lookup(Procs1, ProcId, ProcInfo0),
+	proc_info_set_can_process(ProcInfo0, no, ProcInfo1),
+
+	copy_clauses_to_proc(ProcId, ClausesInfo, ProcInfo1, ProcInfo2),
+	map__det_update(Procs1, ProcId, ProcInfo2, Procs2),
+	pred_info_set_procedures(PredInfo1, Procs2, PredInfo2),
+	map__det_update(Preds0, PredId, PredInfo2, Preds2),
+	module_info_set_preds(ModuleInfo0, Preds2, ModuleInfo2),
+
+	%
+	% insert the pred_proc_id into the request queue
+	%
+	module_info_get_unify_requests(ModuleInfo2, Requests0),
+	unify_proc__get_req_queue(Requests0, ReqQueue0),
+	queue__put(ReqQueue0, proc(PredId, ProcId), ReqQueue),
+	unify_proc__set_req_queue(Requests0, ReqQueue, Requests),
+	module_info_set_unify_requests(ModuleInfo2, Requests, ModuleInfo).
+
 %-----------------------------------------------------------------------------%
 
 	% XXX these belong in modes.m
 
-modecheck_unify_procs(HowToCheckGoal, ModuleInfo0, ModuleInfo) -->
+modecheck_queued_procs(HowToCheckGoal, ModuleInfo0, ModuleInfo, Changed) -->
 	{ module_info_get_unify_requests(ModuleInfo0, Requests0) },
 	{ unify_proc__get_req_queue(Requests0, RequestQueue0) },
 	(
-		{ queue__get(RequestQueue0, UnifyProcId, RequestQueue1) }
+		{ queue__get(RequestQueue0, PredProcId, RequestQueue1) }
 	->
 		{ unify_proc__set_req_queue(Requests0, RequestQueue1,
 			Requests1) },
@@ -276,58 +304,49 @@
 			ModuleInfo1) },
 		globals__io_lookup_bool_option(very_verbose, VeryVerbose),
 		( { VeryVerbose = yes } ->
-			{ UnifyProcId = TypeId - UniMode },
 			( { HowToCheckGoal = check_unique_modes } ->
 				io__write_string(
 	"% Mode-checking, determinism-checking, and unique-mode-checking\n% ")
 			;
 				io__write_string("% Mode-checking ")
 			),
-			io__write_string("unification proc for type `"),
-			hlds_out__write_type_id(TypeId),
-			io__write_string("'\n"),
-			io__write_string("% with insts `"),
-			{ UniMode = ((InstA - InstB) -> _FinalInst) },
+			{ PredProcId = proc(PredId, ProcId) },
+			hlds_out__write_pred_proc_id(ModuleInfo1,
+				PredId, ProcId),
+			io__write_string("\n")
+			/*****
+			{ mode_list_get_initial_insts(Modes, ModuleInfo1,
+				InitialInsts) },
+			io__write_string("% Initial insts: `"),
 			{ varset__init(InstVarSet) },
-			mercury_output_inst(InstA, InstVarSet),
-			io__write_string("', `"),
-			mercury_output_inst(InstB, InstVarSet),
+			mercury_output_inst_list(InitialInsts, InstVarSet),
 			io__write_string("'\n")
+			*****/
 		;
 			[]
 		),
-		modecheck_unification_proc(HowToCheckGoal, UnifyProcId,
-			ModuleInfo1, ModuleInfo2),
-		modecheck_unify_procs(HowToCheckGoal, ModuleInfo2, ModuleInfo)
+		modecheck_queued_proc(HowToCheckGoal, PredProcId,
+			ModuleInfo1, ModuleInfo2, Changed1),
+		modecheck_queued_procs(HowToCheckGoal, ModuleInfo2, ModuleInfo,
+			Changed2),
+		{ bool__or(Changed1, Changed2, Changed) }
 	;
-		{ ModuleInfo = ModuleInfo0 }
+		{ ModuleInfo = ModuleInfo0 },
+		{ Changed = no }
 	).
 
-:- pred modecheck_unification_proc(how_to_check_goal, unify_proc_id,
-				module_info, module_info, io__state, io__state).
-:- mode modecheck_unification_proc(in, in, in, out, di, uo) is det.
+:- pred modecheck_queued_proc(how_to_check_goal, pred_proc_id,
+				module_info, module_info, bool,
+				io__state, io__state).
+:- mode modecheck_queued_proc(in, in, in, out, out, di, uo) is det.
 
-modecheck_unification_proc(HowToCheckGoal, UnifyProcId,
-			ModuleInfo0, ModuleInfo) -->
+modecheck_queued_proc(HowToCheckGoal, PredProcId, ModuleInfo0, ModuleInfo,
+			Changed) -->
 	{
 	%
-	% lookup the pred_id for the unification procedure
-	% that we are going to generate
-	%
-	UnifyProcId = TypeId - _UnifyMode,
-	module_info_get_special_pred_map(ModuleInfo0, SpecialPredMap),
-	map__lookup(SpecialPredMap, unify - TypeId, PredId),
-
-	%
-	% lookup the proc_id
-	%
-	module_info_get_unify_requests(ModuleInfo0, Requests0),
-	unify_proc__get_req_map(Requests0, ReqMap),
-	map__lookup(ReqMap, UnifyProcId, ProcId),
-
-	%
 	% mark the procedure as ready to be processed
 	%
+	PredProcId = proc(PredId, ProcId),
 	module_info_preds(ModuleInfo0, Preds0),
 	map__lookup(Preds0, PredId, PredInfo0),
 	pred_info_procedures(PredInfo0, Procs0),
@@ -342,16 +361,14 @@
 	%
 	% modecheck the procedure
 	%
-	modecheck_proc(ProcId, PredId, ModuleInfo1, ModuleInfo2, NumErrors),
+	modecheck_proc(ProcId, PredId, ModuleInfo1, ModuleInfo2, NumErrors,
+		Changed1),
 	(
 		{ NumErrors \= 0 }
 	->
-		% It _is_ possible for a compiler-generated unification
-		% predicate to get have mode error, in the case where it
-		% contains a unification for a type with a user-defined
-		% equality predicate.
 		io__set_exit_status(1),
-		{ ModuleInfo = ModuleInfo2 }
+		{ ModuleInfo = ModuleInfo2 },
+		{ Changed = Changed1 }
 	;
 		( { HowToCheckGoal = check_unique_modes } ->
 			{ detect_switches_in_proc(ProcId, PredId,
@@ -361,9 +378,12 @@
 			determinism_check_proc(ProcId, PredId,
 						ModuleInfo4, ModuleInfo5),
 			unique_modes__check_proc(ProcId, PredId,
-						ModuleInfo5, ModuleInfo)
+						ModuleInfo5, ModuleInfo,
+						Changed2),
+			{ bool__or(Changed1, Changed2, Changed) }
 		;	
-			{ ModuleInfo = ModuleInfo2 }
+			{ ModuleInfo = ModuleInfo2 },
+			{ Changed = Changed1 }
 		)
 	).
 
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.42
diff -u -r1.42 unique_modes.m
--- unique_modes.m	1997/12/19 03:08:36	1.42
+++ unique_modes.m	1998/01/04 03:27:49
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1996-1997 The University of Melbourne.
+% Copyright (C) 1996-1998 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -41,8 +41,8 @@
 
 	% just check a single procedure
 :- pred unique_modes__check_proc(proc_id, pred_id, module_info,
-				module_info, io__state, io__state).
-:- mode unique_modes__check_proc(in, in, in, out, di, uo) is det.
+				module_info, bool, io__state, io__state).
+:- mode unique_modes__check_proc(in, in, in, out, out, di, uo) is det.
 
 	% just check a single goal
 :- pred unique_modes__check_goal(hlds_goal, hlds_goal, mode_info, mode_info).
@@ -53,7 +53,7 @@
 
 :- implementation.
 
-:- import_module hlds_data, mode_debug, modecheck_unify.
+:- import_module hlds_data, mode_debug, modecheck_unify, modecheck_call.
 :- import_module mode_util, prog_out, hlds_out, mercury_to_mercury, passes_aux.
 :- import_module modes, prog_data, mode_errors, llds, unify_proc.
 :- import_module (inst), instmap, inst_match, inst_util.
@@ -66,9 +66,9 @@
 	check_pred_modes(check_unique_modes, ModuleInfo0, ModuleInfo,
 			_UnsafeToContinue).
 
-unique_modes__check_proc(ProcId, PredId, ModuleInfo0, ModuleInfo) -->
+unique_modes__check_proc(ProcId, PredId, ModuleInfo0, ModuleInfo, Changed) -->
 	modecheck_proc(ProcId, PredId, check_unique_modes,
-		ModuleInfo0, ModuleInfo, NumErrors),
+		ModuleInfo0, ModuleInfo, NumErrors, Changed),
 	( { NumErrors \= 0 } ->
 		io__set_exit_status(1)
 	;
@@ -387,11 +387,11 @@
 	mode_info_unset_call_context,
 	mode_checkpoint(exit, "class method call").
 
-unique_modes__check_goal_2(call(PredId, ProcId, Args, Builtin, CallContext,
+unique_modes__check_goal_2(call(PredId, ProcId0, Args, Builtin, CallContext,
 		PredName), _GoalInfo0, Goal) -->
 	mode_checkpoint(enter, "call"),
 	mode_info_set_call_context(call(PredId)),
-	unique_modes__check_call(PredId, ProcId, Args),
+	unique_modes__check_call(PredId, ProcId0, Args, ProcId),
 	{ Goal = call(PredId, ProcId, Args, Builtin, CallContext, PredName) },
 	mode_info_unset_call_context,
 	mode_checkpoint(exit, "call").
@@ -423,30 +423,83 @@
 
 	% to modecheck a pragma_c_code, we just modecheck the proc for 
 	% which it is the goal.
-unique_modes__check_goal_2(pragma_c_code(IsRecursive, C_Code, PredId, ProcId,
+unique_modes__check_goal_2(pragma_c_code(IsRecursive, C_Code, PredId, ProcId0,
 		Args, ArgNameMap, OrigArgTypes, ExtraPragmaInfo),
 		_GoalInfo, Goal) -->
 	mode_checkpoint(enter, "pragma_c_code"),
 	mode_info_set_call_context(call(PredId)),
-	unique_modes__check_call(PredId, ProcId, Args),
+	unique_modes__check_call(PredId, ProcId0, Args, ProcId),
 	{ Goal = pragma_c_code(IsRecursive, C_Code, PredId, ProcId, Args,
 			ArgNameMap, OrigArgTypes, ExtraPragmaInfo) },
 	mode_info_unset_call_context,
 	mode_checkpoint(exit, "pragma_c_code").
 
-:- pred unique_modes__check_call(pred_id, proc_id, list(var), 
+:- pred unique_modes__check_call(pred_id, proc_id, list(var), proc_id, 
 			mode_info, mode_info).
-:- mode unique_modes__check_call(in, in, in, mode_info_di, mode_info_uo) is det.
+:- mode unique_modes__check_call(in, in, in, out,
+			mode_info_di, mode_info_uo) is det.
 
-unique_modes__check_call(PredId, ProcId, ArgVars, 
+unique_modes__check_call(PredId, ProcId0, ArgVars, ProcId,
 		ModeInfo0, ModeInfo) :-
+	%
+	% set the error list to empty for use below
+	% (saving the old error list and instmap in variables)
+	%
+	mode_info_get_errors(ModeInfo0, OldErrors),
+	mode_info_get_instmap(ModeInfo0, InstMap0),
+	mode_info_set_errors([], ModeInfo0, ModeInfo1),
+
+	%
+	% first off, try using the existing mode
+	%
 	mode_info_get_module_info(ModeInfo0, ModuleInfo),
-	module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+	module_info_pred_proc_info(ModuleInfo, PredId, ProcId0, _, ProcInfo),
 	proc_info_argmodes(ProcInfo, ProcArgModes0),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	proc_info_never_succeeds(ProcInfo, NeverSucceeds),
 	unique_modes__check_call_modes(ArgVars, ProcArgModes0, CodeModel,
-				NeverSucceeds, ModeInfo0, ModeInfo).
+				NeverSucceeds, ModeInfo1, 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),
+	( Errors = [] ->
+		ProcId = ProcId0,
+		ModeInfo = ModeInfo3
+	;
+		%
+		% If it didn't work, restore the original instmap,
+		% and then call modecheck_call_pred.
+		% That will try all the modes, and will infer
+		% new ones if necessary. 
+		%
+		% We set the declared determinism for newly inferred
+		% modes to be the same as the determinism inferred for
+		% the existing mode selected by ordinary (non-unique)
+		% mode analysis.  This means that determinism analysis
+		% will report an error if the determinism changes
+		% as a result of unique mode analysis.  That is OK,
+		% because uniqueness should not affect determinism.
+		%
+		mode_info_set_instmap(InstMap0, ModeInfo3, ModeInfo4),
+		proc_info_inferred_determinism(ProcInfo, Determinism),
+		modecheck_call_pred(PredId, ArgVars, yes(Determinism),
+			ProcId, NewArgVars, ExtraGoals, ModeInfo4, ModeInfo),
+		
+		( NewArgVars = ArgVars, ExtraGoals = no_extra_goals ->
+			true
+		;
+			% this shouldn't happen, since modes.m should do
+			% all the handling of implied modes
+			% XXX it might happen, though, if the user
+			% XXX writes strange code; we should report
+			% XXX a proper error here
+			error("unique_modes.m: call to implied mode?")
+		)
+	).
 
 	% to check a call, we just look up the required initial insts
 	% for the arguments of the call, and then check for each
Index: tests/valid/mostly_uniq_mode_inf.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/mostly_uniq_mode_inf.m,v
retrieving revision 1.1
diff -u -r1.1 mostly_uniq_mode_inf.m
--- mostly_uniq_mode_inf.m	1997/11/24 23:10:38	1.1
+++ mostly_uniq_mode_inf.m	1998/01/04 04:35:27
@@ -1,5 +1,6 @@
 % This module tests inference of mostly-unique modes.
-% The compiler needs to infer mostly-unique modes for foo/2 and foo2/2.
+% The compiler needs to infer muo modes for foo/2 and foo2/2
+% and it needs to infer an (mdi,muo) mode for baz/2.
 
 :- module mostly_uniq_mode_inf.
 :- interface.
@@ -8,12 +9,14 @@
 :- implementation.
 :- import_module int.
 
-p :- foo(42, Z), bar(Z, A), A > 100.
+p :- foo(42, Z), ( baz(Z, B), bar(B, A), A > 100 ; Z > 100 ).
 
 foo(X, Y) :- foo2(X, Y).
 
 foo2(X, Y) :- Y is X + 10.
 foo2(X, Y) :- Y = X.
+
+baz(X, X).
 
 :- mode bar(mdi, muo) is det.
 bar(X, X).
-- 
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.



More information about the developers mailing list