for review: deforestation [2/3]

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


Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.225
diff -u -r1.225 options.m
--- options.m	1998/03/18 08:07:45	1.225
+++ options.m	1998/03/19 04:08:05
@@ -71,6 +71,7 @@
 		;	debug_det
 		;	debug_opt
 		;	debug_vn
+		;	debug_pd
 	% Output options
 		;	make_short_interface
 		;	make_interface
@@ -214,6 +215,10 @@
 		;	follow_code
 		;	prev_code
 		;	optimize_dead_procs
+		;	deforestation
+		;	deforestation_depth_limit
+		;	deforestation_cost_factor
+		;	deforestation_vars_threshold
 		;	termination
 		;	check_termination
 		;	verbose_check_termination
@@ -296,7 +301,6 @@
 :- pred option_defaults_2(option_category, list(pair(option, option_data))).
 :- mode option_defaults_2(in, out) is det.
 :- mode option_defaults_2(out, out) is multidet.
-:- mode option_defaults_2(in(bound(optimization_option)), out) is det.
 
 option_defaults_2(warning_option, [
 		% Warning Options
@@ -333,7 +337,8 @@
 	debug_modes		- 	bool(no),
 	debug_det		- 	bool(no),
 	debug_opt		- 	bool(no),
-	debug_vn		- 	int(0)
+	debug_vn		- 	int(0),
+	debug_pd		-	bool(no)
 ]).
 option_defaults_2(output_option, [
 		% Output Options (mutually exclusive)
@@ -508,6 +513,10 @@
 	optimize_higher_order	-	bool(no),
 	optimize_constructor_last_call -	bool(no),
 	optimize_dead_procs	-	bool(no),
+	deforestation		-	bool(no),
+	deforestation_depth_limit	-	int(4),
+	deforestation_cost_factor	-	int(1000),
+	deforestation_vars_threshold 	-	int(200),
 
 % HLDS -> LLDS
 	smart_indexing		-	bool(no),
@@ -631,6 +640,7 @@
 long_option("debug-det",		debug_det).
 long_option("debug-opt",		debug_opt).
 long_option("debug-vn",			debug_vn).
+long_option("debug-pd",			debug_pd).
 
 % output options (mutually exclusive)
 long_option("generate-dependencies",	generate_dependencies).
@@ -797,6 +807,10 @@
 long_option("optimize-constructor-last-call",	optimize_constructor_last_call).
 long_option("optimize-dead-procs",	optimize_dead_procs).
 long_option("optimise-dead-procs",	optimize_dead_procs).
+long_option("deforestation",		deforestation).
+long_option("deforestation-depth-limit",	deforestation_depth_limit).
+long_option("deforestation-cost-factor",	deforestation_cost_factor).
+long_option("deforestation-vars-threshold",	deforestation_vars_threshold).
 long_option("enable-termination",	termination).
 long_option("enable-term",		termination).
 long_option("check-termination",	check_termination).
@@ -1087,6 +1101,7 @@
 	optimize_saved_vars	-	bool(yes),
 	optimize_unused_args	-	bool(yes),	
 	optimize_higher_order	-	bool(yes),
+	deforestation		-	bool(yes),
 	constant_propagation	-	bool(yes),
 	optimize_repeat		-	int(4)
 ]).
@@ -1235,7 +1250,10 @@
 	io__write_string("\t\tOutput detailed debugging traces of the value numbering\n"),
 	io__write_string("\t\toptimization pass. The different bits in the number\n"),
 	io__write_string("\t\targument of this option control the printing of\n"),
-	io__write_string("\t\tdifferent types of tracing messages.\n").
+	io__write_string("\t\tdifferent types of tracing messages.\n"),
+	io__write_string("\t--debug-pd\n"),
+	io__write_string("\t\tOutput detailed debugging traces of the partial\n"),
+	io__write_string("\t\tdeduction and deforestation process.\n").
 
 :- pred options_help_output(io__state::di, io__state::uo) is det.
 
@@ -1711,7 +1729,20 @@
 	io__write_string("\t\tEnable specialization higher-order predicates.\n"),
 	io__write_string("\t--optimize-constructor-last-call\n"),
 	io__write_string("\t\tEnable the optimization of ""last"" calls that are followed by\n"),
-	io__write_string("\t\tconstructor application.\n").
+	io__write_string("\t\tconstructor application.\n"),
+	io__write_string("\t--deforestation\n"),
+	io__write_string("\t\tEnable deforestation. Deforestation is a program\n"),
+	io__write_string("\t\ttransformation whose aim is to avoid the construction of\n"),
+	io__write_string("\t\tintermediate data structures and to avoid repeated traversals\n"),
+	io__write_string("\t\tover data structures within a conjunction.\n"),
+	io__write_string("\t--deforestation-depth-limit\n"),
+	io__write_string("\t\tSpecify a depth limit for the deforestation algorithm\n"),
+	io__write_string("\t\tin addition to the usual termination checks.\n"),
+	io__write_string("\t\tA value of -1 specifies no depth limit. The default is 4.\n"),
+	io__write_string("\t--deforestation-vars-threshold\n"),
+	io__write_string("\t\tSpecify a rough limit on the number of variables\n"),
+	io__write_string("\t\tin a procedure created by deforestation.\n"),
+	io__write_string("\t\tA value of -1 specifies no limit. The default is 200\n").
 	 
 :- pred options_help_hlds_llds_optimization(io__state::di, io__state::uo) is det.
 
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.131
diff -u -r1.131 polymorphism.m
--- polymorphism.m	1998/03/30 03:09:06	1.131
+++ polymorphism.m	1998/03/31 01:38:22
@@ -295,7 +295,7 @@
 :- import_module hlds_pred, hlds_goal, hlds_data, llds, (lambda).
 :- import_module prog_data, type_util, mode_util, quantification, instmap.
 :- import_module code_util, unify_proc, special_pred, prog_util, make_hlds.
-:- import_module (inst), hlds_out, base_typeclass_info, passes_aux.
+:- import_module (inst), hlds_out, base_typeclass_info, goal_util, passes_aux.
 
 :- import_module bool, int, string, list, set, map.
 :- import_module term, varset, std_util, require, assoc_list.
@@ -554,7 +554,7 @@
 
 	% process any polymorphic calls inside the goal
 	polymorphism__process_goal(Goal0, Goal1, Info0, Info1),
-	polymorphism__fixup_quantification(Goal1, Goal, Info1, Info),
+	polymorphism__fixup_quantification(Goal1, Goal, _, Info1, Info),
 	Info = poly_info(VarSet, VarTypes, TypeVarSet,
 				TypeInfoMap, TypeclassInfoLocations,
 				_Proofs, _PredName, ModuleInfo),
@@ -752,10 +752,11 @@
 		% lambda goal and then convert the lambda expression
 		% into a new predicate
 		polymorphism__process_goal(LambdaGoal0, LambdaGoal1),
-		polymorphism__fixup_quantification(LambdaGoal1, LambdaGoal),
+		polymorphism__fixup_quantification(LambdaGoal1,
+				LambdaGoal, NonLocalTypeInfos),
 		polymorphism__process_lambda(PredOrFunc, Vars, Modes,
-				Det, ArgVars, LambdaGoal, Unification,
-				Y1, Unification1),
+				Det, ArgVars, NonLocalTypeInfos, LambdaGoal,
+				Unification, Y1, Unification1),
 		{ Goal = unify(XVar, Y1, Mode, Unification1, Context)
 				- GoalInfo }
 	;
@@ -961,8 +962,8 @@
 	).
 
 :- pred polymorphism__fixup_quantification(hlds_goal, hlds_goal,
-		poly_info, poly_info).
-:- mode polymorphism__fixup_quantification(in, out, in, out) is det.
+		set(var), poly_info, poly_info).
+:- mode polymorphism__fixup_quantification(in, out, out, in, out) is det.
 
 %
 % If the predicate we are processing is a polymorphic predicate,
@@ -971,36 +972,18 @@
 % so that it includes the type-info variables in the non-locals set.
 %
 
-polymorphism__fixup_quantification(Goal0, Goal, Info0, Info) :-
+polymorphism__fixup_quantification(Goal0, Goal, NewOutsideVars, Info0, Info) :-
 	Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet, TypeVarMap,
 			TypeClassVarMap, Proofs, PredName, ModuleInfo),
 	( map__is_empty(TypeVarMap) ->
+		set__init(NewOutsideVars),
 		Info = Info0,
 		Goal = Goal0
 	;
-		%
-		% A type-info variable may be non-local to a goal if any of 
-		% the ordinary non-local variables for that goal are
-		% polymorphically typed with a type that depends on that
-		% type-info variable.
-		%
-		% In addition, a typeclass-info may be non-local to a goal if
-		% any of the non-local variables for that goal are
-		% polymorphically typed and are constrained by the typeclass
-		% constraints for that typeclass-info variable
-		%
+		goal_util__extra_nonlocal_typeinfos(TypeVarMap,
+			VarTypes0, Goal0, NewOutsideVars),
 		Goal0 = _ - GoalInfo0,
 		goal_info_get_nonlocals(GoalInfo0, NonLocals),
-		set__to_sorted_list(NonLocals, NonLocalsList),
-		map__apply_to_list(NonLocalsList, VarTypes0, NonLocalsTypes),
-		term__vars_list(NonLocalsTypes, NonLocalTypeVars),
-			% Find all the type-infos and typeclass-infos that are
-			% non-local
-		solutions_set(lambda([Var::out] is nondet, (
-				list__member(TheVar, NonLocalTypeVars),
-				map__search(TypeVarMap, TheVar, Location),
-				type_info_locn_var(Location, Var)
-			)), NewOutsideVars),
 		set__union(NewOutsideVars, NonLocals, OutsideVars),
 		implicitly_quantify_goal(Goal0, VarSet0, VarTypes0,
 			OutsideVars, Goal, VarSet, VarTypes, _Warnings),
@@ -1009,14 +992,15 @@
 	).
 
 :- pred polymorphism__process_lambda(pred_or_func, list(var),
-		list(mode), determinism, list(var), hlds_goal, unification,
-		unify_rhs, unification, poly_info, poly_info).
-:- mode polymorphism__process_lambda(in, in, in, in, in, in, in, out, out,
+		list(mode), determinism, list(var), set(var),
+		hlds_goal, unification, unify_rhs, unification,
+		poly_info, poly_info).
+:- mode polymorphism__process_lambda(in, in, in, in, in, in, in, in, out, out,
 		in, out) is det.
 
 polymorphism__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals,
-		LambdaGoal, Unification0, Functor, Unification,
-		PolyInfo0, PolyInfo) :-
+		NonLocalTypeInfos, LambdaGoal, Unification0, Functor,
+		Unification, PolyInfo0, PolyInfo) :-
 	PolyInfo0 = poly_info(VarSet, VarTypes, TVarSet, TVarMap, 
 			TCVarMap, Proofs, PredName, ModuleInfo0),
 
@@ -1030,9 +1014,9 @@
 		AllConstraints, Constraints),
 
 	lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
-		OrigNonLocals, LambdaGoal, Unification0, VarSet, VarTypes,
-		Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
-		Unification, ModuleInfo),
+		OrigNonLocals, NonLocalTypeInfos, LambdaGoal, Unification0,
+		VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
+		ModuleInfo0, Functor, Unification, ModuleInfo),
 	PolyInfo = poly_info(VarSet, VarTypes, TVarSet, TVarMap, 
 			TCVarMap, Proofs, PredName, ModuleInfo).
 
Index: compiler/prog_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_util.m,v
retrieving revision 1.39
diff -u -r1.39 prog_util.m
--- prog_util.m	1998/03/03 17:35:53	1.39
+++ prog_util.m	1998/03/23 02:09:47
@@ -14,7 +14,7 @@
 :- interface.
 
 :- import_module std_util, list, term.
-:- import_module prog_data.
+:- import_module hlds_pred, prog_data.
 
 %-----------------------------------------------------------------------------%
 
@@ -72,6 +72,17 @@
 
 %-----------------------------------------------------------------------------%
 
+	% make_pred_name_with_context(ModuleName, Prefix, PredOrFunc, PredName,
+	%	Line, Counter, SymName).
+	%
+	% Create a predicate name with context, e.g. for introduced
+	% lambda or deforestation predicates.
+:- pred make_pred_name_with_context(module_name, string, pred_or_func,
+		string, int, int, sym_name).
+:- mode make_pred_name_with_context(in, in, in, in, in, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+
 	% A pred declaration may contains just types, as in
 	%	:- pred list__append(list(T), list(T), list(T)).
 	% or it may contain both types and modes, as in
@@ -280,5 +291,20 @@
 	match_sym_name(Module1, Module2).
 match_sym_name(unqualified(Name), unqualified(Name)).
 match_sym_name(unqualified(Name), qualified(_, Name)).
+
+%-----------------------------------------------------------------------------%
+
+make_pred_name_with_context(ModuleName, Prefix,
+		PredOrFunc, PredName, Line, Counter, SymName) :-
+	(
+		PredOrFunc = predicate,
+		PFS = "pred"
+	;
+		PredOrFunc = function,
+		PFS = "func"
+	),
+	string__format("%s__%s__%s__%d__%d",
+		[s(Prefix), s(PFS), s(PredName), i(Line), i(Counter)], Name),
+		SymName = qualified(ModuleName, Name).
 
 %-----------------------------------------------------------------------------%
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.56
diff -u -r1.56 simplify.m
--- simplify.m	1998/03/24 00:06:50	1.56
+++ simplify.m	1998/04/01 00:33:40
@@ -16,7 +16,7 @@
 %	they should not have been included in the program in the first place.
 %
 % Simplification is done in two passes. The first pass performs common
-% structure elimination and branch merging. The second pass performs
+% structure and duplicate call elimination. The second pass performs
 % excess assignment elimination and cleans up the code after the first pass.
 % Two passes are required because the goal must be requantified after the
 % optimizations in common.m are run so that excess assignment elimination
@@ -29,142 +29,197 @@
 :- interface.
 
 :- import_module hlds_goal, hlds_module, hlds_pred, det_report, det_util.
-:- import_module common, instmap.
-:- import_module io, bool, map, term, varset.
+:- import_module common, instmap, globals.
+:- import_module io, bool, list, map, term, varset.
 
-:- pred simplify__proc(simplify, pred_id, proc_id, module_info, module_info,
-	proc_info, proc_info, int, int, io__state, io__state).
+:- pred simplify__proc(list(simplification), pred_id, proc_id,
+	module_info, module_info, proc_info, proc_info,
+	int, int, io__state, io__state).
 :- mode simplify__proc(in, in, in, in, out, in, out, out, out, di, uo) is det.
 
-:- pred simplify__goal(hlds_goal, hlds_goal,
+:- pred simplify__process_goal(hlds_goal, hlds_goal,
 		simplify_info, simplify_info).
-:- mode simplify__goal(in, out, in, out) is det.
-
-:- pred simplify_info_init(det_info, simplify, instmap,
-		varset, map(var, type), simplify_info).
-:- mode simplify_info_init(in, in, in, in, in, out) is det.
+:- mode simplify__process_goal(in, out, in, out) is det.
+	
+	% Find out which simplifications should be run from the options table
+	% stored in the globals. The first argument states whether warnings
+	% should be issued during this pass of simplification.
+:- pred simplify__find_simplifications(bool, globals, list(simplification)).
+:- mode simplify__find_simplifications(in, in, out) is det.
+
+:- type simplification
+	--->	warn_simple_code	% --warn-simple-code
+	;	warn_duplicate_calls	% --warn-duplicate-calls
+	;	do_once			% run things that should be done once
+	;	excess_assigns		% remove excess assignment unifications
+	;	duplicate_calls		% optimize duplicate calls
+	;	constant_prop		% partially evaluate calls
+	;	common_struct		% common structure elimination
+	;	extra_common_struct	% do common structure elimination
+					% even when it might increase stack
+					% usage (used by deforestation).
+	.
 
 :- type simplify_info.
 
-:- type simplify
-	---> 	simplify(
-			bool,	% --warn-simple-code
-			bool,	% --warn-duplicate-calls
-			bool,	% run things that should be done once only
-			bool,	% attempt to merge adjacent switches 
-			bool,	% common subexpression elimination
-			bool,	% remove excess assignment unifications
-			bool,	% optimize duplicate calls
-			bool	% partially evaluate calls
-		).	
-
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
-:- import_module hlds_out.
-
 :- import_module code_aux, det_analysis, follow_code, goal_util, const_prop.
 :- import_module hlds_module, hlds_data, (inst), inst_match.
-:- import_module globals, options, passes_aux, prog_data, mode_util, type_util.
-:- import_module code_util, quantification, modes, purity.
-:- import_module set, list, require, std_util, int.
+:- import_module options, passes_aux, prog_data, mode_util, type_util.
+:- import_module code_util, quantification, modes, purity, pd_cost.
+:- import_module set, require, std_util, int.
 
 %-----------------------------------------------------------------------------%
 
-simplify__proc(Simplify, PredId, ProcId, ModuleInfo0, ModuleInfo,
-		Proc0, Proc, WarnCnt, ErrCnt, State0, State) :-
+simplify__proc(Simplifications, PredId, ProcId, ModuleInfo0, ModuleInfo,
+		Proc0, Proc, WarnCnt, ErrCnt)  -->
+	write_pred_progress_message("% Simplifying ", PredId, ModuleInfo0),
+	simplify__proc_2(Simplifications, PredId, ProcId, ModuleInfo0,
+			ModuleInfo, Proc0, Proc, WarnCnt, ErrCnt).
+
+:- pred simplify__proc_2(list(simplification), pred_id, proc_id, module_info,
+		module_info, proc_info, proc_info, int, int, 
+		io__state, io__state).
+:- mode simplify__proc_2(in, in, in, in, out, in, out, 
+		out, out, di, uo) is det.
+
+simplify__proc_2(Simplifications0, PredId, ProcId, ModuleInfo0, ModuleInfo,
+		ProcInfo0, ProcInfo, WarnCnt, ErrCnt, State0, State) :-
+	(
+		% Don't warn for compiler-generated procedures.
+		list__member(warn_simple_code, Simplifications0),
+		module_info_pred_info(ModuleInfo0, PredId, PredInfo),
+		code_util__compiler_generated(PredInfo)
+	->
+		list__delete_all(Simplifications0, warn_simple_code,
+			Simplifications)
+	;
+		Simplifications = Simplifications0
+	),
 	globals__io_get_globals(Globals, State0, State1),
 	det_info_init(ModuleInfo0, PredId, ProcId, Globals, DetInfo0),
-	proc_info_get_initial_instmap(Proc0, ModuleInfo0, InstMap0),
-	proc_info_varset(Proc0, VarSet0),
-	proc_info_vartypes(Proc0, VarTypes0),
-	simplify_info_init(DetInfo0, Simplify, InstMap0,
+	proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
+	proc_info_varset(ProcInfo0, VarSet0),
+	proc_info_vartypes(ProcInfo0, VarTypes0),
+	proc_info_goal(ProcInfo0, Goal0),
+
+	simplify_info_init(DetInfo0, Simplifications, InstMap0,
 		VarSet0, VarTypes0, Info0),
-	write_pred_progress_message("% Simplifying ", PredId, ModuleInfo0,
-		State1, State2),
-	Simplify = simplify(Warn, WarnCalls, Once, Switch, _,
-			Excess, Calls, Prop),
-	( simplify_do_common(Info0) ->
-		% On the first pass do common structure elimination and
-		% branch merging.
-		simplify_info_set_simplify(Info0,
-			simplify(Warn, WarnCalls, no, Switch, yes, no,
-				Calls, Prop), Info1),
-		simplify__proc_2(Proc0, Proc1, Info1, Info2, State2, State3),
-		simplify_info_get_msgs(Info2, Msgs1),
-		simplify_info_get_det_info(Info2, DetInfo1),
-		proc_info_varset(Proc1, VarSet1),
-		proc_info_vartypes(Proc1, VarTypes1),
-		simplify_info_init(DetInfo1,
-			simplify(no, no, Once, no, no, Excess, no, Prop),
-			InstMap0, VarSet1, VarTypes1, Info3),
-		simplify_info_set_msgs(Info3, Msgs1, Info4),
-		%simplify_info_get_module_info(Info4, ModuleInfo1),
-		%proc_info_goal(Proc1, OutGoal),
-		%hlds_out__write_goal(OutGoal, ModuleInfo1, VarSet1, yes,
-		%	2, ".", State3, State4)
-		State4 = State3
-	;
-		Info4 = Info0,
-		Proc1 = Proc0,
-		State4 = State2
+	simplify__process_goal(Goal0, Goal, Info0, Info),
+
+	simplify_info_get_module_info(Info, ModuleInfo),
+	simplify_info_get_msgs(Info, Msgs0),
+	set__to_sorted_list(Msgs0, Msgs),
+	det_report_msgs(Msgs, ModuleInfo, WarnCnt,
+			ErrCnt, State1, State),
+	simplify_info_get_varset(Info, VarSet),
+	simplify_info_get_var_types(Info, VarTypes),
+	proc_info_set_varset(ProcInfo0, VarSet, ProcInfo1),
+	proc_info_set_vartypes(ProcInfo1, VarTypes, ProcInfo2),
+	proc_info_set_goal(ProcInfo2, Goal, ProcInfo).
+
+simplify__process_goal(Goal0, Goal, Info0, Info) :-
+	simplify_info_get_simplifications(Info0, Simplifications0),
+	simplify_info_get_instmap(Info0, InstMap0),
+
+	( (simplify_do_common(Info0); simplify_do_calls(Info0)) ->
+		% On the first pass do common structure and call elimination. 
+		NotOnFirstPass = [do_once, excess_assigns],
+
+		set__delete_list(Simplifications0, NotOnFirstPass,
+			Simplifications1),
+		simplify_info_set_simplifications(Info0, Simplifications1,
+			Info1),
+		
+		simplify__do_process_goal(Goal0, Goal1, Info1, Info2),
+
+		NotOnSecondPass = [warn_simple_code, warn_duplicate_calls,
+			common_struct, duplicate_calls],
+		set__delete_list(Simplifications0, NotOnSecondPass,
+			Simplifications2),
+		simplify_info_reinit(Simplifications2, InstMap0, Info2, Info3)
+	;
+		Info3 = Info0,
+		Goal1 = Goal0
 	),
 		% On the second pass do excess assignment elimination and
-		% some cleaning up after the common structure and branch 
-		% merging pass.
-	simplify__proc_2(Proc1, Proc, Info4, Info, State4, State5),
-	simplify_info_get_module_info(Info, ModuleInfo),
-	simplify_info_get_msgs(Info, Msgs2),
-	set__to_sorted_list(Msgs2, Msgs),
-	( (Warn = yes ; WarnCalls = yes) ->
-		det_report_msgs(Msgs, ModuleInfo, WarnCnt,
-			ErrCnt, State5, State)
-	;
-		WarnCnt = 0,
-		ErrCnt = 0,
-		State = State5
-	).
+		% some cleaning up after the common structure pass.
+	simplify__do_process_goal(Goal1, Goal, Info3, Info).
 
-:- pred simplify__proc_2(proc_info::in, proc_info::out,
-		simplify_info::in, simplify_info::out,
-		io__state::di, io__state::uo) is det.
-
-simplify__proc_2(Proc0, Proc, Info0, Info, State0, State) :-
-	proc_info_goal(Proc0, Goal0),
-	simplify__goal(Goal0, Goal, Info0, Info1),
-	simplify_info_get_varset(Info1, VarSet),
-	simplify_info_get_var_types(Info1, VarTypes),
-	proc_info_set_goal(Proc0, Goal, Proc1),
-	proc_info_set_varset(Proc1, VarSet, Proc2),
-	proc_info_set_vartypes(Proc2, VarTypes, Proc3),
+:- pred simplify__do_process_goal(hlds_goal::in, hlds_goal::out,
+		simplify_info::in, simplify_info::out) is det.
+
+simplify__do_process_goal(Goal0, Goal, Info0, Info) :-
+	simplify_info_get_instmap(Info0, InstMap0),
+	simplify__goal(Goal0, Goal1, Info0, Info1),
+	simplify_info_get_varset(Info1, VarSet0),
+	simplify_info_get_var_types(Info1, VarTypes0),
 	( simplify_info_requantify(Info1) ->
-		requantify_proc(Proc3, Proc4),
-		( simplify_info_recompute_atomic(Info1) ->
+		Goal1 = _ - GoalInfo1,
+		goal_info_get_nonlocals(GoalInfo1, NonLocals),
+
+		implicitly_quantify_goal(Goal1, VarSet0, VarTypes0, NonLocals,
+			Goal2, VarSet, VarTypes, _),
+
+		simplify_info_set_varset(Info1, VarSet, Info2),
+		simplify_info_set_var_types(Info2, VarTypes, Info3),
+		( simplify_info_recompute_atomic(Info3) ->
 			RecomputeAtomic = yes
 		;
 			RecomputeAtomic = no
 		),
-		proc_info_goal(Proc4, Goal2),
-		simplify_info_get_module_info(Info1, ModuleInfo1),
-		proc_info_get_initial_instmap(Proc4, ModuleInfo1, InstMap0),
-		recompute_instmap_delta(RecomputeAtomic, Goal2, Goal3,
+
+		simplify_info_get_module_info(Info3, ModuleInfo1),
+		recompute_instmap_delta(RecomputeAtomic, Goal2, Goal,
 			InstMap0, ModuleInfo1, ModuleInfo),
-		simplify_info_set_module_info(Info1, ModuleInfo, Info),
-		proc_info_set_goal(Proc4, Goal3, Proc),
-		State = State0
+		simplify_info_set_module_info(Info3, ModuleInfo, Info)
 	;
-		Proc = Proc3,
-		State = State0,
+		Goal = Goal1,
 		Info = Info1
 	).
 
 %-----------------------------------------------------------------------------%
 
+simplify__find_simplifications(WarnThisPass, Globals, S) :-
+	( WarnThisPass = yes ->
+		simplify__lookup_option(Globals, warn_duplicate_calls,
+			warn_duplicate_calls, [], S1),
+		simplify__lookup_option(Globals, warn_simple_code,
+			warn_simple_code, S1, S2)
+	;
+		S2 = []
+	),
+	simplify__lookup_option(Globals, excess_assign, excess_assigns, S2, S3),
+	simplify__lookup_option(Globals, common_struct, common_struct, S3, S4),
+	simplify__lookup_option(Globals, optimize_duplicate_calls,
+		duplicate_calls, S4, S5),
+	simplify__lookup_option(Globals, constant_propagation,
+		constant_prop, S5, S).
+	
+:- pred simplify__lookup_option(globals::in, option::in, simplification::in,
+		list(simplification)::in, list(simplification)::out) is det.
+
+simplify__lookup_option(Globals, Option, Simplification,
+		Simplifications0, Simplifications) :-
+	globals__lookup_bool_option(Globals, Option, Result),
+	( Result = yes ->
+		Simplifications = [Simplification | Simplifications0]
+	;
+		Simplifications = Simplifications0
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pred simplify__goal(hlds_goal, hlds_goal, simplify_info, simplify_info).
+:- mode simplify__goal(in, out, in, out) is det.
+
 simplify__goal(Goal0, Goal - GoalInfo, Info0, Info) :-
-	Goal0 = _GoalExpr0 - GoalInfo0,
-	simplify_info_get_det_info(Info0, DetInfo),
+	Goal0 = _ - GoalInfo0,
 	goal_info_get_determinism(GoalInfo0, Detism),
+	simplify_info_get_det_info(Info0, DetInfo),
 	simplify_info_get_module_info(Info0, ModuleInfo),
 	(
 		%
@@ -179,6 +234,8 @@
 		; code_aux__goal_cannot_loop(ModuleInfo, Goal0)
 		)
 	->
+		pd_cost__goal(Goal0, CostDelta),
+		simplify_info_incr_cost_delta(Info0, CostDelta, Info1),
 		fail_goal(Goal1)
 	;
 		%
@@ -204,14 +261,17 @@
 		; code_aux__goal_cannot_loop(ModuleInfo, Goal0)
 		)
 	->
+		pd_cost__goal(Goal0, CostDelta),
+		simplify_info_incr_cost_delta(Info0, CostDelta, Info1),
 		true_goal(Goal1)
 	;
-		Goal1 = Goal0
+		Goal1 = Goal0,
+		Info1 = Info0
 	),
-	simplify_info_maybe_clear_structs(before, Goal1, Info0, Info1),
+	simplify_info_maybe_clear_structs(before, Goal1, Info1, Info2),
 	Goal1 = GoalExpr1 - GoalInfo1,
-	simplify__goal_2(GoalExpr1, GoalInfo1, Goal, GoalInfo2, Info1, Info2),
-	simplify_info_maybe_clear_structs(after, Goal - GoalInfo2, Info2, Info),
+	simplify__goal_2(GoalExpr1, GoalInfo1, Goal, GoalInfo2, Info2, Info3),
+	simplify_info_maybe_clear_structs(after, Goal - GoalInfo2, Info3, Info),
 	simplify__enforce_invariant(GoalInfo2, GoalInfo).
 
 
@@ -249,11 +309,9 @@
 :- mode simplify__goal_2(in, in, out, out, in, out) is det.
 
 simplify__goal_2(conj(Goals0), GoalInfo0, Goal, GoalInfo0, Info0, Info) :-
-	simplify_info_reset_branch_info(Info0, Info1, PostBranchInstMaps),
-	simplify_info_get_instmap(Info1, InstMap0),
-	simplify__conj(Goals0, [], Goals, GoalInfo0, Info1, Info2),
-	simplify_info_set_branch_info(Info2, PostBranchInstMaps, Info3),
-	simplify_info_set_instmap(Info3, InstMap0, Info),
+	simplify_info_get_instmap(Info0, InstMap0),
+	simplify__conj(Goals0, [], Goals, GoalInfo0, Info0, Info1),
+	simplify_info_set_instmap(Info1, InstMap0, Info),
 	( Goals = [SingleGoal] ->
 		% a singleton conjunction is equivalent to the goal itself
 		SingleGoal = Goal - _
@@ -309,9 +367,8 @@
 		)
 	;
 		simplify_info_get_instmap(Info0, InstMap0),
-		simplify__disj(Disjuncts0, Disjuncts, [], InstMaps,
+		simplify__disj(Disjuncts0, [], Disjuncts, [], InstMaps,
 			Info0, Info0, Info1),
-		simplify_info_create_branch_info(Info0, Info1, InstMaps, Info2),
 		(
 	/****
 	XXX This optimization is not correct, see comment below
@@ -336,17 +393,25 @@
 		;
 	****/
 			Goal = disj(Disjuncts, SM),
-			simplify_info_get_module_info(Info2, ModuleInfo1),
-			goal_info_get_nonlocals(GoalInfo0, NonLocals),
-			merge_instmap_deltas(InstMap0, NonLocals, InstMaps,
-				NewDelta, ModuleInfo1, ModuleInfo2),
-			simplify_info_set_module_info(Info2, ModuleInfo2, Info),
-			goal_info_set_instmap_delta(GoalInfo0, NewDelta,
-				GoalInfo)
+			( Disjuncts = [] ->
+				GoalInfo = GoalInfo0,
+				Info = Info1
+			;
+				simplify_info_get_module_info(Info1, 
+					ModuleInfo1),
+				goal_info_get_nonlocals(GoalInfo0, NonLocals),
+				merge_instmap_deltas(InstMap0, NonLocals, 
+					InstMaps, NewDelta, 
+					ModuleInfo1, ModuleInfo2),
+				simplify_info_set_module_info(Info1, 
+					ModuleInfo2, Info),
+				goal_info_set_instmap_delta(GoalInfo0, 
+					NewDelta, GoalInfo)
+			)
 		)
 	).
 
-simplify__goal_2(switch(Var, SwitchCanFail, Cases0, SM),
+simplify__goal_2(switch(Var, SwitchCanFail0, Cases0, SM),
 		GoalInfo0, Goal, GoalInfo, Info0, Info) :-
 	simplify_info_get_instmap(Info0, InstMap0),
 	simplify_info_get_module_info(Info0, ModuleInfo0),
@@ -360,11 +425,14 @@
 		Cases1 = Cases0,
 		MaybeConsIds = no
 	),
-	( Cases1 = [] ->
+	simplify__switch(Var, Cases1, [], Cases, [], InstMaps, 
+		SwitchCanFail0, SwitchCanFail, Info0, Info0, Info1),
+	( Cases = [] ->
 		% An empty switch always fails.
-		fail_goal(Goal - GoalInfo),
-		Info = Info0
-	; Cases1 = [case(ConsId, SingleGoal0)] ->
+		pd_cost__eliminate_switch(CostDelta),
+		simplify_info_incr_cost_delta(Info1, CostDelta, Info),
+		fail_goal(Goal - GoalInfo)
+	; Cases = [case(ConsId, SingleGoal)] ->
 		% a singleton switch is equivalent to the goal itself with 
 		% a possibly can_fail unification with the functor on the front.
 		cons_id_arity(ConsId, Arity),
@@ -373,40 +441,46 @@
 			MaybeConsIds \= yes([ConsId])
 		->
 			simplify__create_test_unification(Var, ConsId, Arity,
-				UnifyGoal, Info0, Info1),
+				UnifyGoal, Info1, Info2),
 
 			% Conjoin the test and the rest of the case.
-			goal_to_conj_list(SingleGoal0, SingleGoalConj),
+			goal_to_conj_list(SingleGoal, SingleGoalConj),
 			GoalList = [UnifyGoal | SingleGoalConj],
 
-			% Work out the nonlocals, instmap_delta and determinism
-			% of the entire conjunction, starting with an empty
-			% goal_info.
-			set__init(NonLocals),
-			instmap_delta_init_reachable(InstMapDelta),
-			goal_info_init(NonLocals, InstMapDelta, det, 
-				CombinedGoalInfo0),
-			simplify__approximate_goal_info(GoalList, 
-				CombinedGoalInfo0, CombinedGoalInfo),
-			simplify_info_set_requantify(Info1, Info2),
-			Goal1 = conj(GoalList) - CombinedGoalInfo
+			% Work out the nonlocals, instmap_delta 
+			% and determinism of the entire conjunction.
+			goal_info_get_nonlocals(GoalInfo0, NonLocals0),
+			set__insert(NonLocals0, Var, NonLocals),
+			goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
+			simplify_info_get_instmap(Info2, InstMap),
+			instmap_delta_bind_var_to_functor(Var, ConsId, 	
+				InstMap, InstMapDelta0, InstMapDelta, 
+				ModuleInfo0, ModuleInfo),
+			simplify_info_set_module_info(Info2, 
+				ModuleInfo, Info3),	
+			goal_info_get_determinism(GoalInfo0, CaseDetism),
+			det_conjunction_detism(semidet, CaseDetism, Detism),
+			goal_info_init(NonLocals, InstMapDelta, Detism, 
+				CombinedGoalInfo),
+
+			simplify_info_set_requantify(Info3, Info4),
+			Goal = conj(GoalList),
+			GoalInfo = CombinedGoalInfo
 		;
 			% The var can only be bound to this cons_id, so
 			% a test is unnecessary.
-			Goal1 = SingleGoal0,
-			Info2 = Info0
+			SingleGoal = Goal - GoalInfo,
+			Info4 = Info1
 		),
-		simplify__goal(Goal1, Goal - GoalInfo, Info2, Info)
+		pd_cost__eliminate_switch(CostDelta),
+		simplify_info_incr_cost_delta(Info4, CostDelta, Info)
 	;
-		simplify__switch(Var, Cases1, Cases, [], InstMaps,
-			Info0, Info0, Info1),
-		simplify_info_create_branch_info(Info0, Info1, InstMaps, Info2),
 		Goal = switch(Var, SwitchCanFail, Cases, SM),
-		simplify_info_get_module_info(Info2, ModuleInfo1),
+		simplify_info_get_module_info(Info1, ModuleInfo1),
 		goal_info_get_nonlocals(GoalInfo0, NonLocals),
 		merge_instmap_deltas(InstMap0, NonLocals, InstMaps, NewDelta,
 			ModuleInfo1, ModuleInfo2),
-		simplify_info_set_module_info(Info2, ModuleInfo2, Info),
+		simplify_info_set_module_info(Info1, ModuleInfo2, Info),
 		goal_info_set_instmap_delta(GoalInfo0, NewDelta, GoalInfo)
 	).
 
@@ -712,14 +786,12 @@
 			CondThenDelta),
 		Else = _ - ElseInfo,
 		goal_info_get_instmap_delta(ElseInfo, ElseDelta),
-		simplify_info_create_branch_info(Info0, Info6,
-			[ElseDelta, CondThenDelta], Info7),
 		goal_info_get_nonlocals(GoalInfo0, NonLocals),
-		simplify_info_get_module_info(Info7, ModuleInfo0),
+		simplify_info_get_module_info(Info6, ModuleInfo0),
 		merge_instmap_deltas(InstMap0, NonLocals,
 			[CondThenDelta, ElseDelta], NewDelta,
 			ModuleInfo0, ModuleInfo1),
-		simplify_info_set_module_info(Info7, ModuleInfo1, Info),
+		simplify_info_set_module_info(Info6, ModuleInfo1, Info),
 		goal_info_set_instmap_delta(GoalInfo0, NewDelta, GoalInfo1),
 		IfThenElse = if_then_else(Vars, Cond, Then, Else, SM),
 		%
@@ -861,29 +933,18 @@
 	    list__append(SubGoals, Goals0, Goals1),
 	    simplify__conj(Goals1, RevGoals0, Goals, ConjInfo, Info0, Info)
 	;
-	    simplify_info_reset_branch_info(Info0, Info1, BranchInstMaps),
-	    simplify__goal(Goal0, Goal1, Info1, Info2),
+	    simplify__goal(Goal0, Goal1, Info0, Info1),
 	    (
 		% Flatten conjunctions.
 		Goal1 = conj(SubGoals1) - _
 	    ->
-		simplify_info_undo_goal_updates(Info1, Info2, Info3),
-		simplify_info_set_branch_info(Info3, BranchInstMaps, Info4),
+		simplify_info_undo_goal_updates(Info0, Info1, Info2),
 		list__append(SubGoals1, Goals0, Goals1),
-		simplify__conj(Goals1, RevGoals0, Goals, ConjInfo, Info4, Info)
-	    ;
-		% Merge branching goals where the branches of the first goal
-		% contain extra information about the switched on variable
-		% of the second goal.
-		simplify__merge_adjacent_switches(Goal1, Goal, RevGoals0,
-			RevGoals1, BranchInstMaps, Info2, Info3)
-	    ->
-		simplify__conj([Goal | Goals0], RevGoals1, Goals,
-			ConjInfo, Info3, Info)
+		simplify__conj(Goals1, RevGoals0, Goals, ConjInfo, Info2, Info)
 	    ;
 		% Delete unreachable goals.
 		(
-		    simplify_info_get_instmap(Info2, InstMap1),
+		    simplify_info_get_instmap(Info1, InstMap1),
 		    instmap__is_unreachable(InstMap1)
 		;
 		    Goal1 = _ - GoalInfo1,
@@ -891,7 +952,7 @@
 		    determinism_components(Detism1, _, at_most_zero)
 		)
 	    ->
-		Info = Info2,
+		Info = Info1,
 		simplify__conjoin_goal_and_rev_goal_list(Goal1,
 			RevGoals0, RevGoals1),
 
@@ -914,28 +975,18 @@
 		),
 		list__reverse(RevGoals, Goals)
 	    ;
-		Goal1 = GoalExpr - _, 
-		( goal_util__goal_is_branched(GoalExpr) ->
-			Info4 = Info2,
-			GoalNeeded = yes,
-			Goals1 = Goals0,
-			RevGoals1 = RevGoals0
-		;
-			simplify_info_set_branch_info(Info2, BranchInstMaps,
-				Info3),
-			simplify__excess_assigns(Goal1, ConjInfo,
-				Goals0, Goals1, RevGoals0, RevGoals1,
-				GoalNeeded, Info3, Info4)
-		),
+		simplify__excess_assigns(Goal1, ConjInfo,
+			Goals0, Goals1, RevGoals0, RevGoals1,
+			GoalNeeded, Info1, Info2),
 		( GoalNeeded = yes ->
 			simplify__conjoin_goal_and_rev_goal_list(Goal1,
 				RevGoals1, RevGoals2)
 		;
 			RevGoals2 = RevGoals1
 		),
-		simplify_info_update_instmap(Info4, Goal1, Info5),
+		simplify_info_update_instmap(Info2, Goal1, Info3),
 		simplify__conj(Goals1, RevGoals2, Goals,
-			ConjInfo, Info5, Info)
+			ConjInfo, Info3, Info)
 	    )
 	).
 
@@ -952,173 +1003,6 @@
 
 %-----------------------------------------------------------------------------%
 
-	% Check the post-branch instmaps from the last branching structure in
-	% the conjunction to see if there was more information about the
-	% switched on variable at the end of each branch than there is at the
-	% start of the current switch. If there is, it may be worth merging the
-	% goals.
-:- pred simplify__merge_adjacent_switches(hlds_goal::in, hlds_goal::out,
-		hlds_goals::in, hlds_goals::out, maybe(branch_info)::in,
-		simplify_info::in, simplify_info::out) is semidet.
-
-simplify__merge_adjacent_switches(SwitchGoal, Goal, RevGoals0, RevGoals,
-		MaybeBranchInfo, Info0, Info) :-
-	MaybeBranchInfo = yes(branch_info(RevInstMapDeltas,
-		PreGoalCommon, PreGoalInstMap)),
-	simplify_do_switch(Info0),
-	list__reverse(RevInstMapDeltas, BranchInstMaps),
-	BranchInstMaps \= [],
-	BranchInstMaps \= [_],
-	SwitchGoal = switch(Var, _, Cases2, SM) - _,
-	move_follow_code_select(RevGoals0, RevFollowGoals, RevGoals1),
-	RevGoals1 = [BranchedGoal | RevGoals],
-	BranchedGoal = BranchedGoalExpr - BranchedGoalInfo,
-	goal_util__goal_is_branched(BranchedGoalExpr),
-	simplify_info_get_instmap(Info0, InstMap),
-	simplify__check_branches_for_extra_info(Var, InstMap,
-		BranchInstMaps, Cases2, [], RevCaseList),
-	list__reverse(RevCaseList, CaseList),
-	list__reverse(RevFollowGoals, FollowGoals),
-	(
-		BranchedGoalExpr = switch(Var1, CanFail1, Cases1, _)
-	->
-		simplify__merge_switch_into_cases(Cases1,
-			FollowGoals, CaseList, Cases),
-		GoalExpr = switch(Var1, CanFail1, Cases, SM)
-	;
-		BranchedGoalExpr = if_then_else(Vars, Cond,
-			Then0, Else0, IteSM)
-	->
-		CaseList = [ThenCase, ElseCase],
-		simplify__merge_switch_into_goal(Then0, FollowGoals,
-			ThenCase, Then),
-		simplify__merge_switch_into_goal(Else0, FollowGoals,
-			ElseCase, Else),
-		GoalExpr = if_then_else(Vars, Cond, Then, Else, IteSM)
-	;
-		BranchedGoalExpr = disj(Disjuncts0, DisjSM)
-	->
-		simplify__merge_switch_into_goals(Disjuncts0,
-			FollowGoals, CaseList, Disjuncts),
-		GoalExpr = disj(Disjuncts, DisjSM) 
-	;
-		error("simplify__merge_adjacent_switches")
-	),
-	list__append(FollowGoals, [SwitchGoal], NewGoals),
-	simplify__approximate_goal_info(NewGoals, BranchedGoalInfo, GoalInfo),
-	Goal = GoalExpr - GoalInfo,
-	simplify_info_set_requantify(Info0, Info1),
-	simplify_info_set_common_info(Info1, PreGoalCommon, Info2),
-	simplify_info_set_instmap(Info2, PreGoalInstMap, Info3),
-	simplify_info_reset_branch_info(Info3, Info, _).
-
-	% This just checks if every case in the second switch either fails
-	% or matches only one case given the information in the branches of
-	% the first branching goal. Returns the goal for the case that
-	% applies for each branch's instmap delta.
-:- pred simplify__check_branches_for_extra_info(var::in,
-		instmap::in, list(instmap_delta)::in, list(case)::in,
-		list(hlds_goal)::in, list(hlds_goal)::out) is semidet.
-
-simplify__check_branches_for_extra_info(_, _, [], _, CaseList, CaseList).
-simplify__check_branches_for_extra_info(Var, InstMap,
-		[BranchInstMap | BranchInstMaps], Cases, CaseList0, CaseList) :-
-	instmap__lookup_var(InstMap, Var, InstMapInst),
-	( instmap_delta_search_var(BranchInstMap, Var, BranchInstMapInst0) ->
-		BranchInstMapInst = BranchInstMapInst0
-	;
-		BranchInstMapInst = InstMapInst
-	),
-	simplify__inst_contains_more_information(BranchInstMapInst,
-		InstMapInst, Cases, ThisCase),
-	simplify__check_branches_for_extra_info(Var, InstMap,
-		BranchInstMaps, Cases, [ThisCase | CaseList0], CaseList).
-
-:- pred simplify__inst_contains_more_information((inst)::in,
-		(inst)::in, list(case)::in, hlds_goal::out) is semidet.
-
-simplify__inst_contains_more_information(not_reached, _, _, Goal) :-
-	fail_goal(Goal).
-simplify__inst_contains_more_information(bound(_, BoundInsts),
-		_, Cases0, Goal) :-
-	functors_to_cons_ids(BoundInsts, ConsIds0),
-	list__sort(ConsIds0, ConsIds),
-	delete_unreachable_cases(Cases0, ConsIds, Cases),
-	(
-		Cases = [],
-		fail_goal(Goal)
-	;
-		Cases = [case(_, Goal)]
-	).
-
-:- pred simplify__merge_switch_into_goals(hlds_goals::in, hlds_goals::in,
-		list(hlds_goal)::in, hlds_goals::out) is det.
-
-simplify__merge_switch_into_goals([], _, [], []).
-simplify__merge_switch_into_goals([], _, [_|_], []) :-
-	error("simplify__merge_switch_into_goals").
-simplify__merge_switch_into_goals([_|_], _, [], []) :-
-	error("simplify__merge_switch_into_goals").
-simplify__merge_switch_into_goals([Goal0 | Goals0], Builtins, 
-		[SwitchGoal | SwitchGoals], [Goal | Goals]) :-
-	simplify__merge_switch_into_goal(Goal0, Builtins, SwitchGoal, Goal),
-	simplify__merge_switch_into_goals(Goals0, Builtins, SwitchGoals, Goals).
-
-:- pred simplify__merge_switch_into_cases(list(case)::in, hlds_goals::in,
-		list(hlds_goal)::in, list(case)::out) is det.
-
-simplify__merge_switch_into_cases([], _, [], []).
-simplify__merge_switch_into_cases([], _, [_|_], []) :-
-	error("simplify__merge_switch_into_cases").
-simplify__merge_switch_into_cases([_|_], _, [], []) :-
-	error("simplify__merge_switch_into_cases").
-simplify__merge_switch_into_cases([case(ConsId, Goal0) | Cases0], Builtins, 
-		[SwitchGoal | SwitchGoals], [case(ConsId, Goal) | Cases]) :-
-	simplify__merge_switch_into_goal(Goal0, Builtins, SwitchGoal, Goal),
-	simplify__merge_switch_into_cases(Cases0, Builtins, SwitchGoals, Cases).
-
-:- pred simplify__merge_switch_into_goal(hlds_goal::in, hlds_goals::in,
-		hlds_goal::in, hlds_goal::out) is det.
-
-simplify__merge_switch_into_goal(Goal0, Builtins, SwitchGoal, Goal) :-
-	conjoin_goal_and_goal_list(Goal0, Builtins, Goal1),
-	conjoin_goals(Goal1, SwitchGoal, Goal2),
-	Goal2 = GoalExpr - GoalInfo0,
-	( GoalExpr = conj(Goals) -> 
-		simplify__approximate_goal_info(Goals, GoalInfo0, GoalInfo)
-	;
-		GoalInfo = GoalInfo0
-	),
-	Goal = GoalExpr - GoalInfo.
-
-	% Create a conservative goal_info so that simplification can
-	% safely be re-run on the resulting goal. A full recomputation over
-	% the entire goal is done later.
-:- pred simplify__approximate_goal_info(list(hlds_goal)::in,
-		hlds_goal_info::in, hlds_goal_info::out) is det.
-
-simplify__approximate_goal_info(NewGoals, GoalInfo0, GoalInfo) :-
-	ComputeGoalInfo =
-	    lambda([Goal::in, GInfo0::in, GInfo::out] is det, (
-		Goal = _ - GInfo1,
-		goal_info_get_nonlocals(GInfo0, NonLocals0),
-		goal_info_get_instmap_delta(GInfo0, InstMapDelta0),
-		goal_info_get_instmap_delta(GInfo1, InstMapDelta1),
-		instmap_delta_apply_instmap_delta(InstMapDelta0,
-			InstMapDelta1, InstMapDelta),
-		goal_info_get_nonlocals(GInfo1, NonLocals1),
-		set__union(NonLocals0, NonLocals1, NonLocals),
-	    	goal_info_set_instmap_delta(GInfo0, InstMapDelta, GInfo2),
-		goal_info_set_nonlocals(GInfo2, NonLocals, GInfo3),
-		goal_info_get_determinism(GInfo3, Detism0),
-		goal_info_get_determinism(GInfo1, Detism1),
-		det_conjunction_detism(Detism0, Detism1, Detism),
-	    	goal_info_set_determinism(GInfo3, Detism, GInfo)
-	    )),
-	list__foldl(ComputeGoalInfo, NewGoals, GoalInfo0, GoalInfo).
-
-%-----------------------------------------------------------------------------%
-
 :- pred simplify__excess_assigns(hlds_goal::in, hlds_goal_info::in,
 		hlds_goals::in, hlds_goals::out,
 		hlds_goals::in, hlds_goals::out, bool::out,
@@ -1146,30 +1030,9 @@
 			Subn, Goals),
 		goal_util__rename_vars_in_goals(RevGoals0, no,
 			Subn, RevGoals),
-		simplify_info_reset_branch_info(Info0, Info1, BranchInfo0),
-		(
-			BranchInfo0 = yes(
-				branch_info(InstMapDeltas0,
-					Common, PreBranchInstMap0))
-		->
-			simplify_info_get_instmap(Info1, InstMap0),
-			instmap__apply_sub(PreBranchInstMap0, no,
-				Subn, PreBranchInstMap),
-			instmap__apply_sub(InstMap0, no, Subn, InstMap),
-			Lambda = lambda([Delta0::in, Delta::out] is det, (
-			    instmap_delta_apply_sub(Delta0, no, Subn, Delta)
-			)),
-			list__map(Lambda, InstMapDeltas0, InstMapDeltas),
-			simplify_info_set_instmap(Info1, InstMap, Info2),
-			simplify_info_set_branch_info(Info2,
-				yes(branch_info(InstMapDeltas,
-				Common, PreBranchInstMap)), Info3)
-		;
-			Info3 = Info1
-		),
-		simplify_info_get_varset(Info3, VarSet0),
+		simplify_info_get_varset(Info0, VarSet0),
 		varset__delete_var(VarSet0, LocalVar, VarSet),
-		simplify_info_set_varset(Info3, VarSet, Info)
+		simplify_info_set_varset(Info0, VarSet, Info)
 	;
 		GoalNeeded = yes,
 		Goals = Goals0,
@@ -1179,27 +1042,59 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred simplify__switch(var, list(case), list(case), list(instmap_delta),
-	list(instmap_delta), simplify_info, simplify_info, simplify_info).
-:- mode simplify__switch(in, in, out, in, out, in, in, out) is det.
-
-simplify__switch(_, [], [], InstMaps, InstMaps, _, Info, Info). 
-simplify__switch(Var, [Case0 | Cases0], [Case | Cases],
-		InstMaps0, InstMaps, Info0, Info1, Info) :-
+:- pred simplify__switch(var, list(case), list(case), list(case), 
+		list(instmap_delta), list(instmap_delta), can_fail, can_fail,
+		simplify_info, simplify_info, simplify_info).
+:- mode simplify__switch(in, in, in, out, in, out, in, out,
+		in, in, out) is det.
+
+simplify__switch(_, [], RevCases, Cases, InstMaps, InstMaps, 
+		CanFail, CanFail, _, Info, Info) :-
+	list__reverse(RevCases, Cases). 
+simplify__switch(Var, [Case0 | Cases0], RevCases0, Cases, InstMaps0, InstMaps, 
+		CanFail0, CanFail, Info0, Info1, Info) :-
 	simplify_info_get_instmap(Info0, InstMap0),
 	Case0 = case(ConsId, Goal0),
 	simplify_info_get_module_info(Info1, ModuleInfo0),
 	instmap__bind_var_to_functor(Var, ConsId,
-		InstMap0, InstMap1, ModuleInfo0, ModuleInfo),
-	simplify_info_set_module_info(Info1, ModuleInfo, Info2),
+		InstMap0, InstMap1, ModuleInfo0, ModuleInfo1),
+	simplify_info_set_module_info(Info1, ModuleInfo1, Info2),
 	simplify_info_set_instmap(Info2, InstMap1, Info3),
 	simplify__goal(Goal0, Goal, Info3, Info4),
-	simplify_info_post_branch_update(Info0, Info4, Info5),
-	Case = case(ConsId, Goal),
-	Goal = _ - GoalInfo,
-	goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
-	simplify__switch(Var, Cases0, Cases, [InstMapDelta | InstMaps0],
-		InstMaps, Info0, Info5, Info).
+
+		% Remove failing branches. 
+	( Goal = disj([], _) - _ ->
+		RevCases = RevCases0,
+		InstMaps1 = InstMaps0,
+		CanFail1 = can_fail,
+		Info5 = Info4
+	;
+		Case = case(ConsId, Goal),
+		Goal = _ - GoalInfo,
+
+		%
+		% Make sure the switched on variable appears in the
+		% instmap delta. This avoids an abort in merge_instmap_delta
+		% if another branch further instantiates the switched-on 
+		% variable. If the switched on variable does not appear in
+		% this branch's instmap_delta, the inst before the goal
+		% would be used, resulting in a mode error.
+		%
+		goal_info_get_instmap_delta(GoalInfo, InstMapDelta0),
+		simplify_info_get_module_info(Info4, ModuleInfo5),
+		instmap_delta_bind_var_to_functor(Var, ConsId,
+			InstMap0, InstMapDelta0, InstMapDelta, 
+			ModuleInfo5, ModuleInfo),
+		simplify_info_set_module_info(Info4, ModuleInfo, Info5),
+
+		InstMaps1 = [InstMapDelta | InstMaps0],
+		RevCases = [Case | RevCases0],
+		CanFail1 = CanFail0
+	),
+
+	simplify_info_post_branch_update(Info0, Info5, Info6),
+	simplify__switch(Var, Cases0, RevCases, Cases, InstMaps1, InstMaps,
+		CanFail1, CanFail, Info0, Info6, Info).
 
 	% Create a semidet unification at the start of a singleton case
 	% in a can_fail switch.
@@ -1249,34 +1144,73 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred simplify__disj(list(hlds_goal), list(hlds_goal), list(instmap_delta),
-	list(instmap_delta), simplify_info, simplify_info, simplify_info).
-:- mode simplify__disj(in, out, in, out, in, in, out) is det.
+:- pred simplify__disj(list(hlds_goal), list(hlds_goal), list(hlds_goal), 
+	list(instmap_delta), list(instmap_delta), 
+	simplify_info, simplify_info, simplify_info).
+:- mode simplify__disj(in, in, out, in, out, in, in, out) is det.
 
-simplify__disj([], [], InstMaps, InstMaps, _, Info, Info).
-simplify__disj([Goal0 |Goals0], [Goal | Goals], PostBranchInstMaps0,
+simplify__disj([], RevGoals, Goals, InstMaps, InstMaps, _, Info, Info) :-
+	list__reverse(RevGoals, Goals).
+simplify__disj([Goal0 | Goals0], RevGoals0, Goals,  PostBranchInstMaps0,
 		PostBranchInstMaps, Info0, Info1, Info) :-
 	simplify__goal(Goal0, Goal, Info1, Info2),
-	simplify_info_post_branch_update(Info0, Info2, Info3),
-	Goal0 = _ - GoalInfo,
-	goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
-	simplify__disj(Goals0, Goals, [InstMapDelta | PostBranchInstMaps0],
-			PostBranchInstMaps, Info0, Info3, Info4),
+	Goal = _ - GoalInfo,
+
 	(
-		simplify_do_warn(Info4),
-		Goal = _ - GoalInfo,
-		% don't warn about impure disjuncts that can't succeed
+		% Don't prune or warn about impure disjuncts 
+		% that can't succeed.
 		\+ goal_info_is_impure(GoalInfo),
 		goal_info_get_determinism(GoalInfo, Detism),
-		determinism_components(Detism, _, MaxSolns),
+		determinism_components(Detism, _CanFail, MaxSolns),
 		MaxSolns = at_most_zero
 	->
-		goal_info_get_context(GoalInfo, Context),
-		simplify_info_add_msg(Info4, zero_soln_disjunct(Context),
-			Info)
+		( 
+			simplify_do_warn(Info2),
+			% Don't warn where the initial goal was fail,
+			% since that can result from mode analysis
+			% pruning away cases in a switch which cannot
+			% succeed due to sub-typing in the modes.
+			Goal0 \= disj([], _) - _
+		->
+			goal_info_get_context(GoalInfo, Context),
+			simplify_info_add_msg(Info2, 
+				zero_soln_disjunct(Context), Info3)
+		;
+			Info3 = Info2
+		),
+
+		%
+		% Prune away non-succeeding disjuncts where possible.
+		%
+
+		( 
+			(
+				Goal0 = disj([], _) - _
+			;
+				% Only remove disjuncts that might loop
+				% or call error/1 if --no-fully-strict.
+				simplify_info_get_det_info(Info3, DetInfo),
+				det_info_get_fully_strict(DetInfo, no)
+			)
+		->
+			RevGoals1 = RevGoals0,
+			PostBranchInstMaps1 = PostBranchInstMaps0
+		;			
+			RevGoals1 = [Goal | RevGoals0],
+			goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
+			PostBranchInstMaps1 = 
+				[InstMapDelta | PostBranchInstMaps0]
+		)
 	;
-		Info = Info4
-	).
+		Info3 = Info2,
+		RevGoals1 = [Goal | RevGoals0],
+		goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
+		PostBranchInstMaps1 = [InstMapDelta | PostBranchInstMaps0]
+	),
+
+	simplify_info_post_branch_update(Info0, Info3, Info4),
+	simplify__disj(Goals0, RevGoals1, Goals, PostBranchInstMaps1,
+			PostBranchInstMaps, Info0, Info4, Info).
 
 	% Disjunctions that cannot succeed more than once when viewed from the
 	% outside generally need some fixing up, and/or some warnings to be
@@ -1384,7 +1318,7 @@
 	--->	simplify_info(
 			det_info,
 			set(det_msg),
-			simplify,	% How much simplification to do.
+			set(simplification),
 			common_info,	% Info about common subexpressions.
 			instmap,
 			varset,
@@ -1392,37 +1326,47 @@
 			bool,		% Does the goal need requantification.
 			bool,		% Does mode analysis need rerunning
 					% rather than recompute_instmap_delta.
-			maybe(branch_info),	% Final instmaps at the end
-					% of each branch of the last 
-					% branching goal
+			unit,
+			int,		% Measure of the improvement in
+					% the goal from simplification.
 			int		% Count of the number of lambdas
 					% which enclose the current goal.
 		).
 
-	% info used to merge adjacent switches and prepare for rerunning
-	% simplification on the resulting goal.
-:- type branch_info
-	--->	branch_info(
-			list(instmap_delta),	% instmap_delta for each branch
-			common_info,		% from before goal
-			instmap			% from before goal
-		).
-
-simplify_info_init(DetInfo, Simplify, InstMap, VarSet, VarTypes, Info) :-
+simplify_info_init(DetInfo, Simplifications0, InstMap,
+		VarSet, VarTypes, Info) :-
 	common_info_init(CommonInfo),
 	set__init(Msgs),
-	Info = simplify_info(DetInfo, Msgs, Simplify, CommonInfo,
-			InstMap, VarSet, VarTypes, no, no, no, 0). 
+	set__list_to_set(Simplifications0, Simplifications),
+	Info = simplify_info(DetInfo, Msgs, Simplifications, CommonInfo,
+			InstMap, VarSet, VarTypes, no, no, unit, 0, 0). 
+
+	% Reinitialise the simplify_info before reprocessing a goal.
+:- pred simplify_info_reinit(set(simplification)::in, instmap::in,
+		simplify_info::in, simplify_info::out) is det.
+
+simplify_info_reinit(Simplifications, InstMap0, Info0, Info) :-
+	Info0 = simplify_info(DetInfo, Msgs, _, _, _,
+		VarSet, VarTypes, _, _, _, CostDelta, _),
+	common_info_init(Common),
+	Info = simplify_info(DetInfo, Msgs, Simplifications, Common, InstMap0,
+		VarSet, VarTypes, no, no, unit, CostDelta, 0).
 
 	% exported for common.m
 :- interface.
-:- import_module set, std_util.
-:- import_module prog_data, det_util, instmap.
+
+:- import_module prog_data.
+:- import_module set.
+
+:- pred simplify_info_init(det_info, list(simplification), instmap,
+		varset, map(var, type), simplify_info).
+:- mode simplify_info_init(in, in, in, in, in, out) is det.
 
 :- pred simplify_info_get_det_info(simplify_info::in, det_info::out) is det.
 :- pred simplify_info_get_msgs(simplify_info::in, set(det_msg)::out) is det.
 :- pred simplify_info_get_instmap(simplify_info::in, instmap::out) is det.
-:- pred simplify_info_get_simplify(simplify_info::in, simplify::out) is det.
+:- pred simplify_info_get_simplifications(simplify_info::in,
+		set(simplification)::out) is det.
 :- pred simplify_info_get_common_info(simplify_info::in,
 		common_info::out) is det.
 :- pred simplify_info_get_varset(simplify_info::in, varset::out) is det.
@@ -1430,29 +1374,29 @@
 		map(var, type)::out) is det.
 :- pred simplify_info_requantify(simplify_info::in) is semidet.
 :- pred simplify_info_recompute_atomic(simplify_info::in) is semidet.
-:- pred simplify_info_get_branch_info(simplify_info::in,
-		maybe(branch_info)::out) is det.
+:- pred simplify_info_get_cost_delta(simplify_info::in, int::out) is det.
 
 :- pred simplify_info_get_module_info(simplify_info::in,
 		module_info::out) is det.
 
 :- implementation.
 
-simplify_info_get_det_info(simplify_info(Det, _,_,_,_,_,_,_,_,_,_), Det). 
-simplify_info_get_msgs(simplify_info(_, Msgs, _,_,_,_,_,_,_,_,_), Msgs).
-simplify_info_get_simplify(simplify_info(_,_,Simplify,_,_,_,_,_,_,_,_),
+simplify_info_get_det_info(simplify_info(Det, _,_,_,_,_,_,_,_,_,_,_), Det). 
+simplify_info_get_msgs(simplify_info(_, Msgs, _,_,_,_,_,_,_,_,_,_), Msgs).
+simplify_info_get_simplifications(simplify_info(_,_,Simplify,_,_,_,_,_,_,_,_,_),
 	Simplify). 
-simplify_info_get_common_info(simplify_info(_,_,_,Common, _,_,_,_,_,_,_),
+simplify_info_get_common_info(simplify_info(_,_,_,Common, _,_,_,_,_,_,_,_),
 	Common).
-simplify_info_get_instmap(simplify_info(_,_,_,_, InstMap,_,_,_,_,_,_),
-	InstMap).
-simplify_info_get_varset(simplify_info(_,_,_,_,_, VarSet, _,_,_,_,_), VarSet). 
-simplify_info_get_var_types(simplify_info(_,_,_,_,_,_, VarTypes, _,_,_,_),
+simplify_info_get_instmap(simplify_info(_,_,_,_, InstMap,_,_,_,_,_,_,_),
+	InstMap). 
+simplify_info_get_varset(simplify_info(_,_,_,_,_, VarSet, _,_,_,_,_,_), VarSet).
+simplify_info_get_var_types(simplify_info(_,_,_,_,_,_, VarTypes, _,_,_,_,_),
 	VarTypes). 
-simplify_info_requantify(simplify_info(_,_,_,_,_,_,_, yes, _,_,_)).
-simplify_info_recompute_atomic(simplify_info(_,_,_,_,_,_,_,_, yes,_,_)).
-simplify_info_get_branch_info(simplify_info(_,_,_,_,_,_,_,_,_, BranchInfo, _),
-	BranchInfo).
+simplify_info_requantify(simplify_info(_,_,_,_,_,_,_, yes, _,_,_,_)).
+simplify_info_recompute_atomic(simplify_info(_,_,_,_,_,_,_,_, yes,_,_,_)).
+simplify_info_get_cost_delta(simplify_info(_,_,_,_,_,_,_,_,_,_,CostDelta, _),
+	CostDelta).
+
 
 simplify_info_get_module_info(Info, ModuleInfo) :-
 	simplify_info_get_det_info(Info, DetInfo),
@@ -1460,14 +1404,12 @@
 
 :- interface.
 
-:- type branch_info.
-
 :- pred simplify_info_set_det_info(simplify_info::in,
 		det_info::in, simplify_info::out) is det.
 :- pred simplify_info_set_msgs(simplify_info::in,
 		set(det_msg)::in, simplify_info::out) is det.
-:- pred simplify_info_set_simplify(simplify_info::in,
-		simplify::in, simplify_info::out) is det.
+:- pred simplify_info_set_simplifications(simplify_info::in,
+		set(simplification)::in, simplify_info::out) is det.
 :- pred simplify_info_set_instmap(simplify_info::in,
 		instmap::in, simplify_info::out) is det.
 :- pred simplify_info_set_common_info(simplify_info::in, common_info::in,
@@ -1480,12 +1422,15 @@
 		simplify_info::out) is det.
 :- pred simplify_info_set_recompute_atomic(simplify_info::in,
 		simplify_info::out) is det.
-:- pred simplify_info_reset_branch_info(simplify_info::in, simplify_info::out,
-		maybe(branch_info)::out) is det.
-:- pred simplify_info_set_branch_info(simplify_info::in,
-		maybe(branch_info)::in, simplify_info::out) is det.
 :- pred simplify_info_add_msg(simplify_info::in, det_msg::in,
 		simplify_info::out) is det.
+:- pred simplify_info_do_add_msg(simplify_info::in, det_msg::in, 
+		simplify_info::out) is det.
+:- pred simplify_info_set_cost_delta(simplify_info::in, int::in,
+		simplify_info::out) is det.
+:- pred simplify_info_incr_cost_delta(simplify_info::in,
+		int::in, simplify_info::out) is det.
+
 :- pred simplify_info_enter_lambda(simplify_info::in, simplify_info::out)
 		is det.
 :- pred simplify_info_leave_lambda(simplify_info::in, simplify_info::out)
@@ -1497,47 +1442,55 @@
 
 :- implementation.
 
-simplify_info_set_det_info(simplify_info(_, B, C, D, E, F, G, H, I, J, K), Det,
-		simplify_info(Det, B, C, D, E, F, G, H, I, J, K)).
-simplify_info_set_msgs(simplify_info(A, _, C, D, E, F, G, H, I, J, K), Msgs,
-		simplify_info(A, Msgs, C, D, E, F, G, H, I, J, K)). 
-simplify_info_set_simplify(simplify_info(A, B, _, D, E, F, G, H, I, J, K), Simp,
-		simplify_info(A, B, Simp, D, E, F, G, H, I, J, K)).
-simplify_info_set_instmap(simplify_info(A, B, C, D, _, F, G, H, I, J, K),
-		InstMap, simplify_info(A, B, C, D, InstMap, F, G, H, I, J, K)). 
-simplify_info_set_common_info(simplify_info(A, B, C, _, E, F, G, H, I, J, K),
-		Common, simplify_info(A, B, C, Common, E, F, G, H, I, J, K)). 
-simplify_info_set_varset(simplify_info(A, B, C, D, E, _, G, H, I, J, K), VarSet,
-		simplify_info(A, B, C, D, E, VarSet, G, H, I, J, K)). 
-simplify_info_set_var_types(simplify_info(A, B, C, D, E, F, _, H, I, J, K),
-		VarTypes, simplify_info(A, B, C, D, E, F, VarTypes, H, I, J, K)). 
-simplify_info_set_requantify(simplify_info(A, B, C, D, E, F, G, _, I, J, K),
-		simplify_info(A, B, C, D, E, F, G, yes, I, J, K)). 
-simplify_info_set_recompute_atomic(
-		simplify_info(A, B, C, D, E, F, G, H, _, J, K),
-		simplify_info(A, B, C, D, E, F, G, H, yes, J, K)). 
-simplify_info_reset_branch_info(
-		simplify_info(A, B, C, D, E, F, G, H, I, Info, K),
-		simplify_info(A, B, C, D, E, F, G, H, I, no, K), Info). 
-simplify_info_set_branch_info(simplify_info(A, B, C, D, E, F, G, H, I, _, K),
-		Info, simplify_info(A, B, C, D, E, F, G, H, I, Info, K)). 
+simplify_info_set_det_info(simplify_info(_, B, C, D, E, F, G, H, I, J, K, L),
+		Det, simplify_info(Det, B, C, D, E, F, G, H, I, J, K, L)).
+simplify_info_set_msgs(simplify_info(A, _, C, D, E, F, G, H, I, J, K, L), Msgs,
+		simplify_info(A, Msgs, C, D, E, F, G, H, I, J, K, L)). 
+simplify_info_set_simplifications(
+		simplify_info(A, B, _, D, E, F, G, H, I, J, K, L),
+		Simp, simplify_info(A, B, Simp, D, E, F, G, H, I, J, K, L)).
+simplify_info_set_instmap(simplify_info(A, B, C, D, _, F, G, H, I, J, K, L), 
+		InstMap, 
+		simplify_info(A, B, C, D, InstMap, F, G, H, I, J, K, L)). 
+simplify_info_set_common_info(simplify_info(A, B, C, _, E, F, G, H, I, J, K, L),
+		Common, 
+		simplify_info(A, B, C, Common, E, F, G, H, I, J, K, L)). 
+simplify_info_set_varset(simplify_info(A, B, C, D, E, _, G, H, I, J, K, L), 
+		VarSet, 
+		simplify_info(A, B, C, D, E, VarSet, G, H, I, J, K, L)). 
+simplify_info_set_var_types(simplify_info(A, B, C, D, E, F, _, H, I, J, K, L),
+		VarTypes, simplify_info(A, B, C, D, E, F, VarTypes, H,I,J,K,L)).
+simplify_info_set_requantify(simplify_info(A, B, C, D, E, F, G, _, I, J, K, L),
+		simplify_info(A, B, C, D, E, F, G, yes, I, J, K, L)). 
+simplify_info_set_recompute_atomic(simplify_info(A, B, C, D, E, F, G,H,_,J,K,L),
+		simplify_info(A, B, C, D, E, F, G, H, yes, J, K, L)). 
+simplify_info_set_cost_delta(simplify_info(A, B, C, D, E, F, G, H, I, J, _, L),
+		Delta, simplify_info(A, B, C, D, E, F, G, H, I, J, Delta, L)). 
+
+simplify_info_incr_cost_delta(
+		simplify_info(A, B, C, D, E, F,G,H,I,J, Delta0, L),
+		Incr, simplify_info(A, B, C, D, E, F, G, H, I, J, Delta, L)) :-
+	Delta is Delta0 + Incr.
 
 simplify_info_add_msg(Info0, Msg, Info) :-
 	( simplify_do_warn(Info0) ->
-		simplify_info_get_msgs(Info0, Msgs0),
-		set__insert(Msgs0, Msg, Msgs),
-		simplify_info_set_msgs(Info0, Msgs, Info)
+		simplify_info_do_add_msg(Info0, Msg, Info)
 	;
 		Info = Info0
 	).
 
+simplify_info_do_add_msg(Info0, Msg, Info) :-
+	simplify_info_get_msgs(Info0, Msgs0),
+	set__insert(Msgs0, Msg, Msgs),
+	simplify_info_set_msgs(Info0, Msgs, Info).
+
 simplify_info_enter_lambda(
-		simplify_info(A, B, C, D, E, F, G, H, I, J, LambdaCount0),
-		simplify_info(A, B, C, D, E, F, G, H, I, J, LambdaCount)) :-
+		simplify_info(A, B, C, D, E, F, G, H, I, J, K, LambdaCount0),
+		simplify_info(A, B, C, D, E, F, G, H, I, J, K, LambdaCount)) :-
 	LambdaCount is LambdaCount0 + 1.
 simplify_info_leave_lambda(
-		simplify_info(A, B, C, D, E, F, G, H, I, J, LambdaCount0),
-		simplify_info(A, B, C, D, E, F, G, H, I, J, LambdaCount)) :-
+		simplify_info(A, B, C, D, E, F, G, H, I, J, K, LambdaCount0),
+		simplify_info(A, B, C, D, E, F, G, H, I, J, K, LambdaCount)) :-
 	LambdaCount1 is LambdaCount0 - 1,
 	(
 		LambdaCount1 >= 0
@@ -1547,7 +1500,7 @@
 		error("simplify_info_leave_lambda: Left too many lambdas")
 	).
 simplify_info_inside_lambda(
-		simplify_info(_,_,_,_,_,_,_,_,_,_,LambdaCount)) :-
+		simplify_info(_,_,_,_,_,_,_,_,_,_,_,LambdaCount)) :-
 	LambdaCount > 0.
 
 simplify_info_set_module_info(Info0, ModuleInfo, Info) :-
@@ -1560,45 +1513,45 @@
 :- pred simplify_do_warn(simplify_info::in) is semidet.
 :- pred simplify_do_warn_calls(simplify_info::in) is semidet.
 :- pred simplify_do_once(simplify_info::in) is semidet.
-:- pred simplify_do_switch(simplify_info::in) is semidet.
 :- pred simplify_do_common(simplify_info::in) is semidet.
 :- pred simplify_do_excess_assigns(simplify_info::in) is semidet.
 :- pred simplify_do_calls(simplify_info::in) is semidet.
 :- pred simplify_do_const_prop(simplify_info::in) is semidet.
+:- pred simplify_do_more_common(simplify_info::in) is semidet.
 
 :- implementation.
 
 simplify_do_warn(Info) :-
-	simplify_info_get_simplify(Info, Simplify),
-	Simplify = simplify(yes, _, _, _, _, _, _, _).
+	simplify_info_get_simplifications(Info, Simplifications),
+	set__member(warn_simple_code, Simplifications).
 simplify_do_warn_calls(Info) :-
-	simplify_info_get_simplify(Info, Simplify),
-	Simplify = simplify(_, yes, _, _, _, _, _, _).
+	simplify_info_get_simplifications(Info, Simplifications),
+	set__member(warn_duplicate_calls, Simplifications).
 simplify_do_once(Info) :-
-	simplify_info_get_simplify(Info, Simplify),
-	Simplify = simplify(_, _, yes, _, _, _, _, _).
-simplify_do_switch(Info) :-
-	simplify_info_get_simplify(Info, Simplify),
-	Simplify = simplify(_, _, _, yes, _, _, _, _).
-simplify_do_common(Info) :-
-	simplify_info_get_simplify(Info, Simplify), 
-	Simplify = simplify(_, _, _, _, yes, _, _, _).
+	simplify_info_get_simplifications(Info, Simplifications),
+	set__member(do_once, Simplifications).
 simplify_do_excess_assigns(Info) :-
-	simplify_info_get_simplify(Info, Simplify),
-	Simplify = simplify(_, _, _, _, _, yes, _, _).
+	simplify_info_get_simplifications(Info, Simplifications),
+	set__member(excess_assigns, Simplifications).
 simplify_do_calls(Info) :-
-	simplify_info_get_simplify(Info, Simplify),
-	Simplify = simplify(_, _, _, _, _, _, yes, _).
+	simplify_info_get_simplifications(Info, Simplifications),
+	set__member(duplicate_calls, Simplifications).
 simplify_do_const_prop(Info) :-
-	simplify_info_get_simplify(Info, Simplify),
-	Simplify = simplify(_, _, _, _, _, _, _, yes).
+	simplify_info_get_simplifications(Info, Simplifications),
+	set__member(constant_prop, Simplifications).
+simplify_do_common(Info) :-
+	simplify_info_get_simplifications(Info, Simplifications), 
+	set__member(common_struct, Simplifications).
+simplify_do_more_common(Info) :-
+	simplify_info_get_simplifications(Info, Simplifications),
+	set__member(extra_common_struct, Simplifications).
 
 :- pred simplify_info_update_instmap(simplify_info::in, hlds_goal::in,
 		simplify_info::out) is det.
 
 simplify_info_update_instmap(
-		simplify_info(A, B, C, D, InstMap0, F, G, H, I, J, K), Goal,
-		simplify_info(A, B, C, D, InstMap, F, G, H, I, J, K)) :-
+		simplify_info(A, B, C, D, InstMap0, F, G, H, I, J, K, L), Goal,
+		simplify_info(A, B, C, D, InstMap, F, G, H, I, J, K, L)) :-
 	update_instmap(Goal, InstMap0, InstMap).
 
 :- type before_after
@@ -1611,11 +1564,17 @@
 	% would cause more variables to be live across the stack flush.
 	% Calls and construction unifications are not treated in this
 	% way since it is nearly always better to optimize them away.
+	% When doing deforestation, it may be better to remove
+	% as many common structures as possible.
 :- pred simplify_info_maybe_clear_structs(before_after::in, hlds_goal::in,
 		simplify_info::in, simplify_info::out) is det.
 
 simplify_info_maybe_clear_structs(BeforeAfter, Goal, Info0, Info) :-
-	( code_util__cannot_stack_flush(Goal) ->
+	(
+		( code_util__cannot_stack_flush(Goal) 
+		; simplify_do_more_common(Info0)
+		)
+	->
 		Info = Info0
 	;
 		% First check to see if a call is common and can be replaced 
@@ -1628,6 +1587,7 @@
 			Goal = GoalExpr - _,
 			GoalExpr \= call(_, _, _, _, _, _),
 			GoalExpr \= higher_order_call(_, _, _, _, _, _),
+			GoalExpr \= class_method_call(_, _, _, _, _, _),
 			GoalExpr \= pragma_c_code(_, _, _, _, _, _, _)
 		)
 	->
@@ -1647,15 +1607,6 @@
 	simplify_info_set_instmap(PostBranchInfo0, InstMap, PostBranchInfo1),
 	simplify_info_get_common_info(PreBranchInfo, Common),
 	simplify_info_set_common_info(PostBranchInfo1, Common, Info).
-	
-:- pred simplify_info_create_branch_info(simplify_info::in, simplify_info::in,
-		list(instmap_delta)::in, simplify_info::out) is det.
-
-simplify_info_create_branch_info(Info0, Info1, InstMapDeltas, Info) :-
-	simplify_info_get_common_info(Info0, Common),
-	simplify_info_get_instmap(Info0, InstMap),
-	BranchInfo = yes(branch_info(InstMapDeltas, Common, InstMap)),
-	simplify_info_set_branch_info(Info1, BranchInfo, Info).
 
 	% Undo updates to the simplify_info before redoing 
 	% simplification on a goal. 
@@ -1665,7 +1616,5 @@
 simplify_info_undo_goal_updates(Info1, Info2, Info) :-
 	simplify_info_get_common_info(Info1, CommonInfo0),
 	simplify_info_set_common_info(Info2, CommonInfo0, Info3),
-	simplify_info_get_branch_info(Info1, BranchInfo),
-	simplify_info_set_branch_info(Info3, BranchInfo, Info4),
 	simplify_info_get_instmap(Info1, InstMap),
-	simplify_info_set_instmap(Info4, InstMap, Info).
+	simplify_info_set_instmap(Info3, InstMap, Info).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_proc.m,v
retrieving revision 1.66
diff -u -r1.66 unify_proc.m
--- unify_proc.m	1998/03/03 17:36:29	1.66
+++ unify_proc.m	1998/03/10 23:02:08
@@ -47,7 +47,7 @@
 
 :- interface.
 :- import_module hlds_module, hlds_pred, hlds_goal, hlds_data.
-:- import_module modes, prog_data, special_pred.
+:- import_module mode_info, prog_data, special_pred.
 :- import_module bool, std_util, io, list.
 
 :- type proc_requests.
@@ -110,7 +110,7 @@
 :- import_module mercury_to_mercury, hlds_out.
 :- import_module make_hlds, prog_util, prog_out, inst_match.
 :- import_module quantification, clause_to_proc.
-:- import_module globals, options, mode_util, (inst).
+:- import_module globals, options, modes, mode_util, (inst).
 :- import_module switch_detection, cse_detection, det_analysis, unique_modes.
 
 	% We keep track of all the complicated unification procs we need
@@ -340,7 +340,7 @@
 		%
 		% print progress message
 		%
-		( { HowToCheckGoal = check_unique_modes } ->
+		( { HowToCheckGoal = check_unique_modes(_) } ->
 			io__write_string(
 		    "% Analyzing modes, determinism, and unique-modes for\n% ")
 		;
@@ -396,7 +396,7 @@
 		{ ModuleInfo = ModuleInfo2 },
 		{ Changed = Changed1 }
 	;
-		( { HowToCheckGoal = check_unique_modes } ->
+		( { HowToCheckGoal = check_unique_modes(_) } ->
 			{ detect_switches_in_proc(ProcId, PredId,
 						ModuleInfo2, ModuleInfo3) },
 			detect_cse_in_proc(ProcId, PredId,
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unique_modes.m,v
retrieving revision 1.46
diff -u -r1.46 unique_modes.m
--- unique_modes.m	1998/03/03 17:36:30	1.46
+++ unique_modes.m	1998/03/10 04:55:42
@@ -64,11 +64,12 @@
 %-----------------------------------------------------------------------------%
 
 unique_modes__check_module(ModuleInfo0, ModuleInfo) -->
-	check_pred_modes(check_unique_modes, ModuleInfo0, ModuleInfo,
-			_UnsafeToContinue).
+	check_pred_modes(check_unique_modes(may_change_called_proc),
+			ModuleInfo0, ModuleInfo, _UnsafeToContinue).
 
 unique_modes__check_proc(ProcId, PredId, ModuleInfo0, ModuleInfo, Changed) -->
-	modecheck_proc(ProcId, PredId, check_unique_modes,
+	modecheck_proc(ProcId, PredId,
+		check_unique_modes(may_change_called_proc),
 		ModuleInfo0, ModuleInfo, NumErrors, Changed),
 	( { NumErrors \= 0 } ->
 		io__set_exit_status(1)
@@ -403,7 +404,7 @@
 	mode_info_set_call_context(unify(UnifyContext)),
 
 	modecheck_unification(A0, B0, UnifyInfo0, UnifyContext, GoalInfo0,
-		check_unique_modes, Goal),
+		Goal),
 
 	mode_info_unset_call_context,
 	mode_checkpoint(exit, "unify").
@@ -467,9 +468,16 @@
 	%
 	mode_info_get_errors(ModeInfo2, Errors),
 	mode_info_set_errors(OldErrors, ModeInfo2, ModeInfo3),
+	mode_info_get_how_to_check(ModeInfo3, HowToCheck),
 	( Errors = [] ->
 		ProcId = ProcId0,
 		ModeInfo = ModeInfo3
+	; HowToCheck = check_unique_modes(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)
 	;
 		%
 		% If it didn't work, restore the original instmap,
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.17
diff -u -r1.17 compiler_design.html
--- compiler_design.html	1998/01/10 09:14:51	1.17
+++ compiler_design.html	1998/02/25 04:32:14
@@ -414,6 +414,27 @@
 <li> pushing constraints as far left as possible (constraint.m);
   this does not yet work.
 
+<li> deforestation and partial evaluation (deforest.m). This optimizes
+  multiple traversals of data structures within a conjunction, and
+  avoids creating intermediate data structures. It also performs
+  loop unrolling where the clause used is known at compile time.
+  deforest.m makes use of the following sub-modules
+  (`pd_' stands for "partial deduction"):
+  <ul>
+  <li>
+  pd_cost.m contains some predicates to estimate the improvement
+  caused by deforest.m.
+  <li>
+  pd_debug.m produces debugging output.
+  <li>
+  pd_info.m contains a state type for deforestation.
+  <li>
+  pd_term.m contains predicates to check that the deforestation algorithm
+  terminates.
+  <li>
+  pd_util.m contains various utility predicates.
+  </ul>
+
 <li> issue warnings about unused arguments from predicates, and create
   specialized versions without them (unused_args.m); type_infos are
   often unused
Index: doc/user_guide.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/user_guide.texi,v
retrieving revision 1.120
diff -u -r1.120 user_guide.texi
--- user_guide.texi	1998/03/18 08:09:45	1.120
+++ user_guide.texi	1998/03/19 04:08:34
@@ -2363,9 +2363,11 @@
 Reorder goals to minimize the number of variables
 that have to be saved across calls.
 
- at c @sp 1
- at c @item --no-specialize
- at c Disable the specialization of procedures.
+ at sp 1
+ at item --deforestation
+Enable deforestation. Deforestation is a program transformation whose aim
+is to avoid the construction of intermediate data structures and to avoid
+repeated traversals over data structures within a conjunction.
 
 @end table
 
Index: library/varset.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/varset.m,v
retrieving revision 1.57
diff -u -r1.57 varset.m
--- varset.m	1998/03/03 17:26:11	1.57
+++ varset.m	1998/03/06 11:51:26
@@ -28,7 +28,7 @@
 
 :- module varset.
 :- interface.
-:- import_module term, list, map, assoc_list.
+:- import_module term, list, map, set, assoc_list.
 
 :- type varset.
 
@@ -146,6 +146,11 @@
 :- pred varset__ensure_unique_names(list(var), string, varset, varset).
 :- mode varset__ensure_unique_names(in, in, in, out) is det.
 
+	% Given a varset and a set of variables, remove the names
+	% and values of any other variables stored in the varset.
+:- pred varset__select(varset, set(var), varset).
+:- mode varset__select(in, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -416,6 +421,13 @@
 	;
 		Final = Trial0
 	).
+
+%-----------------------------------------------------------------------------%
+
+varset__select(varset(Supply, VarNameMap0, Values0), Vars,
+		varset(Supply, VarNameMap, Values)) :-
+	map__select(VarNameMap0, Vars, VarNameMap),
+	map__select(Values0, Vars, Values).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: tests/misc_tests/mdemangle_test.exp
===================================================================
RCS file: /home/staff/zs/imp/tests/misc_tests/mdemangle_test.exp,v
retrieving revision 1.9
diff -u -r1.9 mdemangle_test.exp
--- mdemangle_test.exp	1997/10/13 10:18:34	1.9
+++ mdemangle_test.exp	1998/03/24 01:36:49
@@ -90,6 +90,12 @@
 <func goal (#4) from 'collect_vars' in module 'lp' line 153>
 <func goal (#4) from 'collect_vars' in module 'lp' line 153>
 
+	procedures introduced by deforestation
+<deforestation procedure (#9) from 'simplex' in module 'lp' line 262 label 5>
+<deforestation procedure (#9) from 'simplex' in module 'lp' line 262 label 5>
+<deforestation procedure (#4) from 'collect_vars' in module 'lp' line 153>
+<deforestation procedure (#4) from 'collect_vars' in module 'lp' line 153>
+
 	A realistic test
 ml -s asm_fast.gc.tr --no-demangle -o interpreter interpreter_init.o \
 interpreter.o -lcfloat_lib 
Index: tests/misc_tests/mdemangle_test.inp
===================================================================
RCS file: /home/staff/zs/imp/tests/misc_tests/mdemangle_test.inp,v
retrieving revision 1.10
diff -u -r1.10 mdemangle_test.inp
--- mdemangle_test.inp	1997/10/13 10:18:35	1.10
+++ mdemangle_test.inp	1998/03/24 01:36:17
@@ -90,6 +90,12 @@
 mercury__lp__IntroducedFrom__func__collect_vars__153__4_3_0
 <func goal (#4) from 'collect_vars' in module 'lp' line 153>
 
+	procedures introduced by deforestation
+mercury__lp__DeforestationIn__pred__simplex__262__9_7_0_i5
+<deforestation procedure (#9) from 'simplex' in module 'lp' line 262 label 5>
+mercury__lp__DeforestationIn__pred__collect_vars__153__4_3_0
+<deforestation procedure (#4) from 'collect_vars' in module 'lp' line 153>
+
 	A realistic test
 ml -s asm_fast.gc.tr --no-demangle -o interpreter interpreter_init.o \
 interpreter.o -lcfloat_lib 
Index: util/mdemangle.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/util/mdemangle.c,v
retrieving revision 1.29
diff -u -r1.29 mdemangle.c
--- mdemangle.c	1998/03/03 17:39:40	1.29
+++ mdemangle.c	1998/03/24 01:29:07
@@ -106,6 +106,7 @@
 	   avoid a naming conflict with strchr's alter ego index() */
 
 	static const char introduced[]  = "IntroducedFrom__";
+	static const char deforestation[]  = "DeforestationIn__";
 	static const char pred[]  = "pred__";
 	static const char func[]  = "func__";
 
@@ -119,7 +120,12 @@
 	static const char base_type_functors[] = "base_type_functors_";
 	static const char common[] = "common";
 
-	static const char * trailing_context_1[] = { introduced, NULL };
+	static const char * trailing_context_1[] = {
+		introduced,
+		deforestation,
+		NULL
+	};
+
 	static const char * trailing_context_2[] = {
 		base_type_layout,
 		base_type_info,
@@ -143,7 +149,8 @@
 	int lambda_seq_number = 0;
 	char *lambda_pred_name = NULL;
 	const char *lambda_kind = NULL;
-	enum { ORDINARY, UNIFY, COMPARE, INDEX, LAMBDA } category;
+	enum { ORDINARY, UNIFY, COMPARE, INDEX, LAMBDA, DEFORESTATION }
+		category;
 	enum { COMMON, INFO, LAYOUT, FUNCTORS } data_category;
 
 	/*
@@ -305,12 +312,17 @@
 	module = strip_module_name(&start, end, trailing_context_1);
 
 	/*
-	** look for "IntroducedFrom"
+	** look for "IntroducedFrom" or "DeforestationIn"
 	*/
-	if (category == ORDINARY
-			&& strip_prefix(&start, introduced))
-	{
-		category = LAMBDA;
+	if (category == ORDINARY) {
+		if (strip_prefix(&start, introduced)) {
+			category = LAMBDA;
+		} else if (strip_prefix(&start, deforestation)) {
+			category = DEFORESTATION;
+		}
+	}
+
+	if (category == LAMBDA || category == DEFORESTATION) {
 		if (strip_prefix(&start, pred)) {
 			lambda_kind = "pred";
 		} else if (strip_prefix(&start, func)) {
@@ -359,6 +371,11 @@
 		printf("%s goal (#%d) from '%s' in module '%s' line %d",
 			lambda_kind, lambda_seq_number,
 			lambda_pred_name, module, lambda_line);
+		break;
+	case DEFORESTATION:
+		printf("deforestation procedure (#%d) from '%s' in module '%s' line %d",
+			lambda_seq_number, lambda_pred_name,
+			module, lambda_line);
 		break;
 	default:
 		if (*module == '\0') {



More information about the developers mailing list