[m-rev.] for review: constraint propagation [2]
Simon Taylor
stayl at cs.mu.OZ.AU
Thu Aug 2 22:51:40 AEST 2001
Estimated hours taken: 85
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.
compiler/pd_util.m:
Add pd_util__propagate_constraints, which uses constraint.m
to push constraints within a goal.
Add some documentation for the exported predicates.
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/make_hlds.m:
Add `no_inline' markers 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:
Announce the new transformation.
doc/user_guide.texi:
Document the new options.
tests/hard_coded/Mmakefile:
tests/hard_coded/constraint.{m,exp}:
tests/hard_coded/constraint_order.{m,exp}:
Test cases.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.213
diff -u -u -r1.213 NEWS
--- NEWS 2001/06/27 05:03:57 1.213
+++ NEWS 2001/08/02 08:39:47
@@ -52,6 +52,14 @@
This change will break some existing programs, but that is easily fixed
by adding any necessary `:- import_module' or `:- use_module' declarations.
+* We've added a new optimization pass -- 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).
+
* The `--convert-to-goedel' option has been removed.
It never really worked anyway.
Index: compiler/constraint.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 2001 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, map.
:- type constraint_info.
% constraint__propagate_constraints_in_goal pushes constraints
% left and inward within a single goal. Specialized versions of
% procedures which are called with constrained outputs are created
% by deforest.m.
:- pred constraint__propagate_constraints_in_goal(hlds_goal, hlds_goal,
constraint_info, constraint_info).
:- mode constraint__propagate_constraints_in_goal(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.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- 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, list, require, set, std_util.
:- import_module string, term, varset.
%-----------------------------------------------------------------------------%
constraint__propagate_constraints_in_goal(Goal0, Goal) -->
% We need to strip off any existing constraint markers first.
% Constraint markers are meant to indicate where a constraint
% is meant to be attached to a call, and that deforest.m should
% consider creating a specialized version for the call.
% If deforest.m rearranges the goal, the constraints may
% not remain next to the call.
{ Goal1 = strip_constraint_markers(Goal0) },
constraint__propagate_goal(Goal1, [], Goal).
:- 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.
constraint__propagate_goal(Goal0, Constraints, Goal) -->
% We need to treat all single goals as conjunctions so that
% constraint__propagate_conj can move the constraints to the
% left of the goal if that is allowed.
{ goal_to_conj_list(Goal0, Goals0) },
constraint__propagate_conj(Goals0, Constraints, Goals),
{ 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_conj_sub_goal(hlds_goal, list(constraint),
hlds_goals, constraint_info, constraint_info).
:- mode constraint__propagate_conj_sub_goal(in, in, out,
in, out) is det.
constraint__propagate_conj_sub_goal(Goal0, Constraints, Goals) -->
{ Goal0 = GoalExpr0 - _ },
( { goal_is_atomic(GoalExpr0) } ->
[]
;
% If a non-empty list of constraints is pushed into a sub-goal,
% quantification, instmap_deltas and determinism need to be
% recomputed.
constraint_info_update_changed(Constraints)
),
InstMap0 =^ instmap,
constraint__propagate_conj_sub_goal_2(Goal0, Constraints, Goals),
^ instmap := InstMap0.
:- pred constraint__propagate_conj_sub_goal_2(hlds_goal, list(constraint),
list(hlds_goal), constraint_info, constraint_info).
:- mode constraint__propagate_conj_sub_goal_2(in, in, out, in, out) is det.
constraint__propagate_conj_sub_goal_2(conj(Goals0) - Info, Constraints,
[conj(Goals) - Info]) -->
constraint__propagate_conj(Goals0, Constraints, Goals).
constraint__propagate_conj_sub_goal_2(disj(Goals0, SM) - Info, Constraints,
[disj(Goals, SM) - Info]) -->
constraint__propagate_disj(Goals0, Constraints, Goals).
constraint__propagate_conj_sub_goal_2(switch(Var, CanFail, Cases0, SM) - Info,
Constraints, [switch(Var, CanFail, Cases, SM) - Info]) -->
constraint__propagate_cases(Var, Cases0, Constraints, Cases).
constraint__propagate_conj_sub_goal_2(
if_then_else(Vars, Cond0, Then0, Else0, SM) - Info,
Constraints,
[if_then_else(Vars, Cond, Then, Else, SM) - Info]) -->
InstMap0 =^ instmap,
% We can't safely propagate constraints into
% the condition of an if-then-else, because that
% would change the answers generated by the procedure.
constraint__propagate_goal(Cond0, [], Cond),
constraint_info_update_goal(Cond),
constraint__propagate_goal(Then0, Constraints, Then),
^ instmap := InstMap0,
constraint__propagate_goal(Else0, Constraints, Else).
% XXX propagate constraints into par_conjs -- this isn't
% possible at the moment because par_conj goals must have
% determinism det.
constraint__propagate_conj_sub_goal_2(par_conj(Goals0, SM) - GoalInfo,
Constraints0,
[par_conj(Goals, SM) - GoalInfo | Constraints]) -->
% Propagate constraints within the goals of the conjunction.
% 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_conj_sub_goal_2(some(Vars, CanRemove, Goal0) - GoalInfo,
Constraints, [some(Vars, CanRemove, Goal) - GoalInfo]) -->
constraint__propagate_goal(Goal0, Constraints, Goal).
constraint__propagate_conj_sub_goal_2(not(NegGoal0) - GoalInfo, Constraints0,
[not(NegGoal) - GoalInfo | Constraints]) -->
% We can't safely propagate constraints into a negation,
% because that would change the answers computed by the
% procedure.
constraint__propagate_goal(NegGoal0, [], NegGoal),
{ constraint__flatten_constraints(Constraints0, Constraints) }.
constraint__propagate_conj_sub_goal_2(Goal, Constraints0,
[Goal | Constraints]) -->
% constraint__propagate_conj will move the constraints
% to the left of the call if that is possible, so nothing
% needs to be done here.
{ Goal = call(_, _, _, _, _, _) - _ },
{ constraint__flatten_constraints(Constraints0, Constraints) }.
constraint__propagate_conj_sub_goal_2(Goal, Constraints0,
[Goal | Constraints]) -->
{ Goal = generic_call(_, _, _, _) - _ },
{ constraint__flatten_constraints(Constraints0, Constraints) }.
constraint__propagate_conj_sub_goal_2(Goal, Constraints0,
[Goal | Constraints]) -->
{ Goal = foreign_proc(_, _, _, _, _, _, _) - _ },
{ constraint__flatten_constraints(Constraints0, Constraints) }.
constraint__propagate_conj_sub_goal_2(Goal, _, _) -->
{ Goal = shorthand(_) - _ },
{ error("constraint__propagate_conj_sub_goal_2: shorthand") }.
constraint__propagate_conj_sub_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 = 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.
:- 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.
constraint__propagate_conj(Goals0, Constraints, Goals) -->
( { Goals0 = [] } ->
{ constraint__flatten_constraints(Constraints, Goals) }
; { Goals0 = [Goal0], Constraints = [] } ->
constraint__propagate_conj_sub_goal(Goal0, [], Goals)
;
constraint_info_update_changed(Constraints),
InstMap0 =^ instmap,
ModuleInfo =^ module_info,
VarTypes =^ vartypes,
{ constraint__annotate_conj_output_vars(Goals0, ModuleInfo,
VarTypes, 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,
vartypes, instmap, annotated_conj, annotated_conj).
:- mode constraint__annotate_conj_output_vars(in, in, in, in, in, out) is det.
constraint__annotate_conj_output_vars([], _, _, _, RevGoals, RevGoals).
constraint__annotate_conj_output_vars([Goal | Goals], ModuleInfo, VarTypes,
InstMap0, RevGoals0, RevGoals) :-
Goal = _ - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
instmap_changed_vars(InstMap0, InstMap, VarTypes,
ModuleInfo, ChangedVars),
% Restrict the set of changed variables down to the set
% for which the new inst is not an acceptable subsitute
% for the old. This is done to allow reordering of a goal which
% uses a variable with inst `ground(shared, no)' with
% a constraint which just adds information, changing the inst
% to `bound(shared, ...)'.
InCompatible = (pred(Var::in) is semidet :-
instmap__lookup_var(InstMap0, Var, InstBefore),
instmap_delta_search_var(InstMapDelta, Var, InstAfter),
\+ inst_matches_initial(InstAfter, InstBefore,
map__lookup(VarTypes, Var), ModuleInfo)
),
IncompatibleInstVars = set__filter(InCompatible, ChangedVars),
Bound = (pred(Var::in) is semidet :-
instmap__lookup_var(InstMap0, Var, InstBefore),
instmap_delta_search_var(InstMapDelta, Var, InstAfter),
\+ inst_matches_binding(InstAfter, InstBefore,
map__lookup(VarTypes, Var), ModuleInfo)
),
BoundVars = set__filter(Bound, ChangedVars),
AnnotatedConjunct = annotated_conjunct(Goal, ChangedVars, BoundVars,
IncompatibleInstVars),
constraint__annotate_conj_output_vars(Goals, ModuleInfo, VarTypes,
InstMap, [AnnotatedConjunct | RevGoals0], RevGoals).
%-----------------------------------------------------------------------------%
% Conjunction annotated with the variables each conjunct
% changes the instantiatedness of.
:- type annotated_conj == list(annotated_conjunct).
:- type annotated_conjunct
---> annotated_conjunct(
hlds_goal,
% All variables returned by instmap_changed_vars.
set(prog_var),
% All variables returned by instmap_changed_vars for
% which inst_matches_binding(NewInst, OldInst) fails.
set(prog_var),
% Variables returned by instmap_changed_vars
% for which the new inst cannot be substituted
% for the old as an input to a goal
% (inst_matches_initial(NewInst, OldInst) fails).
set(prog_var)
).
% A constraint is a goal with no outputs which can fail and
% always terminates.
:- type constraint
---> constraint(
% The constraint itself.
hlds_goal,
% All variables returned by instmap_changed_vars.
set(prog_var),
% Variables returned by instmap_changed_vars
% for which the new inst cannot be substituted
% for the old as an input to a goal
% (inst_matches_initial(NewInst, OldInst) fails).
set(prog_var),
% Goals to construct constants used by the constraint.
% (as in X = 2, Y < X). These need to be propagated
% with the constraint.
list(hlds_goal)
).
% 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,
[Conjunct | RevConjuncts0],
Constraints0, Goals0, Goals) -->
{ Goal = GoalExpr - GoalInfo },
{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
{ Conjunct = annotated_conjunct(Goal, ChangedVars,
OutputVars, IncompatibleInstVars) },
(
% Propagate goals with no output variables which can fail.
% Propagating cc_nondet goals would be tricky, because we
% would need to be careful about reordering the constraints
% (the cc_nondet goal can't be moved before any goals
% which can fail).
%
{ goal_info_get_determinism(GoalInfo, Detism) },
{ Detism = semidet
; Detism = failure
},
{ set__empty(OutputVars) },
% Don't propagate impure goals.
{ goal_info_is_pure(GoalInfo) },
% Don't propagate goals that can loop.
{ code_aux__goal_cannot_loop(ModuleInfo, Goal) }
->
% It's a constraint, add it to the list of constraints
% to be attached to goals earlier in the conjunction.
{ Goals1 = Goals0 },
{ Constraint = constraint(GoalExpr - GoalInfo,
ChangedVars, IncompatibleInstVars, []) },
{ Constraints1 = [Constraint | 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)
;
% Prune away the constraints after a goal
% which cannot succeed -- they can never be
% executed.
{ goal_info_get_determinism(GoalInfo, Detism) },
{ determinism_components(Detism, _, at_most_zero) }
->
{ Constraints1 = [] },
{ Goals1 = [Goal - [] | Goals0] }
;
% 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) }
;
% Don't move goals which can fail before a goal which
% can loop if `--fully-strict' is set.
{ \+ code_aux__goal_cannot_loop(ModuleInfo, Goal) },
{ module_info_globals(ModuleInfo, Globals) },
{ globals__lookup_bool_option(Globals, fully_strict, yes) }
->
{ constraint__filter_dependent_constraints(NonLocals,
ChangedVars, Constraints0, [], ConstraintsToAttach,
[], OtherConstraints) },
{ constraint__flatten_constraints(OtherConstraints,
ConstraintGoals) },
{ list__map(add_empty_constraints, ConstraintGoals,
GoalsAndConstraints) },
{ Goals1 =
[attach_constraints(Goal, ConstraintsToAttach)
| GoalsAndConstraints]
++ Goals0 },
{ Constraints1 = [] }
;
{ constraint__filter_dependent_constraints(NonLocals,
OutputVars, Constraints0, [], ConstraintsToAttach,
[], Constraints1) },
{ Goals1 = [attach_constraints(Goal, ConstraintsToAttach)
| Goals0] }
),
constraint__annotate_conj_constraints(ModuleInfo, RevConjuncts0,
Constraints1, Goals1, Goals).
:- pred add_empty_constraints(hlds_goal::in,
pair(hlds_goal, list(constraint))::out) is det.
add_empty_constraints(Goal, Goal - []).
:- func attach_constraints(hlds_goal, list(constraint)) =
pair(hlds_goal, list(constraint)).
attach_constraints(Goal, Constraints0) = Goal - Constraints :-
( Goal = call(_, _, _, _, _, _) - _ ->
Constraints = list__map(
(func(constraint(Goal0, B, C, Constructs0)) =
constraint(add_constraint_feature(Goal0), B, C,
list__map(add_constraint_feature, Constructs0))
), Constraints0)
;
Constraints = Constraints0
).
:- func add_constraint_feature(hlds_goal) = hlds_goal.
add_constraint_feature(Goal - GoalInfo0) = Goal - GoalInfo :-
goal_info_add_feature(GoalInfo0, constraint, GoalInfo).
%-----------------------------------------------------------------------------%
:- 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 | Constraints0],
[Constraint | Constraints]) -->
{ Constraint0 = constraint(ConstraintGoal0, ChangedVars,
IncompatibleInstVars, Constructs0) },
(
{ ConstraintGoal0 = _ - 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, Construct) },
{ Constructs = [Construct | Constructs0] },
{ goal_util__rename_vars_in_goal(ConstraintGoal0,
Subn, ConstraintGoal) },
{ Constraint = constraint(ConstraintGoal, ChangedVars,
IncompatibleInstVars, Constructs) }
;
{ Constraint = Constraint0 }
),
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), set(prog_var),
list(constraint), list(constraint), list(constraint),
list(constraint), list(constraint)).
:- mode constraint__filter_dependent_constraints(in, in, in,
in, out, in, out) is det.
constraint__filter_dependent_constraints(_NonLocals, _Vars, [],
RevToAttach, ToAttach, RevOthers, Others) :-
list__reverse(RevToAttach, ToAttach),
list__reverse(RevOthers, Others).
constraint__filter_dependent_constraints(NonLocals, GoalOutputVars,
[Constraint | Goals], ToAttach0, ToAttach, Others0, Others) :-
Constraint = constraint(ConstraintGoal, _, IncompatibleInstVars, _),
ConstraintGoal = _ - ConstraintGoalInfo,
goal_info_get_nonlocals(ConstraintGoalInfo, ConstraintNonLocals),
set__intersect(ConstraintNonLocals, GoalOutputVars,
OutputVarsUsedByConstraint),
% Don't reorder a constraint which changes the inst of
% a variable in such a way that the new inst is incompatible
% with the old inst (e.g. by losing uniqueness),
% with any goal which has that variable in its non-locals set.
%
% Don't reorder a constraint with another constraint which
% changes the instantiatedness of one of its input variables.
set__intersect(NonLocals, IncompatibleInstVars,
IncompatibleInstVarsUsedByGoal),
(
(
set__empty(OutputVarsUsedByConstraint),
set__empty(IncompatibleInstVarsUsedByGoal)
;
list__member(EarlierConstraint, ToAttach0),
EarlierConstraint = constraint(_,
EarlierChangedVars, _, _),
set__intersect(EarlierChangedVars, ConstraintNonLocals,
EarlierConstraintIntersection),
\+ set__empty(EarlierConstraintIntersection)
)
->
Others1 = [Constraint | Others0],
ToAttach1 = ToAttach0
;
Others1 = Others0,
ToAttach1 = [Constraint | ToAttach0]
),
constraint__filter_dependent_constraints(NonLocals, 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_conj_sub_goal(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
).
%-----------------------------------------------------------------------------%
% Remove all `constraint' goal features from the goal_infos
% of all sub-goals of the given goal.
:- func strip_constraint_markers(hlds_goal) = hlds_goal.
strip_constraint_markers(Goal - GoalInfo0) =
strip_constraint_markers_expr(Goal) - GoalInfo :-
( goal_info_has_feature(GoalInfo0, constraint) ->
goal_info_remove_feature(GoalInfo0, constraint, GoalInfo)
;
GoalInfo = GoalInfo0
).
:- func strip_constraint_markers_expr(hlds_goal_expr) = hlds_goal_expr.
strip_constraint_markers_expr(conj(Goals)) =
conj(list__map(strip_constraint_markers, Goals)).
strip_constraint_markers_expr(disj(Goals, SM)) =
disj(list__map(strip_constraint_markers, Goals), SM).
strip_constraint_markers_expr(switch(Var, CanFail, Cases0, SM)) =
switch(Var, CanFail, Cases, SM) :-
Cases = list__map(
(func(case(ConsId, Goal)) =
case(ConsId, strip_constraint_markers(Goal))
), Cases0).
strip_constraint_markers_expr(not(Goal)) =
not(strip_constraint_markers(Goal)).
strip_constraint_markers_expr(some(Vars, Remove, Goal)) =
some(Vars, Remove, strip_constraint_markers(Goal)).
strip_constraint_markers_expr(if_then_else(Vars, If, Then, Else, SM)) =
if_then_else(Vars, strip_constraint_markers(If),
strip_constraint_markers(Then),
strip_constraint_markers(Else), SM).
strip_constraint_markers_expr(par_conj(Goals, SM)) =
par_conj(list__map(strip_constraint_markers, Goals), SM).
strip_constraint_markers_expr(Goal) = Goal :-
Goal = foreign_proc(_, _, _, _, _, _, _).
strip_constraint_markers_expr(Goal) = Goal :-
Goal = generic_call(_, _, _, _).
strip_constraint_markers_expr(Goal) = Goal :-
Goal = call(_, _, _, _, _, _).
strip_constraint_markers_expr(Goal) = Goal :-
Goal = unify(_, _, _, _, _).
strip_constraint_markers_expr(Goal) = Goal :-
Goal = shorthand(_).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.23
diff -u -u -r1.23 deforest.m
--- compiler/deforest.m 2001/07/30 18:58:32 1.23
+++ compiler/deforest.m 2001/07/31 07:57:49
@@ -19,6 +19,10 @@
% goal in the called procedure is a switch and the functor of the
% switched-on variable is known. This allows simplify.m to prune away
% the failing branches.
+%
+% The constraint propagation pass, which is called from the deforestation
+% pass, transforms the code so that goals which could fail are executed as
+% early as possible.
%
% For a more detailed description, see Simon Taylor's Honours thesis,
% available from
@@ -45,10 +49,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),
@@ -80,10 +84,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) :-
@@ -130,21 +165,25 @@
pd_info_set_io_state(IOState),
{ simplify__find_simplifications(no, Globals, Simplifications) },
pd_util__simplify_goal(Simplifications, Goal0, Goal1),
+
+ pd_util__propagate_constraints(Goal1, Goal2),
- deforest__goal(Goal1, Goal2),
+ pd_debug__output_goal("after constraints\n", Goal2),
+ deforest__goal(Goal2, Goal3),
+
pd_info_get_proc_info(ProcInfo1),
- { proc_info_set_goal(ProcInfo1, Goal2, ProcInfo2) },
+ { proc_info_set_goal(ProcInfo1, Goal3, ProcInfo2) },
pd_info_get_changed(Changed),
( { Changed = yes } ->
pd_info_get_module_info(ModuleInfo2),
{ requantify_proc(ProcInfo2, ProcInfo3) },
- { proc_info_goal(ProcInfo3, Goal3) },
+ { proc_info_goal(ProcInfo3, Goal4) },
{ proc_info_get_initial_instmap(ProcInfo3,
ModuleInfo2, InstMap0) },
{ proc_info_vartypes(ProcInfo3, VarTypes) },
{ proc_info_inst_varset(ProcInfo3, InstVarSet) },
- { recompute_instmap_delta(yes, Goal3, Goal, VarTypes,
+ { recompute_instmap_delta(yes, Goal4, Goal, VarTypes,
InstVarSet, InstMap0, ModuleInfo2, ModuleInfo3) },
pd_info_set_module_info(ModuleInfo3),
@@ -173,7 +212,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),
@@ -192,10 +235,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!
@@ -329,9 +385,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,
@@ -499,10 +602,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
@@ -602,19 +711,9 @@
bool::out, pd_info::pd_info_di, pd_info::pd_info_uo) is det.
deforest__should_try_deforestation(DeforestInfo, ShouldTry) -->
-
{ DeforestInfo = deforest_info(EarlierGoal, EarlierBranchInfo,
BetweenGoals, LaterGoal, _, _) },
- pd_info_lookup_option(deforestation_depth_limit, DepthLimitOpt),
- pd_info_get_depth(Depth0),
- { Depth is Depth0 + 1 },
- pd_info_set_depth(Depth),
-
- pd_info_get_module_info(ModuleInfo),
- pd_info_lookup_option(fully_strict, FullyStrictOp),
- pd_info_get_pred_info(PredInfo),
pd_info_get_useless_versions(UselessVersions),
- pd_info_lookup_option(deforestation_size_threshold, SizeLimitOpt),
(
{ EarlierGoal = call(PredId1, ProcId1, _, _, _, _) - _ },
{ LaterGoal = call(PredId2, ProcId2, _, _, _, _) - _ },
@@ -625,6 +724,42 @@
[]),
{ ShouldTry = no }
;
+ %
+ % If some later goal depends on a variable such as an io__state
+ % for which the construction cannot be reversed, recursive
+ % folding will be impossible, so give up on the optimization.
+ %
+ { EarlierBranchInfo = pd_branch_info(_, _, OpaqueVars) },
+ { list__member(OpaqueGoal, BetweenGoals)
+ ; OpaqueGoal = LaterGoal
+ },
+ { OpaqueGoal = _ - OpaqueGoalInfo },
+ { goal_info_get_nonlocals(OpaqueGoalInfo, OpaqueNonLocals) },
+ { set__intersect(OpaqueNonLocals, OpaqueVars,
+ UsedOpaqueVars) },
+ \+ { set__empty(UsedOpaqueVars) }
+ ->
+ pd_debug__message("later goals depend on opaque vars\n", []),
+ { ShouldTry = no }
+ ;
+ { ShouldTry = yes }
+ ).
+
+:- pred deforest__can_optimize_conj(hlds_goal::in, list(hlds_goal)::in,
+ maybe(hlds_goal)::in, bool::out,
+ pd_info::pd_info_di, pd_info::pd_info_uo) is det.
+
+deforest__can_optimize_conj(EarlierGoal, BetweenGoals,
+ MaybeLaterGoal, ShouldTry) -->
+ pd_info_get_pred_info(PredInfo),
+ pd_info_lookup_option(deforestation_depth_limit, DepthLimitOpt),
+ pd_info_get_depth(Depth0),
+ { Depth is Depth0 + 1 },
+ pd_info_set_depth(Depth),
+ pd_info_lookup_option(deforestation_size_threshold, SizeLimitOpt),
+ pd_info_get_module_info(ModuleInfo),
+ pd_info_lookup_option(fully_strict, FullyStrictOp),
+ (
{ DepthLimitOpt = int(MaxDepth) },
{ MaxDepth \= -1 }, % no depth limit set
{ Depth0 >= MaxDepth }
@@ -646,7 +781,7 @@
{ SizeLimitOpt = int(SizeLimit) },
{ SizeLimit \= -1 },
{ EarlierGoal = call(PredId, ProcId, _, _, _, _) - _
- ; LaterGoal = call(PredId, ProcId, _, _, _, _) - _
+ ; MaybeLaterGoal = yes(call(PredId, ProcId, _, _, _, _) - _)
},
{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
_, CalledProcInfo) },
@@ -661,7 +796,8 @@
% Check whether either of the goals to be
% deforested can't be inlined.
{ EarlierGoal = call(PredId, ProcId, _, BuiltinState, _, _) - _
- ; LaterGoal = call(PredId, ProcId, _, BuiltinState, _, _) - _
+ ; MaybeLaterGoal = yes(
+ call(PredId, ProcId, _, BuiltinState, _, _) - _)
},
% We don't attempt to deforest predicates which are
@@ -674,30 +810,11 @@
{ pred_info_get_markers(PredInfo, CallerMarkers) },
{ \+ inlining__can_inline_proc(PredId, ProcId, BuiltinState,
InlinePromisedPure, CallerMarkers, ModuleInfo) }
-
->
pd_debug__message("non-inlineable calls\n", []),
{ ShouldTry = no }
;
%
- % If some later goal depends on a variable such as an io__state
- % for which the construction cannot be reversed, recursive
- % folding will be impossible, so give up on the optimization.
- %
- { EarlierBranchInfo = pd_branch_info(_, _, OpaqueVars) },
- { list__member(OpaqueGoal, BetweenGoals)
- ; OpaqueGoal = LaterGoal
- },
- { OpaqueGoal = _ - OpaqueGoalInfo },
- { goal_info_get_nonlocals(OpaqueGoalInfo, OpaqueNonLocals) },
- { set__intersect(OpaqueNonLocals, OpaqueVars,
- UsedOpaqueVars) },
- \+ { set__empty(UsedOpaqueVars) }
- ->
- pd_debug__message("later goals depend on opaque vars\n", []),
- { ShouldTry = no }
- ;
- %
% Don't optimize if that would require duplicating
% branched goal structures.
%
@@ -711,10 +828,10 @@
% XXX We should probably allow deforestation of
% semipure goals.
%
- ( { list__member(ImpureGoal, BetweenGoals) }
- ; { ImpureGoal = EarlierGoal }
- ; { ImpureGoal = LaterGoal }
- ),
+ { list__member(ImpureGoal, BetweenGoals)
+ ; ImpureGoal = EarlierGoal
+ ; MaybeLaterGoal = yes(ImpureGoal)
+ },
{ ImpureGoal = _ - ImpureGoalInfo },
\+ { goal_info_is_pure(ImpureGoalInfo) }
->
@@ -728,12 +845,14 @@
%
{ FullyStrictOp = bool(FullyStrict) },
{ list__member(OtherGoal, BetweenGoals)
- ; OtherGoal = LaterGoal
+ ; MaybeLaterGoal = yes(LaterGoal), OtherGoal = LaterGoal
},
\+ { 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 }
@@ -770,16 +889,17 @@
%-----------------------------------------------------------------------------%
% 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.
-
-deforest__call_call(ConjNonLocals, DeforestInfo, Goal, Optimized) -->
- { DeforestInfo = deforest_info(EarlierGoal, _,
- BetweenGoals, LaterGoal, _, _) },
-
+:- 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, EarlierGoal, BetweenGoals,
+ MaybeLaterGoal, MaybeGoal) -->
+ deforest__can_optimize_conj(EarlierGoal, BetweenGoals,
+ MaybeLaterGoal, ShouldTry),
+ ( { ShouldTry = yes } ->
{ deforest__create_conj(EarlierGoal, BetweenGoals,
- LaterGoal, ConjNonLocals, FoldGoal) },
+ MaybeLaterGoal, ConjNonLocals, FoldGoal) },
pd_info__search_version(FoldGoal, MaybeVersion),
pd_info_get_parent_versions(Parents),
@@ -803,7 +923,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),
@@ -816,18 +936,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) },
@@ -838,37 +960,38 @@
% 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)
- ).
+ )
+ ;
+ { MaybeGoal = no }
+ ).
%-----------------------------------------------------------------------------%
% 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, _, _, _, _) - _ },
-
(
% no threshold set.
{ VarsOpt = int(-1) }
@@ -913,7 +1036,7 @@
deforest__unfold_call(no, no, PredId1, ProcId1, Args1,
EarlierGoal, UnfoldedCall, DidUnfold),
{ deforest__create_conj(UnfoldedCall, BetweenGoals,
- LaterGoal, NonLocals, DeforestGoal0) },
+ MaybeLaterGoal, NonLocals, DeforestGoal0) },
{ set__to_sorted_list(NonLocals, NonLocalsList) },
( { DidUnfold = yes, RunModes = yes } ->
@@ -958,8 +1081,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),
@@ -992,11 +1122,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
@@ -1007,8 +1137,7 @@
pd_info_set_instmap(InstMap0)
;
pd_debug__message("vars threshold exceeded\n", []),
- { Optimized = no },
- { CallGoal = LaterGoal }
+ { MaybeCallGoal = no }
).
%-----------------------------------------------------------------------------%
@@ -1094,14 +1223,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
@@ -1117,15 +1251,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) },
@@ -1141,8 +1273,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
@@ -1151,30 +1283,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),
@@ -1197,13 +1328,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).
@@ -1242,12 +1371,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, _, _, _) - _,
@@ -1312,7 +1441,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),
%
@@ -1339,26 +1468,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).
%-----------------------------------------------------------------------------%
@@ -1678,8 +1821,8 @@
->
pd_info_get_pred_info(PredInfo0),
pd_info_get_module_info(ModuleInfo0),
- { module_info_pred_proc_info(ModuleInfo0,
- PredId, ProcId, CalledPredInfo, CalledProcInfo) },
+ { 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) },
@@ -1691,7 +1834,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.113
diff -u -u -r1.113 handle_options.m
--- compiler/handle_options.m 2001/07/20 14:13:24 1.113
+++ compiler/handle_options.m 2001/07/31 04:37:16
@@ -572,8 +572,12 @@
[]
),
- % --no-reorder-conj implies --no-deforestation.
+ % --no-reorder-conj implies --no-deforestation,
+ % --no-constraint-propagation and --no-local-constraint-propagation.
option_neg_implies(reorder_conj, deforestation, bool(no)),
+ option_neg_implies(reorder_conj, constraint_propagation, bool(no)),
+ option_neg_implies(reorder_conj, local_constraint_propagation,
+ bool(no)),
% --stack-trace requires `procid' stack layouts
option_implies(stack_trace, procid_stack_layout, bool(yes)),
@@ -635,6 +639,12 @@
% If we are doing type-specialization, we may as well take
% advantage of the declarations supplied by the programmer.
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
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.99
diff -u -u -r1.99 hlds_pred.m
--- compiler/hlds_pred.m 2001/07/31 14:29:37 1.99
+++ compiler/hlds_pred.m 2001/08/01 17:41:15
@@ -1355,9 +1355,10 @@
TermInfo = no
),
+ MaybeDeclaredDetism = no,
proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, InstVarSet,
- Detism, Goal0, Context, TVarMap, TCVarMap, IsAddressTaken,
- ProcInfo0),
+ MaybeDeclaredDetism, Detism, Goal0, Context,
+ TVarMap, TCVarMap, IsAddressTaken, ProcInfo0),
proc_info_set_maybe_termination_info(ProcInfo0, TermInfo, ProcInfo),
set__init(Assertions),
@@ -1451,6 +1452,13 @@
:- 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), inst_varset, 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, in, out)
+ is det.
+
:- pred proc_info_set_body(proc_info, prog_varset, vartypes,
list(prog_var), hlds_goal, type_info_varmap,
typeclass_info_varmap, proc_info).
@@ -1902,8 +1910,16 @@
Liveness, TVarMap, TCVarsMap, eval_normal, ArgSizes,
Termination, no, IsAddressTaken, RLExprn, no, no, no).
-proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet, Detism,
- Goal, Context, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :-
+proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet,
+ Detism, Goal, Context, TVarMap, TCVarsMap,
+ IsAddressTaken, ProcInfo) :-
+ proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet,
+ yes(Detism), Detism, Goal, Context, TVarMap,
+ TCVarsMap, IsAddressTaken, ProcInfo).
+
+proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet,
+ MaybeDeclaredDetism, Detism, Goal, Context, TVarMap,
+ TCVarsMap, IsAddressTaken, ProcInfo) :-
map__init(StackSlots),
set__init(Liveness),
MaybeHeadLives = no,
@@ -1911,8 +1927,9 @@
ModeErrors = [],
ProcInfo = procedure(VarSet, VarTypes, HeadVars, HeadModes, ModeErrors,
InstVarSet, MaybeHeadLives, Goal, Context, StackSlots,
- yes(Detism), Detism, yes, [], Liveness, TVarMap, TCVarsMap,
- eval_normal, no, no, no, IsAddressTaken, RLExprn, no, no, no).
+ MaybeDeclaredDetism, Detism, yes, [], Liveness, TVarMap,
+ TCVarsMap, eval_normal, no, no, no, IsAddressTaken,
+ RLExprn, no, no, no).
proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal,
TI_VarMap, TCI_VarMap, ProcInfo) :-
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.378
diff -u -u -r1.378 make_hlds.m
--- compiler/make_hlds.m 2001/07/31 14:29:43 1.378
+++ compiler/make_hlds.m 2001/08/02 11:51:46
@@ -2955,7 +2955,19 @@
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
HeadVars, ClauseList, TI_VarMap, TCI_VarMap,
HasForeignClauses),
- 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. The code generator will still generate
+ % inline code for 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.214
diff -u -u -r1.214 mercury_compile.m
--- compiler/mercury_compile.m 2001/07/28 18:07:38 1.214
+++ compiler/mercury_compile.m 2001/08/02 11:16:44
@@ -2567,8 +2567,10 @@
mercury_compile__maybe_deforestation(HLDS0, Verbose, Stats, HLDS) -->
globals__io_lookup_bool_option(deforestation, Deforest),
- ( { Deforest = yes } ->
- maybe_write_string(Verbose, "% Deforestation...\n"),
+ globals__io_lookup_bool_option(constraint_propagation, Constraints),
+ ( { Deforest = yes ; Constraints = yes } ->
+ maybe_write_string(Verbose,
+ "% Deforestation and/or constraint propagation...\n"),
maybe_flush_output(Verbose),
deforestation(HLDS0, HLDS),
maybe_write_string(Verbose, "% done.\n"),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.330
diff -u -u -r1.330 options.m
--- compiler/options.m 2001/08/01 15:46:30 1.330
+++ compiler/options.m 2001/08/02 11:53:58
@@ -352,6 +352,7 @@
; common_struct
; common_goal
; constraint_propagation
+ ; local_constraint_propagation
; optimize_unused_args
; intermod_unused_args
; optimize_higher_order
@@ -774,6 +775,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),
@@ -1191,6 +1193,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).
@@ -1580,6 +1583,7 @@
optimize_unused_args - bool(yes),
optimize_higher_order - bool(yes),
deforestation - bool(yes),
+ local_constraint_propagation - bool(yes),
constant_propagation - bool(yes),
% Disabled until a bug in extras/trailed_update/var.m is resolved.
%introduce_accumulators - bool(yes),
@@ -2519,8 +2523,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 attemps to transform the code so that goals",
+ "\twhich can fail are executed as early as possible.",
+ "--local-constraint-propagation",
+ "\tEnable the constraint propagation transformation,",
+ "\tbut only rearrange goals within each procedure.",
+ "\tSpecialized versions of procedures will not be created.",
"--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 2001/08/01 08:49:42
@@ -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 2001/07/31 04:37:17
@@ -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.14
diff -u -u -r1.14 pd_util.m
--- compiler/pd_util.m 2000/11/19 12:43:31 1.14
+++ compiler/pd_util.m 2001/08/01 09:09:38
@@ -21,14 +21,22 @@
:- pred pd_util__goal_get_calls(hlds_goal::in,
list(pred_proc_id)::out) is det.
+ % Call constraint.m to transform a goal so that goals which
+ % can fail are executed as early as possible.
+:- pred pd_util__propagate_constraints(hlds_goal::in, hlds_goal::out,
+ pd_info::pd_info_di, pd_info::pd_info_uo) is det.
+
+ % Apply simplify.m to the goal.
:- 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.
+ % Apply unique_modes.m to the goal.
:- pred pd_util__unique_modecheck_goal(hlds_goal::in, hlds_goal::out,
list(mode_error_info)::out, pd_info::pd_info_di,
pd_info::pd_info_uo) is det.
+ % Apply unique_modes.m to the goal.
:- pred pd_util__unique_modecheck_goal(set(prog_var)::in, hlds_goal::in,
hlds_goal::out, list(mode_error_info)::out,
pd_info::pd_info_di, pd_info::pd_info_uo) is det.
@@ -45,10 +53,12 @@
maybe(pd_branch_info(prog_var))::out, pd_info::pd_info_di,
pd_info::pd_info_uo) is det.
+ % Recompute the non-locals of the goal.
:- pred pd_util__requantify_goal(hlds_goal::in, set(prog_var)::in,
hlds_goal::out, pd_info::pd_info_di, pd_info::pd_info_uo)
is det.
+ % Apply mode_util__recompute_instmap_delta to the goal.
:- pred pd_util__recompute_instmap_delta(hlds_goal::in, hlds_goal::out,
pd_info::pd_info_di, pd_info::pd_info_uo) is det.
@@ -128,11 +138,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 +154,48 @@
%-----------------------------------------------------------------------------%
+pd_util__propagate_constraints(Goal0, 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) },
+ { constraint__propagate_constraints_in_goal(Goal0, Goal1,
+ CInfo0, CInfo) },
+ { 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),
+ ( { Changed = yes } ->
+ pd_debug__output_goal(
+ "after constraints, before recompute\n",
+ Goal1),
+ { Goal1 = _ - GoalInfo1 },
+ { goal_info_get_nonlocals(GoalInfo1, NonLocals) },
+ 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.
@@ -275,6 +327,35 @@
%-----------------------------------------------------------------------------%
+:- 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) },
+ { proc_info_vartypes(ProcInfo, VarTypes) },
+ { det_info_init(ModuleInfo, VarTypes, PredId, ProcId,
+ Globals, DetInfo) },
+ pd_info_get_instmap(InstMap),
+ { det_infer_goal(Goal0, InstMap, SolnContext, DetInfo, Goal, _, _) }.
+
+%-----------------------------------------------------------------------------%
+
pd_util__convert_branch_info(ArgInfo, Args, VarInfo) :-
ArgInfo = pd_branch_info(ArgMap, LeftArgs, OpaqueArgs),
map__to_assoc_list(ArgMap, ArgList),
@@ -1028,8 +1109,20 @@
pd_util__can_reorder_goals(ModuleInfo, FullyStrict, EarlierGoal, LaterGoal) :-
EarlierGoal = _ - EarlierGoalInfo,
LaterGoal = _ - LaterGoalInfo,
+
+ goal_info_get_determinism(EarlierGoalInfo, EarlierDetism),
+ goal_info_get_determinism(LaterGoalInfo, LaterDetism),
- % Impure goals cannot be reordered.
+ % Check that the reordering would not violate determinism
+ % correctness by moving a goal out of a single solution context
+ % by placing a goal which can fail after it.
+ (
+ determinism_components(EarlierDetism, can_fail, _)
+ =>
+ \+ determinism_components(LaterDetism, _, at_most_many_cc)
+ ),
+
+ % Impure goals cannot be reordered.
\+ goal_info_is_impure(EarlierGoalInfo),
\+ goal_info_is_impure(LaterGoalInfo),
@@ -1059,7 +1152,7 @@
goal_info_get_nonlocals(GoalInfo2, NonLocals2),
set__intersect(ChangedVars1, NonLocals2, Intersection),
\+ set__empty(Intersection).
-
+
pd_util__reordering_maintains_termination(ModuleInfo, FullyStrict,
EarlierGoal, LaterGoal) :-
EarlierGoal = _ - EarlierGoalInfo,
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.65
diff -u -u -r1.65 compiler_design.html
--- compiler/notes/compiler_design.html 2001/06/27 05:04:36 1.65
+++ compiler/notes/compiler_design.html 2001/07/31 04:37:17
@@ -554,9 +554,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
@@ -564,6 +561,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/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.268
diff -u -u -r1.268 user_guide.texi
--- doc/user_guide.texi 2001/08/01 15:46:34 1.268
+++ doc/user_guide.texi 2001/08/02 11:21:19
@@ -4839,9 +4839,18 @@
Disabling this optimization reduces the class of predicates
that the compiler considers to be deterministic.
- at c @item --constraint-propagation
- at c @findex --constraint-propagation
- at c Enable the constraint propagation transformation.
+ at item --constraint-propagation
+ at findex --constraint-propagation
+"--constraint-propagation",
+Enable the constraint propagation transformation,
+which attempts to transform the code so that goals
+which can fail are executed as early as possible.
+
+ at item --local-constraint-propagation
+ at findex --local-constraint-propagation
+Enable the constraint propagation transformation,
+but only rearrange goals within each procedure.
+Specialized versions of procedures will not be created.
@c @sp 1
@c @item --prev-code
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.124
diff -u -u -r1.124 Mmakefile
--- tests/hard_coded/Mmakefile 2001/08/01 00:31:39 1.124
+++ tests/hard_coded/Mmakefile 2001/08/02 10:21:17
@@ -22,6 +22,8 @@
common_type_cast \
compare_spec \
comparison \
+ constraint \
+ constraint_order \
construct \
curry \
curry2 \
@@ -210,6 +212,8 @@
MCFLAGS-checked_nondet_tailcall = --checked-nondet-tailcalls
MCFLAGS-bigtest = --intermodule-optimization -O3
+MCFLAGS-constraint = --constraint-propagation --enable-termination
+MCFLAGS-constraint_order = --constraint-propagation --enable-termination
MCFLAGS-lp = --intermodule-optimization -O3
MCFLAGS-boyer = --infer-all
MCFLAGS-func_test = --infer-all
Index: tests/hard_coded/constraint_order.exp
===================================================================
RCS file: constraint_order.exp
diff -N constraint_order.exp
--- /dev/null Mon Apr 16 11:57:05 2001
+++ constraint_order.exp Thu Aug 2 20:22:24 2001
@@ -0,0 +1,3 @@
+call to test
+call to q
+succeeded: 1
Index: tests/hard_coded/constraint_order.m
===================================================================
RCS file: constraint_order.m
diff -N constraint_order.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ constraint_order.m Thu Aug 2 20:23:15 2001
@@ -0,0 +1,43 @@
+% Test that constraint propagation maintains unique mode correctness.
+% The calls to q/2 and test/1 in p/2 must not be reordered.
+:- module constraint_order.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+main -->
+ ( { p(3, Y) } ->
+ io__write_string("succeeded: "),
+ io__write_int(Y),
+ io__nl
+ ;
+ io__write_string("failed\n")
+ ).
+
+:- pred p(int::di, int::out) is semidet.
+
+p(X, Y) :- q(X, Y), test(X).
+
+:- pred q(int::ui, int::out) is det.
+:- pragma promise_pure(q/2).
+:- pragma no_inline(q/2).
+:- pragma terminates(q/2).
+
+q(_, 1) :- impure unsafe_write_string("call to q\n").
+
+:- pred test(int::di) is semidet.
+:- pragma promise_pure(test/1).
+:- pragma no_inline(test/1).
+:- pragma terminates(test/1).
+
+test(3) :- impure unsafe_write_string("call to test\n").
+
+:- impure pred unsafe_write_string(string::in) is det.
+
+:- pragma c_code(unsafe_write_string(Str::in), "printf(Str);").
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list