[m-dev.] for review: constraint propagation

Simon Taylor stayl at cs.mu.OZ.AU
Wed Feb 23 16:12:03 AEDT 2000



Estimated hours taken: 80

Constraint propagation.

compiler/constraint.m:
	Push constraints left and inwards as much as possible
	within a goal.
	This module has been completely rewritten.

compiler/deforest.m:
	Push constraints within a goal before processing it.

	Make specialized versions for calls with constrained outputs.

	Rerun determinism inference on specialized versions
	when constraint propagation has been run, because the
	determinism can change from nondet to semidet.

	Use the same method as inlining.m to work out whether
	a procedure can be inlined, and avoid attempting optimization
	if any of the procedures involved can't be inlined.

compiler/pd_util.m:
	Add pd_util__propagate_constraints, which uses constraint.m
	to push constraints within a goal.

compiler/pd_term.m:
	Add support for checking termination of the optimization process
	for constraint propagation, which differs from deforestation
	in that the conjunctions selected for optimization don't
	necessarily have a call at both ends.

compiler/pd_debug.m:
	Print some extra information when `--debug-pd' is enabled.

compiler/mercury_compile.m:
	Check whether constraint propagation should be performed when
	working out whether to run the deforestation pass.

compiler/inlining.m:
	Add a predicate inlining__can_inline_proc, which tests
	whether a procedure can be inlined (for example, it doesn't
	have a `no_inline' marker), without applying any heuristics.

compiler/make_hlds.m:
	Add `no_inline' marker to the "recursive" procedures
	introduced for builtins to stop constraint propagation
	attempting to specialize such procedures.

compiler/hlds_pred.m:
	Don't fill in the declared determinism field of the predicates
	introduced by `hlds_pred__define_new_pred', so that rerunning
	determinism inference will compute a more accurate determinism.

compiler/options.m:
	Add documentation for `--constraint-propagation'.

	Add option `--local-constraint-propagation', which makes
	deforestation call constraint.m to move constraints within
	a goal, but does not create specialized versions of procedures
	for which there are calls with constrained outputs.

compiler/handle_options.m:
	`--constraint-propagation' implies `--local-constraint-propagation'.

compiler/notes/compiler_design.html:
	Change the documentation to show that constraint.m is now part
	of the deforestation pass.

NEWS:
w3/news/newsdb.inc:
	Announce the new transformation.

doc/user_guide.texi:
	Document the new options.



Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.163
diff -u -u -r1.163 NEWS
--- NEWS	2000/02/16 08:36:03	1.163
+++ NEWS	2000/02/18 02:01:42
@@ -24,6 +24,16 @@
 * We've generalized the higher-order term syntax a little:
   in `Foo(Args)', we now allow Foo to be any term, not just
   a variable.
+
+Changes to the Mercury implementation:
+
+* We've added a new transformation -- constraint propagation.
+
+  Constraint propagation attempts to transform the code so
+  that goals which can fail are executed as early as possible.
+  It is enabled with the `--constraint-propagation' option
+  (or `--local-constraint-propagation' for a more restricted
+  version of the transformation).
  
 Changes to the standard library:
 
compiler/constraint.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
% File: constraint.m
% Main author: stayl.
%
% The constraint propagation transformation attempts to improve
% the efficiency of a generate-and-test style program by statically
% scheduling constraints as early as possible, where a "constraint"
% is any goal which has no output and can fail.
%
%-----------------------------------------------------------------------------%

:- module constraint.

:- interface.

:- import_module hlds_goal, hlds_module, instmap, prog_data.
:- import_module bool, list, map, std_util.

:- pred constraint__propagate_goal(hlds_goal, list(constraint),
		hlds_goal, constraint_info, constraint_info).
:- mode constraint__propagate_goal(in, in, out, 
		in, out) is det.

:- pred constraint__propagate_conj(list(hlds_goal), list(constraint), 
		list(hlds_goal), constraint_info, constraint_info).
:- mode constraint__propagate_conj(in, in, out,
		in, out) is det.

:- pred constraint_info_init(module_info, map(prog_var, type), prog_varset,
		instmap, constraint_info).
:- mode constraint_info_init(in, in, in, in, out) is det.

:- pred constraint_info_deconstruct(constraint_info, module_info,
		map(prog_var, type), prog_varset, bool).
:- mode constraint_info_deconstruct(in, out, out, out, out) is det.

:- type constraint_info.

	% A constraint is a goal with no outputs which can fail and
	% always terminates, and a list of goals to construct static
	% constants for the constraint. All the goals should have a
	% `constraint' annotation.
:- type constraint == pair(hlds_goal, list(hlds_goal)).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module goal_util, hlds_pred, hlds_module, hlds_data.
:- import_module mode_util, passes_aux, code_aux, inst_match, purity.
:- import_module options, globals.

:- import_module assoc_list, require, set, string, term, varset.

%-----------------------------------------------------------------------------%

constraint__propagate_goal(Goal0, Constraints, Goal) -->
	{ Goal0 = _ - GoalInfo0 },
	
	% 
	% If the goal cannot succeed, prune away the constraints.
	% This is necessary because the goal might not produce some
	% of the inputs to the constraints, so reordering the constraints
	% with the goal may cause compiler aborts later.
	%
	{ goal_info_get_determinism(GoalInfo0, Detism) },
	( { determinism_components(Detism, _, at_most_zero) } ->
		{ Goals = [Goal0] }
	;
		InstMap0 =^ instmap,
		constraint__propagate_goal_2(Goal0, Constraints, Goals),
		^ instmap := InstMap0
	),
	{ Goals = [Goal1] ->
		Goal = Goal1
	;
		goal_list_nonlocals(Goals, NonLocals),
		goal_list_instmap_delta(Goals, Delta),
		goal_list_determinism(Goals, ConjDetism),
		goal_info_init(NonLocals, Delta, ConjDetism, GoalInfo),
		conj_list_to_goal(Goals, GoalInfo, Goal)
	}.

:- pred constraint__propagate_goal_2(hlds_goal, list(constraint),
		list(hlds_goal), constraint_info, constraint_info).
:- mode constraint__propagate_goal_2(in, in, out, in, out) is det.

constraint__propagate_goal_2(conj(Goals0) - Info, Constraints, 
		[conj(Goals) - Info]) -->
	constraint_info_update_changed(Constraints),
	constraint__propagate_conj(Goals0, Constraints, Goals).

constraint__propagate_goal_2(disj(Goals0, SM) - Info, Constraints,
		[disj(Goals, SM) - Info]) -->
	constraint__propagate_disj(Goals0, Constraints, Goals).

constraint__propagate_goal_2(switch(Var, CanFail, Cases0, SM) - Info,
		Constraints, [switch(Var, CanFail, Cases, SM) - Info]) -->
	constraint_info_update_changed(Constraints),
	constraint__propagate_cases(Var, Cases0, Constraints, Cases).
	
constraint__propagate_goal_2(
		if_then_else(Vars, Cond0, Then0, Else0, SM) - Info,
		Constraints, 
		[if_then_else(Vars, Cond, Then, Else, SM) - Info]) -->
	InstMap0 =^ instmap,
	constraint_info_update_changed(Constraints),

	% We can't safely propagate constraints into 
	% the condition of an if-then-else.
	constraint__propagate_goal(Cond0, [], Cond),
	constraint_info_update_goal(Cond),
	constraint__propagate_goal(Then0, Constraints, Then),
	^ instmap := InstMap0,
	constraint__propagate_goal(Else0, Constraints, Else),
	^ instmap := InstMap0.

	% XXX propagate constraints into par_conjs - could be a little tricky.
constraint__propagate_goal_2(par_conj(Goals0, SM) - GoalInfo, Constraints0,
		[par_conj(Goals, SM) - GoalInfo | Constraints]) -->
	% constraint__propagate_disj treats its list of goals as
	% independent rather than specifically disjoint, so we can
	% use it to process a list of independent parallel conjuncts.
	constraint__propagate_disj(Goals0, [], Goals),
	{ constraint__flatten_constraints(Constraints0, Constraints) }.

constraint__propagate_goal_2(some(Vars, CanRemove, Goal0) - GoalInfo,
		Constraints, [some(Vars, CanRemove, Goal) - GoalInfo]) -->
	constraint_info_update_changed(Constraints),
	constraint__propagate_goal(Goal0, Constraints, Goal).

constraint__propagate_goal_2(not(NegGoal0) - GoalInfo, Constraints0,
		[not(NegGoal) - GoalInfo | Constraints]) -->
	% We can't safely propagate constraints into a negation.
	constraint__propagate_goal(NegGoal0, [], NegGoal),
	{ constraint__flatten_constraints(Constraints0, Constraints) }.

constraint__propagate_goal_2(Goal, Constraints0, [Goal | Constraints]) -->
	{ Goal = call(_, _, _, _, _, _) - _ },
	{ constraint__flatten_constraints(Constraints0, Constraints) }.

constraint__propagate_goal_2(Goal, Constraints0, [Goal | Constraints]) -->
	{ Goal = generic_call(_, _, _, _) - _ },
	{ constraint__flatten_constraints(Constraints0, Constraints) }.

constraint__propagate_goal_2(Goal, Constraints0, [Goal | Constraints]) -->
	{ Goal = pragma_c_code(_, _, _, _, _, _, _) - _ },
	{ constraint__flatten_constraints(Constraints0, Constraints) }.

constraint__propagate_goal_2(Goal, _, _) -->
	{ Goal = bi_implication(_, _) - _ },
	{ error("constraint__propagate_goal_2: bi_implication") }.

constraint__propagate_goal_2(Goal, Constraints0, [Goal | Constraints]) -->
	{ Goal = unify(_, _, _, _, _) - _ },
	{ constraint__flatten_constraints(Constraints0, Constraints) }.

%-----------------------------------------------------------------------------%

	% Put the constant constructions in front of the constraint.
:- pred constraint__flatten_constraints(list(constraint)::in,
		list(hlds_goal)::out) is det.

constraint__flatten_constraints(Constraints0, Goals) :-
	list__map(lambda([Constraint::in, Lists::out] is det, (
			Constraint = Goal - Constructs,
			Lists = [Constructs, [Goal]]
	)), Constraints0, GoalLists0),
	list__condense(GoalLists0, GoalLists),
	list__condense(GoalLists, Goals).

%-----------------------------------------------------------------------------%

:- pred constraint__propagate_disj(list(hlds_goal), list(constraint),
		list(hlds_goal), constraint_info, constraint_info).
:- mode constraint__propagate_disj(in, in, out, 
		in, out) is det.

constraint__propagate_disj([], _, []) --> [].
constraint__propagate_disj([Goal0 | Goals0], Constraints, [Goal | Goals]) -->
	InstMap0 =^ instmap,
	constraint__propagate_goal(Goal0, Constraints, Goal),
	^ instmap := InstMap0,
	constraint__propagate_disj(Goals0, Constraints, Goals).

%-----------------------------------------------------------------------------%

:- pred constraint__propagate_cases(prog_var, list(case), list(constraint), 
			list(case), constraint_info, constraint_info).
:- mode constraint__propagate_cases(in, in, in, out,
			in, out) is det.

constraint__propagate_cases(_, [], _, []) --> [].
constraint__propagate_cases(Var, [case(ConsId, Goal0) | Cases0], Constraints,
			[case(ConsId, Goal) | Cases]) -->
	InstMap0 =^ instmap,
	constraint_info_bind_var_to_functor(Var, ConsId),
	constraint__propagate_goal(Goal0, Constraints, Goal),
	^ instmap := InstMap0,
	constraint__propagate_cases(Var, Cases0, Constraints, Cases).

%-----------------------------------------------------------------------------%

	% constraint__propagate_conj detects the constraints in
	% a conjunction and moves them to as early as possible
	% in the list. Some effort is made to keep the constraints
	% in the same order as they are encountered to increase
	% the likelihood of folding recursive calls.

constraint__propagate_conj(Goals0, Constraints, Goals) -->
	InstMap0 =^ instmap,
	ModuleInfo =^ module_info,
	{ constraint__annotate_conj_output_vars(Goals0, ModuleInfo,
		InstMap0, [], RevGoals1) },
	constraint__annotate_conj_constraints(ModuleInfo, RevGoals1, 
		Constraints, [], Goals2),
	constraint__propagate_conj_constraints(Goals2, [], Goals).

	% Annotate each conjunct with the variables it produces.
:- pred constraint__annotate_conj_output_vars(list(hlds_goal), 
		module_info, instmap, annotated_conj, annotated_conj).
:- mode constraint__annotate_conj_output_vars(in, in, in, in, out) is det.

constraint__annotate_conj_output_vars([], _, _, RevGoals, RevGoals).
constraint__annotate_conj_output_vars([Goal | Goals], ModuleInfo, InstMap0, 
		RevGoals0, RevGoals) :-
	Goal = _ - GoalInfo,
	goal_info_get_instmap_delta(GoalInfo, InstMapDelta),

	% XXX this won't work on the alias branch.
	instmap_delta_changed_vars(InstMapDelta, ChangedVars0),
	Bound = lambda([Var::in] is semidet, (
			instmap__lookup_var(InstMap0, Var, InstMapInst),
			instmap_delta_search_var(InstMapDelta, Var, DeltaInst),
			\+ inst_matches_binding(InstMapInst,
				DeltaInst, ModuleInfo)
		)),
	set__to_sorted_list(ChangedVars0, ChangedVars1),
	list__filter(Bound, ChangedVars1, ChangedVars2),
	set__sorted_list_to_set(ChangedVars2, ChangedVars),
	instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
	constraint__annotate_conj_output_vars(Goals, ModuleInfo, InstMap, 
		[Goal - ChangedVars | RevGoals0], RevGoals).

%-----------------------------------------------------------------------------%

	% Conjunction annotated with its output variables.
:- type annotated_conj == assoc_list(hlds_goal, set(prog_var)).

	% Conjunction annotated with constraining goals.
:- type constrained_conj == assoc_list(hlds_goal, list(constraint)).

	% Pass backwards over the conjunction, annotating each conjunct
	% with the constraints that should be pushed into it.
:- pred constraint__annotate_conj_constraints(module_info, annotated_conj,
	list(constraint), constrained_conj, constrained_conj,
	constraint_info, constraint_info).
:- mode constraint__annotate_conj_constraints(in, in, in,
	in, out, in, out) is det.

constraint__annotate_conj_constraints(_, [], Constraints0, Goals0, Goals) -->
	{ constraint__flatten_constraints(Constraints0, Constraints1) },
	{ list__map(lambda([Goal::in, CnstrGoal::out] is det, (
			CnstrGoal = Goal - []
		)), Constraints1, Constraints) },
	{ list__append(Constraints, Goals0, Goals) }.
constraint__annotate_conj_constraints(ModuleInfo, 
		[Goal - OutputVars | RevGoals0], 
		Constraints0, Goals0, Goals) -->
	{ Goal = GoalExpr - GoalInfo },
	(
		% Propagate goals with no output variables which can fail.
		{ goal_info_get_determinism(GoalInfo, Detism) },
		{ Detism = semidet
		; Detism = failure
		% ; Detism = cc_nondet	% ??
		},
		{ set__empty(OutputVars) },

		% Don't propagate goals that can loop. 
		{ code_aux__goal_cannot_loop(ModuleInfo, Goal) }
	->
		{ Goals1 = Goals0 },
		% Put the `constraint' feature on the goal so deforest.m
		% knows to attempt to propagate this goal through calls.
		{ goal_info_add_feature(GoalInfo, constraint, GoalInfo1) },
		{ Constraints1 = [(GoalExpr - GoalInfo1) - [] | Constraints0] }
	;
		%
		% Look for a simple goal which some constraint depends
		% on which can be propagated backwards. This handles
		% cases like X = 2, Y < X. This should only be done for
		% goals which result in no execution at runtime, such
		% as construction of static constants. Currently we only
		% allow constructions of zero arity constants.
		% 
		% Make a renamed copy of the goal, renaming within
		% the constraint as well, so that a copy of the constant
		% doesn't need to be kept on the stack.
		%
		{ Goal = unify(_, _, _, Unify, _) - _ },
		{ Unify = construct(ConstructVar, _, [], _, _, _, _) }
	->
		{ Goals1 = [Goal - [] | Goals0] },
		constraint__add_constant_construction(ConstructVar, Goal,
			Constraints0, Constraints1)
	;	
		% Don't propagate constraints into or past impure goals.
		{ Goal = _ - GoalInfo },
		{ goal_info_is_impure(GoalInfo) }
	->
		{ Constraints1 = [] },
		{ constraint__flatten_constraints(Constraints0,
			ConstraintGoals) },
		{ list__map(add_empty_constraints, [Goal | ConstraintGoals],
			GoalsAndConstraints) },

		{ list__append(GoalsAndConstraints, Goals0, Goals1) }
	;
		% Prune away the constraints after a goal
		% which cannot succeed.
		{ Goal = _ - GoalInfo },
		{ goal_info_get_determinism(GoalInfo, Detism) },
		{ determinism_components(Detism, _, at_most_zero) }
	->
		{ Constraints1 = [] },
		{ Goals1 = [Goal - [] | Goals0] }	
	;
		% Don't move goals which can fail before a goal which
		% can loop if `--fully-strict' is set.
		{ module_info_globals(ModuleInfo, Globals) },
		{ \+ code_aux__goal_cannot_loop(ModuleInfo, Goal) },
		{ globals__lookup_bool_option(Globals, fully_strict, yes) }
	->
		{ constraint__filter_dependent_constraints(OutputVars, 
			Constraints0, [], ConstraintsToAttach,
			[], OtherConstraints) },
		{ constraint__flatten_constraints(OtherConstraints,
			ConstraintGoals) },
		{ list__map(add_empty_constraints, ConstraintGoals,
			GoalsAndConstraints) },
		{ list__append(
			[Goal - ConstraintsToAttach | GoalsAndConstraints],
			Goals0, Goals1) },
		{ Constraints1 = [] }
	;
		{ constraint__filter_dependent_constraints(OutputVars, 
			Constraints0, [], ConstraintsToAttach,
			[], Constraints1) },
		{ Goals1 = [Goal - ConstraintsToAttach | Goals0] }
	),
	constraint__annotate_conj_constraints(ModuleInfo, RevGoals0, 
		Constraints1, Goals1, Goals).

:- pred add_empty_constraints(hlds_goal::in,
		pair(hlds_goal, list(constraint))::out) is det.

add_empty_constraints(Goal, Goal - []).

:- pred constraint__add_constant_construction(prog_var::in, hlds_goal::in,
		list(constraint)::in, list(constraint)::out,
		constraint_info::in, constraint_info::out) is det.

constraint__add_constant_construction(_, _, [], []) --> [].
constraint__add_constant_construction(ConstructVar, Construct0,
		[Constraint0 - Constructs0 | Constraints0],
		[Constraint - Constructs | Constraints]) -->
	(
		{
		Constraint0 = _ - ConstraintInfo,
		goal_info_get_nonlocals(ConstraintInfo, ConstraintNonLocals),
		set__member(ConstructVar, ConstraintNonLocals)
		}
	->
		VarSet0 =^ varset,
		VarTypes0 =^ vartypes,
		{ varset__new_var(VarSet0, NewVar, VarSet) },
		{ map__lookup(VarTypes0, ConstructVar, VarType) },
		{ map__det_insert(VarTypes0, NewVar, VarType, VarTypes) },
		^ varset := VarSet,
		^ vartypes := VarTypes,
		{ map__from_assoc_list([ConstructVar - NewVar], Subn) },
		{ goal_util__rename_vars_in_goal(Construct0,
			Subn, Construct1) },
		{ Construct1 = ConstructExpr - ConstructInfo1 },
		{ goal_info_add_feature(ConstructInfo1,
			constraint, ConstructInfo) },
		{ Constructs = [ConstructExpr - ConstructInfo | Constructs0] },
		{ goal_util__rename_vars_in_goal(Constraint0,
			Subn, Constraint) }
	;
		{ Constraint = Constraint0 },
		{ Constructs = Constructs0 }
	),
	constraint__add_constant_construction(ConstructVar, Construct0,
		Constraints0, Constraints). 

	% Find all constraints which depend on the
	% output variables of the goal.
:- pred constraint__filter_dependent_constraints(set(prog_var),
		list(constraint), list(constraint), list(constraint),
		list(constraint), list(constraint)).
:- mode constraint__filter_dependent_constraints(in, in, 
		in, out, in, out) is det.

constraint__filter_dependent_constraints(_Vars, [], RevToAttach, ToAttach, 
		RevOthers, Others) :-
	list__reverse(RevToAttach, ToAttach),
	list__reverse(RevOthers, Others).
constraint__filter_dependent_constraints(GoalOutputVars, [Constraint | Goals],
		ToAttach0, ToAttach, Others0, Others) :-
	Constraint = Goal - _,
	Goal = _ - GoalInfo,
	goal_info_get_nonlocals(GoalInfo, NonLocals),
	set__intersect(NonLocals, GoalOutputVars, Intersection),
	( set__empty(Intersection) ->
		Others1 = [Constraint | Others0],
		ToAttach1 = ToAttach0
	;
		Others1 = Others0,
		ToAttach1 = [Constraint | ToAttach0]
	),
	constraint__filter_dependent_constraints(GoalOutputVars, Goals, 
		ToAttach1, ToAttach, Others1, Others).
	
%-----------------------------------------------------------------------------%

	% Push the constraints into each conjunct.
:- pred constraint__propagate_conj_constraints(constrained_conj,
		list(hlds_goal), list(hlds_goal),
		constraint_info, constraint_info).
:- mode constraint__propagate_conj_constraints(in, in, out, in, out) is det.

constraint__propagate_conj_constraints([], RevGoals, Goals) --> 
	{ list__reverse(RevGoals, Goals) }.
constraint__propagate_conj_constraints([Goal0 - Constraints | Goals0],
		RevGoals0, RevGoals) -->
	constraint__propagate_goal_2(Goal0, Constraints, GoalList1),
	{ list__reverse(GoalList1, RevGoalList1) },
	{ list__append(RevGoalList1, RevGoals0, RevGoals1) },
	constraint_info_update_goal(Goal0),
	constraint__propagate_conj_constraints(Goals0, RevGoals1, RevGoals).

%-----------------------------------------------------------------------------%

:- type constraint_info
	---> constraint_info(
		module_info :: module_info,
		vartypes :: map(prog_var, type),
		varset :: prog_varset,
		instmap :: instmap,
		changed :: bool			% has anything changed.
	).

constraint_info_init(ModuleInfo, VarTypes, VarSet, InstMap, ConstraintInfo) :-
	ConstraintInfo = constraint_info(ModuleInfo, VarTypes, VarSet,
		InstMap, no).

constraint_info_deconstruct(ConstraintInfo, ModuleInfo,
		VarTypes, VarSet, Changed) :-
	ConstraintInfo = constraint_info(ModuleInfo, VarTypes, VarSet,
		_, Changed).

:- pred constraint_info_update_goal(hlds_goal::in,
		constraint_info::in, constraint_info::out) is det.

constraint_info_update_goal(_ - GoalInfo) -->
	InstMap0 =^ instmap,
	{ goal_info_get_instmap_delta(GoalInfo, InstMapDelta) },
	{ instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap) },
	^ instmap := InstMap.

:- pred constraint_info_bind_var_to_functor(prog_var::in, cons_id::in,
		constraint_info::in, constraint_info::out) is det.

constraint_info_bind_var_to_functor(Var, ConsId) -->
	InstMap0 =^ instmap,
	ModuleInfo0 =^ module_info,
	VarTypes =^ vartypes,
	{ map__lookup(VarTypes, Var, Type) },
	{ instmap__bind_var_to_functor(Var, Type, ConsId, InstMap0, InstMap,
		ModuleInfo0, ModuleInfo) },
	^ instmap := InstMap,
	^ module_info := ModuleInfo.

	% If a non-empty list of constraints is pushed into a sub-goal,
	% quantification, instmap_deltas and determinism need to be
	% recomputed.
:- pred constraint_info_update_changed(list(constraint)::in,
		constraint_info::in, constraint_info::out) is det.

constraint_info_update_changed(Constraints) -->
	( { Constraints = [] } ->
		[]
	;
		^ changed := yes
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.12
diff -u -u -r1.12 deforest.m
--- compiler/deforest.m	1999/10/25 03:48:42	1.12
+++ compiler/deforest.m	2000/02/22 05:38:14
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1999 University of Melbourne.
+% Copyright (C) 1998-2000 University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -7,9 +7,10 @@
 % Main author: stayl.
 %-----------------------------------------------------------------------------%
 %
-% Deforestation.
+% Deforestation and constraint propagation.
 %
-% A start on the documentation for this is in $CVSROOT/papers/deforest.
+% For a description, see Simon Taylor's Honours thesis, which is available
+% from the Mercury web site.
 %
 %-----------------------------------------------------------------------------%
 :- module deforest.
@@ -32,10 +33,10 @@
 :- import_module dependency_graph, hlds_data, det_analysis, globals.
 :- import_module mode_util, goal_util, prog_data, prog_util, purity.
 :- import_module modes, mode_info, unique_modes, options, hlds_out.
-:- import_module quantification, term, varset.
+:- import_module prog_out, quantification.
 
 :- import_module assoc_list, bool, getopt, int, list, map, require.
-:- import_module set, std_util, string.
+:- import_module set, std_util, string, term, varset.
 
 deforestation(ModuleInfo0, ModuleInfo, IO0, IO) :-
 	proc_arg_info_init(ProcArgInfo0),
@@ -67,10 +68,41 @@
 
 	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),
-	pd_info_get_io_state(IO, PdInfo, _).
+	pd_info_get_module_info(ModuleInfo3, PdInfo1, PdInfo2),
+	module_info_clobber_dependency_info(ModuleInfo3, ModuleInfo4),
+	pd_info_get_io_state(IO2, PdInfo2, PdInfo),
+	pd_info_get_versions(VersionIndex, PdInfo, _),
 
+	map__keys(VersionIndex, Versions),
+
+	globals__io_lookup_bool_option(constraint_propagation,
+		Constraints, IO2, IO3),
+	(
+		Constraints = yes,
+		Versions \= []
+	->
+		% We can sometimes improve efficiency by rerunning determinism
+		% inference on the specialized versions after constraint
+		% propagation, because some nondet predicates will have
+		% become semidet.
+		list__foldl(reset_inferred_proc_determinism, Versions,
+			ModuleInfo4, ModuleInfo5),
+		determinism_pass(ModuleInfo5, ModuleInfo, IO3, IO)	
+	;
+		IO = IO3,
+		ModuleInfo = ModuleInfo4
+	).
+
+:- pred reset_inferred_proc_determinism(pred_proc_id::in,
+		module_info::in, module_info::out) is det.
+
+reset_inferred_proc_determinism(PredProcId, ModuleInfo0, ModuleInfo) :-
+	module_info_pred_proc_info(ModuleInfo0, PredProcId,
+		PredInfo, ProcInfo0),
+	proc_info_set_inferred_determinism(ProcInfo0, erroneous, ProcInfo),
+	module_info_set_pred_proc_info(ModuleInfo0, PredProcId,
+		PredInfo, ProcInfo, ModuleInfo).
+
 :- pred proc_arg_info_init(map(pred_proc_id, pd_proc_arg_info)::out) is det.
 
 proc_arg_info_init(ProcArgInfo0) :-
@@ -110,9 +142,15 @@
 		PredInfo0, ProcInfo0) },
 	pd_info_init_unfold_info(proc(PredId, ProcId), PredInfo0, ProcInfo0),
 	{ proc_info_goal(ProcInfo0, Goal0) },
-	deforest__goal(Goal0, Goal1),
+
+	{ Goal0 = _ - GoalInfo0 },
+	{ goal_info_get_nonlocals(GoalInfo0, NonLocals) },
+	pd_util__propagate_constraints(Goal0, [], NonLocals, Goal1),
+
+	pd_debug__output_goal("after constraints\n", Goal1),
+	deforest__goal(Goal1, Goal2),
 	pd_info_get_proc_info(ProcInfo1),
-	{ proc_info_set_goal(ProcInfo1, Goal1, ProcInfo2) },
+	{ proc_info_set_goal(ProcInfo1, Goal2, ProcInfo2) },
 	pd_info_get_changed(Changed),
 
 	( { Changed = yes } ->
@@ -154,7 +192,11 @@
 		pd_info_set_proc_arg_info(ProcArgInfo),
 		pd_info_set_module_info(ModuleInfo6)
 	;
-		[]
+		pd_info_get_module_info(ModuleInfo2),
+		pd_info_get_pred_info(PredInfo),
+		{ module_info_set_pred_proc_info(ModuleInfo2, PredId, ProcId,
+			PredInfo, ProcInfo2, ModuleInfo3) },
+		pd_info_set_module_info(ModuleInfo3)
 	),		
 
 	pd_info_get_module_info(ModuleInfo),
@@ -173,10 +215,23 @@
 	pd_info_get_instmap(InstMap0),
 	deforest__partially_evaluate_conj_goals(Goals0, [], Goals1),
 	pd_info_set_instmap(InstMap0),
-	deforest__compute_goal_infos(Goals1, Goals2),
-	pd_info_set_instmap(InstMap0),
 	{ goal_info_get_nonlocals(Info, NonLocals) },
-	deforest__conj(Goals2, NonLocals, [], Goals),
+	pd_info_lookup_bool_option(deforestation, Deforestation),
+	( { Deforestation = yes } ->
+		deforest__compute_goal_infos(Goals1, Goals2),
+		pd_info_set_instmap(InstMap0),
+		deforest__conj(Goals2, NonLocals, [], Goals3)
+	;
+		{ Goals3 = Goals1 }
+	),
+	pd_info_lookup_bool_option(constraint_propagation, Constraints),
+	pd_info_set_instmap(InstMap0),
+	( { Constraints = yes } ->
+		deforest__propagate_conj_constraints(Goals3,
+			NonLocals, [], Goals)
+	;
+		{ Goals = Goals3 }
+	),
 	pd_info_set_instmap(InstMap0).
 
 	% XXX cannot deforest across parallel_conjunctions!
@@ -213,8 +268,8 @@
 	deforest__goal(Goal0, Goal).
 
 deforest__goal(Goal0, Goal) -->
-	{ Goal0 = call(PredId, ProcId, Args, _, _, Name) - _ },
-	deforest__call(PredId, ProcId, Args, Name, Goal0, Goal).
+	{ Goal0 = call(PredId, ProcId, Args, BuiltinState, _, Name) - _ },
+	deforest__call(PredId, ProcId, Args, BuiltinState, Name, Goal0, Goal).
 	
 deforest__goal(Goal, Goal) -->
 	{ Goal = unify(_, _, _, _, _) - _ }.
@@ -310,9 +365,56 @@
 	).
 
 %-----------------------------------------------------------------------------%
+
+:- pred deforest__propagate_conj_constraints(list(hlds_goal)::in,
+	set(prog_var)::in, list(hlds_goal)::in, list(hlds_goal)::out,
+	pd_info::pd_info_di, pd_info::pd_info_uo) is det.
+
+deforest__propagate_conj_constraints([], _, RevGoals, Goals) --> 
+	{ list__reverse(RevGoals, Goals) }.
+deforest__propagate_conj_constraints([Goal0 | Goals0],
+		NonLocals, RevGoals0, Goals) -->
+	pd_info_get_module_info(ModuleInfo),
+	(
+		% constraint.m ensures that only constraints relevant
+		% to this goal are placed adjacent to it.
+		{ Goal0 = call(PredId, _ProcId, _Args, _, _, SymName) - _ }, 
+		{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+		{ \+ pred_info_is_imported(PredInfo) },
+		{ list__takewhile(lambda([CnstrGoal::in] is semidet, (
+			CnstrGoal = _ - CnstrGoalInfo,
+			goal_info_has_feature(CnstrGoalInfo, constraint)
+		)), Goals0, Constraints, Goals1) },
+		{ Constraints \= [] }
+	->
+		{ prog_out__sym_name_to_string(SymName, SymNameString) },
+		pd_debug__message("propagating constraints into call to %s\n",
+			[s(SymNameString)]),
+		
+		{ deforest__get_sub_conj_nonlocals(NonLocals, RevGoals0, [],
+			Goal0, Constraints, no, [], Goals1, ConjNonLocals) },
+		deforest__call_call(ConjNonLocals, Goal0,
+			Constraints, no, MaybeGoal),
+		( { MaybeGoal = yes(Goal) } ->
+			pd_info_set_rerun_det(yes),
+			pd_info_update_goal(Goal),
+			deforest__propagate_conj_constraints(Goals1,
+				NonLocals, [Goal | RevGoals0], Goals)
+		;
+			pd_info_update_goal(Goal0),
+			deforest__propagate_conj_constraints(Goals0,
+				NonLocals, [Goal0 | RevGoals0], Goals)
+		)
+	;
+		pd_info_update_goal(Goal0),
+		deforest__propagate_conj_constraints(Goals0, NonLocals,
+			[Goal0 | RevGoals0], Goals)
+	).
+
+%-----------------------------------------------------------------------------%
 
-:- type annotated_conj
-	==	assoc_list(hlds_goal, maybe(pd_branch_info(prog_var))).
+:- type annotated_conj ==
+		assoc_list(hlds_goal, maybe(pd_branch_info(prog_var))).
 
 :- pred deforest__conj(annotated_conj::in, set(prog_var)::in,
 		list(hlds_goal)::in, list(hlds_goal)::out,
@@ -480,10 +582,16 @@
 		{ predicate_name(ModuleInfo0, PredId1, PredName1) },
 		{ predicate_name(ModuleInfo0, PredId2, PredName2) },
 		pd_debug__message("deforesting calls to %s and %s\n",
-		[s(PredName1), s(PredName2)]),
-		deforest__call_call(ConjNonLocals, DeforestInfo,
-			Goal, Optimized0),
-		{ Goals = [Goal] }
+			[s(PredName1), s(PredName2)]),
+		deforest__call_call(ConjNonLocals, EarlierGoal, BetweenGoals,
+			yes(LaterGoal), MaybeGoal),
+		{ MaybeGoal = yes(Goal) ->
+			Optimized0 = yes,
+			Goals = [Goal]
+		;
+			Optimized0 = no,
+			Goals = []
+		}
 	;
 		%
 		% If the first goal is branched and the second goal is
@@ -593,6 +701,7 @@
 
 	pd_info_get_module_info(ModuleInfo),
 	pd_info_lookup_option(fully_strict, FullyStrictOp),
+	pd_info_get_pred_info(PredInfo),
 	( 
 		{ DepthLimitOpt = int(MaxDepth) },
 		{ MaxDepth \= -1 }, 	% no depth limit set
@@ -608,13 +717,16 @@
 		% Check whether either of the goals to be
 		% deforested can't be inlined.
 		( 
-			{ EarlierGoal = call(PredId, _, _, _, _, _) - _ }
+			{ EarlierGoal = call(PredId, ProcId, _,
+				BuiltinState, _, _) - _ }
 		;
-			{ LaterGoal = call(PredId, _, _, _, _, _) - _ }
+			{ LaterGoal = call(PredId, ProcId, _,
+				BuiltinState, _, _) - _ }
 		),
-		{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-		{ pred_info_get_markers(PredInfo, Markers) },
-		{ check_marker(Markers, no_inline) }
+		{ module_info_pred_info(ModuleInfo, PredId, CalledPredInfo) },
+		{ pred_info_get_markers(PredInfo, CallingPredMarkers) },
+		{ \+ inlining__can_inline_proc(CalledPredInfo, ProcId,
+			BuiltinState, CallingPredMarkers) }
 	->
 		pd_debug__message("non-inlineable calls\n", []),		
 		{ ShouldTry = no }
@@ -671,7 +783,9 @@
 		\+ { pd_util__reordering_maintains_termination(ModuleInfo,
 			FullyStrict, EarlierGoal, OtherGoal) }
 	->
-		pd_debug__message("interleaving execution could change termination behaviour\n", []),
+		pd_debug__message(
+		"interleaving execution could change termination behaviour\n",
+			[]),
 		{ ShouldTry = no }
 	;
 		{ ShouldTry = yes }
@@ -708,16 +822,45 @@
 %-----------------------------------------------------------------------------%
 
 	% Attempt deforestation on a pair of calls.
-:- pred deforest__call_call(set(prog_var)::in, deforest_info::in, 
-		hlds_goal::out, bool::out,
-		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
+:- pred deforest__call_call(set(prog_var)::in, hlds_goal::in,
+	list(hlds_goal)::in, maybe(hlds_goal)::in, maybe(hlds_goal)::out,
+	pd_info::pd_info_di, pd_info::pd_info_uo) is det.
 
-deforest__call_call(ConjNonLocals, DeforestInfo, Goal, Optimized) -->
-	{ DeforestInfo = deforest_info(EarlierGoal, _, 
-			BetweenGoals, LaterGoal, _, _) },
-
+deforest__call_call(ConjNonLocals, EarlierGoal, BetweenGoals,
+			MaybeLaterGoal, MaybeGoal) -->
+	pd_info_get_module_info(ModuleInfo),
+	pd_info_get_pred_info(PredInfo),
+	(
+		%
+		% Stop now if either call is to a predicate which can't
+		% be inlined. 
+		%
+		{
+			( Goal = EarlierGoal
+			; MaybeLaterGoal = yes(Goal)
+			),
+			Goal = call(PredId, ProcId, _, BuiltinState, _, _) - _,
+			module_info_pred_info(ModuleInfo, PredId,
+				CalledPredInfo),
+			pred_info_get_markers(PredInfo, CallingPredMarkers),
+			\+ inlining__can_inline_proc(CalledPredInfo, ProcId,
+				BuiltinState, CallingPredMarkers)
+		}
+	->
+		{ MaybeGoal = no }
+	;
+		deforest__call_call_2(ConjNonLocals, EarlierGoal,
+			BetweenGoals, MaybeLaterGoal, MaybeGoal)
+	).
+		
+:- pred deforest__call_call_2(set(prog_var)::in, hlds_goal::in,
+	list(hlds_goal)::in, maybe(hlds_goal)::in, maybe(hlds_goal)::out,
+	pd_info::pd_info_di, pd_info::pd_info_uo) is det.
+	
+deforest__call_call_2(ConjNonLocals, EarlierGoal,
+		BetweenGoals, MaybeLaterGoal, MaybeGoal) -->
 	{ deforest__create_conj(EarlierGoal, BetweenGoals, 
-		LaterGoal, ConjNonLocals, FoldGoal) },
+		MaybeLaterGoal, ConjNonLocals, FoldGoal) },
 
 	pd_info__search_version(FoldGoal, MaybeVersion),
 	pd_info_get_parent_versions(Parents),
@@ -741,7 +884,7 @@
 		pd_info_incr_size_delta(SizeDelta),
 		deforest__create_call_goal(VersionPredProcId, 
 			VersionInfo, Renaming, TypeRenaming, Goal),
-		{ Optimized = yes }
+		{ MaybeGoal = yes(Goal) }
 	;
 		pd_info_get_global_term_info(TermInfo0),
 		pd_info_get_parent_versions(ParentVersions0),
@@ -754,18 +897,20 @@
 		pd_info_get_versions(Versions),
 		pd_info_get_instmap(InstMap),
 		{ pd_term__global_check(ModuleInfo, EarlierGoal, BetweenGoals, 
-			LaterGoal, InstMap, Versions, TermInfo0, 
+			MaybeLaterGoal, InstMap, Versions, TermInfo0, 
 			TermInfo, CheckResult) },
 		( 
 			{ CheckResult = ok(ProcPair, Size) },
-			pd_debug__message("global termination check succeeded - creating new version\n", []),
+			pd_debug__message(
+		"global termination check succeeded - creating new version\n",
+				[]),
 			pd_info_set_global_term_info(TermInfo),
 			{ RunModes = no },
 			{ MaybeGeneralised = no },
 			deforest__create_deforest_goal(EarlierGoal, 
-				BetweenGoals, LaterGoal, FoldGoal,
+				BetweenGoals, MaybeLaterGoal, FoldGoal,
 				ConjNonLocals, RunModes, ProcPair, Size,
-				MaybeGeneralised, Goal, Optimized)
+				MaybeGeneralised, MaybeGoal)
 		;
 			{ CheckResult = possible_loop(ProcPair, Size, 
 						CoveringPredProcId) },
@@ -776,14 +921,14 @@
 			% generalisation on the insts then keep 
 			% on going.
 			deforest__try_generalisation(EarlierGoal,
-				BetweenGoals, LaterGoal, FoldGoal,
+				BetweenGoals, MaybeLaterGoal, FoldGoal,
 				ConjNonLocals, ProcPair, Size, 
-				CoveringPredProcId, Goal, Optimized)
+				CoveringPredProcId, MaybeGoal)
 		;
 			{ CheckResult = loop },
-			pd_debug__message("global termination check failed\n", []),
-			{ Goal = LaterGoal },
-			{ Optimized = no }
+			pd_debug__message(
+				"global termination check failed\n", []),
+			{ MaybeGoal = no }
 		),
 		pd_info_set_global_term_info(TermInfo0)
 	).
@@ -793,19 +938,19 @@
 	% Create a new procedure for a conjunction to be deforested, then
 	% recursively process that procedure.
 :- pred deforest__create_deforest_goal(hlds_goal::in, hlds_goals::in, 
-	hlds_goal::in, hlds_goal::in, set(prog_var)::in, bool::in,
-	pair(pred_proc_id)::in, int::in, maybe(pred_proc_id)::in, 
-	hlds_goal::out, bool::out, pd_info::pd_info_di, 
+	maybe(hlds_goal)::in, hlds_goal::in, set(prog_var)::in, bool::in,
+	proc_pair::in, int::in, maybe(pred_proc_id)::in, 
+	maybe(hlds_goal)::out, pd_info::pd_info_di, 
 	pd_info::pd_info_uo) is det.
 
-deforest__create_deforest_goal(EarlierGoal, BetweenGoals, LaterGoal,
+deforest__create_deforest_goal(EarlierGoal, BetweenGoals, MaybeLaterGoal,
 		FoldGoal0, NonLocals, RunModes, ProcPair, Size, 
-		MaybeGeneralised, CallGoal, Optimized) -->
+		MaybeGeneralised, MaybeCallGoal) -->
 	pd_info_get_module_info(ModuleInfo0),
 	pd_info_lookup_option(deforestation_vars_threshold, VarsOpt),
 	(
-		{ EarlierGoal = call(PredId1, ProcId1, Args1, _, _, _) - _ },
-		{ LaterGoal = call(PredId2, ProcId2, _, _, _, _) - _ },
+		{ EarlierGoal = call(PredId1, ProcId1, Args1, BuiltinState,
+					_, _) - _ },
 
 		( 
 				% no threshold set.
@@ -849,9 +994,9 @@
 		pd_debug__message("unfolding first call\n", []),
 
 		deforest__unfold_call(no, no, PredId1, ProcId1, Args1, 
-			EarlierGoal, UnfoldedCall, DidUnfold),
+			BuiltinState, EarlierGoal, UnfoldedCall, DidUnfold),
 		{ deforest__create_conj(UnfoldedCall, BetweenGoals,
-			LaterGoal, NonLocals, DeforestGoal0) },
+			MaybeLaterGoal, NonLocals, DeforestGoal0) },
 		{ set__to_sorted_list(NonLocals, NonLocalsList) },
 
 		( { DidUnfold = yes, RunModes = yes } ->
@@ -896,8 +1041,15 @@
 			{ predicate_name(ModuleInfo, PredId, PredName) },
 			pd_debug__message("\nCreated predicate %s\n", 
 				[s(PredName)]),
-			{ CalledPreds = [proc(PredId1, ProcId1),
-					proc(PredId2, ProcId2)] },
+			{
+				MaybeLaterGoal = yes(
+					call(PredId2, ProcId2, _, _, _, _) - _)
+			->
+				CalledPreds = [proc(PredId1, ProcId1),
+					proc(PredId2, ProcId2)]
+			;
+				CalledPreds = [proc(PredId1, ProcId1)]
+			},
 			pd_info_get_parent_versions(Parents0),
 			
 			pd_info_get_proc_info(ProcInfo1),
@@ -930,11 +1082,11 @@
 				CurrPredId, CurrProcId, ModuleInfo, 
 				IO0, IO) },
 			pd_info_set_io_state(IO),
-			{ Optimized = yes }
+			{ MaybeCallGoal = yes(CallGoal) }
 		;
-			pd_debug__message("Generalisation produced mode errors\n", []),
-			{ CallGoal = LaterGoal },
-			{ Optimized = no }
+			pd_debug__message(
+				"Generalisation produced mode errors\n", []),
+			{ MaybeCallGoal = no }
 		),
 
 		% The varset and vartypes fields were increased when
@@ -945,8 +1097,7 @@
 		pd_info_set_instmap(InstMap0)
 	;
 		pd_debug__message("vars threshold exceeded\n", []),
-		{ Optimized = no },
-		{ CallGoal = LaterGoal }
+		{ MaybeCallGoal = no }
 	).
 		
 %-----------------------------------------------------------------------------%
@@ -1032,14 +1183,19 @@
 	% Combine the two goals to be deforested and the 
 	% goals in between into a conjunction.
 :- pred deforest__create_conj(hlds_goal::in, list(hlds_goal)::in, 
-		hlds_goal::in, set(prog_var)::in, hlds_goal::out) is det.
+	maybe(hlds_goal)::in, set(prog_var)::in, hlds_goal::out) is det.
 
-deforest__create_conj(EarlierGoal, BetweenGoals, LaterGoal, 
+deforest__create_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, 
 			NonLocals, FoldGoal) :-
-	list__append([EarlierGoal | BetweenGoals], [LaterGoal],
-		DeforestConj),
+	( MaybeLaterGoal = yes(LaterGoal) ->
+		list__append([EarlierGoal | BetweenGoals], [LaterGoal],
+			DeforestConj)
+	;
+		DeforestConj = [EarlierGoal | BetweenGoals]
+	),
 	goal_list_determinism(DeforestConj, Detism),
-	goal_list_instmap_delta(DeforestConj, InstMapDelta),
+	goal_list_instmap_delta(DeforestConj, InstMapDelta0),
+	instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
 	goal_info_init(NonLocals, InstMapDelta, Detism, ConjInfo0),
 
 	% Give the conjunction a context so that the generated predicate
@@ -1055,15 +1211,13 @@
 	% termination check to fail and/or the insts of the versions
 	% not to match in an attempt to achieve folding.
 :- pred deforest__try_generalisation(hlds_goal::in, list(hlds_goal)::in,
-		hlds_goal::in, hlds_goal::in, set(prog_var)::in, 
-		pair(pred_proc_id)::in, int::in, 
-		pred_proc_id::in, hlds_goal::out, bool::out,
-		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
-
-deforest__try_generalisation(EarlierGoal, BetweenGoals, LaterGoal, FoldGoal, 
-		ConjNonLocals, ProcPair, Size, 
-		CoveringPredProcId, Goal, Optimized) -->
-
+	maybe(hlds_goal)::in, hlds_goal::in, set(prog_var)::in,
+	proc_pair::in, int::in, pred_proc_id::in, maybe(hlds_goal)::out,
+	pd_info::pd_info_di, pd_info::pd_info_uo) is det.
+
+deforest__try_generalisation(EarlierGoal, BetweenGoals, MaybeLaterGoal,
+		FoldGoal, ConjNonLocals, ProcPair, Size, 
+		CoveringPredProcId, MaybeGoal) -->
 	pd_debug__message("trying generalisation\n", []),
 	pd_info_get_versions(VersionIndex),
 	{ map__lookup(VersionIndex, CoveringPredProcId, Version) },
@@ -1079,8 +1233,8 @@
 	->
 		deforest__do_generalisation(VersionArgs, Renaming,
 			VersionInstMap, EarlierGoal, BetweenGoals, 
-			LaterGoal, FoldGoal, ConjNonLocals, ProcPair,
-			Size, CoveringPredProcId, Goal, Optimized)
+			MaybeLaterGoal, FoldGoal, ConjNonLocals, ProcPair,
+			Size, CoveringPredProcId, MaybeGoal)
 	;
 		% If the earlier goal is a generalisation of another
 		% version, try matching against that. This happens
@@ -1089,30 +1243,29 @@
 		{ proc_info_varset(ProcInfo, VarSet) },
 		{ deforest__match_generalised_version(ModuleInfo,
 			VersionGoal, VersionArgs, VersionArgTypes,
-			EarlierGoal, BetweenGoals, LaterGoal, ConjNonLocals,
-			VarSet, VarTypes, Versions, Renaming) }
+			EarlierGoal, BetweenGoals, MaybeLaterGoal,
+			ConjNonLocals, VarSet, VarTypes, Versions, Renaming) }
 	->
 		pd_debug__message("matched with generalised version\n", []),
 		deforest__do_generalisation(VersionArgs, Renaming,
 			VersionInstMap, EarlierGoal, BetweenGoals, 
-			LaterGoal, FoldGoal, ConjNonLocals, ProcPair, 
-			Size, CoveringPredProcId, Goal, Optimized)
+			MaybeLaterGoal, FoldGoal, ConjNonLocals, ProcPair, 
+			Size, CoveringPredProcId, MaybeGoal)
 	;
 		pd_debug__message("goals don't match\n", []),
-		{ Goal = LaterGoal },
-		{ Optimized = no }
+		{ MaybeGoal = no }
 	).	
 
 :- pred deforest__do_generalisation(list(prog_var)::in,
 		map(prog_var, prog_var)::in, instmap::in, hlds_goal::in,
-		list(hlds_goal)::in, hlds_goal::in, hlds_goal::in,
-		set(prog_var)::in, pair(pred_proc_id)::in, int::in, 
-		pred_proc_id::in, hlds_goal::out, bool::out, 
+		list(hlds_goal)::in, maybe(hlds_goal)::in, hlds_goal::in,
+		set(prog_var)::in, proc_pair::in, int::in, 
+		pred_proc_id::in, maybe(hlds_goal)::out,
 		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
 
 deforest__do_generalisation(VersionArgs, Renaming, VersionInstMap, EarlierGoal, 
-		BetweenGoals, LaterGoal, FoldGoal, ConjNonLocals, 
-		ProcPair, Size, Generalised, Goal, Optimized) -->
+		BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals, 
+		ProcPair, Size, Generalised, MaybeGoal) -->
 	pd_debug__message("goals match, trying MSG\n", []),
 	pd_info_get_module_info(ModuleInfo),
 	pd_info_get_instmap(InstMap0),
@@ -1135,13 +1288,11 @@
 		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)
+			MaybeLaterGoal, FoldGoal, ConjNonLocals, yes, 
+			ProcPair, Size, yes(Generalised), MaybeGoal)
 	;
 		pd_debug__message("MSG failed\n", []),
-		{ Goal = LaterGoal },
-		{ Optimized = no }
+		{ MaybeGoal = no }
 	),
 	pd_info_set_instmap(InstMap0).
 
@@ -1180,12 +1331,12 @@
 	% XXX this only undoes one level of generalisation.
 :- pred deforest__match_generalised_version(module_info::in, 
 		hlds_goal::in, list(prog_var)::in, list(type)::in,
-		hlds_goal::in, list(hlds_goal)::in, hlds_goal::in,
+		hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in,
 		set(prog_var)::in, prog_varset::in, map(prog_var, type)::in, 
 		version_index::in, map(prog_var, prog_var)::out) is semidet.
 
 deforest__match_generalised_version(ModuleInfo, VersionGoal, VersionArgs, 
-		VersionArgTypes, FirstGoal, BetweenGoals, LastGoal, 
+		VersionArgTypes, FirstGoal, BetweenGoals, MaybeLastGoal, 
 		ConjNonLocals, VarSet0, VarTypes0, Versions, Renaming) :-
 
 	FirstGoal = call(FirstPredId, FirstProcId, FirstArgs, _, _, _) - _,
@@ -1250,7 +1401,7 @@
 	NonGeneralFirstGoal = call(NonGeneralisedPredId, 
 		NonGeneralisedProcId, NewArgs, not_builtin, 
 		no, unqualified("")) - GoalInfo,
-	deforest__create_conj(NonGeneralFirstGoal, BetweenGoals, LastGoal, 
+	deforest__create_conj(NonGeneralFirstGoal, BetweenGoals, MaybeLastGoal, 
 		ConjNonLocals, GoalToMatch),
 
 	%
@@ -1277,26 +1428,40 @@
 
 	DeforestInfo = deforest_info(EarlierGoal, _, BetweenGoals, 
 				LaterGoal, _, _),
-
+	assoc_list__keys(AfterGoals0, AfterGoals),
+	deforest__get_sub_conj_nonlocals(NonLocals0, RevBeforeGoals,
+		BeforeIrrelevant, EarlierGoal, BetweenGoals, yes(LaterGoal),
+		AfterIrrelevant, AfterGoals, SubConjNonLocals).
+
+:- pred deforest__get_sub_conj_nonlocals(set(prog_var)::in,
+		list(hlds_goal)::in, list(hlds_goal)::in, hlds_goal::in,
+		list(hlds_goal)::in, maybe(hlds_goal)::in, list(hlds_goal)::in,
+		list(hlds_goal)::in, set(prog_var)::out) is det.
+
+deforest__get_sub_conj_nonlocals(NonLocals0, RevBeforeGoals, BeforeIrrelevant,
+		EarlierGoal, BetweenGoals, MaybeLaterGoal,
+		AfterIrrelevant, AfterGoals, SubConjNonLocals) :-
 	AddGoalNonLocals =
 	    lambda([Goal::in, Vars0::in, Vars::out] is det, (
 		Goal = _ - GoalInfo,
 		goal_info_get_nonlocals(GoalInfo, GoalNonLocals),
 		set__union(Vars0, GoalNonLocals, Vars)
 	    )),
-
 	list__foldl(AddGoalNonLocals, RevBeforeGoals, NonLocals0, NonLocals1),
 	list__foldl(AddGoalNonLocals, BeforeIrrelevant,
 		NonLocals1, NonLocals2),
 	list__foldl(AddGoalNonLocals, AfterIrrelevant, NonLocals2, NonLocals3),
-	assoc_list__keys(AfterGoals0, AfterGoals),
 	list__foldl(AddGoalNonLocals, AfterGoals, NonLocals3, NonLocals),
 
 	set__init(SubConjNonLocals0),
 	list__foldl(AddGoalNonLocals, [EarlierGoal | BetweenGoals], 
 		SubConjNonLocals0, SubConjNonLocals1),
-	call(AddGoalNonLocals, LaterGoal, SubConjNonLocals1, 
-		SubConjNonLocals2),
+	( MaybeLaterGoal = yes(LaterGoal) ->
+		call(AddGoalNonLocals, LaterGoal, SubConjNonLocals1, 
+			SubConjNonLocals2)
+	;
+		SubConjNonLocals2 = SubConjNonLocals1
+	),
 	set__intersect(NonLocals, SubConjNonLocals2, SubConjNonLocals).
 
 %-----------------------------------------------------------------------------%
@@ -1513,10 +1678,10 @@
 %-----------------------------------------------------------------------------%
 
 :- pred deforest__call(pred_id::in, proc_id::in, list(prog_var)::in,
-		sym_name::in, hlds_goal::in, hlds_goal::out, 
+		builtin_state::in, sym_name::in, hlds_goal::in, hlds_goal::out, 
 		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
 
-deforest__call(PredId, ProcId, Args, SymName, Goal0, Goal) -->
+deforest__call(PredId, ProcId, Args, BuiltinState, SymName, Goal0, Goal) -->
 	pd_info_get_proc_arg_info(ProcArgInfos),
 	pd_info_get_module_info(ModuleInfo),
 	pd_info_get_instmap(InstMap),
@@ -1526,10 +1691,12 @@
 	{ goal_info_get_context(GoalInfo0, Context) },
 
 	pd_info_get_local_term_info(LocalTermInfo0),
-	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-	{ pred_info_get_markers(PredInfo, Markers) },
+	{ module_info_pred_info(ModuleInfo, PredId, CalledPredInfo) },
+	pd_info_get_pred_info(PredInfo),
+	{ pred_info_get_markers(PredInfo, CallingPredMarkers) },
 	( 
-		{ \+ check_marker(Markers, no_inline) },
+		{ inlining__can_inline_proc(CalledPredInfo, ProcId,
+			BuiltinState, CallingPredMarkers) },
 		{ map__search(ProcArgInfos, proc(PredId, ProcId), 
 			ProcArgInfo) },
 		{ ProcArgInfo = pd_branch_info(_, LeftArgs, _) },
@@ -1549,7 +1716,7 @@
 				[]),
 			pd_info_set_local_term_info(LocalTermInfo),
 			deforest__unfold_call(yes, yes, PredId, ProcId, 
-				Args, Goal0, Goal1, Optimized),
+				Args, BuiltinState, Goal0, Goal1, Optimized),
 			( { Optimized = yes } ->
 				deforest__goal(Goal1, Goal)
 			;
@@ -1569,16 +1736,24 @@
 	).
 
 :- pred deforest__unfold_call(bool::in, bool::in, pred_id::in, proc_id::in, 
-		list(prog_var)::in, hlds_goal::in, hlds_goal::out, bool::out,
+		list(prog_var)::in, builtin_state::in,
+		hlds_goal::in, hlds_goal::out, bool::out,
 		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
 
 deforest__unfold_call(CheckImprovement, CheckVars, PredId, ProcId, Args, 
-		Goal0, Goal, Optimized) -->
+		BuiltinState, Goal0, Goal, Optimized) -->
 	pd_info_lookup_option(deforestation_vars_threshold, VarsOpt),
 	pd_info_get_proc_info(ProcInfo0),
 	{ proc_info_varset(ProcInfo0, VarSet0) },
 	{ varset__vars(VarSet0, Vars) },
 	{ list__length(Vars, NumVars) },
+
+	pd_info_get_pred_info(PredInfo0),
+	{ pred_info_get_markers(PredInfo0, CallingPredMarkers) },
+
+	pd_info_get_module_info(ModuleInfo0),
+	{ module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
+		CalledPredInfo, CalledProcInfo) },
 	( 
 		%
 		% Check that we haven't already got too many variables.
@@ -1590,12 +1765,10 @@
 		;
 			{ VarsOpt = int(MaxVars) },
 			{ NumVars < MaxVars }
-		)
+		),
+		{ inlining__can_inline_proc(CalledPredInfo, ProcId,
+			BuiltinState, CallingPredMarkers) }
 	->
-		pd_info_get_pred_info(PredInfo0),
-		pd_info_get_module_info(ModuleInfo0),
-		{ module_info_pred_proc_info(ModuleInfo0, 
-			PredId, ProcId, CalledPredInfo, CalledProcInfo) },
 		{ pred_info_typevarset(PredInfo0, TypeVarSet0) },
 		{ pred_info_get_univ_quant_tvars(PredInfo0, UnivQVars) },
 		{ proc_info_vartypes(ProcInfo0, VarTypes0) },
@@ -1607,7 +1780,8 @@
 		{ pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo) },
 		{ proc_info_set_varset(ProcInfo0, VarSet, ProcInfo1) },
 		{ proc_info_set_vartypes(ProcInfo1, VarTypes, ProcInfo2) },
-		{ proc_info_set_typeinfo_varmap(ProcInfo2, TypeInfoVarMap, ProcInfo) },
+		{ proc_info_set_typeinfo_varmap(ProcInfo2,
+			TypeInfoVarMap, ProcInfo) },
 		pd_info_set_pred_info(PredInfo),
 		pd_info_set_proc_info(ProcInfo),
 
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.88
diff -u -u -r1.88 handle_options.m
--- compiler/handle_options.m	2000/01/10 05:26:18	1.88
+++ compiler/handle_options.m	2000/02/08 05:57:27
@@ -432,6 +432,12 @@
 	option_implies(type_specialization, user_guided_type_specialization,
 		bool(yes)),
 
+	% The local constraint propagation transformation (constraint.m)
+	% is a required part of the constraint propagation transformation
+	% performed by deforest.m.
+	option_implies(constraint_propagation, local_constraint_propagation,
+		bool(yes)),
+
 	% --intermod-unused-args implies --intermodule-optimization and
 	% --optimize-unused-args.
 	option_implies(intermod_unused_args, intermodule_optimization,
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.72
diff -u -u -r1.72 hlds_pred.m
--- compiler/hlds_pred.m	2000/02/16 02:15:36	1.72
+++ compiler/hlds_pred.m	2000/02/18 02:01:13
@@ -1279,8 +1279,10 @@
 		TermInfo = no
 	),
 
-	proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, Detism, Goal0,
-		Context, TVarMap, TCVarMap, IsAddressTaken, ProcInfo0),
+	MaybeDeclaredDetism = no,
+	proc_info_create(VarSet, VarTypes, ArgVars, ArgModes,
+		MaybeDeclaredDetism, Detism, Goal0, Context,
+		TVarMap, TCVarMap, IsAddressTaken, ProcInfo0),
 	proc_info_set_maybe_termination_info(ProcInfo0, TermInfo, ProcInfo),
 
 	set__init(Assertions),
@@ -1338,6 +1340,12 @@
 	in, in, in, in, out) is det.
 
 :- pred proc_info_create(prog_varset, vartypes, list(prog_var),
+	list(mode), maybe(determinism), determinism, hlds_goal, prog_context,
+	type_info_varmap, typeclass_info_varmap, is_address_taken, proc_info).
+:- mode proc_info_create(in, in, in, in, in, in, in, in, in, in, in,
+	out) is det.
+
+:- pred proc_info_create(prog_varset, vartypes, list(prog_var),
 	list(mode), determinism, hlds_goal, prog_context,
 	type_info_varmap, typeclass_info_varmap, is_address_taken, proc_info).
 :- mode proc_info_create(in, in, in, in, in, in, in, in, in, in, out) is det.
@@ -1650,13 +1658,20 @@
 
 proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
 		Context, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :-
+	proc_info_create(VarSet, VarTypes, HeadVars, HeadModes,
+		yes(Detism), Detism, Goal, Context, TVarMap, TCVarsMap,
+		IsAddressTaken, ProcInfo).
+
+proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, MaybeDeclaredDetism,
+		Detism, Goal, Context, TVarMap, TCVarsMap, IsAddressTaken,
+		ProcInfo) :-
 	map__init(StackSlots),
 	set__init(Liveness),
 	MaybeHeadLives = no,
 	RLExprn = no,
-	ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
-		MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
-		Liveness, TVarMap, TCVarsMap, eval_normal, no, no, no, 
+	ProcInfo = procedure(MaybeDeclaredDetism, VarSet, VarTypes, HeadVars,
+		HeadModes, MaybeHeadLives, Goal, Context, StackSlots, Detism,
+		yes, [], Liveness, TVarMap, TCVarsMap, eval_normal, no, no, no, 
 		IsAddressTaken, RLExprn).
 
 proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal,
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.84
diff -u -u -r1.84 inlining.m
--- compiler/inlining.m	1999/10/25 03:48:59	1.84
+++ compiler/inlining.m	2000/02/10 02:38:03
@@ -110,8 +110,25 @@
 		tvarset, tvarset, map(tvar, type_info_locn), 
 		map(tvar, type_info_locn), hlds_goal).
 :- mode inlining__do_inline_call(in, in, in, in, in, out, in, out,
-	in, out, in, out, out) is det.
+		in, out, in, out, out) is det.
 
+	% inlining__can_inline_proc(PredInfo, ProcId, BuiltinState,
+	%	CallingPredMarkers).
+	%
+	% Succeed if the called predicate can be inlined into the caller.
+	% Possible reasons for this failing are
+	% - the called predicate is imported
+	% - the called predicate is a builtin
+	% - the called predicate is tabled
+	% - the called predicate has a no_inline marker
+	% - the called predicate is an Aditi procedure and the caller
+	% 	is not (inlining such procedures can cause severe
+	% 	slowdowns by performing joins using backtracking rather
+	% 	than using specialized algorithms in the database.
+:- pred inlining__can_inline_proc(pred_info, proc_id,
+		builtin_state, pred_markers).
+:- mode inlining__can_inline_proc(in, in, in, in) is semidet.
+
 	% inlining__get_type_substitution(CalleeArgTypes, CallerArgTypes,
 	%	HeadTypeParams, CalleeExistQTVars, TypeSubn).
 	%
@@ -733,16 +750,30 @@
 
 inlining__should_inline_proc(PredId, ProcId, BuiltinState, InlinedProcs,
 		CallingPredMarkers, ModuleInfo) :-
+	module_info_pred_info(ModuleInfo, PredId, PredInfo),
+	inlining__can_inline_proc(PredInfo, ProcId, BuiltinState,
+		CallingPredMarkers),
+
+	% OK, we could inline it - but should we?  Apply our heuristic.
+
+	(
+		pred_info_requested_inlining(PredInfo)
+	;
+		set__member(proc(PredId, ProcId), InlinedProcs)
+	).
 
+inlining__can_inline_proc(PredInfo, ProcId,
+		BuiltinState, CallingPredMarkers) :-
 	% don't inline builtins, the code generator will handle them
 
 	BuiltinState = not_builtin,
 
+	pred_info_procedures(PredInfo, Procs),
+	map__lookup(Procs, ProcId, ProcInfo),
+
 	% don't try to inline imported predicates, since we don't
 	% have the code for them.
 
-	module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, 
-		ProcInfo),
 	\+ pred_info_is_imported(PredInfo),
 		% this next line catches the case of locally defined
 		% unification predicates for imported types.
@@ -773,14 +804,6 @@
 	\+ (
 		\+ check_marker(CallingPredMarkers, aditi),
 		check_marker(CalledPredMarkers, aditi)
-	),
-
-	% OK, we could inline it - but should we?  Apply our heuristic.
-
-	(
-		pred_info_requested_inlining(PredInfo)
-	;
-		set__member(proc(PredId, ProcId), InlinedProcs)
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.324
diff -u -u -r1.324 make_hlds.m
--- compiler/make_hlds.m	2000/02/16 07:27:01	1.324
+++ compiler/make_hlds.m	2000/02/18 02:01:16
@@ -2754,7 +2754,18 @@
 	map__init(TCI_VarMap),
 	ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes,
 				HeadVars, ClauseList, TI_VarMap, TCI_VarMap),
-	pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo).
+	pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo1),
+
+		%
+		% It's pointless but harmless to inline these clauses.
+		% The main purpose of the `no_inline' marker is to stop
+		% constraint propagation creating real infinite loops in
+		% the generated code when processing calls to these
+		% predicates.
+		%
+	pred_info_get_markers(PredInfo1, Markers0),
+	add_marker(Markers0, no_inline, Markers),
+	pred_info_set_markers(PredInfo1, Markers, PredInfo).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.148
diff -u -u -r1.148 mercury_compile.m
--- compiler/mercury_compile.m	2000/02/10 04:37:38	1.148
+++ compiler/mercury_compile.m	2000/02/10 04:48:35
@@ -1731,7 +1731,9 @@
 
 mercury_compile__maybe_deforestation(HLDS0, Verbose, Stats, HLDS) -->
 	globals__io_lookup_bool_option(deforestation, Deforest),
-	( { Deforest = yes } ->
+	globals__io_lookup_bool_option(local_constraint_propagation,
+		Constraints),
+	( { Deforest = yes ; Constraints = yes } ->
 		maybe_write_string(Verbose, "% Deforestation...\n"),
 		maybe_flush_output(Verbose),
 		deforestation(HLDS0, HLDS),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.277
diff -u -u -r1.277 options.m
--- compiler/options.m	2000/01/10 00:43:45	1.277
+++ compiler/options.m	2000/02/09 05:23:58
@@ -289,6 +289,7 @@
 		;	common_struct
 		;	common_goal
 		;	constraint_propagation
+		;	local_constraint_propagation
 		;	optimize_unused_args
 		;	intermod_unused_args
 		;	optimize_higher_order
@@ -640,6 +641,7 @@
 		% common_goal is not really an optimization, since
 		% it affects the semantics
 	constraint_propagation	-	bool(no),
+	local_constraint_propagation	-	bool(no),
 	optimize_duplicate_calls -	bool(no),
 	constant_propagation	-	bool(no),
 	excess_assign		-	bool(no),
@@ -989,6 +991,7 @@
 long_option("prev-code",		prev_code).
 long_option("follow-code",		follow_code).
 long_option("constraint-propagation",	constraint_propagation).
+long_option("local-constraint-propagation",	local_constraint_propagation).
 long_option("optimize-unused-args",	optimize_unused_args).
 long_option("optimise-unused-args",	optimize_unused_args).
 long_option("intermod-unused-args",	intermod_unused_args).
@@ -1340,6 +1343,7 @@
 	optimize_unused_args	-	bool(yes),	
 	optimize_higher_order	-	bool(yes),
 	deforestation		-	bool(yes),
+	local_constraint_propagation -	bool(yes),
 	constant_propagation	-	bool(yes),
 	optimize_repeat		-	int(4)
 ]).
@@ -2074,8 +2078,14 @@
 		"\tdetects only common deconstruction unifications.",
 		"\tDisabling this optimization reduces the class of predicates",
 		"\tthat the compiler considers to be deterministic.",
-	% 	"\t--constraint-propagation",
-	% 	"\t\tEnable the C-tranformation.  (Doesn't work.)",
+	 	"--constraint-propagation",
+	 	"\tEnable the constraint propagation transformation,",
+		"\twhich attempts to execute goals which can fail as",
+		"\tearly as possible.",
+	 	"--local-constraint-propagation",
+	 	"\tEnable the constraint propagation transformation,",
+		"\tbut don't create specialized versions of predicates",
+		"\twhen performing the transformation.",
 		"--prev-code",
 		"\tMigrate into the start of branched goals.",
 		"--no-follow-code",
Index: compiler/pd_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_debug.m,v
retrieving revision 1.3
diff -u -u -r1.3 pd_debug.m
--- compiler/pd_debug.m	1999/03/12 06:14:15	1.3
+++ compiler/pd_debug.m	1999/10/11 02:25:11
@@ -47,7 +47,7 @@
 :- implementation.
 
 :- import_module globals, hlds_module, hlds_out, instmap, options.
-:- import_module instmap, prog_out, goal_util.
+:- import_module instmap, prog_out, goal_util, mercury_to_mercury.
 :- import_module bool, io, set, std_util.
 
 pd_debug__do_io(Pred) -->
@@ -103,7 +103,7 @@
 
 pd_debug__output_version(ModuleInfo, PredProcId,
 		Version, WriteUnfoldedGoal) -->
-	{ Version = version_info(Goal - GoalInfo, _, _, _, InstMap, 
+	{ Version = version_info(Goal - GoalInfo, _, Args, _, InstMap, 
 			InitialCost, CostDelta, Parents, _) }, 
 	{ predicate_name(ModuleInfo, PredId, PredName) },
 	io__write_string(PredName),
@@ -127,9 +127,12 @@
 		PredId, ProcId, _, ProcInfo) },
 	{ proc_info_varset(ProcInfo, VarSet) },
 	{ instmap__restrict(InstMap, NonLocals, InstMap1) },
+	io__write_string(" args: "),
+	mercury_output_vars(Args, VarSet, yes),
+	io__nl,
 	hlds_out__write_instmap(InstMap1, VarSet, yes, 1),
 	io__nl,
-	hlds_out__write_goal(Goal - GoalInfo, ModuleInfo, VarSet, no, 1, "\n"),
+	hlds_out__write_goal(Goal - GoalInfo, ModuleInfo, VarSet, yes, 1, "\n"),
 	io__nl,
 	io__write_string("Parents: "),
 	{ set__to_sorted_list(Parents, ParentsList) },
@@ -140,7 +143,7 @@
 		{ proc_info_goal(ProcInfo, ProcGoal) },
 		io__write_string("Unfolded goal\n"),
 		hlds_out__write_goal(ProcGoal, 
-			ModuleInfo, VarSet, no, 1, "\n"),
+			ModuleInfo, VarSet, yes, 1, "\n"),
 		io__nl
 	;
 		[]
Index: compiler/pd_term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_term.m,v
retrieving revision 1.2
diff -u -u -r1.2 pd_term.m
--- compiler/pd_term.m	1998/11/20 04:08:44	1.2
+++ compiler/pd_term.m	1999/09/22 02:45:27
@@ -45,14 +45,20 @@
 	% (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,
+		list(hlds_goal)::in, maybe(hlds_goal)::in,
 		instmap::in, version_index::in, 
 		global_term_info::in, global_term_info::out, 
 		global_check_result::out) is det.
 
+	% A proc_pair holds the pred_proc_ids of the procedures called at
+	% the ends of a conjunction to be deforested.
+	% The maybe(pred_proc_id) is `no' in the case of a predicate
+	% created for constraint propagation.
+:- type proc_pair == pair(pred_proc_id, maybe(pred_proc_id)).
+
 :- type global_check_result
-	--->	ok(pair(pred_proc_id), int)
-	;	possible_loop(pair(pred_proc_id), int, pred_proc_id)
+	--->	ok(proc_pair, int)
+	;	possible_loop(proc_pair, int, pred_proc_id)
 	;	loop.
 
 	% Check whether a call can be unfolded without the
@@ -70,8 +76,8 @@
 	% Update the global termination information when we find
 	% out the pred_proc_id that has been assigned to a version.
 :- pred pd_term__update_global_term_info(global_term_info::in,
-		pair(pred_proc_id)::in, pred_proc_id::in, int::in,
-		global_term_info::out) is det.
+		proc_pair::in, pred_proc_id::in,
+		int::in, global_term_info::out) is det.
 
 :- type global_term_info. 
 :- type local_term_info.
@@ -98,10 +104,10 @@
 	% Map from a pair of procedures at the end of the conjunction
 	% to be deforested and the most recent ancestor with this pair
 	% of goals.
-:- type multiple_covering_goals == map(pair(pred_proc_id), 
-					pair(int, maybe(pred_proc_id))).
+:- type multiple_covering_goals ==
+		map(proc_pair, pair(int, maybe(pred_proc_id))).
 
-		% Mapping from argument to size.
+	% Mapping from argument to size.
 :- type pd_proc_term_info	== 	assoc_list(int, int).
 	
 %-----------------------------------------------------------------------------%
@@ -119,20 +125,27 @@
 
 %-----------------------------------------------------------------------------%
 
-pd_term__global_check(_ModuleInfo, EarlierGoal, BetweenGoals, LaterGoal, 
+pd_term__global_check(_ModuleInfo, EarlierGoal, BetweenGoals, MaybeLaterGoal, 
 		_InstMap, Versions, Info0, Info, Result) :-
 	Info0 = global_term_info(SingleGoalCover0, MultipleGoalCover0),
 	(
 		EarlierGoal = call(PredId1, ProcId1, _, _, _, _) - _,
-		LaterGoal = call(PredId2, ProcId2, _, _, _, _) - _,
 		Hd = lambda([List::in, Head::out] is semidet, 
 			List = [Head | _]),
 		expand_calls(Hd, Versions, proc(PredId1, ProcId1), 
 			FirstPredProcId),
-		expand_calls(list__last, Versions, proc(PredId2, ProcId2), 
-			LastPredProcId)
+		(
+			MaybeLaterGoal = yes(
+				call(PredId2, ProcId2, _, _, _, _) - _),
+			expand_calls(list__last, Versions,
+				proc(PredId2, ProcId2), LastPredProcId),
+			MaybeLastPredProcId = yes(LastPredProcId)
+		;
+			MaybeLaterGoal = no,
+			MaybeLastPredProcId = no
+		)
 	->
-		ProcPair = FirstPredProcId - LastPredProcId,
+		ProcPair = FirstPredProcId - MaybeLastPredProcId,
 		list__length(BetweenGoals, Length),
 		( 
 			map__search(MultipleGoalCover0, ProcPair, 
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.7
diff -u -u -r1.7 pd_util.m
--- compiler/pd_util.m	1999/10/15 03:45:01	1.7
+++ compiler/pd_util.m	2000/02/08 05:57:56
@@ -21,6 +21,10 @@
 :- pred pd_util__goal_get_calls(hlds_goal::in,
 		list(pred_proc_id)::out) is det.
 
+:- pred pd_util__propagate_constraints(hlds_goal::in, list(hlds_goal)::in,
+		set(prog_var)::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.
@@ -128,11 +132,11 @@
 %-----------------------------------------------------------------------------%
 :- implementation.
 
-:- import_module pd_cost, hlds_data, instmap, mode_util.
+:- import_module det_analysis, constraint, pd_cost, hlds_data, instmap.
 :- import_module unused_args, inst_match, (inst), quantification, mode_util.
-:- import_module code_aux, purity, mode_info, unique_modes, term.
-:- import_module type_util, det_util, options, goal_util.
-:- import_module assoc_list, int, require, set.
+:- import_module code_aux, purity, mode_info, unique_modes, pd_debug.
+:- import_module type_util, det_util, det_analysis, options, goal_util.
+:- import_module assoc_list, int, require, set, term.
 
 pd_util__goal_get_calls(Goal0, CalledPreds) :-
 	goal_to_conj_list(Goal0, GoalList),
@@ -144,6 +148,51 @@
 
 %-----------------------------------------------------------------------------%
 
+pd_util__propagate_constraints(Goal0, Constraints, NonLocals, Goal) -->
+	pd_info_lookup_bool_option(local_constraint_propagation,
+		ConstraintProp),
+	( { ConstraintProp = yes } ->
+		pd_debug__message("%% Propagating constraints\n", []),
+		pd_info_get_module_info(ModuleInfo0),
+		pd_info_get_proc_info(ProcInfo0),
+		pd_info_get_instmap(InstMap),
+		{ proc_info_vartypes(ProcInfo0, VarTypes0) },
+		{ proc_info_varset(ProcInfo0, VarSet0) },
+		{ constraint_info_init(ModuleInfo0, VarTypes0,
+			VarSet0, InstMap, CInfo0) },
+		{ goal_to_conj_list(Goal0, Goals0) },
+		{ list__append(Goals0, Constraints, Goals1) },
+		{ constraint__propagate_conj(Goals1, [], Goals,
+			CInfo0, CInfo) },
+		{ goal_list_instmap_delta(Goals, Delta) },
+		{ goal_list_determinism(Goals, Detism) }, 
+		{ goal_info_init(NonLocals, Delta, Detism, GoalInfo) },
+		{ conj_list_to_goal(Goals, GoalInfo, Goal1) },
+		{ constraint_info_deconstruct(CInfo, ModuleInfo,
+			VarTypes, VarSet, Changed) },
+		pd_info_set_module_info(ModuleInfo),
+		{ proc_info_set_vartypes(ProcInfo0, VarTypes, ProcInfo1) },
+		{ proc_info_set_varset(ProcInfo1, VarSet, ProcInfo) },
+		pd_info_set_proc_info(ProcInfo),
+		pd_debug__output_goal("after constraints, before recompute\n",
+			Goal1),	
+		( { Changed = yes } ->
+			pd_util__requantify_goal(Goal1, NonLocals, Goal2),
+			pd_util__recompute_instmap_delta(Goal2, Goal3),
+			pd_util__rerun_det_analysis(Goal3, Goal4),
+		        { module_info_globals(ModuleInfo, Globals) },
+		        { simplify__find_simplifications(no,
+				Globals, Simplifications) },
+			pd_util__simplify_goal(Simplifications, Goal4, Goal)
+		;
+			{ Goal = Goal1 }
+		)
+	;
+		{ Goal = Goal0 }
+	).
+
+%-----------------------------------------------------------------------------%
+
 pd_util__simplify_goal(Simplifications, Goal0, Goal) -->
 	%
 	% Construct a simplify_info.
@@ -265,6 +314,33 @@
 	),
 	pd_util__get_goal_live_vars_2(ModuleInfo, NonLocals, 
 		InstMap, InstMapDelta, Vars1, Vars).
+
+%-----------------------------------------------------------------------------%
+
+:- pred pd_util__rerun_det_analysis(hlds_goal::in, hlds_goal::out,
+		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
+
+pd_util__rerun_det_analysis(Goal0, Goal) -->
+	{ Goal0 = _ - GoalInfo0 },
+
+	{ goal_info_get_determinism(GoalInfo0, Det) },
+	{ det_get_soln_context(Det, SolnContext) },
+
+	% det_infer_goal looks up the proc_info in the module_info
+	% for the vartypes, so we'd better stick them back in the
+	% module_info.
+	pd_info_get_pred_proc_id(proc(PredId, ProcId)),
+	pd_info_get_pred_info(PredInfo),
+	pd_info_get_proc_info(ProcInfo),
+	pd_info_get_module_info(ModuleInfo0),
+	{ module_info_set_pred_proc_info(ModuleInfo0, PredId, ProcId,
+		PredInfo, ProcInfo, ModuleInfo) },
+	pd_info_set_module_info(ModuleInfo),
+
+	{ module_info_globals(ModuleInfo, Globals) },
+	{ det_info_init(ModuleInfo, PredId, ProcId, Globals, DetInfo) },
+	pd_info_get_instmap(InstMap),
+	{ det_infer_goal(Goal0, InstMap, SolnContext, DetInfo, Goal, _, _) }.
 
 %-----------------------------------------------------------------------------%
 
Index: w3/news/newsdb.inc
===================================================================
RCS file: /home/mercury1/repository/w3/news/newsdb.inc,v
retrieving revision 1.44
diff -u -u -r1.44 newsdb.inc
--- w3/news/newsdb.inc	2000/02/22 01:39:45	1.44
+++ w3/news/newsdb.inc	2000/02/23 05:02:53
@@ -21,6 +21,14 @@
 
 $newsdb = array(
 
+"24 Feb 2000" => array("Constraint propagation",
+
+"Constraint propagation is an optimization which transforms
+programs so that goals which can fail are executed earlier.
+The optimization is available in our latest
+<A HREF=\"download/rotd.html\">release of the day</A>."
+),
+
 "21 Feb 2000" => array("New papers",
 
 "Two new papers on Mercury are now available from our
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.44
diff -u -u -r1.44 compiler_design.html
--- compiler/notes/compiler_design.html	2000/01/10 00:43:57	1.44
+++ compiler/notes/compiler_design.html	2000/02/18 04:14:35
@@ -546,9 +546,6 @@
 
 <li> inlining (i.e. unfolding) of simple procedures (inlining.m)
 
-<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
@@ -556,6 +553,9 @@
   deforest.m makes use of the following sub-modules
   (`pd_' stands for "partial deduction"):
   <ul>
+  <li>
+  constraint.m transforms goals so that goals which can fail
+  are executed earlier.
   <li>
   pd_cost.m contains some predicates to estimate the improvement
   caused by deforest.m.
Index: doc/user_guide.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/user_guide.texi,v
retrieving revision 1.200
diff -u -u -r1.200 user_guide.texi
--- doc/user_guide.texi	2000/01/10 00:43:58	1.200
+++ doc/user_guide.texi	2000/02/09 05:28:12
@@ -3745,8 +3745,14 @@
 Disabling this optimization reduces the class of predicates
 that the compiler considers to be deterministic.
 
- at c @item --constraint-propagation
- at c Enable the constraint propagation transformation.
+ at item --constraint-propagation
+Enable the constraint propagation transformation, which attempts
+to execute goals which can fail as early as possible.
+
+ at item --local-constraint-propagation
+Enable the constraint propagation transformation, but do not
+create specialized versions of predicates when performing the
+transformation.
 
 @c @sp 1
 @c @item --prev-code
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmakefile,v
retrieving revision 1.78
diff -u -u -r1.78 Mmakefile
--- tests/hard_coded/Mmakefile	2000/02/17 06:38:21	1.78
+++ tests/hard_coded/Mmakefile	2000/02/18 04:16:10
@@ -19,6 +19,7 @@
 	checked_nondet_tailcall \
 	closure_extension \
 	common_type_cast \
+	constraint \
 	construct \
 	copy_pred \
 	curry \
@@ -120,6 +121,7 @@
 
 MCFLAGS-checked_nondet_tailcall	=	--checked-nondet-tailcalls
 MCFLAGS-bigtest		=	--intermodule-optimization -O3
+MCFLAGS-constraint	=	--constraint-propagation
 MCFLAGS-lp		=	--intermodule-optimization -O3
 MCFLAGS-boyer		=	--infer-all
 MCFLAGS-func_test	=	--infer-all
Index: tests/hard_coded/constraint.exp
===================================================================
RCS file: constraint.exp
diff -N constraint.exp
--- /dev/null	Wed Feb 23 16:05:01 2000
+++ constraint.exp	Fri Feb 18 15:19:18 2000
@@ -0,0 +1 @@
+found
\ No newline at end of file
Index: tests/hard_coded/constraint.m
===================================================================
RCS file: constraint.m
diff -N constraint.m
--- /dev/null	Wed Feb 23 16:05:01 2000
+++ constraint.m	Fri Feb 11 17:09:49 2000
@@ -0,0 +1,39 @@
+% Test constraint propagation.
+:- module constraint.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+
+main -->
+	{ benchmark([1,16,100,15,20], Found) },
+	io__write_string(Found).
+
+:- pred benchmark(list(int), string).
+:- mode benchmark(in, out) is det.
+	% Disable unrolling of the loop.
+:- pragma no_inline(benchmark/2).
+
+benchmark(Data, Out) :-
+	( mymember(X, Data), test(X) ->
+		Out = "found"
+	;
+		Out = "not_found"
+	).
+
+:- pred mymember(int, list(int)).
+:- mode mymember(out, in) is nondet.
+
+mymember(X, [X|_]).
+mymember(X, [_|Xs]) :- mymember(X, Xs).
+
+:- pred test(int).
+:- mode test(in) is semidet.
+
+test(15).
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list