[m-dev.] inefficiencies when creating the .opt file

[Simon TAYLOR]

Chris wrote:
> 	I was just looking at the code for making the .opt files (with
> the intention of adding termination information to the files).  I think
> that in some cases the datestamp of the .opt file may be changed
> unnecessarily, causing unnecessary recompilation of other files. 

Thanks for spotting that Chris.

Could you please review this diff fixing this and another efficiency problem
with inter-module optimization.

Simon.


Estimated hours taken: 3

Efficiency improvements for inter-module optimization.

compiler/intermod.m
compiler/mercury_compile.m
	Fix a bug with the date-stamps and --intermod-unused-args by
	delaying calling update_interface and touch_interface_datestamp
	until after the unused arguments information has been written to
	the .opt.tmp file.

compiler/unused_args.m
	Write unused argument information to the .opt.tmp file rather 
	than the .opt file.

compiler/dead_proc_elim.m
compiler/mercury_compile.m
	Add a pass to eliminated dead non-local predicates immediately after 
	building the HLDS to avoid doing analysis of predicates from .opt 
	files which are not used.

compiler/hlds_module.m
	Add module_info_remove_predicate to remove a predicate completely from
	the predicate_table.


Index: dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.29
diff -u -r1.29 dead_proc_elim.m
--- dead_proc_elim.m	1997/06/17 08:19:00	1.29
+++ dead_proc_elim.m	1997/07/15 08:03:54
@@ -4,8 +4,8 @@
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
 %
-% The job of this module is to delete dead procedures and base_gen_info
-% structures from the HLDS.
+% The job of this module is to delete dead predicates, procedures 
+% and base_gen_info structures from the HLDS.
 %
 % It also computes the usage counts that inlining.m uses for the
 % `--inline-single-use' option.
@@ -30,6 +30,14 @@
 	io__state, io__state).
 :- mode dead_proc_elim__eliminate(in, in, out, di, uo) is det.
 
+	% This is performed immediately after make_hlds.m to avoid doing
+	% semantic checking and optimization on predicates from `.opt' 
+	% files which are not used in the current module. This assumes that
+	% the clauses_info is still valid, so it cannot be run after mode
+	% analysis.
+:- pred dead_pred_elim(module_info, module_info).
+:- mode dead_pred_elim(in, out) is det.
+
 :- type entity		--->	proc(pred_id, proc_id)
 			;	base_gen_info(string, string, int).
 
@@ -40,7 +48,7 @@
 
 :- implementation.
 :- import_module hlds_pred, hlds_goal, hlds_data, prog_data, llds.
-:- import_module passes_aux, globals, options.
+:- import_module passes_aux, globals, options, code_util.
 :- import_module int, list, set, queue, map, bool, std_util, require.
 
 %-----------------------------------------------------------------------------%
@@ -574,4 +582,158 @@
 		BaseGenInfos = [NeuteredBaseGenInfo | BaseGenInfos1]
 	).
 
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- type dead_pred_info
+	--->	dead_pred_info(
+			module_info,
+			queue(pred_id),	% preds to examine.
+			set(pred_id),	% preds examined.
+			set(pred_id),	% needed pred_ids.
+			set(sym_name)	% pred names needed.
+		).
+
+dead_pred_elim(ModuleInfo0, ModuleInfo) :-
+	module_info_predids(ModuleInfo0, PredIds),
+	queue__init(Queue0),
+	set__init(Preds0),
+	set__init(Names0),
+	DeadInfo0 = dead_pred_info(ModuleInfo0, Queue0, 
+		Preds0, Preds0, Names0),
+	list__foldl(dead_pred_elim_initialize, PredIds, 
+		DeadInfo0, DeadInfo1),
+	dead_pred_elim_analyze(DeadInfo1, DeadInfo),
+	DeadInfo = dead_pred_info(ModuleInfo1, _, _, NeededPreds, _),
+	set__list_to_set(PredIds, PredIdSet),
+	set__difference(PredIdSet, NeededPreds, DeadPreds),
+	set__to_sorted_list(DeadPreds, DeadPredList),
+	list__foldl(module_info_remove_predicate, DeadPredList,
+		ModuleInfo1, ModuleInfo).
+
+:- pred dead_pred_elim_initialize(pred_id::in, dead_pred_info::in,
+		dead_pred_info::out) is det.
+
+dead_pred_elim_initialize(PredId, DeadInfo0, DeadInfo) :-
+	DeadInfo0 = dead_pred_info(ModuleInfo, Q0, Ex, Needed, NeededNames0),
+	module_info_pred_info(ModuleInfo, PredId, PredInfo),
+	( 
+		pred_info_module(PredInfo, PredModule),
+		(
+			% Don't eliminate special preds since they won't
+			% be actually called from the HLDS until after 
+			% polymorphism.
+			code_util__compiler_generated(PredInfo)
+		;
+			% Don't eliminate preds from mercury_builtin.m since
+			% polymorphism.m needs unify/2 and friends.
+			PredModule = "mercury_builtin"
+		;
+			% Don't attempt to eliminate local preds here, since we
+			% want to do semantic checking on those even if they 
+			% aren't used.
+			\+ pred_info_is_imported(PredInfo), 
+			\+ pred_info_import_status(PredInfo, opt_imported)
+		)
+	->
+		pred_info_name(PredInfo, PredName),
+		set__insert(NeededNames0, qualified(PredModule, PredName), 
+			NeededNames),
+		queue__put(Q0, PredId, Q)
+	;
+		NeededNames = NeededNames0,
+		Q = Q0
+	),
+	DeadInfo = dead_pred_info(ModuleInfo, Q, Ex, Needed, NeededNames).
+
+:- pred dead_pred_elim_analyze(dead_pred_info::in, 
+		dead_pred_info::out) is det.
+
+dead_pred_elim_analyze(DeadInfo0, DeadInfo) :-
+	DeadInfo0 = dead_pred_info(ModuleInfo, Q0, Ex0, Needed0, NeededNames),
+	( queue__get(Q0, PredId, Q) ->
+		( set__member(PredId, Ex0) ->
+			DeadInfo2 = dead_pred_info(ModuleInfo, Q,
+				Ex0, Needed0, NeededNames)
+		;
+			set__insert(Needed0, PredId, Needed),
+			set__insert(Ex0, PredId, Ex),
+			DeadInfo1 = dead_pred_info(ModuleInfo, Q, Ex, 
+				Needed, NeededNames),
+			module_info_pred_info(ModuleInfo, PredId, PredInfo),
+			pred_info_clauses_info(PredInfo, ClausesInfo),
+			ClausesInfo = clauses_info(_,_,_,_, Clauses),
+			list__foldl(dead_pred_elim_process_clause, Clauses,
+				DeadInfo1, DeadInfo2)
+		),
+		dead_pred_elim_analyze(DeadInfo2, DeadInfo)
+	;
+		DeadInfo = DeadInfo0
+	).
+
+:- pred dead_pred_elim_process_clause(clause::in, dead_pred_info::in, 
+		dead_pred_info::out) is det.
+
+dead_pred_elim_process_clause(clause(_, Goal, _)) -->
+	pre_modecheck_examine_goal(Goal).
+
+:- pred pre_modecheck_examine_goal(hlds_goal::in, 
+		dead_pred_info::in, dead_pred_info::out) is det.
+
+pre_modecheck_examine_goal(conj(Goals) - _) -->
+	list__foldl(pre_modecheck_examine_goal, Goals).
+pre_modecheck_examine_goal(disj(Goals, _) - _) -->
+	list__foldl(pre_modecheck_examine_goal, Goals).
+pre_modecheck_examine_goal(if_then_else(_, If, Then, Else, _) - _) -->
+	list__foldl(pre_modecheck_examine_goal, [If, Then, Else]).
+pre_modecheck_examine_goal(switch(_, _, Cases, _) - _) -->
+	{ ExamineCase = lambda([Case::in, Info0::in, Info::out] is det, (
+		Case = case(_, Goal),
+		pre_modecheck_examine_goal(Goal, Info0, Info)
+	)) },
+	list__foldl(ExamineCase, Cases).
+pre_modecheck_examine_goal(higher_order_call(_,_,_,_,_) - _) --> [].
+pre_modecheck_examine_goal(not(Goal) - _) -->
+	pre_modecheck_examine_goal(Goal).
+pre_modecheck_examine_goal(some(_, Goal) - _) -->
+	pre_modecheck_examine_goal(Goal).
+pre_modecheck_examine_goal(call(_, _, _, _, _, PredName) - _) -->
+	dead_pred_info_add_pred_name(PredName).
+pre_modecheck_examine_goal(pragma_c_code(_, _, _, _, _, _, _, _) - _) --> [].
+pre_modecheck_examine_goal(unify(_, Rhs, _, _, _) - _) -->
+	pre_modecheck_examine_unify_rhs(Rhs).
+
+:- pred pre_modecheck_examine_unify_rhs(unify_rhs::in, 
+		dead_pred_info::in, dead_pred_info::out) is det.
+
+pre_modecheck_examine_unify_rhs(var(_)) --> [].
+pre_modecheck_examine_unify_rhs(functor(Functor, _)) -->
+	( { Functor = cons(Name, _) } ->
+		dead_pred_info_add_pred_name(Name)
+	;
+		[]
+	).
+pre_modecheck_examine_unify_rhs(lambda_goal(_, _, _, _, Goal)) -->
+	pre_modecheck_examine_goal(Goal).
+
+:- pred dead_pred_info_add_pred_name(sym_name::in, dead_pred_info::in, 
+		dead_pred_info::out) is det.
+
+dead_pred_info_add_pred_name(Name, DeadInfo0, DeadInfo) :-
+	DeadInfo0 = dead_pred_info(ModuleInfo, Q0, Ex, Needed, NeededNames0),
+	( set__member(Name, NeededNames0) ->	
+		DeadInfo = DeadInfo0
+	;
+		module_info_get_predicate_table(ModuleInfo, PredicateTable),
+		set__insert(NeededNames0, Name, NeededNames),
+		( predicate_table_search_sym(PredicateTable, Name, PredIds) ->
+			queue__put_list(Q0, PredIds, Q)
+		;
+			Q = Q0
+		),
+		DeadInfo = dead_pred_info(ModuleInfo, Q, Ex,
+			Needed, NeededNames)
+	).
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: hlds_module.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_module.m,v
retrieving revision 1.22
diff -u -r1.22 hlds_module.m
--- hlds_module.m	1997/06/29 23:10:40	1.22
+++ hlds_module.m	1997/07/14 07:17:37
@@ -288,6 +288,11 @@
 :- pred module_info_remove_predid(module_info, pred_id, module_info).
 :- mode module_info_remove_predid(in, in, out) is det.
 
+	% Completely remove a predicate from a module.
+
+:- pred module_info_remove_predicate(pred_id, module_info, module_info).
+:- mode module_info_remove_predicate(in, in, out) is det.
+
 	% Once the module_info has been built, we call module_info_optimize
 	% to attempt to optimize the data structures for lots of accesses
 	% and relatively few insertion/deletions. (This was useful when
@@ -700,6 +705,13 @@
 	module_info_set_predicate_table(ModuleInfo0, PredicateTable,
 				ModuleInfo).
 
+module_info_remove_predicate(PredId, ModuleInfo0, ModuleInfo) :-
+	module_info_get_predicate_table(ModuleInfo0, PredicateTable0),
+	predicate_table_remove_predicate(PredicateTable0, PredId,
+				PredicateTable),
+	module_info_set_predicate_table(ModuleInfo0, PredicateTable,
+				ModuleInfo).
+
 	% After we have finished constructing the symbol tables,
 	% we balance all the binary trees, to improve performance
 	% in later stages of the compiler.
@@ -825,7 +837,8 @@
 
 	% Set the pred_id->pred_info map.
 	% NB You shouldn't modify the keys in this table, only
-	% use predicate_table_insert and predicate_table_remove_predid.
+	% use predicate_table_insert, predicate_table_remove_predid and
+	% predicate_table_remove_predicate.
 
 :- pred predicate_table_set_preds(predicate_table, pred_table, predicate_table).
 :- mode predicate_table_set_preds(in, in, out) is det.
@@ -841,6 +854,10 @@
 					predicate_table).
 :- mode predicate_table_remove_predid(in, in, out) is det.
 
+:- pred predicate_table_remove_predicate(predicate_table, pred_id,
+					predicate_table).
+:- mode predicate_table_remove_predicate(in, in, out) is det.
+
 	% Search the table for (a) predicates or functions
 	% (b) predicates only or (c) functions only
 	% matching this (possibly module-qualified) sym_name.
@@ -1079,6 +1096,81 @@
 	PredicateTable0 = predicate_table(A, B, PredIds0, D, E, F, G, H, I),
 	list__delete_all(PredIds0, PredId, PredIds),
 	PredicateTable = predicate_table(A, B, PredIds, D, E, F, G, H, I).
+
+predicate_table_remove_predicate(PredicateTable0, PredId, PredicateTable) :-
+	PredicateTable0 = predicate_table(Preds0, NextPredId, PredIds0, 
+		PredN0, PredNA0, PredMNA0, FuncN0, FuncNA0, FuncMNA0),
+	list__delete_all(PredIds0, PredId, PredIds),
+	map__det_remove(Preds0, PredId, PredInfo, Preds),
+	pred_info_module(PredInfo, Module),
+	pred_info_name(PredInfo, Name),
+	pred_info_arity(PredInfo, Arity),
+	pred_info_get_is_pred_or_func(PredInfo, IsPredOrFunc),
+	(
+		IsPredOrFunc = predicate,
+		predicate_table_remove_from_index(Module, Name, Arity, PredId,
+			PredN0, PredN, PredNA0, PredNA, PredMNA0, PredMNA),
+		PredicateTable = predicate_table(Preds, NextPredId, PredIds, 
+			PredN, PredNA, PredMNA, FuncN0, FuncNA0, FuncMNA0)
+	;
+		IsPredOrFunc = function,
+		FuncArity is Arity - 1,
+		predicate_table_remove_from_index(Module, Name, FuncArity, 
+			PredId, FuncN0, FuncN, FuncNA0, FuncNA, 
+			FuncMNA0, FuncMNA),
+		PredicateTable = predicate_table(Preds, NextPredId, PredIds, 
+			PredN0, PredNA0, PredMNA0, FuncN, FuncNA, FuncMNA)
+	).
+
+:- pred predicate_table_remove_from_index(string, string, int, pred_id, 
+		name_index, name_index, name_arity_index, name_arity_index, 
+		module_name_arity_index, module_name_arity_index).
+:- mode predicate_table_remove_from_index(in, in, in, in, in, out, 
+		in, out, in, out) is det.
+
+predicate_table_remove_from_index(Module, Name, Arity, PredId,
+		N0, N, NA0, NA, MNA0, MNA) :-
+	do_remove_from_index(N0, Name, PredId, N),
+	do_remove_from_index(NA0, Name / Arity, PredId, NA),
+	do_remove_from_m_n_a_index(MNA0, Module, Name, Arity, PredId, MNA).
+
+:- pred do_remove_from_index(map(T, list(pred_id)), T, pred_id, 
+			map(T, list(pred_id))).
+:- mode do_remove_from_index(in, in, in, out) is det.
+
+do_remove_from_index(Index0, T, PredId, Index) :-
+	( map__search(Index0, T, NamePredIds0) ->
+		list__delete_all(NamePredIds0, PredId, NamePredIds),
+		( NamePredIds = [] ->
+			map__delete(Index0, T, Index)	
+		;
+			map__det_update(Index0, T, NamePredIds, Index)
+		)
+	;
+		Index = Index0
+	).
+
+:- pred	do_remove_from_m_n_a_index(module_name_arity_index, 
+		string, string, int, pred_id, module_name_arity_index).
+:- mode do_remove_from_m_n_a_index(in, in, in, in, in, out) is det.
+
+do_remove_from_m_n_a_index(MNA0, Module, Name, Arity, PredId, MNA) :-
+	map__lookup(MNA0, Module - Name, Arities0),
+	map__lookup(Arities0, Arity, PredIds0),
+	list__delete_all(PredIds0, PredId, PredIds),
+	( PredIds = [] ->
+		map__delete(Arities0, Arity, Arities),
+		( map__is_empty(Arities) ->
+			map__delete(MNA0, Module - Name, MNA)	
+		;
+			map__det_update(MNA0, Module - Name, Arities, MNA)
+		)
+	;
+		map__det_update(Arities0, Arity, PredIds, Arities),
+		map__det_update(MNA0, Module - Name, Arities, MNA)
+	).	
+
+%-----------------------------------------------------------------------------%
 
 :- pred predicate_table_reverse_predids(predicate_table, predicate_table).
 :- mode predicate_table_reverse_predids(in, out) is det.
Index: intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.27
diff -u -r1.27 intermod.m
--- intermod.m	1997/06/29 23:10:49	1.27
+++ intermod.m	1997/07/14 07:44:20
@@ -109,8 +109,6 @@
 				PredDecls, IntermodInfo4, IntermodInfo) },
 		intermod__write_intermod_info(IntermodInfo),
 		io__told,
-		{ string__append(ModuleName, ".opt", OptName) },
-		update_interface(OptName),
 		globals__io_lookup_bool_option(intermod_unused_args,
 			UnusedArgs),
 		( { UnusedArgs = yes } ->
@@ -118,8 +116,7 @@
 				ModuleInfo1, ModuleInfo) }
 		;
 			{ ModuleInfo = ModuleInfo1 }
-		),
-		touch_interface_datestamp(ModuleName, ".optdate")
+		)
 	).
 
 	% a collection of stuff to go in the .opt file
Index: mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.46
diff -u -r1.46 mercury_compile.m
--- mercury_compile.m	1997/07/08 05:54:43	1.46
+++ mercury_compile.m	1997/07/14 09:53:06
@@ -284,7 +284,16 @@
 	( { FoundError = yes ; IntermodError = yes } ->
 		{ module_info_incr_errors(HLDS0, HLDS1) }
 	;	
-		{ HLDS1 = HLDS0 }
+		globals__io_lookup_bool_option(intermodule_optimization,
+			Intermod),
+		globals__io_lookup_bool_option(make_optimization_interface,
+			MakeOptInt),
+		( { Intermod = yes, MakeOptInt = no } ->
+			% Eliminate unnecessary clauses from `.opt' files.
+			{ dead_pred_elim(HLDS0, HLDS1) }
+		;
+			{ HLDS1 = HLDS0 }
+		)
 	).
 
 :- pred mercury_compile__module_qualify_items(item_list, item_list, string,
@@ -449,8 +458,8 @@
 
 		% If intermod_unused_args is being performed, run mode and
 		% determinism analysis and polymorphism, then run unused_args
-		% to append the unused argument information to the `.opt' file
-		% written above.
+		% to append the unused argument information to the `.opt.tmp' 
+		% file written above.
 		( { IntermodArgs = yes } ->
 			mercury_compile__frontend_pass_2_by_phases(
 				HLDS1, HLDS2, FoundModeError),
@@ -465,7 +474,11 @@
 			)
 		;
 			{ HLDS = HLDS1 }
-		)
+		),
+		{ module_info_name(HLDS, ModuleName) },
+		{ string__append(ModuleName, ".opt", OptName) },
+		update_interface(OptName),
+		touch_interface_datestamp(ModuleName, ".optdate")
 	;
 		{ HLDS = HLDS0 }
 	).
Index: unused_args.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unused_args.m,v
retrieving revision 1.31
diff -u -r1.31 unused_args.m
--- unused_args.m	1997/06/29 23:11:38	1.31
+++ unused_args.m	1997/07/14 07:36:28
@@ -93,7 +93,7 @@
 	globals__io_lookup_bool_option(make_optimization_interface, MakeOpt),
 	( { MakeOpt = yes } ->
 		{ module_info_name(ModuleInfo0, ModuleName) },
-		{ string__append(ModuleName, ".opt", OptFileName) },
+		{ string__append(ModuleName, ".opt.tmp", OptFileName) },
 		io__open_append(OptFileName, OptFileRes),
 		( { OptFileRes = ok(OptFile) } ->
 			{ MaybeOptFile = yes(OptFile) }