for review: deforestation [3/3]

Simon Taylor stayl at cs.mu.OZ.AU
Wed Apr 1 10:44:20 AEST 1998


--- deforest.m	Tue Mar 24 14:51:23 1998
+++ ../compiler/deforest.m	Mon Mar 23 12:50:20 1998
@@ -40,6 +40,10 @@
 deforestation(ModuleInfo0, ModuleInfo, IO0, IO) :-
 	proc_arg_info_init(ProcArgInfo0),
 	type_to_univ(ProcArgInfo0, UnivProcArgInfo0),
+
+	% Find out which arguments of each procedure are switched on
+	% at the top level or are constructed in a way which is
+	% possibly deforestable.
 	Task0 = update_module_cookie(deforest__get_branch_vars_proc,
 			UnivProcArgInfo0),
 	process_all_nonimported_procs(Task0, Task, 
@@ -52,15 +56,16 @@
 	;
 		error("deforestation: passes_aux stuffed up")
 	),
+
+	% We process the module bottom-up to make estimation of the 
+	% cost improvement of new versions a little more accurate and
+	% also to avoid redoing optimizations.
 	module_info_ensure_dependency_info(ModuleInfo1, ModuleInfo2),
 	module_info_dependency_info(ModuleInfo2, DepInfo),
 	hlds_dependency_info_get_dependency_ordering(DepInfo, DepOrdering),
 	list__condense(DepOrdering, DepList),
-	pd_info_init(ModuleInfo2, ProcArgInfo, IO1, PdInfo0),
 
-	% We process the module bottom-up to make estimation of the 
-	% cost improvement of new versions a little more accurate and
-	% also to avoid redoing optimizations.
+	pd_info_init(ModuleInfo2, ProcArgInfo, IO1, PdInfo0),
 	pd_info_foldl(deforest__proc, DepList, PdInfo0, PdInfo1),
 	pd_info_get_module_info(ModuleInfo3, PdInfo1, PdInfo),
 	module_info_clobber_dependency_info(ModuleInfo3, ModuleInfo),
@@ -125,14 +130,21 @@
 		{ module_info_set_pred_proc_info(ModuleInfo3, PredId, ProcId,
 			PredInfo, ProcInfo, ModuleInfo4) },
 
-		% If the determinism of some sub-goals has changed,
-		% then we re-run determinism analysis. As with inlining.m,
-		% this avoids problems with inlining erroneous procedures.
-		pd_info_get_io_state(IO10),
-		{ globals__io_get_globals(Globals, IO10, IO11) },
-		pd_info_set_io_state(IO11),
-		{ det_infer_proc(PredId, ProcId, ModuleInfo4, ModuleInfo5,
-			Globals, _, _, _) },
+		pd_info_get_rerun_det(RerunDet),
+
+		( { RerunDet = yes } ->
+			% If the determinism of some sub-goals has changed,
+			% then we re-run determinism analysis. As with
+			% inlining.m, this avoids problems with inlining
+			% erroneous procedures.
+			pd_info_get_io_state(IO10),
+			{ globals__io_get_globals(Globals, IO10, IO11) },
+			pd_info_set_io_state(IO11),
+			{ det_infer_proc(PredId, ProcId, ModuleInfo4,
+				ModuleInfo5, Globals, _, _, _) }
+		;
+			{ ModuleInfo5 = ModuleInfo4 }
+		),
 
 		% Recompute the branch_info for the procedure.
 		pd_info_get_proc_arg_info(ProcArgInfo0),
@@ -334,7 +346,7 @@
 		pd_branch_info(var),	% branch_info for later goal
 		set(int)		% branches for which there is
 					% extra information about the second
-					% goal
+					% goal, numbering starts at 1.
 	).
 
 	% Search backwards through the conjunction for the last
@@ -550,7 +562,8 @@
 		deforest__compute_goal_infos(GoalsToProcess, GoalsAndInfo),
 		{ list__append(GoalsAndInfo, AfterGoals0, AfterGoals) },
 		pd_info_set_instmap(InstMap0),
-		pd_info_set_changed(yes)
+		pd_info_set_changed(yes),
+		pd_info_set_rerun_det(yes)
 	),
 	pd_debug__message("finished deforestation at depth %i\n", [i(Depth0)]),
 	pd_info_set_parents(Parents0).
@@ -996,7 +1009,13 @@
 		DeforestConj),
 	goal_list_determinism(DeforestConj, Detism),
 	goal_list_instmap_delta(DeforestConj, InstMapDelta),
-	goal_info_init(NonLocals, InstMapDelta, Detism, ConjInfo),
+	goal_info_init(NonLocals, InstMapDelta, Detism, ConjInfo0),
+
+	% Give the conjunction a context so that the generated predicate
+	% name points to the location of the first goal.
+	EarlierGoal = _ - EarlierGoalInfo,
+	goal_info_get_context(EarlierGoalInfo, EarlierContext),
+	goal_info_set_context(ConjInfo0, EarlierContext, ConjInfo),	
 	FoldGoal = conj(DeforestConj) - ConjInfo.
 
 %-----------------------------------------------------------------------------%
@@ -1062,56 +1081,55 @@
 deforest__do_generalisation(VersionArgs, Renaming, VersionInstMap, EarlierGoal, 
 		BetweenGoals, LaterGoal, FoldGoal, ConjNonLocals, 
 		ProcPair, Size, Generalised, Goal, Optimized) -->
-	pd_debug__message("goals match, trying msg\n", []),
+	pd_debug__message("goals match, trying MSG\n", []),
 	pd_info_get_module_info(ModuleInfo),
 	pd_info_get_instmap(InstMap0),
 	{ instmap__lookup_vars(VersionArgs, VersionInstMap, 
 		VersionInsts) },
-	{ set__init(Expansions) },
 	{ pd_util__inst_list_size(ModuleInfo, VersionInsts, 
-		Expansions, 0, VersionInstSizes) },
+		VersionInstSizes) },
 	{ set__to_sorted_list(ConjNonLocals, ConjNonLocalsList) },
 	(
 		% Check whether we can do a most specific 
 		% generalisation of insts of the non-locals.
-		{ deforest__try_msg(ModuleInfo, VersionInstMap, 
+		{ deforest__try_MSG(ModuleInfo, VersionInstMap, 
 			VersionArgs, Renaming, InstMap0, InstMap) },
 		{ instmap__lookup_vars(ConjNonLocalsList, InstMap,
 			ArgInsts) },
 		{ pd_util__inst_list_size(ModuleInfo, ArgInsts,
-			Expansions, 0, NewInstSizes) },
+			NewInstSizes) },
 		{ NewInstSizes < VersionInstSizes }
 	->	
-		pd_debug__message("msg succeeded", []),
+		pd_debug__message("MSG succeeded", []),
 		pd_info_set_instmap(InstMap),
 		deforest__create_deforest_goal(EarlierGoal, BetweenGoals, 
 			LaterGoal, FoldGoal, ConjNonLocals, yes, 
 			ProcPair, Size, yes(Generalised),
 			Goal, Optimized)
 	;
-		pd_debug__message("msg failed\n", []),
+		pd_debug__message("MSG failed\n", []),
 		{ Goal = LaterGoal },
 		{ Optimized = no }
 	),
 	pd_info_set_instmap(InstMap0).
 
-:- pred deforest__try_msg(module_info::in, instmap::in, list(var)::in, 
+:- pred deforest__try_MSG(module_info::in, instmap::in, list(var)::in, 
 		map(var, var)::in, instmap::in, instmap::out) is semidet.
 
-deforest__try_msg(_, _, [], _, InstMap, InstMap).
-deforest__try_msg(ModuleInfo, VersionInstMap, [VersionArg | VersionArgs], 
+deforest__try_MSG(_, _, [], _, InstMap, InstMap).
+deforest__try_MSG(ModuleInfo, VersionInstMap, [VersionArg | VersionArgs], 
 		Renaming, InstMap0, InstMap) :-
 	instmap__lookup_var(VersionInstMap, VersionArg, VersionInst),
 	(
 		map__search(Renaming, VersionArg, Arg),
 		instmap__lookup_var(InstMap0, Arg, VarInst),
-		inst_msg(VersionInst, VarInst, ModuleInfo, Inst) 
+		inst_MSG(VersionInst, VarInst, ModuleInfo, Inst) 
 	->
 		instmap__set(InstMap0, Arg, Inst, InstMap1)
 	;
 		InstMap1 = InstMap0
 	),
-	deforest__try_msg(ModuleInfo, VersionInstMap, VersionArgs,
+	deforest__try_MSG(ModuleInfo, VersionInstMap, VersionArgs,
 		Renaming, InstMap1, InstMap).
 
 %-----------------------------------------------------------------------------%
@@ -1253,10 +1271,7 @@
 	% This does a safe re-ordering that is guaranteed not to require
 	% rescheduling of the conjunction, since it does not reorder goals
 	% that depend on each other. 
-	% We prefer to move goals forward out of the conjunction so that
-	% they can participate in deforestation with goals later in the
-	% conjunction. Constraint propagation should be run later to 
-	% push goals backwards to counter any efficiency loss.
+	% We favor moving goals backward to avoid removing tail recursion.
 :- pred deforest__reorder_conj(deforest_info::in, deforest_info::out,
 		list(hlds_goal)::out, list(hlds_goal)::out, 
 		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
@@ -1271,8 +1286,6 @@
 	pd_info_get_module_info(ModuleInfo),
 	pd_info_lookup_bool_option(fully_strict, FullyStrict),
 
-		% Favor moving goals backward to
-		% avoid removing tail recursion.
 	deforest__move_goals(deforest__can_move_goal_backward, ModuleInfo, 
 		FullyStrict, BetweenGoals0, [], RevBetweenGoals1, EarlierGoal, 
 		[], RevBeforeIrrelevant),
@@ -1387,8 +1400,14 @@
 	{ goal_info_init(NonLocals, Delta, Detism, GoalInfo) },
 	{ Goal2 = GoalExpr - GoalInfo },
 
-	pd_util__simplify_goal(simplify(no, no, no, yes, yes, yes, yes, yes),
-		Goal2, Goal3),
+	pd_info_get_module_info(ModuleInfo),
+	{ module_info_globals(ModuleInfo, Globals) },
+	{ simplify__find_simplifications(no, Globals, Simplifications0) },
+
+	% Be a bit more aggressive with common structure elimination.
+	% This helps achieve folding in some cases.
+	{ Simplifications = [extra_common_struct | Simplifications0] },
+	pd_util__simplify_goal(Simplifications, Goal2, Goal3),
 	pd_info_set_instmap(InstMap0),
 
 	% Perform any folding which may now be possible.
@@ -1589,10 +1608,12 @@
 			{ Optimized0 = no }
 		),
 
-		% Only prune away the branches.
-		{ Simplify = simplify(no, no, no, no, no, no, no, no) },
 		pd_debug__message("Running simplify\n", []),
-		pd_util__simplify_goal(Simplify, Goal3, Goal4),
+		pd_info_get_module_info(ModuleInfo),
+		{ module_info_globals(ModuleInfo, Globals) },
+		{ simplify__find_simplifications(no, Globals,
+			Simplifications) },
+		pd_util__simplify_goal(Simplifications, Goal3, Goal4),
 
 		pd_info_get_cost_delta(CostDelta1),
 		{ CostDelta is CostDelta1 - CostDelta0 },
@@ -1622,6 +1643,20 @@
 			pd_util__requantify_goal(Goal4, NonLocals, Goal),
 			pd_info_incr_size_delta(SizeDelta),
 			pd_info_set_changed(yes),
+			{ goal_info_get_determinism(GoalInfo0, Det0) },
+			{ Goal = _ - GoalInfo },
+			{ goal_info_get_determinism(GoalInfo, Det) },
+
+			% Rerun determinism analysis later if
+			% the determinism of any of the sub-goals
+			% changes - this avoids problems with inlining
+			% erroneous predicates.
+			( { Det = Det0 } ->
+				[]
+			;
+				pd_info_set_rerun_det(yes)
+			),
+
 			{ Optimized = yes }
 		;
 			pd_debug__message("not enough improvement - not inlining: cost(%i) size(%i)\n",
--- pd_cost.m	Tue Mar 24 14:51:37 1998
+++ ../compiler/pd_cost.m	Wed Mar 11 11:59:10 1998
@@ -35,7 +35,7 @@
 %-----------------------------------------------------------------------------%
 :- implementation.
 
-:- import_module hlds_data.
+:- import_module hlds_data, prog_data.
 :- import_module int, list, set, std_util, term.
 
 %-----------------------------------------------------------------------------%
@@ -96,8 +96,17 @@
 	goal_info_get_nonlocals(GoalInfo, NonLocals),
 	pd_cost__unify(NonLocals, Unification, Cost).
 
-pd_cost__goal(pragma_c_code(_, _, _, _, _, _, _) - _, Cost) :-
-	pd_cost__stack_flush(Cost).
+pd_cost__goal(pragma_c_code(MayCallMercury, _, _, Args, _, _, _) - _, Cost) :-
+	( MayCallMercury = will_not_call_mercury ->
+		Cost1 = 0
+	;
+		pd_cost__stack_flush(Cost1)
+	),
+	pd_cost__call(Cost2),
+	list__length(Args, Arity),
+	InputArgs is Arity // 2,	% rough
+	pd_cost__reg_assign(AssignCost),
+	Cost is Cost1 + Cost2 + AssignCost * InputArgs.
 
 :- pred pd_cost__unify(set(var)::in, unification::in, int::out) is det.
 
--- pd_debug.m	Tue Mar 24 14:51:54 1998
+++ ../compiler/pd_debug.m	Fri Mar  6 23:03:26 1998
@@ -12,7 +12,7 @@
 
 :- interface.
 
-:- import_module pd_info, hlds_goal.
+:- import_module pd_info, hlds_goal, hlds_pred.
 :- import_module list, string.
 
 :- pred pd_debug__do_io(pred(io__state, io__state)::pred(di, uo) is det,
@@ -46,7 +46,7 @@
 %-----------------------------------------------------------------------------%
 :- implementation.
 
-:- import_module globals, hlds_module, hlds_out, hlds_pred, instmap, options.
+:- import_module globals, hlds_module, hlds_out, instmap, options.
 :- import_module instmap, prog_out, goal_util.
 :- import_module bool, io, set, std_util.
 
--- pd_info.m	Tue Mar 24 14:52:55 1998
+++ ../compiler/pd_info.m	Mon Mar 30 12:43:00 1998
@@ -13,8 +13,9 @@
 
 :- interface.
 
-:- import_module pd_term, hlds_module, options, hlds_data, instmap.
-:- import_module map, list, io, set, std_util, term, getopt.
+:- import_module pd_term, hlds_module, hlds_pred, options, hlds_data, instmap.
+:- import_module hlds_goal, prog_data.
+:- import_module bool, map, list, io, set, std_util, term, getopt.
 
 :- type pd_info 
 	---> pd_info(
@@ -160,7 +161,7 @@
 :- implementation.
 
 :- import_module hlds_pred, prog_data, pd_debug, pd_util, det_util, globals.
-:- import_module inst_match, hlds_goal.
+:- import_module inst_match, hlds_goal, prog_util.
 :- import_module assoc_list, bool, int, require, string.
 
 pd_info_init(ModuleInfo, ProcArgInfos, IO, PdInfo) :-
@@ -182,7 +183,7 @@
 	pd_term__local_term_info_init(LocalTermInfo),
 	set__singleton_set(Parents, PredProcId),
 	UnfoldInfo = unfold_info(ProcInfo, InstMap, CostDelta, LocalTermInfo, 
-			PredInfo, Parents, PredProcId, no, 0, unit)
+			PredInfo, Parents, PredProcId, no, 0, no)
 	},
 	pd_info_set_unfold_info(UnfoldInfo).
 
@@ -287,19 +288,22 @@
 
 :- interface.
 
+	% unfold_info contains data used while processing a goal.
 :- type unfold_info
 	--->	unfold_info(
 			proc_info,
 			instmap,
-			int,		% cost delta
+			int,		% improvement in cost measured while
+					% processing this procedure
 			local_term_info,% local termination info
 			pred_info,
 			set(pred_proc_id),
 			pred_proc_id,	% current pred_proc_id
-			bool,		% does determinism analysis 
-					% need to be run
-			int,		% size delta
-			unit
+			bool,		% has anything changed
+			int,		% increase in size measured while
+					% processing this procedure
+			bool		% does determinism analysis
+					% need to be rerun.
 		).	
 
 	% pd_arg_info records which procedures have arguments for which
@@ -352,6 +356,9 @@
 :- pred pd_info_get_size_delta(int, pd_info, pd_info).
 :- mode pd_info_get_size_delta(out, pd_info_di, pd_info_uo) is det.
 
+:- pred pd_info_get_rerun_det(bool, pd_info, pd_info).
+:- mode pd_info_get_rerun_det(out, pd_info_di, pd_info_uo) is det.
+
 :- pred pd_info_set_proc_info(proc_info, pd_info, pd_info).
 :- mode pd_info_set_proc_info(in, pd_info_di, pd_info_uo) is det.
 
@@ -379,6 +386,9 @@
 :- pred pd_info_set_size_delta(int, pd_info, pd_info).
 :- mode pd_info_set_size_delta(in, pd_info_di, pd_info_uo) is det.
 
+:- pred pd_info_set_rerun_det(bool, pd_info, pd_info).
+:- mode pd_info_set_rerun_det(in, pd_info_di, pd_info_uo) is det.
+
 :- pred pd_info_incr_cost_delta(int, pd_info, pd_info).
 :- mode pd_info_incr_cost_delta(in, pd_info_di, pd_info_uo) is det.
 
@@ -416,8 +426,10 @@
 pd_info_get_size_delta(SizeDelta) -->
 	pd_info_get_unfold_info(UnfoldInfo),
 	{ UnfoldInfo = unfold_info(_,_,_,_,_,_,_,_,SizeDelta,_) }.
+pd_info_get_rerun_det(Rerun) -->
+	pd_info_get_unfold_info(UnfoldInfo),
+	{ UnfoldInfo = unfold_info(_,_,_,_,_,_,_,_,_,Rerun) }.
 	
-
 pd_info_set_proc_info(ProcInfo) -->
 	pd_info_get_unfold_info(UnfoldInfo0),
 	{ UnfoldInfo0 = unfold_info(_,B,C,D,E,F,G,H,I,J) },
@@ -463,6 +475,11 @@
 	{ UnfoldInfo0 = unfold_info(A,B,C,D,E,F,G,H,_,J) },
 	{ UnfoldInfo = unfold_info(A,B,C,D,E,F,G,H, SizeDelta, J) },
 	pd_info_set_unfold_info(UnfoldInfo).
+pd_info_set_rerun_det(Rerun) -->
+	pd_info_get_unfold_info(UnfoldInfo0),
+	{ UnfoldInfo0 = unfold_info(A,B,C,D,E,F,G,H,I,_) },
+	{ UnfoldInfo = unfold_info(A,B,C,D,E,F,G,H,I, Rerun) },
+	pd_info_set_unfold_info(UnfoldInfo).
 
 pd_info_incr_cost_delta(Delta1) -->
 	pd_info_get_cost_delta(Delta0),
@@ -479,9 +496,12 @@
 
 :- interface.
 
+	% Find the best matching version for a goal.
 :- pred pd_info__search_version(hlds_goal::in, maybe_version::out,
 	pd_info::pd_info_di, pd_info::pd_info_uo) is det.
 
+	% Create a new predicate for the input goal, returning a
+	% goal which calls the new predicate.
 :- pred pd_info__define_new_pred(hlds_goal::in, pred_proc_id::out,
 	hlds_goal::out, pd_info::pd_info_di, pd_info::pd_info_uo) is det.
 
@@ -697,9 +717,17 @@
 	pd_info_get_counter(Counter0),
 	{ Counter is Counter0 + 1 },
 	pd_info_set_counter(Counter),
-	{ string__format("_mercury_deforestation__%i", [i(Counter0)], Name) },
-	pd_info_get_proc_info(ProcInfo),
 	pd_info_get_pred_info(PredInfo),
+	{ pred_info_name(PredInfo, PredName) },
+	{ goal_info_get_context(GoalInfo, Context) },
+	{ term__context_line(Context, Line) },
+	pd_info_get_module_info(ModuleInfo0),
+	{ module_info_name(ModuleInfo0, ModuleName) },	
+	{ make_pred_name_with_context(ModuleName, "DeforestationIn",
+		predicate, PredName, Line, Counter0, SymName) },
+	{ unqualify_name(SymName, Name) },
+
+	pd_info_get_proc_info(ProcInfo),
 	{ pred_info_typevarset(PredInfo, TVarSet) },
 	{ pred_info_get_markers(PredInfo, Markers) },
 	{ pred_info_get_class_context(PredInfo, ClassContext) },
@@ -707,7 +735,6 @@
 	{ proc_info_vartypes(ProcInfo, VarTypes) },
 	{ proc_info_typeinfo_varmap(ProcInfo, TVarMap) },
 	{ proc_info_typeclass_info_varmap(ProcInfo, TCVarMap) },
-	pd_info_get_module_info(ModuleInfo0),
 	{ hlds_pred__define_new_pred(Goal, CallGoal, Args, InstMap, 
 		Name, TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
 		VarSet, Markers, ModuleInfo0, ModuleInfo, PredProcId) },
--- pd_term.m	Tue Mar 24 14:53:09 1998
+++ ../compiler/pd_term.m	Wed Apr  1 09:44:35 1998
@@ -6,8 +6,12 @@
 % File: pd_term.m
 % Main author: stayl
 %
-% Termination checking for partial deduction / deforestation.
-%
+% Termination checking for the deforestation process. 
+% There are two places where care must be taken to ensure
+% termination of the process:
+% - when unfolding a call to a recursive procedure
+% - when creating a new version, to avoid creating an infinite sequence of 
+% 	new versions for which folding never occurs.
 %
 % For conjunctions, count up the length of the conjunction.
 % For each pair of calls on the end of the conjunction,
@@ -31,8 +35,15 @@
 
 :- interface.
 
-:- import_module hlds_goal, hlds_module, instmap, pd_info.
+:- import_module hlds_goal, hlds_module, hlds_pred, instmap, pd_info.
+:- import_module list, std_util.
 
+	% pd_term__global_check(Module, CallGoal1, BetweenGoals, CallGoal2,
+	% 	InstMap, Versions, Info0, Info, Result)
+	%
+	% Check whether a new version can be created for the conjunction
+	% (CallGoal1, BetweenGoals, CallGoal2) without the deforestation
+	% process looping.
 :- pred pd_term__global_check(module_info::in, hlds_goal::in,
 		list(hlds_goal)::in, hlds_goal::in,
 		instmap::in, version_index::in, 
@@ -44,6 +55,8 @@
 	;	possible_loop(pair(pred_proc_id), int, pred_proc_id)
 	;	loop.
 
+	% Check whether a call can be unfolded without the
+	% unfolding process looping.
 :- pred pd_term__local_check(module_info::in, hlds_goal::in,
 	instmap::in, local_term_info::in, local_term_info::out) is semidet.
 
@@ -68,7 +81,7 @@
 :- implementation.
 
 :- import_module hlds_pred, (inst), mode_util, prog_data, pd_util.
-:- import_module assoc_list, bool, int, list, map, require, set, std_util, term.
+:- import_module assoc_list, bool, int, map, require, set, term.
 
 :- type global_term_info
 	--->	global_term_info(
@@ -105,7 +118,6 @@
 	map__search(TermInfo, PredProcId, ProcTermInfo).
 
 %-----------------------------------------------------------------------------%
-:- import_module string.
 
 pd_term__global_check(_ModuleInfo, EarlierGoal, BetweenGoals, LaterGoal, 
 		_InstMap, Versions, Info0, Info, Result) :-
--- pd_util.m	Tue Mar 24 14:53:15 1998
+++ ../compiler/pd_util.m	Wed Apr  1 10:28:08 1998
@@ -14,15 +14,16 @@
 :- interface.
 
 :- import_module pd_info, hlds_goal, hlds_module, hlds_pred, mode_errors.
-:- import_module simplify.
-:- import_module list, set.
+:- import_module prog_data, simplify, (inst).
+:- import_module bool, list, map, set, std_util, term.
 
 	% Pick out the pred_proc_ids of the calls in a list of atomic goals.
 :- pred pd_util__goal_get_calls(hlds_goal::in,
 		list(pred_proc_id)::out) is det.
 
-:- pred pd_util__simplify_goal(simplify::in, hlds_goal::in, hlds_goal::out,
-		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
+:- pred pd_util__simplify_goal(list(simplification)::in, hlds_goal::in,
+		hlds_goal::out, pd_info::pd_info_di,
+		pd_info::pd_info_uo) is det.
 
 :- pred pd_util__unique_modecheck_goal(hlds_goal::in, hlds_goal::out,
 		list(mode_error_info)::out, pd_info::pd_info_di, 
@@ -55,14 +56,14 @@
 :- pred pd_util__convert_branch_info(pd_branch_info(int)::in, list(var)::in,
 		pd_branch_info(var)::out) is det.	
 
-	% inst_msg(InstA, InstB, InstC):
+	% inst_MSG(InstA, InstB, InstC):
 	% 	Take the most specific generalisation of two insts.
 	%       The information in InstC is the minimum of the
 	%       information in InstA and InstB.  Where InstA and
 	%       InstB specify a binding (free or bound), it must be
 	%       the same in both.
 	% 	The uniqueness of the final inst is taken from InstB.
-	% 	The difference between inst_merge and inst_msg is that the 
+	% 	The difference between inst_merge and inst_MSG is that the 
 	% 	msg of `bound([functor, []])' and `bound([another_functor, []])'
 	%	is `ground' rather than `bound([functor, another_functor])'. 
 	% 	Also the msgs are not tabled, so the module_info is not
@@ -73,19 +74,22 @@
 	% 	of deforestation - InstA is the inst in an old version,
 	% 	we are taking the msg with to avoid non-termination,
 	% 	InstB is the inst in the new version we want to create.
-	%	It is always safe for inst_msg to fail - this will just
+	%	It is always safe for inst_MSG to fail - this will just
 	% 	result in less optimization.
 	% 	Mode analysis should be run on the goal to
 	%	check that this doesn't introduce mode errors, since
 	% 	the information that was removed may actually have been
 	%	necessary for mode correctness.
-:- pred inst_msg(inst, inst, module_info, inst).
-:- mode inst_msg(in, in, in, out) is semidet.
+:- pred inst_MSG(inst, inst, module_info, inst).
+:- mode inst_MSG(in, in, in, out) is semidet.
 
-:- pred pd_util__inst_list_size(module_info::in, list(inst)::in,
-		set(inst_name)::in, int::in, int::out) is det.
 
+	% Produce an estimate of the size of an inst, based on the 
+	% number of nodes in the inst. The inst is expanded down
+	% to the first repeat of an already expanded inst_name.
 :- pred pd_util__inst_size(module_info::in, (inst)::in, int::out) is det.
+:- pred pd_util__inst_list_size(module_info::in, list(inst)::in,
+		int::out) is det.
 
 	% pd_util__goals_match(ModuleInfo, OldGoal, OldArgs, NewGoal,
 	% 		OldToNewRenaming)
@@ -104,7 +108,7 @@
 	%
 	% Goals can be reordered if
 	% - the goals are independent
-	% - the goals are pure
+	% - the goals are not impure
 	% - any possible change in termination behaviour is allowed
 	% 	according to the semantics options.
 :- pred pd_util__can_reorder_goals(module_info::in, bool::in, hlds_goal::in,
@@ -114,18 +118,19 @@
 	%
 	% Succeeds if any possible change in termination behaviour from
 	% reordering the goals is allowed according to the semantics options.
+	% The information computed by termination analysis is used when
+	% making this decision.
 :- pred pd_util__reordering_maintains_termination(module_info::in, bool::in, 
 		hlds_goal::in, hlds_goal::in) is semidet.
 
 %-----------------------------------------------------------------------------%
 :- implementation.
 
-:- import_module pd_cost, hlds_data, instmap, mode_util, prog_data.
+:- import_module pd_cost, hlds_data, instmap, mode_util.
 :- import_module unused_args, inst_match, (inst), quantification, mode_util.
 :- import_module code_aux, purity, mode_info, unique_modes.
 :- import_module type_util, det_util, options.
-:- import_module assoc_list, bool, int, list, map.
-:- import_module require, set, std_util, term.
+:- import_module assoc_list, int, require, set, term.
 
 pd_util__goal_get_calls(Goal0, CalledPreds) :-
 	goal_to_conj_list(Goal0, GoalList),
@@ -137,7 +142,7 @@
 
 %-----------------------------------------------------------------------------%
 
-pd_util__simplify_goal(Simplify, Goal0, Goal) -->
+pd_util__simplify_goal(Simplifications, Goal0, Goal) -->
 	%
 	% Construct a simplify_info.
 	% 
@@ -150,7 +155,7 @@
 	pd_info_get_proc_info(ProcInfo0),
 	{ proc_info_varset(ProcInfo0, VarSet0) },
 	{ proc_info_vartypes(ProcInfo0, VarTypes0) },
-	{ simplify_info_init(DetInfo0, Simplify, InstMap0,
+	{ simplify_info_init(DetInfo0, Simplifications, InstMap0,
 		VarSet0, VarTypes0, SimplifyInfo0) },
 
 	{ simplify__process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo) },
@@ -190,8 +195,13 @@
 	pd_info_get_proc_info(ProcInfo0),
 	{ module_info_set_pred_proc_info(ModuleInfo0, PredId, ProcId,
 		PredInfo0, ProcInfo0, ModuleInfo1) },
+
+	% If we perform generalisation, we shouldn't change any called
+	% procedures, since that could cause a less efficient version to
+	% be chosen.
+	{ HowToCheck = check_unique_modes(may_not_change_called_proc) },
 	{ mode_info_init(IO0, ModuleInfo1, PredId, ProcId, Context,
-		LiveVars, InstMap0, ModeInfo0) },
+		LiveVars, InstMap0, HowToCheck, ModeInfo0) },
 
 	{ unique_modes__check_goal(Goal0, Goal, ModeInfo0, ModeInfo1) },
 	pd_info_lookup_bool_option(debug_pd, Debug),
@@ -285,6 +295,8 @@
 
 :- type pd_var_info 	==	branch_info_map(var).
 
+	% Find out which arguments of the procedure are interesting
+	% for deforestation.
 pd_util__get_branch_vars_proc(PredProcId, ProcInfo, 
 		Info0, Info, ModuleInfo0, ModuleInfo) :-
 	proc_info_goal(ProcInfo, Goal),
@@ -657,7 +669,7 @@
 
 %-----------------------------------------------------------------------------%
 
-	% inst_msg(InstA, InstB, InstC):
+	% inst_MSG(InstA, InstB, InstC):
 	%       The information in InstC is the minimum of the
 	%       information in InstA and InstB.  Where InstA and
 	%       InstB specify a binding (free or bound), it must be
@@ -666,7 +678,7 @@
 	%	When in doubt, fail. This will only result in less 
 	% 	optimization, not loss of correctness.
 
-inst_msg(InstA, InstB, ModuleInfo, Inst) :-
+inst_MSG(InstA, InstB, ModuleInfo, Inst) :-
 	( InstA = InstB ->
 		Inst = InstA
 	;
@@ -675,38 +687,38 @@
 		( InstB2 = not_reached ->
 			Inst = InstA2
 		;
-			inst_msg_2(InstA2, InstB2, ModuleInfo, Inst)
+			inst_MSG_2(InstA2, InstB2, ModuleInfo, Inst)
 		)
 	).
 
-:- pred inst_msg_2(inst, inst, module_info, inst).
-:- mode inst_msg_2(in, in, in, out) is semidet.
+:- pred inst_MSG_2(inst, inst, module_info, inst).
+:- mode inst_MSG_2(in, in, in, out) is semidet.
 
-inst_msg_2(any(_), any(Uniq), _, any(Uniq)).
-inst_msg_2(free, free, _M, free).
+inst_MSG_2(any(_), any(Uniq), _, any(Uniq)).
+inst_MSG_2(free, free, _M, free).
 
-inst_msg_2(bound(_, ListA), bound(UniqB, ListB), ModuleInfo, Inst) :-
-	bound_inst_list_msg(ListA, ListB, ModuleInfo, UniqB, ListB, Inst).
-inst_msg_2(bound(_, _), ground(UniqB, InfoB), _, ground(UniqB, InfoB)).
+inst_MSG_2(bound(_, ListA), bound(UniqB, ListB), ModuleInfo, Inst) :-
+	bound_inst_list_MSG(ListA, ListB, ModuleInfo, UniqB, ListB, Inst).
+inst_MSG_2(bound(_, _), ground(UniqB, InfoB), _, ground(UniqB, InfoB)).
 
 	% fail here, since the increasing inst size could 
 	% cause termination problems for deforestation.
-inst_msg_2(ground(_, _), bound(_UniqB, _ListB), _, _) :- fail.
-inst_msg_2(ground(_, _), ground(UniqB, InfoB), _, ground(UniqB, InfoB)). 
-inst_msg_2(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
+inst_MSG_2(ground(_, _), bound(_UniqB, _ListB), _, _) :- fail.
+inst_MSG_2(ground(_, _), ground(UniqB, InfoB), _, ground(UniqB, InfoB)). 
+inst_MSG_2(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
 		ModuleInfo, abstract_inst(Name, Args)) :-
-	inst_list_msg(ArgsA, ArgsB, ModuleInfo, Args).
-inst_msg_2(not_reached, Inst, _, Inst).
+	inst_list_MSG(ArgsA, ArgsB, ModuleInfo, Args).
+inst_MSG_2(not_reached, Inst, _, Inst).
 
-:- pred inst_list_msg(list(inst), list(inst), module_info, list(inst)).
-:- mode inst_list_msg(in, in, in, out) is semidet.
+:- pred inst_list_MSG(list(inst), list(inst), module_info, list(inst)).
+:- mode inst_list_MSG(in, in, in, out) is semidet.
 
-inst_list_msg([], [], _ModuleInfo, []).
-inst_list_msg([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo, [Arg | Args]) :-
-	inst_msg(ArgA, ArgB, ModuleInfo, Arg),
-	inst_list_msg(ArgsA, ArgsB, ModuleInfo, Args).
+inst_list_MSG([], [], _ModuleInfo, []).
+inst_list_MSG([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo, [Arg | Args]) :-
+	inst_MSG(ArgA, ArgB, ModuleInfo, Arg),
+	inst_list_MSG(ArgsA, ArgsB, ModuleInfo, Args).
 
-	% bound_inst_list_msg(Xs, Ys, ModuleInfo, Zs):
+	% bound_inst_list_MSG(Xs, Ys, ModuleInfo, Zs):
 	% The two input lists Xs and Ys must already be sorted.
 	% If any of the functors in Xs are not in Ys or vice
 	% versa, the final inst is ground, unless either of the insts
@@ -715,11 +727,11 @@
 	% the msg operation could introduce mode errors. 
 	% Otherwise, the take the msg of the argument insts.
 
-:- pred bound_inst_list_msg(list(bound_inst), list(bound_inst),
+:- pred bound_inst_list_MSG(list(bound_inst), list(bound_inst),
 		module_info, uniqueness, list(bound_inst), inst).
-:- mode bound_inst_list_msg(in, in, in, in, in, out) is semidet.
+:- mode bound_inst_list_MSG(in, in, in, in, in, out) is semidet.
 
-bound_inst_list_msg(Xs, Ys, ModuleInfo, Uniq, List, Inst) :-
+bound_inst_list_MSG(Xs, Ys, ModuleInfo, Uniq, List, Inst) :-
 	(
 		Xs = [],
 		Ys = []
@@ -731,9 +743,9 @@
 		X = functor(ConsId, ArgsX),
 		Y = functor(ConsId, ArgsY)
 	->
-		inst_list_msg(ArgsX, ArgsY, ModuleInfo, Args),
+		inst_list_MSG(ArgsX, ArgsY, ModuleInfo, Args),
 		Z = functor(ConsId, Args),
-		bound_inst_list_msg(Xs1, Ys1, ModuleInfo, Uniq, List, Inst1),
+		bound_inst_list_MSG(Xs1, Ys1, ModuleInfo, Uniq, List, Inst1),
 		( Inst1 = bound(Uniq, Zs) ->
 			Inst = bound(Uniq, [Z | Zs])
 		;
@@ -791,6 +803,13 @@
 	Size2 is Size1 + 1,
 	pd_util__bound_inst_size(ModuleInfo, Insts, Expansions, Size2, Size).
 
+pd_util__inst_list_size(ModuleInfo, Insts, Size) :-
+	set__init(Expansions),
+	pd_util__inst_list_size(ModuleInfo, Insts, Expansions, 0, Size).
+
+:- pred pd_util__inst_list_size(module_info::in, list(inst)::in,
+		set(inst_name)::in, int::in, int::out) is det.
+
 pd_util__inst_list_size(_, [], _, Size, Size).
 pd_util__inst_list_size(ModuleInfo, [Inst | Insts],
 		Expansions, Size0, Size) :-
@@ -934,8 +953,8 @@
 	LaterGoal = _ - LaterGoalInfo,
 
 		% Impure goals cannot be reordered.
-	goal_info_is_pure(EarlierGoalInfo),
-	goal_info_is_pure(LaterGoalInfo),
+	\+ goal_info_is_impure(EarlierGoalInfo),
+	\+ goal_info_is_impure(LaterGoalInfo),
 
 	pd_util__reordering_maintains_termination(ModuleInfo, FullyStrict, 
 		EarlierGoal, LaterGoal),



More information about the developers mailing list