mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
44d1f0db9c
compiler/prog_type_subst.m:
compiler/type_util.m:
Apply s/apply_variable_renaming_to_/apply_renaming_to_/ and
s/_to_x_list/_to_xs/ to the names of predicate.
Conform to the change in hlds_class.m below.
compiler/hlds_class.m:
This module used to define types named (a) hlds_constraint, and
(b) hlds_constraints, and the latter was NOT a list of items
of type hlds_constraint. Rename the latter to hlds_constraint_db
to free up the name apply_renaming_to_constraints to apply
to list(hlds_constraint). However, the rename also makes code
operating on hlds_constraint_dbs easier to understand. Before
this diff, several modules used variables named Constraints
to refer to a list(hlds_constraint) in some places and to
what is now a hlds_constraint_db in other places, which is confusing;
the latter are now named ConstraintDb.
compiler/type_assign.m:
Conform to the changes above.
Add an XXX about some existing variable names that *look* right
but turn out to be subtly misleading.
compiler/add_pragma_type_spec.m:
compiler/add_type.m:
compiler/check_typeclass.m:
compiler/comp_unit_interface.m:
compiler/cse_detection.m:
compiler/ctgc.util.m:
compiler/decide_type_repn.m:
compiler/deforest.m:
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/higher_order.higher_order_global_info.m:
compiler/higher_order.make_specialized_preds.m:
compiler/higher_order.specialize_calls.m:
compiler/hlds_rtti.m:
compiler/inlining.m:
compiler/modecheck_coerce.m:
compiler/old_type_constraints.m:
compiler/polymorphism_clause.m:
compiler/polymorphism_goal.m:
compiler/polymorphism_type_class_info.m:
compiler/prog_type_unify.m:
compiler/qual_info.m:
compiler/recompilation.version.m:
compiler/resolve_unify_functor.m:
compiler/typecheck.m:
compiler/typecheck_clauses.m:
compiler/typecheck_cons_infos.m:
compiler/typecheck_debug.m:
compiler/typecheck_error_type_assign.m:
compiler/typecheck_errors.m:
compiler/typecheck_unify_var_functor.m:
compiler/typecheck_util.m:
compiler/typeclasses.m:
compiler/unify_proc.m:
compiler/var_table.m:
compiler/vartypes.m:
Conform to the changes above.
2257 lines
92 KiB
Mathematica
2257 lines
92 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1999-2012 The University of Melbourne.
|
|
% Copyright (C) 2014-2017, 2019-2025 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: deforest.m.
|
|
% Main author: stayl.
|
|
%
|
|
% Deforestation attempts to remove multiple traversals over data structures,
|
|
% and construction followed by immediate deconstruction of data structures.
|
|
% It does this by combining the bodies of pairs of called procedures in a
|
|
% conjunction where the top-level functor of one of the argument variables of
|
|
% the first called procedure is known at the end of some of the branches of
|
|
% the body of that procedure, and the second called procedure switches on that
|
|
% variable.
|
|
%
|
|
% The deforestation pass also inlines calls for which the top-level 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 the papers page of mercurylang.org.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.deforest.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_module.
|
|
|
|
:- import_module io.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred deforest_module(io.text_output_stream::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.det_analysis.
|
|
:- import_module check_hlds.recompute_instmap_deltas.
|
|
:- import_module check_hlds.simplify.
|
|
:- import_module check_hlds.simplify.simplify_tasks.
|
|
:- import_module hlds.goal_form.
|
|
:- import_module hlds.goal_reorder.
|
|
:- import_module hlds.goal_util.
|
|
:- import_module hlds.goal_vars.
|
|
:- import_module hlds.hlds_dependency_graph.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_markers.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.hlds_proc_util.
|
|
:- import_module hlds.inst_test.
|
|
:- import_module hlds.instmap.
|
|
:- import_module hlds.mode_util.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module hlds.quantification.
|
|
:- import_module hlds.var_table_hlds.
|
|
:- import_module libs.
|
|
:- import_module libs.dependency_graph.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.optimization_options.
|
|
:- import_module libs.options.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_detism.
|
|
:- import_module parse_tree.prog_type_subst.
|
|
:- import_module parse_tree.set_of_var.
|
|
:- import_module parse_tree.var_table.
|
|
:- import_module transform_hlds.inlining.
|
|
:- import_module transform_hlds.pd_cost.
|
|
:- import_module transform_hlds.pd_debug.
|
|
:- import_module transform_hlds.pd_info.
|
|
:- import_module transform_hlds.pd_term.
|
|
:- import_module transform_hlds.pd_util.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module getopt.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module univ.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
deforest_module(ProgressStream, !ModuleInfo) :-
|
|
proc_arg_info_init(ProcArgInfo0),
|
|
type_to_univ(ProcArgInfo0, UnivProcArgInfo0),
|
|
|
|
% Find out which arguments of each procedure are switched on at the top
|
|
% level or are constructed in a way which is possibly deforestable.
|
|
Task0 = update_module_cookie(get_branch_vars_proc_univ, UnivProcArgInfo0),
|
|
process_valid_nonimported_procs_update(Task0, Task, !ModuleInfo),
|
|
( if
|
|
Task = update_module_cookie(_, UnivProcArgInfo),
|
|
univ_to_type(UnivProcArgInfo, ProcArgInfo1)
|
|
then
|
|
ProcArgInfo = ProcArgInfo1
|
|
else
|
|
unexpected($pred, "passes_aux stuffed up")
|
|
),
|
|
|
|
% We process the module bottom-up to make estimation of the
|
|
% cost improvement of new versions a little more accurate and
|
|
% also to avoid redoing optimizations.
|
|
module_info_ensure_dependency_info(!ModuleInfo, DepInfo),
|
|
DepList = dependency_info_get_condensed_bottom_up_sccs(DepInfo),
|
|
|
|
pd_info_init(ProgressStream, !.ModuleInfo, ProcArgInfo, PDInfo0),
|
|
list.foldl(deforest_proc, DepList, PDInfo0, PDInfo),
|
|
pd_info_get_module_info(PDInfo, !:ModuleInfo),
|
|
module_info_clobber_dependency_info(!ModuleInfo),
|
|
pd_info_get_versions(PDInfo, VersionIndex),
|
|
|
|
map.keys(VersionIndex, Versions),
|
|
|
|
module_info_get_globals(!.ModuleInfo, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
PropConstraints = OptTuple ^ ot_prop_constraints,
|
|
( if
|
|
PropConstraints = prop_constraints,
|
|
Versions = [_ | _]
|
|
then
|
|
% 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, !ModuleInfo),
|
|
|
|
disable_det_warnings(_OptionsToRestore, Globals, NoWarnGlobals),
|
|
module_info_set_globals(NoWarnGlobals, !ModuleInfo),
|
|
determinism_pass(ProgressStream, Specs, !ModuleInfo),
|
|
module_info_set_globals(Globals, !ModuleInfo),
|
|
|
|
FoundErrors = contains_errors(Globals, Specs),
|
|
expect(unify(FoundErrors, no), $pred,
|
|
"determinism errors after deforestation")
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred reset_inferred_proc_determinism(pred_proc_id::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
reset_inferred_proc_determinism(PredProcId, !ModuleInfo) :-
|
|
module_info_pred_proc_info(!.ModuleInfo, PredProcId, PredInfo, ProcInfo0),
|
|
proc_info_get_inferred_determinism(ProcInfo0, Detism0),
|
|
determinism_components(Detism0, _, MaxSolns),
|
|
(
|
|
MaxSolns = at_most_many_cc
|
|
% `cc_multi' or `cc_nondet' determinisms are never inferred,
|
|
% so resetting the determinism would cause determinism errors.
|
|
;
|
|
( MaxSolns = at_most_zero
|
|
; MaxSolns = at_most_one
|
|
; MaxSolns = at_most_many
|
|
),
|
|
proc_info_set_inferred_determinism(detism_erroneous,
|
|
ProcInfo0, ProcInfo),
|
|
module_info_set_pred_proc_info(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) :-
|
|
map.init(ProcArgInfo0).
|
|
|
|
:- pred get_branch_vars_proc_univ(pred_proc_id::in,
|
|
proc_info::in, proc_info::out, module_info::in, module_info::out,
|
|
univ::in, univ::out) is det.
|
|
|
|
get_branch_vars_proc_univ(PredProcId, ProcInfo, ProcInfo,
|
|
!ModuleInfo, UnivProcArgInfo0, UnivProcArgInfo) :-
|
|
det_univ_to_type(UnivProcArgInfo0, ProcArgInfo0),
|
|
pd_util.get_branch_vars_proc(PredProcId, ProcInfo, !ModuleInfo,
|
|
ProcArgInfo0, ProcArgInfo),
|
|
type_to_univ(ProcArgInfo, UnivProcArgInfo).
|
|
|
|
:- pred deforest_proc(pred_proc_id::in, pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_proc(PredProcId, !PDInfo) :-
|
|
deforest_proc_deltas(PredProcId, _, _, !PDInfo).
|
|
|
|
:- pred deforest_proc_deltas(pred_proc_id::in, int::out, int::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_proc_deltas(PredProcId, CostDelta, SizeDelta, !PDInfo) :-
|
|
some [!ModuleInfo, !PredInfo, !ProcInfo, !Goal] (
|
|
pd_info_get_progress_stream(!.PDInfo, ProgressStream),
|
|
pd_info_get_module_info(!.PDInfo, !:ModuleInfo),
|
|
trace [io(!IO)] (
|
|
maybe_write_proc_progress_message(ProgressStream, !.ModuleInfo,
|
|
"Deforesting", PredProcId, !IO)
|
|
),
|
|
module_info_pred_proc_info(!.ModuleInfo, PredProcId,
|
|
!:PredInfo, !:ProcInfo),
|
|
pd_info_init_unfold_info(PredProcId, !.PredInfo, !.ProcInfo, !PDInfo),
|
|
proc_info_get_goal(!.ProcInfo, !:Goal),
|
|
|
|
% Inlining may have created some opportunities for simplification.
|
|
module_info_get_globals(!.ModuleInfo, Globals),
|
|
find_simplify_tasks(Globals, do_not_generate_warnings, SimplifyTasks),
|
|
pd_util.pd_simplify_goal("deforest_proc_deltas", SimplifyTasks,
|
|
!Goal, !PDInfo),
|
|
pd_util.propagate_constraints(!Goal, !PDInfo),
|
|
trace [io(!IO)] (
|
|
pd_debug_output_goal(!.PDInfo, "deforest_proc_deltas",
|
|
"after constraints\n", !.Goal, !IO)
|
|
),
|
|
deforest_goal(!Goal, !PDInfo),
|
|
pd_info_get_proc_info(!.PDInfo, !:ProcInfo),
|
|
proc_info_set_goal(!.Goal, !ProcInfo),
|
|
pd_info_get_changed(!.PDInfo, Changed),
|
|
|
|
(
|
|
Changed = yes,
|
|
pd_info_get_module_info(!.PDInfo, !:ModuleInfo),
|
|
requantify_proc_general(ord_nl_no_lambda, !ProcInfo),
|
|
proc_info_get_goal(!.ProcInfo, !:Goal),
|
|
proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InstMap0),
|
|
proc_info_get_var_table(!.ProcInfo, VarTable),
|
|
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
|
|
recompute_instmap_delta(recomp_atomics, VarTable, InstVarSet,
|
|
InstMap0, !Goal, !ModuleInfo),
|
|
pd_info_set_module_info(!.ModuleInfo, !PDInfo),
|
|
pd_info_get_pred_info(!.PDInfo, !:PredInfo),
|
|
proc_info_set_goal(!.Goal, !ProcInfo),
|
|
module_info_set_pred_proc_info(PredProcId,
|
|
!.PredInfo, !.ProcInfo, !ModuleInfo),
|
|
pd_info_get_rerun_det(!.PDInfo, RerunDet),
|
|
|
|
(
|
|
RerunDet = yes,
|
|
PredProcId = proc(PredId, ProcId),
|
|
% If the determinism of some sub-goals has changed,
|
|
% then we re-run determinism analysis. As with inlining.m,
|
|
% this avoids problems with inlining erroneous procedures.
|
|
det_infer_proc_ignore_msgs(ProgressStream, PredId, ProcId,
|
|
!ModuleInfo)
|
|
;
|
|
RerunDet = no
|
|
),
|
|
|
|
% Recompute the branch_info for the procedure.
|
|
pd_info_get_proc_arg_info(!.PDInfo, ProcArgInfo0),
|
|
pd_util.get_branch_vars_proc(PredProcId, !.ProcInfo,
|
|
!ModuleInfo, ProcArgInfo0, ProcArgInfo),
|
|
pd_info_set_proc_arg_info(ProcArgInfo, !PDInfo),
|
|
pd_info_set_module_info(!.ModuleInfo, !PDInfo)
|
|
;
|
|
Changed = no,
|
|
pd_info_get_module_info(!.PDInfo, !:ModuleInfo),
|
|
pd_info_get_pred_info(!.PDInfo, !:PredInfo),
|
|
module_info_set_pred_proc_info(PredProcId, !.PredInfo, !.ProcInfo,
|
|
!ModuleInfo),
|
|
pd_info_set_module_info(!.ModuleInfo, !PDInfo)
|
|
),
|
|
|
|
pd_info_get_module_info(!.PDInfo, !:ModuleInfo),
|
|
trace [io(!IO)] (
|
|
maybe_write_proc_progress_message(ProgressStream, !.ModuleInfo,
|
|
"Finished deforesting", PredProcId, !IO)
|
|
),
|
|
pd_info_get_cost_delta(!.PDInfo, CostDelta),
|
|
pd_info_get_size_delta(!.PDInfo, SizeDelta),
|
|
pd_info_unset_unfold_info(!PDInfo)
|
|
).
|
|
|
|
:- pred deforest_goal(hlds_goal::in, hlds_goal::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_goal(Goal0, Goal, !PDInfo) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
deforest_goal_expr(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !PDInfo),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
:- pred deforest_goal_expr(hlds_goal_expr::in, hlds_goal_expr::out,
|
|
hlds_goal_info::in, hlds_goal_info::out, pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_goal_expr(GoalExpr0, GoalExpr, !GoalInfo, !PDInfo) :-
|
|
(
|
|
GoalExpr0 = conj(ConjType, Goals0),
|
|
some [!Goals] (
|
|
!:Goals = Goals0,
|
|
(
|
|
ConjType = plain_conj,
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
partially_evaluate_conj_goals(!.Goals, [], !:Goals, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
NonLocals = goal_info_get_nonlocals(!.GoalInfo),
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
Deforest = OptTuple ^ ot_deforest,
|
|
(
|
|
Deforest = deforest,
|
|
compute_goal_infos(!Goals, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
deforest_conj(!.Goals, NonLocals, [], !:Goals, !PDInfo)
|
|
;
|
|
Deforest = do_not_deforest
|
|
),
|
|
PropConstraints = OptTuple ^ ot_prop_constraints,
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
(
|
|
PropConstraints = prop_constraints,
|
|
propagate_conj_constraints(!.Goals, NonLocals, [], !:Goals,
|
|
!PDInfo)
|
|
;
|
|
PropConstraints = do_not_prop_constraints
|
|
),
|
|
pd_info_set_instmap(InstMap0, !PDInfo)
|
|
;
|
|
ConjType = parallel_conj
|
|
% XXX cannot deforest across parallel_conjunctions!
|
|
),
|
|
Goals = !.Goals
|
|
),
|
|
GoalExpr = conj(ConjType, Goals)
|
|
;
|
|
GoalExpr0 = disj(Goals0),
|
|
deforest_disj(Goals0, Goals, !PDInfo),
|
|
GoalExpr = disj(Goals)
|
|
;
|
|
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
deforest_goal(Cond0, Cond, !PDInfo),
|
|
pd_info_update_goal(Cond, !PDInfo),
|
|
deforest_goal(Then0, Then, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
deforest_goal(Else0, Else, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
GoalExpr = if_then_else(Vars, Cond, Then, Else)
|
|
;
|
|
GoalExpr0 = switch(Var, CanFail, Cases0),
|
|
deforest_cases(Var, Cases0, Cases, !PDInfo),
|
|
GoalExpr = switch(Var, CanFail, Cases)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
deforest_goal(SubGoal0, SubGoal, !PDInfo),
|
|
GoalExpr = negation(SubGoal)
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
( if
|
|
Reason = from_ground_term(_, FGT),
|
|
( FGT = from_ground_term_construct
|
|
; FGT = from_ground_term_deconstruct
|
|
)
|
|
then
|
|
SubGoal = SubGoal0
|
|
else
|
|
deforest_goal(SubGoal0, SubGoal, !PDInfo)
|
|
),
|
|
GoalExpr = scope(Reason, SubGoal)
|
|
;
|
|
GoalExpr0 = plain_call(PredId, ProcId, Args, BuiltinState, _, Name),
|
|
deforest_call(PredId, ProcId, Args, Name, BuiltinState,
|
|
hlds_goal(GoalExpr0, !.GoalInfo), hlds_goal(GoalExpr, !:GoalInfo),
|
|
!PDInfo)
|
|
;
|
|
( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
|
|
; GoalExpr0 = generic_call(_, _, _, _, _)
|
|
; GoalExpr = unify(_, _, _, _, _)
|
|
),
|
|
GoalExpr = GoalExpr0
|
|
;
|
|
GoalExpr0 = shorthand(_),
|
|
% These should have been expanded out by now.
|
|
unexpected($pred, "shorthand")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred deforest_disj(list(hlds_goal)::in, list(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_disj([], [], !PDInfo).
|
|
deforest_disj([Goal0 | Goals0], [Goal | Goals], !PDInfo) :-
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
deforest_goal(Goal0, Goal, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
deforest_disj(Goals0, Goals, !PDInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred deforest_cases(prog_var::in, list(case)::in, list(case)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_cases(_, [], [], !PDInfo).
|
|
deforest_cases(Var, [Case0 | Cases0], [Case | Cases], !PDInfo) :-
|
|
Case0 = case(MainConsId, OtherConsIds, Goal0),
|
|
% Bind Var to MainConsId or one of the OtherConsIds in the instmap
|
|
% before processing this case.
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo),
|
|
deforest_goal(Goal0, Goal, !PDInfo),
|
|
Case = case(MainConsId, OtherConsIds, Goal),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
deforest_cases(Var, Cases0, Cases, !PDInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Perform partial evaluation on the goals of a conjunction.
|
|
%
|
|
:- pred partially_evaluate_conj_goals(list(hlds_goal)::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
partially_evaluate_conj_goals([], RevGoals, Goals, !PDInfo) :-
|
|
list.reverse(RevGoals, Goals).
|
|
partially_evaluate_conj_goals([Goal0 | Goals0], RevGoals0, Goals, !PDInfo) :-
|
|
deforest_goal(Goal0, Goal1, !PDInfo),
|
|
pd_info_update_goal(Goal1, !PDInfo),
|
|
( if Goal1 = hlds_goal(conj(plain_conj, Goals1), _) then
|
|
list.reverse(Goals1, RevGoals1),
|
|
list.append(RevGoals1, RevGoals0, RevGoals2)
|
|
else
|
|
RevGoals2 = [Goal1 | RevGoals0]
|
|
),
|
|
partially_evaluate_conj_goals(Goals0, RevGoals2, Goals, !PDInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Compute the branch info for each goal in a conjunction.
|
|
%
|
|
:- pred compute_goal_infos(list(hlds_goal)::in, annotated_conj::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
compute_goal_infos([], [], !PDInfo).
|
|
compute_goal_infos([Goal | Goals0], [Goal - MaybeBranchInfo | Goals],
|
|
!PDInfo) :-
|
|
deforest_get_branch_vars_goal(Goal, MaybeBranchInfo, !PDInfo),
|
|
pd_info_update_goal(Goal, !PDInfo),
|
|
compute_goal_infos(Goals0, Goals, !PDInfo).
|
|
|
|
:- pred deforest_get_branch_vars_goal(hlds_goal::in,
|
|
maybe(pd_branch_info(prog_var))::out, pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_get_branch_vars_goal(Goal, MaybeBranchInfo, !PDInfo) :-
|
|
Goal = hlds_goal(GoalExpr, _),
|
|
(
|
|
( GoalExpr = disj(_)
|
|
; GoalExpr = switch(_, _, _)
|
|
; GoalExpr = if_then_else(_, _, _, _)
|
|
),
|
|
pd_util.get_branch_vars_goal(Goal, MaybeBranchInfo, !PDInfo)
|
|
;
|
|
( GoalExpr = unify(_, _, _, _, _)
|
|
; GoalExpr = generic_call(_, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
; GoalExpr = conj(_, _)
|
|
; GoalExpr = negation(_)
|
|
; GoalExpr = scope(_, _)
|
|
),
|
|
MaybeBranchInfo = no
|
|
;
|
|
GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
|
|
pd_info_get_proc_arg_info(!.PDInfo, ProcBranchInfos),
|
|
( if
|
|
map.search(ProcBranchInfos, proc(PredId, ProcId), BranchInfo0)
|
|
then
|
|
% Rename the branch_info for the called procedure
|
|
% onto the argument variables.
|
|
pd_util.convert_branch_info(BranchInfo0, Args, BranchInfo),
|
|
MaybeBranchInfo = yes(BranchInfo)
|
|
else
|
|
MaybeBranchInfo = no
|
|
)
|
|
;
|
|
GoalExpr = shorthand(_),
|
|
unexpected($pred, "shorthand")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred propagate_conj_constraints(list(hlds_goal)::in,
|
|
set_of_progvar::in, list(hlds_goal)::in, list(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
propagate_conj_constraints([], _, RevGoals, Goals, !PDInfo) :-
|
|
list.reverse(RevGoals, Goals).
|
|
propagate_conj_constraints([Goal0 | Goals0], NonLocals, RevGoals0, Goals,
|
|
!PDInfo) :-
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
( if
|
|
% constraint.m ensures that only constraints relevant
|
|
% to this goal are placed adjacent to it.
|
|
Goal0 = hlds_goal(GoalExpr0, _GoalInfo0),
|
|
GoalExpr0 = plain_call(PredId, _ProcId, _Args, _, _, SymName),
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
not pred_info_is_imported(PredInfo),
|
|
list.take_while(
|
|
( pred(CnstrGoal::in) is semidet :-
|
|
CnstrGoal = hlds_goal(_, CnstrGoalInfo),
|
|
goal_info_has_feature(CnstrGoalInfo, feature_constraint)
|
|
), Goals0, Constraints, Goals1),
|
|
Constraints = [_ | _]
|
|
then
|
|
SymNameString = sym_name_to_string(SymName),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "propagate_conj_constraints",
|
|
"propagating constraints into call to %s\n",
|
|
[s(SymNameString)], !IO)
|
|
),
|
|
|
|
do_get_sub_conj_nonlocals(NonLocals, RevGoals0, [],
|
|
Goal0, Constraints, no, [], Goals1, ConjNonLocals),
|
|
call_call(ConjNonLocals, Goal0, Constraints, no, MaybeGoal, !PDInfo),
|
|
(
|
|
MaybeGoal = yes(Goal),
|
|
pd_info_set_rerun_det(yes, !PDInfo),
|
|
pd_info_update_goal(Goal, !PDInfo),
|
|
propagate_conj_constraints(Goals1, NonLocals,
|
|
[Goal | RevGoals0], Goals, !PDInfo)
|
|
;
|
|
MaybeGoal = no,
|
|
pd_info_update_goal(Goal0, !PDInfo),
|
|
propagate_conj_constraints(Goals0, NonLocals,
|
|
[Goal0 | RevGoals0], Goals, !PDInfo)
|
|
)
|
|
else
|
|
pd_info_update_goal(Goal0, !PDInfo),
|
|
propagate_conj_constraints(Goals0, NonLocals,
|
|
[Goal0 | RevGoals0], Goals, !PDInfo)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type annotated_conj ==
|
|
assoc_list(hlds_goal, maybe(pd_branch_info(prog_var))).
|
|
|
|
:- pred deforest_conj(annotated_conj::in, set_of_progvar::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_conj([], _, RevGoals, Goals, !PDInfo) :-
|
|
list.reverse(RevGoals, Goals).
|
|
deforest_conj([Goal0 - MaybeBranchInfo | Goals0], NonLocals,
|
|
RevGoals0, RevGoals, !PDInfo) :-
|
|
( if
|
|
% Look for a goal later in the conjunction to deforest with.
|
|
MaybeBranchInfo = yes(GoalBranchInfo),
|
|
detect_deforestation(Goal0, GoalBranchInfo, Goals0, Goals1,
|
|
DeforestInfo)
|
|
then
|
|
handle_deforestation(NonLocals, DeforestInfo,
|
|
RevGoals0, Goals1, Goals2, Optimized, !PDInfo),
|
|
(
|
|
Optimized = yes,
|
|
deforest_conj(Goals2, NonLocals, RevGoals0, RevGoals, !PDInfo)
|
|
;
|
|
Optimized = no,
|
|
pd_info_update_goal(Goal0, !PDInfo),
|
|
RevGoals1 = [Goal0 | RevGoals0],
|
|
deforest_conj(Goals0, NonLocals, RevGoals1, RevGoals, !PDInfo)
|
|
)
|
|
else
|
|
pd_info_update_goal(Goal0, !PDInfo),
|
|
RevGoals1 = [Goal0 | RevGoals0],
|
|
deforest_conj(Goals0, NonLocals, RevGoals1, RevGoals, !PDInfo)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type deforest_info
|
|
---> deforest_info(
|
|
hlds_goal, % earlier goal in conjunction
|
|
pd_branch_info(prog_var),
|
|
% branch_info for earlier goal
|
|
list(hlds_goal), % goals in between
|
|
hlds_goal, % later goal in conjunction
|
|
pd_branch_info(prog_var),
|
|
% branch_info for later goal
|
|
set(int) % branches for which there is
|
|
% extra information about the
|
|
% second goal, numbering starts
|
|
% at 1.
|
|
).
|
|
|
|
% Search backwards through the conjunction for the last goal which contains
|
|
% extra information about the variable being switched on.
|
|
%
|
|
:- pred detect_deforestation(hlds_goal::in,
|
|
pd_branch_info(prog_var)::in, annotated_conj::in,
|
|
annotated_conj::out, deforest_info::out) is semidet.
|
|
|
|
detect_deforestation(EarlierGoal, BranchInfo, !Goals, DeforestInfo) :-
|
|
search_for_deforest_goal(EarlierGoal, BranchInfo, [], !Goals,
|
|
DeforestInfo).
|
|
|
|
:- pred search_for_deforest_goal(hlds_goal::in,
|
|
pd_branch_info(prog_var)::in, annotated_conj::in,
|
|
annotated_conj::in, annotated_conj::out,
|
|
deforest_info::out) is semidet.
|
|
|
|
search_for_deforest_goal(EarlierGoal, EarlierBranchInfo, RevBetweenGoals0,
|
|
[Goal | Goals0], Goals, DeforestInfo) :-
|
|
( if
|
|
Goal = LaterGoal - yes(LaterBranchInfo),
|
|
potential_deforestation(EarlierBranchInfo,
|
|
LaterBranchInfo, DeforestBranches)
|
|
then
|
|
list.reverse(RevBetweenGoals0, BetweenGoals1),
|
|
assoc_list.keys(BetweenGoals1, BetweenGoals),
|
|
Goals = Goals0,
|
|
DeforestInfo = deforest_info(EarlierGoal, EarlierBranchInfo,
|
|
BetweenGoals, LaterGoal, LaterBranchInfo, DeforestBranches)
|
|
else
|
|
search_for_deforest_goal(EarlierGoal, EarlierBranchInfo,
|
|
[Goal | RevBetweenGoals0], Goals0, Goals, DeforestInfo)
|
|
).
|
|
|
|
% Look for a variable in the second branch_info for which we have more
|
|
% information in the first than in the instmap. Get the branches in the
|
|
% first goal which contain this extra information.
|
|
%
|
|
:- pred potential_deforestation(pd_branch_info(prog_var)::in,
|
|
pd_branch_info(prog_var)::in, set(int)::out) is semidet.
|
|
|
|
potential_deforestation(Info1, Info2, DeforestBranches) :-
|
|
Info1 = pd_branch_info(VarMap1, _, _),
|
|
Info2 = pd_branch_info(_, LeftVars2, _),
|
|
|
|
map.select(VarMap1, LeftVars2, VarMap),
|
|
map.to_assoc_list(VarMap, VarAssoc),
|
|
not map.is_empty(VarMap),
|
|
|
|
% Work out which branches of the first goal should contain
|
|
% unfolded versions of the second goal.
|
|
GetBranches =
|
|
( pred(VarInfo::in, Branches0::in, Branches::out) is det :-
|
|
VarInfo = _ - Branches1,
|
|
set.union(Branches0, Branches1, Branches)
|
|
),
|
|
set.init(DeforestBranches0),
|
|
list.foldl(GetBranches, VarAssoc, DeforestBranches0, DeforestBranches).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Take the part of a conjunction found to have potential
|
|
% for deforestation and attempt the optimization.
|
|
%
|
|
:- pred handle_deforestation(set_of_progvar::in, deforest_info::in,
|
|
list(hlds_goal)::in,
|
|
annotated_conj::in, annotated_conj::out, bool::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
handle_deforestation(NonLocals, DeforestInfo0, RevBeforeGoals0, !AfterGoals,
|
|
Optimized, !PDInfo) :-
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
pd_info_get_created_versions(!.PDInfo, CreatedVersions0),
|
|
|
|
pd_info_get_depth(!.PDInfo, Depth0),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "handle_deforestation",
|
|
"checking for deforestation at depth %i\n", [i(Depth0)], !IO)
|
|
),
|
|
|
|
reorder_conj(DeforestInfo0, DeforestInfo,
|
|
BeforeIrrelevant, AfterIrrelevant, !.PDInfo),
|
|
|
|
get_sub_conj_nonlocals(NonLocals, DeforestInfo, RevBeforeGoals0,
|
|
BeforeIrrelevant, AfterIrrelevant, !.AfterGoals, ConjNonLocals),
|
|
|
|
% Update the instmap.
|
|
list.foldl(pd_info_update_goal, BeforeIrrelevant, !PDInfo),
|
|
|
|
pd_info_get_pred_proc_id(!.PDInfo, CurrPredProcId),
|
|
pd_info_get_parents(!.PDInfo, Parents0),
|
|
pd_info_get_cost_delta(!.PDInfo, CostDelta0),
|
|
pd_info_get_size_delta(!.PDInfo, SizeDelta0),
|
|
|
|
DeforestInfo = deforest_info(EarlierGoal, _, BetweenGoals,
|
|
LaterGoal, _, DeforestBranches),
|
|
|
|
should_try_deforestation(DeforestInfo, !.PDInfo, ShouldOptimize),
|
|
(
|
|
ShouldOptimize = no,
|
|
Optimized0 = no,
|
|
Goals = []
|
|
;
|
|
ShouldOptimize = yes,
|
|
( if
|
|
EarlierGoal = hlds_goal(plain_call(PredId1, _, _, _, _, _), _),
|
|
LaterGoal = hlds_goal(plain_call(PredId2, _, _, _, _, _), _)
|
|
then
|
|
% If both goals are calls, create a new predicate for the
|
|
% conjunction to be deforested, and process it.
|
|
PredName1 = predicate_name(ModuleInfo, PredId1),
|
|
PredName2 = predicate_name(ModuleInfo, PredId2),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "handle_deforestation",
|
|
"deforesting calls to %s and %s\n",
|
|
[s(PredName1), s(PredName2)], !IO)
|
|
),
|
|
call_call(ConjNonLocals, EarlierGoal, BetweenGoals,
|
|
yes(LaterGoal), MaybeGoal, !PDInfo),
|
|
(
|
|
MaybeGoal = yes(Goal),
|
|
Optimized0 = yes,
|
|
Goals = [Goal]
|
|
;
|
|
MaybeGoal = no,
|
|
Optimized0 = no,
|
|
Goals = []
|
|
)
|
|
else if
|
|
% If the first goal is branched and the second goal is a call,
|
|
% attempt to push the call into the branches. Don't push a
|
|
% recursive call or a call to a predicate we have already pushed
|
|
% into a switch, since it is difficult to stop the process.
|
|
EarlierGoal = hlds_goal(EarlierGoalExpr, _),
|
|
goal_util.goal_is_branched(EarlierGoalExpr),
|
|
LaterGoal = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _),
|
|
PredProcId = proc(PredId, ProcId),
|
|
PredProcId \= CurrPredProcId,
|
|
not set.member(PredProcId, Parents0)
|
|
then
|
|
CurrPredName = predicate_name(ModuleInfo, PredId),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "handle_deforestation",
|
|
"pushing call to %s into goal\n",
|
|
[s(CurrPredName)], !IO)
|
|
),
|
|
set.insert(proc(PredId, ProcId), Parents0, Parents),
|
|
pd_info_set_parents(Parents, !PDInfo),
|
|
push_goal_into_goal(ConjNonLocals, DeforestBranches,
|
|
EarlierGoal, BetweenGoals, LaterGoal, Goal, !PDInfo),
|
|
Goals = [Goal],
|
|
Optimized0 = yes
|
|
else if
|
|
% If both goals are branched, push the second into the branches
|
|
% of the first.
|
|
EarlierGoal = hlds_goal(EarlierGoalExpr, _),
|
|
LaterGoal = hlds_goal(LaterGoalExpr, _),
|
|
goal_util.goal_is_branched(EarlierGoalExpr),
|
|
goal_util.goal_is_branched(LaterGoalExpr)
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "handle_deforestation",
|
|
"pushing goal into goal\n", [], !IO),
|
|
pd_debug_output_goal(!.PDInfo, "handle_deforestation",
|
|
"first goal being pushed into", EarlierGoal, !IO),
|
|
(
|
|
BetweenGoals = [],
|
|
pd_debug_message(!.PDInfo, "handle_deforestation",
|
|
"no goal between first/second goals\n", [], !IO)
|
|
;
|
|
BetweenGoals = [BetweenGoal],
|
|
pd_debug_output_goal(!.PDInfo, "handle_deforestation",
|
|
"one goal between first/second goals",
|
|
BetweenGoal, !IO)
|
|
;
|
|
BetweenGoals = [_, _ | _],
|
|
pd_debug_output_goals(!.PDInfo, "handle_deforestation",
|
|
"goals beteween first/second goals",
|
|
BetweenGoals, !IO)
|
|
),
|
|
pd_debug_output_goal(!.PDInfo, "handle_deforestation",
|
|
"second goal being pushed", LaterGoal, !IO)
|
|
),
|
|
push_goal_into_goal(ConjNonLocals, DeforestBranches,
|
|
EarlierGoal, BetweenGoals, LaterGoal, Goal, !PDInfo),
|
|
trace [io(!IO)] (
|
|
pd_debug_output_goal(!.PDInfo, "handle_deforestation",
|
|
"result of pushing goal into goal", Goal, !IO)
|
|
),
|
|
Goals = [Goal],
|
|
goals_size([EarlierGoal | BetweenGoals], ConjSize1),
|
|
goal_size(LaterGoal, ConjSize2),
|
|
goal_size(Goal, NewSize),
|
|
SizeDiff = NewSize - ConjSize1 - ConjSize2,
|
|
pd_info_incr_size_delta(SizeDiff, !PDInfo),
|
|
Optimized0 = yes
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "handle_deforestation",
|
|
"not optimizing\n", [], !IO)
|
|
),
|
|
Goals = [],
|
|
Optimized0 = no
|
|
)
|
|
),
|
|
Optimized = is_any_improvement_worth_while(!.PDInfo, Optimized0,
|
|
CostDelta0, SizeDelta0),
|
|
|
|
% Clean up.
|
|
pd_info_set_depth(Depth0, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
(
|
|
Optimized = no,
|
|
|
|
% XXX Currently this only attempts to deforest the first goal
|
|
% with the first matching goal later in the conjunction. If the
|
|
% deforestation failed, other later goals should be tried.
|
|
%
|
|
% Return everything to the state it was in before the attempted
|
|
% optimization.
|
|
pd_info_set_cost_delta(CostDelta0, !PDInfo),
|
|
pd_info_set_size_delta(SizeDelta0, !PDInfo),
|
|
|
|
% Remove any versions which were created.
|
|
pd_info_get_created_versions(!.PDInfo, CreatedVersions),
|
|
set.difference(CreatedVersions, CreatedVersions0, NewVersions0),
|
|
set.to_sorted_list(NewVersions0, NewVersions),
|
|
list.foldl(pd_info_remove_version, NewVersions, !PDInfo)
|
|
|
|
% AfterGoals will be restored properly in conj.
|
|
;
|
|
Optimized = yes,
|
|
% We want to reprocess the deforested goal to see if it can be
|
|
% deforested with other goals later in the conjunction.
|
|
list.condense([BeforeIrrelevant, Goals, AfterIrrelevant],
|
|
GoalsToProcess),
|
|
compute_goal_infos(GoalsToProcess, GoalsAndInfo, !PDInfo),
|
|
list.append(GoalsAndInfo, !AfterGoals),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
pd_info_set_changed(yes, !PDInfo),
|
|
pd_info_set_rerun_det(yes, !PDInfo)
|
|
),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "handle_deforestation",
|
|
"finished deforestation at depth %i\n", [i(Depth0)], !IO)
|
|
),
|
|
pd_info_set_parents(Parents0, !PDInfo).
|
|
|
|
% Check whether deforestation is legal and worthwhile.
|
|
%
|
|
:- pred should_try_deforestation(deforest_info::in, pd_info::in,
|
|
bool::out) is det.
|
|
|
|
should_try_deforestation(DeforestInfo, PDInfo, ShouldTry) :-
|
|
DeforestInfo = deforest_info(EarlierGoal, EarlierBranchInfo,
|
|
BetweenGoals, LaterGoal, _, _),
|
|
pd_info_get_useless_versions(PDInfo, UselessVersions),
|
|
( if
|
|
EarlierGoal = hlds_goal(plain_call(PredId1, ProcId1, _, _, _, _), _),
|
|
LaterGoal = hlds_goal(plain_call(PredId2, ProcId2, _, _, _, _), _),
|
|
set.member(proc(PredId1, ProcId1) - proc(PredId2, ProcId2),
|
|
UselessVersions)
|
|
then
|
|
trace [compile_time(flag("debug_deforest")), io(!IO)] (
|
|
pd_debug_message(PDInfo, "should_try_deforestation",
|
|
"version tried before, not worthwhile\n", [], !IO)
|
|
),
|
|
ShouldTry = no
|
|
else if
|
|
% 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 = hlds_goal(_, OpaqueGoalInfo),
|
|
OpaqueNonLocals = goal_info_get_nonlocals(OpaqueGoalInfo),
|
|
OpaqueVarsSet = set_of_var.set_to_bitset(OpaqueVars),
|
|
set_of_var.intersect(OpaqueNonLocals, OpaqueVarsSet, UsedOpaqueVars),
|
|
set_of_var.is_non_empty(UsedOpaqueVars)
|
|
then
|
|
trace [compile_time(flag("debug_deforest")), io(!IO)] (
|
|
pd_debug_message(PDInfo, "should_try_deforestation",
|
|
"later goals depend on opaque vars\n", [], !IO)
|
|
),
|
|
ShouldTry = no
|
|
else if
|
|
% A disjunction can be semidet only if it binds no variables.
|
|
% If we push a goal which binds a variable into a semidet disjunction,
|
|
% it won't be semidet anymore.
|
|
%
|
|
% We assume that LaterGoal can bind variables, because we don't know
|
|
% whether it can or not. Its instmap_delta doesn't tell us, because
|
|
% it tells us only the NEW inst of the variables whose insts it
|
|
% changes. Without knowing their old insts as well, we don't know
|
|
% whether the inst change reflects the variable being bound, or just
|
|
% the gathering of knowledge about what its initial value could have
|
|
% been.
|
|
EarlierGoal = hlds_goal(disj(_), EarlierGoalInfo),
|
|
EarlierGoalDetism = goal_info_get_determinism(EarlierGoalInfo),
|
|
determinism_components(EarlierGoalDetism, _, EarlierGoalMaxSolns),
|
|
EarlierGoalMaxSolns \= at_most_many
|
|
then
|
|
ShouldTry = no
|
|
else
|
|
ShouldTry = yes
|
|
).
|
|
|
|
:- pred can_optimize_conj(hlds_goal::in, list(hlds_goal)::in,
|
|
maybe(hlds_goal)::in, bool::out, pd_info::in, pd_info::out) is det.
|
|
|
|
can_optimize_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, ShouldTry,
|
|
!PDInfo) :-
|
|
pd_info_get_depth(!.PDInfo, Depth0),
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
MaxDepth = OptTuple ^ ot_deforestation_depth_limit,
|
|
Depth = Depth0 + 1,
|
|
pd_info_set_depth(Depth, !PDInfo),
|
|
SizeLimit = OptTuple ^ ot_deforestation_size_threshold,
|
|
globals.lookup_option(Globals, fully_strict, FullyStrictOp),
|
|
( if
|
|
MaxDepth \= -1, % no depth limit set
|
|
% XXX The *default* value of the depth_limit is 4,
|
|
% so -1 does NOT mean that there is no depth limit set.
|
|
Depth0 >= MaxDepth
|
|
then
|
|
% The depth limit was exceeded. This should not occur too often in
|
|
% practice - the depth limit is just a safety net.
|
|
trace [compile_time(flag("debug_deforest")), io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "can_optimize_conj",
|
|
"\n\n*****Depth limit exceeded*****\n\n", [], !IO)
|
|
),
|
|
ShouldTry = no
|
|
else if
|
|
% Check whether either of the goals to be deforested is too large.
|
|
% XXX This is probably a bit too crude, especially for LaterGoal,
|
|
% which should be reduced in size in the specialized version
|
|
% (the specialized version will only include one branch of the
|
|
% top-level switch).
|
|
SizeLimit \= -1,
|
|
(
|
|
EarlierGoal = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _)
|
|
;
|
|
MaybeLaterGoal = yes(
|
|
hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _))
|
|
),
|
|
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
|
|
_, CalledProcInfo),
|
|
proc_info_get_goal(CalledProcInfo, CalledGoal),
|
|
goal_size(CalledGoal, CalledGoalSize),
|
|
SizeLimit \= -1,
|
|
CalledGoalSize > SizeLimit
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "can_optimize_conj",
|
|
"goal too large\n", [], !IO)
|
|
),
|
|
ShouldTry = no
|
|
else if
|
|
% Check whether either of the goals to be deforested can't be inlined.
|
|
(
|
|
EarlierGoal = hlds_goal(EarlierGoalExpr, _),
|
|
EarlierGoalExpr = plain_call(PredId, ProcId, _, BuiltinState, _, _)
|
|
;
|
|
MaybeLaterGoal = yes(hlds_goal(LaterGoalExpr, _)),
|
|
LaterGoalExpr = plain_call(PredId, ProcId, _, BuiltinState, _, _)
|
|
),
|
|
|
|
% We don't attempt to deforest predicates which have purity promises
|
|
% because the extra impurity propagated through the goal when such
|
|
% predicates are inlined will defeat any attempt at deforestation.
|
|
% XXX We should probably allow deforestation of semipure goals.
|
|
not inlining.can_inline_proc(ModuleInfo, PredId, ProcId, BuiltinState,
|
|
may_not_inline_purity_promised_pred)
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "can_optimize_conj",
|
|
"non-inlineable calls\n", [], !IO)
|
|
),
|
|
ShouldTry = no
|
|
else if
|
|
%
|
|
% Don't optimize if that would require duplicating
|
|
% branched goal structures.
|
|
%
|
|
not is_simple_goal_list(BetweenGoals)
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "can_optimize_conj",
|
|
"between goals not simple enough\n", [], !IO)
|
|
),
|
|
ShouldTry = no
|
|
else if
|
|
% Give up if there are any impure goals involved.
|
|
% XXX We should probably allow deforestation of semipure goals.
|
|
( list.member(ImpureGoal, BetweenGoals)
|
|
; ImpureGoal = EarlierGoal
|
|
; MaybeLaterGoal = yes(ImpureGoal)
|
|
),
|
|
ImpureGoal = hlds_goal(_, ImpureGoalInfo),
|
|
not goal_info_get_purity(ImpureGoalInfo) = purity_pure
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "can_optimize_conj",
|
|
"goal list contains impure goal(s)\n", [], !IO)
|
|
),
|
|
ShouldTry = no
|
|
else if
|
|
% Check whether interleaving the execution of the goals could alter
|
|
% the termination behaviour in a way which is illegal according to the
|
|
% semantics options.
|
|
%
|
|
FullyStrictOp = bool(FullyStrict),
|
|
(
|
|
list.member(OtherGoal, BetweenGoals)
|
|
;
|
|
MaybeLaterGoal = yes(LaterGoal),
|
|
OtherGoal = LaterGoal
|
|
),
|
|
not reordering_maintains_termination_old(ModuleInfo, FullyStrict,
|
|
EarlierGoal, OtherGoal)
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "can_optimize_conj",
|
|
"interleaving execution could change termination behaviour\n",
|
|
[], !IO)
|
|
),
|
|
ShouldTry = no
|
|
else
|
|
ShouldTry = yes
|
|
).
|
|
|
|
% Check that the code size increase is justified by the estimated
|
|
% performance increase. This should err towards allowing optimization
|
|
% - without any check at all the code size of the library only increases
|
|
% ~10%.
|
|
%
|
|
:- func is_any_improvement_worth_while(pd_info, bool, int, int) = bool.
|
|
|
|
is_any_improvement_worth_while(PDInfo, Optimized0, CostDelta0, SizeDelta0)
|
|
= Optimized :-
|
|
(
|
|
Optimized0 = no,
|
|
Optimized = no
|
|
;
|
|
Optimized0 = yes,
|
|
pd_info_get_cost_delta(PDInfo, CostDelta),
|
|
pd_info_get_size_delta(PDInfo, SizeDelta),
|
|
CostDiff = CostDelta - CostDelta0,
|
|
SizeDiff = SizeDelta - SizeDelta0,
|
|
|
|
pd_info_get_module_info(PDInfo, ModuleInfo),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
Factor = OptTuple ^ ot_deforestation_cost_factor,
|
|
( if
|
|
( if SizeDiff =< 5 then
|
|
% For small increases in size, accept any amount of
|
|
% optimization.
|
|
CostDiff > 0
|
|
else
|
|
% Accept the optimization if we save the equivalent of
|
|
% a heap increment per 3 extra atomic goals. Note that
|
|
% folding is heavily rewarded by pd_cost.m, so this
|
|
% isn't very restrictive if a fold occurs.
|
|
ExpectedCostDiff = 1000 * cost_of_heap_incr * SizeDiff // 3,
|
|
FudgedCostDiff = CostDiff * Factor,
|
|
FudgedCostDiff >= ExpectedCostDiff
|
|
)
|
|
then
|
|
Optimized = yes,
|
|
trace [io(!IO)] (
|
|
pd_debug_message(PDInfo, "is_improvement_worth_while",
|
|
"enough improvement: cost(%i) size(%i)\n",
|
|
[i(CostDiff), i(SizeDiff)], !IO)
|
|
)
|
|
else
|
|
Optimized = no,
|
|
trace [io(!IO)] (
|
|
pd_debug_message(PDInfo, "is_improvement_worth_while",
|
|
"not enough improvement: cost(%i) size(%i)\n",
|
|
[i(CostDiff), i(SizeDiff)], !IO)
|
|
)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Attempt deforestation on a pair of calls.
|
|
%
|
|
:- pred call_call(set_of_progvar::in, hlds_goal::in,
|
|
list(hlds_goal)::in, maybe(hlds_goal)::in, maybe(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
call_call(ConjNonLocals, EarlierGoal, BetweenGoals, MaybeLaterGoal, MaybeGoal,
|
|
!PDInfo) :-
|
|
can_optimize_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, ShouldTry,
|
|
!PDInfo),
|
|
(
|
|
ShouldTry = yes,
|
|
disable_warning [suspicious_recursion] (
|
|
call_call(ConjNonLocals, EarlierGoal, BetweenGoals,
|
|
MaybeLaterGoal, MaybeGoal, !PDInfo)
|
|
)
|
|
;
|
|
ShouldTry = no,
|
|
MaybeGoal = no
|
|
).
|
|
|
|
% Attempt deforestation on a pair of calls.
|
|
%
|
|
:- pred call_call_2(set_of_progvar::in, hlds_goal::in,
|
|
list(hlds_goal)::in, maybe(hlds_goal)::in, maybe(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
:- pragma consider_used(pred(call_call_2/7)).
|
|
|
|
call_call_2(ConjNonLocals, EarlierGoal, BetweenGoals, MaybeLaterGoal,
|
|
MaybeGoal, !PDInfo) :-
|
|
create_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, ConjNonLocals,
|
|
FoldGoal),
|
|
|
|
pd_info_search_version(!.PDInfo, FoldGoal, MaybeVersion),
|
|
pd_info_get_parent_versions(!.PDInfo, Parents),
|
|
|
|
( if
|
|
MaybeVersion = version(_, VersionPredProcId,
|
|
VersionInfo, Renaming, TypeRenaming)
|
|
then
|
|
% If we see an opportunity to fold, take it.
|
|
VersionPredProcId = proc(VersionPredId, _),
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
|
|
FoldPredName = predicate_name(ModuleInfo0, VersionPredId),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "call_call_2",
|
|
"Folded with %s\n", [s(FoldPredName)], !IO)
|
|
),
|
|
( if set.member(VersionPredProcId, Parents) then
|
|
FoldCostDelta = cost_of_recursive_fold
|
|
else
|
|
FoldCostDelta = cost_of_fold
|
|
),
|
|
pd_info_incr_cost_delta(FoldCostDelta, !PDInfo),
|
|
goals_size([EarlierGoal | BetweenGoals], NegSizeDelta),
|
|
SizeDelta = - NegSizeDelta,
|
|
pd_info_incr_size_delta(SizeDelta, !PDInfo),
|
|
create_call_goal(VersionPredProcId, VersionInfo, Renaming,
|
|
TypeRenaming, Goal, !PDInfo),
|
|
MaybeGoal = yes(Goal)
|
|
else
|
|
pd_info_get_global_term_info(!.PDInfo, TermInfo0),
|
|
pd_info_get_parent_versions(!.PDInfo, ParentVersions0),
|
|
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "call_call_2",
|
|
"Parents: %s\n", [s(string.string(ParentVersions0))], !IO)
|
|
),
|
|
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
pd_info_get_versions(!.PDInfo, Versions),
|
|
pd_info_get_instmap(!.PDInfo, InstMap),
|
|
pd_term.global_check(ModuleInfo, EarlierGoal, BetweenGoals,
|
|
MaybeLaterGoal, InstMap, Versions, TermInfo0, TermInfo,
|
|
CheckResult),
|
|
(
|
|
CheckResult = ok(ProcPair, Size),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "call_call_2",
|
|
"global termination check succeeded - " ++
|
|
"creating new version\n",
|
|
[], !IO)
|
|
),
|
|
pd_info_set_global_term_info(TermInfo, !PDInfo),
|
|
RunModes = no,
|
|
MaybeGeneralised = no,
|
|
create_deforest_goal(EarlierGoal, BetweenGoals,
|
|
MaybeLaterGoal, FoldGoal, ConjNonLocals, RunModes, ProcPair,
|
|
Size, MaybeGeneralised, MaybeGoal, !PDInfo)
|
|
;
|
|
CheckResult = possible_loop(ProcPair, Size, CoveringPredProcId),
|
|
% The termination check found the same pair of end-points with the
|
|
% same length goal. If the goal matches the goal for the "covering"
|
|
% predicate, perform a most specific generalisation on the insts
|
|
% then keep on going.
|
|
try_generalisation(EarlierGoal, BetweenGoals,
|
|
MaybeLaterGoal, FoldGoal, ConjNonLocals, ProcPair, Size,
|
|
CoveringPredProcId, MaybeGoal, !PDInfo)
|
|
;
|
|
CheckResult = loop,
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "call_call_2",
|
|
"global termination check failed\n", [], !IO)
|
|
),
|
|
MaybeGoal = no
|
|
),
|
|
pd_info_set_global_term_info(TermInfo0, !PDInfo)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Create a new procedure for a conjunction to be deforested, then
|
|
% recursively process that procedure.
|
|
%
|
|
:- pred create_deforest_goal(hlds_goal::in, list(hlds_goal)::in,
|
|
maybe(hlds_goal)::in, hlds_goal::in, set_of_progvar::in, bool::in,
|
|
proc_pair::in, int::in, maybe(pred_proc_id)::in, maybe(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
create_deforest_goal(EarlierGoal, BetweenGoals, MaybeLaterGoal,
|
|
FoldGoal0, NonLocals, RunModes, ProcPair, Size,
|
|
MaybeGeneralised, MaybeCallGoal, !PDInfo) :-
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
|
|
module_info_get_globals(ModuleInfo0, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
VarsThreshold = OptTuple ^ ot_deforestation_vars_threshold,
|
|
( if
|
|
EarlierGoal = hlds_goal(EarlierGoalExpr, _),
|
|
EarlierGoalExpr = plain_call(PredId1, ProcId1, Args1, _, _, _),
|
|
(
|
|
% No threshold set.
|
|
VarsThreshold = -1
|
|
% XXX The *default* value of the vars threshold is 200,
|
|
% so -1 does NOT mean that there is no threshold set.
|
|
;
|
|
% Check that we are not creating a procedure with a massive number
|
|
% of variables. We assume that all the variables in the first
|
|
% called goal are present in the final version. If the number
|
|
% of variables in the first called goal plus the number of
|
|
% variables in BetweenGoals is less than
|
|
% --deforestation-vars-threshold, go ahead and optimize.
|
|
|
|
module_info_pred_proc_info(ModuleInfo0, PredId1, ProcId1, _,
|
|
CalledProcInfo1),
|
|
proc_info_get_goal(CalledProcInfo1, CalledGoal1),
|
|
vars_in_goal(CalledGoal1, GoalVars1),
|
|
set_of_var.to_sorted_list(GoalVars1, GoalVarsList1),
|
|
vars_in_goals(BetweenGoals, GoalVars2),
|
|
set_of_var.to_sorted_list(GoalVars2, GoalVarsList2),
|
|
|
|
list.length(GoalVarsList1, NumVars1),
|
|
list.length(GoalVarsList2, NumVars2),
|
|
NumVars = NumVars1 + NumVars2,
|
|
NumVars < VarsThreshold
|
|
)
|
|
then
|
|
% Create the goal for the new predicate, unfolding the first call.
|
|
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
pd_info_get_proc_info(!.PDInfo, ProcInfo0),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "create_deforest_goal",
|
|
"unfolding first call\n", [], !IO)
|
|
),
|
|
|
|
maybe_unfold_call(no, no, PredId1, ProcId1, Args1, DidUnfold,
|
|
EarlierGoal, UnfoldedCall, !PDInfo),
|
|
create_conj(UnfoldedCall, BetweenGoals, MaybeLaterGoal, NonLocals,
|
|
DeforestGoal0),
|
|
set_of_var.to_sorted_list(NonLocals, NonLocalsList),
|
|
|
|
( if
|
|
DidUnfold = yes,
|
|
RunModes = yes
|
|
then
|
|
% If we did a generalisation step when creating this version,
|
|
% we need to modecheck to propagate through the new insts.
|
|
% If this causes mode errors, don't create the new version.
|
|
% This can happen if a procedure expected an input to be bound
|
|
% to a particular functor but the extra information was
|
|
% generalised away.
|
|
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "create_deforest_goal",
|
|
"running modes on deforest goal\n", [], !IO)
|
|
),
|
|
pd_util.unique_modecheck_goal(DeforestGoal0, DeforestGoal,
|
|
Errors1, !PDInfo),
|
|
pd_util.unique_modecheck_goal(FoldGoal0, FoldGoal,
|
|
Errors2, !PDInfo),
|
|
Errors = Errors1 ++ Errors2
|
|
else
|
|
DeforestGoal = DeforestGoal0,
|
|
FoldGoal = FoldGoal0,
|
|
Errors = []
|
|
),
|
|
|
|
% We must have been able to unfold the first call to proceed
|
|
% with the optimization, otherwise we will introduce an
|
|
% infinite loop in the generated code.
|
|
( if
|
|
DidUnfold = yes,
|
|
Errors = []
|
|
then
|
|
% Create the new version.
|
|
|
|
pd_info_define_new_pred(DeforestGoal, PredProcId, CallGoal,
|
|
!PDInfo),
|
|
PredProcId = proc(PredId, _),
|
|
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
|
|
PredName = predicate_name(ModuleInfo, PredId),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "create_deforest_goal",
|
|
"created predicate %s\n", [s(PredName)], !IO)
|
|
),
|
|
( if
|
|
MaybeLaterGoal = yes(hlds_goal(LaterGoalExpr, _)),
|
|
LaterGoalExpr = plain_call(PredId2, ProcId2, _, _, _, _)
|
|
then
|
|
CalledPreds = [proc(PredId1, ProcId1), proc(PredId2, ProcId2)]
|
|
else
|
|
CalledPreds = [proc(PredId1, ProcId1)]
|
|
),
|
|
pd_info_get_parent_versions(!.PDInfo, Parents0),
|
|
|
|
pd_info_get_proc_info(!.PDInfo, ProcInfo1),
|
|
proc_info_get_var_table(ProcInfo1, VarTable),
|
|
lookup_var_types(VarTable, NonLocalsList, ArgTypes),
|
|
VersionInfo = version_info(FoldGoal, CalledPreds, NonLocalsList,
|
|
ArgTypes, InstMap0, 0, 0, Parents0, MaybeGeneralised),
|
|
pd_info_get_global_term_info(!.PDInfo, TermInfo0),
|
|
pd_term.update_global_term_info(ProcPair, PredProcId,
|
|
Size, TermInfo0, TermInfo),
|
|
pd_info_set_global_term_info(TermInfo, !PDInfo),
|
|
set.insert_list([PredProcId | CalledPreds], Parents0, Parents),
|
|
pd_info_set_parent_versions(Parents, !PDInfo),
|
|
pd_info_register_version(PredProcId, VersionInfo, !PDInfo),
|
|
|
|
% Run deforestation on the new predicate to do the folding.
|
|
pd_info_get_unfold_info(!.PDInfo, UnfoldInfo),
|
|
deforest_proc_deltas(PredProcId, CostDelta, SizeDelta, !PDInfo),
|
|
pd_info_set_unfold_info(UnfoldInfo, !PDInfo),
|
|
pd_info_incr_cost_delta(CostDelta, !PDInfo),
|
|
pd_info_incr_size_delta(SizeDelta, !PDInfo),
|
|
pd_info_set_parent_versions(Parents0, !PDInfo),
|
|
|
|
pd_info_get_progress_stream(!.PDInfo, ProgressStream),
|
|
pd_info_get_pred_proc_id(!.PDInfo, CurPredProcId),
|
|
trace [io(!IO)] (
|
|
maybe_write_proc_progress_message(ProgressStream, ModuleInfo,
|
|
"Back in", CurPredProcId, !IO)
|
|
),
|
|
MaybeCallGoal = yes(CallGoal)
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "create_deforest_goal",
|
|
"generalisation produced mode errors\n", [], !IO)
|
|
),
|
|
MaybeCallGoal = no
|
|
),
|
|
|
|
% The var_table field was updated when we unfolded the first call,
|
|
% but all the new variables are only used in the new version,
|
|
% so it is safe to reset the proc_info.
|
|
pd_info_set_proc_info(ProcInfo0, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo)
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "create_deforest_goal",
|
|
"vars threshold exceeded\n", [], !IO)
|
|
),
|
|
MaybeCallGoal = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Create a goal to call a newly created version.
|
|
%
|
|
:- pred create_call_goal(pred_proc_id::in, version_info::in,
|
|
map(prog_var, prog_var)::in, tsubst::in, hlds_goal::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
create_call_goal(proc(PredId, ProcId), VersionInfo, Renaming, TypeSubn, Goal,
|
|
!PDInfo) :-
|
|
OldArgVars = VersionInfo ^ version_arg_vars,
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
|
|
CalledPredInfo, CalledProcInfo),
|
|
pred_info_get_arg_types(CalledPredInfo, CalledTVarSet, _CalledExistQVars,
|
|
ArgTypes0),
|
|
|
|
% Rename the arguments in the version.
|
|
pd_info_get_proc_info(!.PDInfo, ProcInfo0),
|
|
pd_info_get_pred_info(!.PDInfo, PredInfo0),
|
|
|
|
proc_info_get_var_table(ProcInfo0, VarTable0),
|
|
pred_info_get_typevarset(PredInfo0, TVarSet0),
|
|
|
|
% Rename the argument types using the current pred's tvarset.
|
|
tvarset_merge_renaming(TVarSet0, CalledTVarSet, TVarSet, TypeRenaming),
|
|
pred_info_set_typevarset(TVarSet, PredInfo0, PredInfo),
|
|
pd_info_set_pred_info(PredInfo, !PDInfo),
|
|
apply_renaming_to_types(TypeRenaming, ArgTypes0, ArgTypes1),
|
|
|
|
create_deforest_call_arg_vars(ModuleInfo, Renaming, TypeSubn,
|
|
OldArgVars, ArgTypes1, ArgVars, VarTable0, VarTable),
|
|
proc_info_set_var_table(VarTable, ProcInfo0, ProcInfo),
|
|
pd_info_set_proc_info(ProcInfo, !PDInfo),
|
|
|
|
% Compute a goal_info.
|
|
proc_info_get_argmodes(CalledProcInfo, ArgModes),
|
|
instmap_delta_from_mode_list(ModuleInfo, ArgVars, ArgModes, InstMapDelta),
|
|
proc_info_interface_determinism(ProcInfo, Detism),
|
|
set_of_var.list_to_set(ArgVars, NonLocals),
|
|
pred_info_get_purity(CalledPredInfo, Purity),
|
|
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, GoalInfo),
|
|
|
|
PredModule = pred_info_module(CalledPredInfo),
|
|
PredName = pred_info_name(CalledPredInfo),
|
|
GoalExpr = plain_call(PredId, ProcId, ArgVars, not_builtin, no,
|
|
qualified(PredModule, PredName)),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
:- pred create_deforest_call_arg_vars(module_info::in,
|
|
map(prog_var, prog_var)::in, tsubst::in,
|
|
list(prog_var)::in, list(mer_type)::in, list(prog_var)::out,
|
|
var_table::in, var_table::out) is det.
|
|
|
|
create_deforest_call_arg_vars(_, _, _, [], [], [], !VarTable).
|
|
create_deforest_call_arg_vars(_, _, _, [], [_ | _], _, !VarTable) :-
|
|
unexpected($pred, "length mismatch").
|
|
create_deforest_call_arg_vars(_, _, _, [_ | _], [], _, !VarTable) :-
|
|
unexpected($pred, "length mismatch").
|
|
create_deforest_call_arg_vars(ModuleInfo, Renaming, TypeSubn,
|
|
[OldArgVar | OldArgVars], [ArgType | ArgTypes], [ArgVar | ArgVars],
|
|
!VarTable) :-
|
|
( if map.search(Renaming, OldArgVar, ArgVarPrime) then
|
|
ArgVar = ArgVarPrime
|
|
else
|
|
% The variable is local to the call. Create a fresh variable.
|
|
apply_subst_to_type(TypeSubn, ArgType, SubnArgType),
|
|
create_fresh_var(ModuleInfo, SubnArgType, ArgVar, !VarTable)
|
|
),
|
|
create_deforest_call_arg_vars(ModuleInfo, Renaming, TypeSubn,
|
|
OldArgVars, ArgTypes, ArgVars, !VarTable).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Combine the two goals to be deforested and the goals in between
|
|
% into a conjunction.
|
|
%
|
|
:- pred create_conj(hlds_goal::in, list(hlds_goal)::in,
|
|
maybe(hlds_goal)::in, set_of_progvar::in, hlds_goal::out) is det.
|
|
|
|
create_conj(EarlierGoal, BetweenGoals, MaybeLaterGoal, NonLocals, FoldGoal) :-
|
|
(
|
|
MaybeLaterGoal = yes(LaterGoal),
|
|
list.append([EarlierGoal | BetweenGoals], [LaterGoal], DeforestConj)
|
|
;
|
|
MaybeLaterGoal = no,
|
|
DeforestConj = [EarlierGoal | BetweenGoals]
|
|
),
|
|
goal_list_determinism(DeforestConj, Detism),
|
|
goal_list_instmap_delta(DeforestConj, InstMapDelta0),
|
|
instmap_delta_restrict(NonLocals, InstMapDelta0, InstMapDelta),
|
|
goal_list_purity(DeforestConj, Purity),
|
|
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, ConjInfo0),
|
|
|
|
% Give the conjunction a context so that the generated predicate
|
|
% name points to the location of the first goal.
|
|
EarlierGoal = hlds_goal(_, EarlierGoalInfo),
|
|
EarlierContext = goal_info_get_context(EarlierGoalInfo),
|
|
goal_info_set_context(EarlierContext, ConjInfo0, ConjInfo),
|
|
FoldGoal = hlds_goal(conj(plain_conj, DeforestConj), ConjInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% "Round-off" some of the extra information that caused the termination
|
|
% check to fail and/or the insts of the versions not to match in an attempt
|
|
% to achieve folding.
|
|
%
|
|
:- pred try_generalisation(hlds_goal::in, list(hlds_goal)::in,
|
|
maybe(hlds_goal)::in, hlds_goal::in, set_of_progvar::in,
|
|
proc_pair::in, int::in, pred_proc_id::in, maybe(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
try_generalisation(EarlierGoal, BetweenGoals, MaybeLaterGoal,
|
|
FoldGoal, ConjNonLocals, ProcPair, Size,
|
|
CoveringPredProcId, MaybeGoal, !PDInfo) :-
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "try_generalisation",
|
|
"start\n", [], !IO)
|
|
),
|
|
pd_info_get_versions(!.PDInfo, VersionIndex),
|
|
map.lookup(VersionIndex, CoveringPredProcId, Version),
|
|
Version = version_info(VersionGoal, _, VersionArgVars,
|
|
VersionArgTypes, VersionInstMap, _, _, _, _),
|
|
pd_info_get_versions(!.PDInfo, Versions),
|
|
pd_info_get_proc_info(!.PDInfo, ProcInfo),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
( if
|
|
pd_util.goals_match(ModuleInfo, VersionGoal, VersionArgVars,
|
|
VersionArgTypes, FoldGoal, VarTable, Renaming, _)
|
|
then
|
|
do_generalisation(VersionArgVars, Renaming, VersionInstMap,
|
|
EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals,
|
|
ProcPair, Size, CoveringPredProcId, MaybeGoal, !PDInfo)
|
|
else if
|
|
% If the earlier goal is a generalisation of another version, try
|
|
% matching against that. This happens when attempting two
|
|
% deforestations in a row and the first deforestation required
|
|
% generalisation.
|
|
match_generalised_version(ModuleInfo, VersionGoal,
|
|
VersionArgVars, VersionArgTypes, EarlierGoal, BetweenGoals,
|
|
MaybeLaterGoal, ConjNonLocals, VarTable, Versions,
|
|
Renaming)
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "try_generalisation",
|
|
"matched with generalised version\n", [], !IO)
|
|
),
|
|
do_generalisation(VersionArgVars, Renaming, VersionInstMap,
|
|
EarlierGoal, BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals,
|
|
ProcPair, Size, CoveringPredProcId, MaybeGoal, !PDInfo)
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "try_generalisation",
|
|
"goals don't match\n", [], !IO)
|
|
),
|
|
MaybeGoal = no
|
|
).
|
|
|
|
:- pred do_generalisation(list(prog_var)::in,
|
|
map(prog_var, prog_var)::in, instmap::in, hlds_goal::in,
|
|
list(hlds_goal)::in, maybe(hlds_goal)::in, hlds_goal::in,
|
|
set_of_progvar::in, proc_pair::in, int::in,
|
|
pred_proc_id::in, maybe(hlds_goal)::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
do_generalisation(VersionArgVars, Renaming, VersionInstMap, EarlierGoal,
|
|
BetweenGoals, MaybeLaterGoal, FoldGoal, ConjNonLocals,
|
|
ProcPair, Size, Generalised, MaybeGoal, !PDInfo) :-
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "do_generalisation",
|
|
"goals match, trying MSG\n", [], !IO)
|
|
),
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
instmap_lookup_vars(VersionInstMap, VersionArgVars, VersionInsts),
|
|
pd_util.inst_list_size(ModuleInfo, VersionInsts, VersionInstSizes),
|
|
set_of_var.to_sorted_list(ConjNonLocals, ConjNonLocalsList),
|
|
|
|
pd_info_get_proc_info(!.PDInfo, ProcInfo),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
( if
|
|
% Check whether we can do a most specific generalisation of insts
|
|
% of the non-locals.
|
|
try_MSG(ModuleInfo, VarTable, VersionInstMap, Renaming, VersionArgVars,
|
|
InstMap0, InstMap),
|
|
instmap_lookup_vars(InstMap, ConjNonLocalsList, ArgInsts),
|
|
pd_util.inst_list_size(ModuleInfo, ArgInsts, NewInstSizes),
|
|
NewInstSizes < VersionInstSizes
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "do_generalisation",
|
|
"MSG succeeded", [], !IO)
|
|
),
|
|
pd_info_set_instmap(InstMap, !PDInfo),
|
|
create_deforest_goal(EarlierGoal, BetweenGoals,
|
|
MaybeLaterGoal, FoldGoal, ConjNonLocals, yes, ProcPair,
|
|
Size, yes(Generalised), MaybeGoal, !PDInfo)
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "do_generalisation",
|
|
"MSG failed\n", [], !IO)
|
|
),
|
|
MaybeGoal = no
|
|
),
|
|
pd_info_set_instmap(InstMap0, !PDInfo).
|
|
|
|
:- pred try_MSG(module_info::in, var_table::in, instmap::in,
|
|
map(prog_var, prog_var)::in, list(prog_var)::in,
|
|
instmap::in, instmap::out) is semidet.
|
|
|
|
try_MSG(_, _, _, _, [], !InstMap).
|
|
try_MSG(ModuleInfo, VarTable, VersionInstMap, Renaming,
|
|
[VersionArgVar | VersionArgVars], !InstMap) :-
|
|
lookup_var_type(VarTable, VersionArgVar, VersionType),
|
|
instmap_lookup_var(VersionInstMap, VersionArgVar, VersionInst),
|
|
( if
|
|
map.search(Renaming, VersionArgVar, ArgVar),
|
|
instmap_lookup_var(!.InstMap, ArgVar, VarInst),
|
|
inst_MSG(ModuleInfo, VersionType, VersionInst, VarInst, Inst)
|
|
then
|
|
instmap_set_var(ArgVar, Inst, !InstMap)
|
|
else
|
|
true
|
|
),
|
|
try_MSG(ModuleInfo, VarTable, VersionInstMap, Renaming,
|
|
VersionArgVars, !InstMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% If the global termination check and generalisation failed and
|
|
% the first goal in the conjunction to be specialised is a generalisation
|
|
% of another version, try matching and generalising using that
|
|
% (non-generalised) version.
|
|
%
|
|
% This predicate maps the call to the generalised predicate back
|
|
% onto the non-generalised version. This makes the goal match
|
|
% with the previous conjunction, so the generalisation can be
|
|
% reapplied to the entire conjunction.
|
|
%
|
|
% XXX This only undoes one level of generalisation.
|
|
%
|
|
:- pred match_generalised_version(module_info::in,
|
|
hlds_goal::in, list(prog_var)::in, list(mer_type)::in,
|
|
hlds_goal::in, list(hlds_goal)::in, maybe(hlds_goal)::in,
|
|
set_of_progvar::in, var_table::in,
|
|
version_index::in, map(prog_var, prog_var)::out) is semidet.
|
|
|
|
match_generalised_version(ModuleInfo, VersionGoal, VersionArgVars,
|
|
VersionArgTypes, FirstGoal, BetweenGoals, MaybeLastGoal,
|
|
ConjNonLocals, !.VarTable, Versions, Renaming) :-
|
|
FirstGoal = hlds_goal(FirstGoalExpr, _),
|
|
FirstGoalExpr =
|
|
plain_call(FirstPredId, FirstProcId, FirstArgVars, _, _, _),
|
|
|
|
% Look up the version which the first goal calls.
|
|
map.search(Versions, proc(FirstPredId, FirstProcId), FirstVersionInfo),
|
|
FirstVersionInfo = version_info(FirstVersionGoal, _, FirstVersionArgVars,
|
|
_, _, _, _, _, MaybeNonGeneralisedVersion),
|
|
MaybeNonGeneralisedVersion = yes(NonGeneralisedPredProcId),
|
|
map.from_corresponding_lists(FirstVersionArgVars, FirstArgVars,
|
|
FirstRenaming0),
|
|
|
|
vars_in_goal(FirstVersionGoal, FirstVersionVars0),
|
|
set_of_var.to_sorted_list(FirstVersionVars0, FirstVersionVars),
|
|
|
|
module_info_pred_proc_info(ModuleInfo, FirstPredId, FirstProcId,
|
|
_, FirstProcInfo),
|
|
proc_info_get_var_table(FirstProcInfo, FirstVersionVarTable),
|
|
|
|
clone_variables(FirstVersionVars, FirstVersionVarTable,
|
|
!VarTable, FirstRenaming0, FirstRenaming),
|
|
must_rename_vars_in_goal(FirstRenaming,
|
|
FirstVersionGoal, RenamedFirstVersionGoal),
|
|
|
|
% Look up the version which was generalised to create the version
|
|
% which the first goal calls.
|
|
NonGeneralisedPredProcId = proc(NonGeneralisedPredId,
|
|
NonGeneralisedProcId),
|
|
goal_to_conj_list(VersionGoal, VersionGoalList),
|
|
VersionGoalList = [hlds_goal(
|
|
plain_call(NonGeneralisedPredId, NonGeneralisedProcId, _, _, _, _), _)
|
|
| _],
|
|
|
|
% Find a renaming from the argument variables of the generalised
|
|
% version to the version which was generalised.
|
|
map.search(Versions, NonGeneralisedPredProcId,
|
|
NonGeneralisedVersion),
|
|
NonGeneralisedVersion = version_info(NonGeneralisedGoal, _,
|
|
NonGeneralisedArgVars, NonGeneralisedArgTypes, _, _, _, _, _),
|
|
pd_util.goals_match(ModuleInfo, NonGeneralisedGoal,
|
|
NonGeneralisedArgVars, NonGeneralisedArgTypes,
|
|
RenamedFirstVersionGoal, !.VarTable,
|
|
GeneralRenaming, TypeRenaming),
|
|
|
|
module_info_pred_info(ModuleInfo, NonGeneralisedPredId,
|
|
NonGeneralisedPredInfo),
|
|
pred_info_get_arg_types(NonGeneralisedPredInfo, NonGeneralisedArgTypes),
|
|
create_deforest_call_arg_vars(ModuleInfo, GeneralRenaming, TypeRenaming,
|
|
NonGeneralisedArgVars, NonGeneralisedArgTypes, NewArgVars,
|
|
!.VarTable, _),
|
|
|
|
% Only fill in as much as pd_util.goals_match actually looks at.
|
|
goal_info_init(GoalInfo),
|
|
NonGeneralFirstGoalExpr = plain_call(NonGeneralisedPredId,
|
|
NonGeneralisedProcId, NewArgVars, not_builtin, no, unqualified("")),
|
|
NonGeneralFirstGoal = hlds_goal(NonGeneralFirstGoalExpr, GoalInfo),
|
|
create_conj(NonGeneralFirstGoal, BetweenGoals, MaybeLastGoal,
|
|
ConjNonLocals, GoalToMatch),
|
|
|
|
% Check whether the entire conjunction matches.
|
|
pd_util.goals_match(ModuleInfo, VersionGoal, VersionArgVars,
|
|
VersionArgTypes, GoalToMatch, !.VarTable, Renaming, _).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Work out the nonlocals of a sub-conjunction from the non-locals of the
|
|
% entire conjunction and the goals before and after the sub-conjunction.
|
|
% This is needed to ensure that the temporary list in double_append is
|
|
% found to be local to the conjunction and can be removed.
|
|
%
|
|
:- pred get_sub_conj_nonlocals(set_of_progvar::in, deforest_info::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::in, list(hlds_goal)::in,
|
|
annotated_conj::in, set_of_progvar::out) is det.
|
|
|
|
get_sub_conj_nonlocals(NonLocals0, DeforestInfo,
|
|
RevBeforeGoals, BeforeIrrelevant, AfterIrrelevant,
|
|
AfterGoals0, SubConjNonLocals) :-
|
|
DeforestInfo = deforest_info(EarlierGoal, _, BetweenGoals, LaterGoal,
|
|
_, _),
|
|
assoc_list.keys(AfterGoals0, AfterGoals),
|
|
do_get_sub_conj_nonlocals(NonLocals0, RevBeforeGoals,
|
|
BeforeIrrelevant, EarlierGoal, BetweenGoals, yes(LaterGoal),
|
|
AfterIrrelevant, AfterGoals, SubConjNonLocals).
|
|
|
|
:- pred do_get_sub_conj_nonlocals(set_of_progvar::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_of_progvar::out) is det.
|
|
|
|
do_get_sub_conj_nonlocals(!.NonLocals, RevBeforeGoals, BeforeIrrelevant,
|
|
EarlierGoal, BetweenGoals, MaybeLaterGoal,
|
|
AfterIrrelevant, AfterGoals, !:SubConjNonLocals) :-
|
|
AddGoalNonLocals =
|
|
( pred(Goal::in, Vars0::in, Vars::out) is det :-
|
|
Goal = hlds_goal(_, GoalInfo),
|
|
GoalNonLocals = goal_info_get_nonlocals(GoalInfo),
|
|
set_of_var.union(GoalNonLocals, Vars0, Vars)
|
|
),
|
|
list.foldl(AddGoalNonLocals, RevBeforeGoals, !NonLocals),
|
|
list.foldl(AddGoalNonLocals, BeforeIrrelevant, !NonLocals),
|
|
list.foldl(AddGoalNonLocals, AfterIrrelevant, !NonLocals),
|
|
list.foldl(AddGoalNonLocals, AfterGoals, !NonLocals),
|
|
|
|
list.foldl(AddGoalNonLocals, [EarlierGoal | BetweenGoals],
|
|
set_of_var.init, !:SubConjNonLocals),
|
|
(
|
|
MaybeLaterGoal = yes(LaterGoal),
|
|
call(AddGoalNonLocals, LaterGoal, !SubConjNonLocals)
|
|
;
|
|
MaybeLaterGoal = no
|
|
),
|
|
set_of_var.intersect(!.NonLocals, !SubConjNonLocals).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Attempt to move irrelevant goals out of the conjunction. This does a safe
|
|
% re-ordering that is guaranteed not to require rescheduling of the
|
|
% conjunction, since it does not reorder goals that depend on each other.
|
|
% We favor moving goals backward to avoid removing tail recursion.
|
|
%
|
|
:- pred reorder_conj(deforest_info::in, deforest_info::out,
|
|
list(hlds_goal)::out, list(hlds_goal)::out, pd_info::in) is det.
|
|
|
|
reorder_conj(DeforestInfo0, DeforestInfo,
|
|
BeforeIrrelevant, AfterIrrelevant, PDInfo) :-
|
|
pd_info_get_module_info(PDInfo, ModuleInfo),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
trace [io(!IO)] (
|
|
pd_debug_message(PDInfo, "reorder_conj", "starting\n", [], !IO)
|
|
),
|
|
DeforestInfo0 = deforest_info(EarlierGoal, EarlierBranchInfo,
|
|
BetweenGoals0, LaterGoal, LaterBranchInfo, DeforestBranches),
|
|
|
|
globals.lookup_bool_option(Globals, fully_strict, FullyStrict),
|
|
move_goals(deforest.can_move_goal_backward, ModuleInfo,
|
|
FullyStrict, BetweenGoals0, [], RevBetweenGoals1, EarlierGoal,
|
|
[], RevBeforeIrrelevant),
|
|
move_goals(deforest.can_move_goal_forward,
|
|
ModuleInfo, FullyStrict, RevBetweenGoals1,
|
|
[], BetweenGoals, LaterGoal, [], AfterIrrelevant),
|
|
|
|
list.reverse(RevBeforeIrrelevant, BeforeIrrelevant),
|
|
DeforestInfo = deforest_info(EarlierGoal, EarlierBranchInfo,
|
|
BetweenGoals, LaterGoal, LaterBranchInfo, DeforestBranches).
|
|
|
|
:- pred move_goals(can_move::can_move, module_info::in, bool::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::in, list(hlds_goal)::out,
|
|
hlds_goal::in, list(hlds_goal)::in, list(hlds_goal)::out) is det.
|
|
|
|
move_goals(_, _, _, [], !BetweenGoals, _, !MovedGoal).
|
|
move_goals(CanMove, ModuleInfo, FullyStrict, [BetweenGoal | RevBetweenGoals0],
|
|
!BetweenGoals, EndGoal, !MovedGoals) :-
|
|
( if
|
|
call(CanMove, ModuleInfo, FullyStrict, BetweenGoal,
|
|
[EndGoal | !.BetweenGoals])
|
|
then
|
|
!:MovedGoals = [BetweenGoal | !.MovedGoals]
|
|
else
|
|
!:BetweenGoals = [BetweenGoal | !.BetweenGoals]
|
|
),
|
|
move_goals(CanMove, ModuleInfo, FullyStrict,
|
|
RevBetweenGoals0, !BetweenGoals, EndGoal, !MovedGoals).
|
|
|
|
:- type can_move == pred(module_info, bool, hlds_goal, list(hlds_goal)).
|
|
:- mode can_move == in(pred(in, in, in, in) is semidet).
|
|
|
|
% Check all goals occurring later in the conjunction to see if they depend
|
|
% on the current goal. A goal depends on the current goal if any of the
|
|
% non-locals of the later goal have their instantiatedness changed
|
|
% by the current goal.
|
|
%
|
|
:- pred can_move_goal_forward(module_info::in, bool::in,
|
|
hlds_goal::in, list(hlds_goal)::in) is semidet.
|
|
|
|
can_move_goal_forward(ModuleInfo, FullyStrict, ThisGoal, Goals) :-
|
|
(
|
|
list.member(LaterGoal, Goals)
|
|
=>
|
|
pd_can_reorder_goals(ModuleInfo, FullyStrict, ThisGoal, LaterGoal)
|
|
).
|
|
|
|
% Check all goals occurring earlier in the conjunction to see
|
|
% if the current goal depends on them.
|
|
%
|
|
:- pred can_move_goal_backward(module_info::in, bool::in,
|
|
hlds_goal::in, list(hlds_goal)::in) is semidet.
|
|
|
|
can_move_goal_backward(ModuleInfo, FullyStrict, ThisGoal, Goals) :-
|
|
(
|
|
list.member(EarlierGoal, Goals)
|
|
=>
|
|
pd_can_reorder_goals(ModuleInfo, FullyStrict,
|
|
EarlierGoal, ThisGoal)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Tack the second goal and the goals in between onto the end of each branch
|
|
% of the first goal, unfolding the second goal in the branches which have
|
|
% extra information about the arguments.
|
|
%
|
|
:- pred push_goal_into_goal(set_of_progvar::in, set(int)::in,
|
|
hlds_goal::in, list(hlds_goal)::in, hlds_goal::in, hlds_goal::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
push_goal_into_goal(NonLocals, DeforestInfo, EarlierGoal,
|
|
BetweenGoals, LaterGoal, Goal, !PDInfo) :-
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
EarlierGoal = hlds_goal(EarlierGoalExpr, _),
|
|
(
|
|
EarlierGoalExpr = switch(Var1, CanFail1, Cases1),
|
|
set_of_var.insert(Var1, NonLocals, CaseNonLocals),
|
|
append_goal_to_cases(Var1, BetweenGoals, LaterGoal,
|
|
CaseNonLocals, 1, DeforestInfo, Cases1, Cases, !PDInfo),
|
|
GoalExpr = switch(Var1, CanFail1, Cases)
|
|
;
|
|
EarlierGoalExpr = if_then_else(Vars, Cond, Then0, Else0),
|
|
pd_info_update_goal(Cond, !PDInfo),
|
|
Cond = hlds_goal(_, CondInfo),
|
|
CondNonLocals = goal_info_get_nonlocals(CondInfo),
|
|
set_of_var.union(CondNonLocals, NonLocals, ThenNonLocals),
|
|
append_goal(Then0, BetweenGoals, LaterGoal,
|
|
ThenNonLocals, 1, DeforestInfo, Then, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
append_goal(Else0, BetweenGoals, LaterGoal,
|
|
NonLocals, 2, DeforestInfo, Else, !PDInfo),
|
|
GoalExpr = if_then_else(Vars, Cond, Then, Else)
|
|
;
|
|
EarlierGoalExpr = disj(Disjuncts0),
|
|
append_goal_to_disjuncts(BetweenGoals, LaterGoal,
|
|
NonLocals, 1, DeforestInfo, Disjuncts0, Disjuncts, !PDInfo),
|
|
GoalExpr = disj(Disjuncts)
|
|
;
|
|
( EarlierGoalExpr = unify(_, _, _, _, _)
|
|
; EarlierGoalExpr = plain_call(_, _, _, _, _, _)
|
|
; EarlierGoalExpr = generic_call(_, _, _, _, _)
|
|
; EarlierGoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
; EarlierGoalExpr = conj(_, _)
|
|
; EarlierGoalExpr = negation(_)
|
|
; EarlierGoalExpr = scope(_, _)
|
|
; EarlierGoalExpr = shorthand(_)
|
|
),
|
|
unexpected($pred, "unexpected goal type")
|
|
),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
goal_list_instmap_delta([EarlierGoal | BetweenGoals], Delta0),
|
|
LaterGoal = hlds_goal(_, LaterInfo),
|
|
Delta1 = goal_info_get_instmap_delta(LaterInfo),
|
|
instmap_delta_apply_instmap_delta(Delta0, Delta1, test_size, Delta2),
|
|
instmap_delta_restrict(NonLocals, Delta2, Delta),
|
|
goal_list_determinism([EarlierGoal | BetweenGoals], Detism0),
|
|
Detism1 = goal_info_get_determinism(LaterInfo),
|
|
det_conjunction_detism(Detism0, Detism1, Detism),
|
|
goal_list_purity([EarlierGoal | BetweenGoals], Purity0),
|
|
Purity1 = goal_info_get_purity(LaterInfo),
|
|
worst_purity(Purity0, Purity1) = Purity,
|
|
goal_info_init(NonLocals, Delta, Detism, Purity, GoalInfo),
|
|
Goal2 = hlds_goal(GoalExpr, GoalInfo),
|
|
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
find_simplify_tasks(Globals, do_not_generate_warnings, SimplifyTasks0),
|
|
SimpList0 = simplify_tasks_to_list(SimplifyTasks0),
|
|
% Be a bit more aggressive with common structure elimination.
|
|
% This helps achieve folding in some cases.
|
|
SimpList = [simptask_extra_common_structs | SimpList0],
|
|
SimplifyTasks = list_to_simplify_tasks(Globals, SimpList),
|
|
pd_util.pd_simplify_goal("push_goal_into_goal", SimplifyTasks,
|
|
Goal2, Goal3, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
|
|
% Perform any folding which may now be possible.
|
|
deforest_goal(Goal3, Goal, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo).
|
|
|
|
:- pred append_goal_to_disjuncts(list(hlds_goal)::in, hlds_goal::in,
|
|
set_of_progvar::in, int::in, set(int)::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out, pd_info::in, pd_info::out)
|
|
is det.
|
|
|
|
append_goal_to_disjuncts(_, _, _, _, _, [], [], !PDInfo).
|
|
append_goal_to_disjuncts(BetweenGoals, GoalToAppend, NonLocals,
|
|
CurrBranch, Branches, [Goal0 | Goals0], [Goal | Goals], !PDInfo) :-
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
append_goal(Goal0, BetweenGoals, GoalToAppend,
|
|
NonLocals, CurrBranch, Branches, Goal, !PDInfo),
|
|
NextBranch = CurrBranch + 1,
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
append_goal_to_disjuncts(BetweenGoals, GoalToAppend,
|
|
NonLocals, NextBranch, Branches, Goals0, Goals, !PDInfo).
|
|
|
|
:- pred append_goal_to_cases(prog_var::in, list(hlds_goal)::in,
|
|
hlds_goal::in, set_of_progvar::in, int::in, set(int)::in,
|
|
list(case)::in, list(case)::out, pd_info::in, pd_info::out) is det.
|
|
|
|
append_goal_to_cases(_, _, _, _, _, _, [], [], !PDInfo).
|
|
append_goal_to_cases(Var, BetweenGoals, GoalToAppend, NonLocals,
|
|
CurrCase, Branches, [Case0 | Cases0], [Case | Cases], !PDInfo) :-
|
|
Case0 = case(MainConsId, OtherConsIds, Goal0),
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo),
|
|
append_goal(Goal0, BetweenGoals, GoalToAppend, NonLocals,
|
|
CurrCase, Branches, Goal, !PDInfo),
|
|
Case = case(MainConsId, OtherConsIds, Goal),
|
|
NextCase = CurrCase + 1,
|
|
pd_info_set_instmap(InstMap0, !PDInfo),
|
|
append_goal_to_cases(Var, BetweenGoals, GoalToAppend,
|
|
NonLocals, NextCase, Branches, Cases0, Cases, !PDInfo).
|
|
|
|
:- pred append_goal(hlds_goal::in, list(hlds_goal)::in,
|
|
hlds_goal::in, set_of_progvar::in, int::in, set(int)::in,
|
|
hlds_goal::out, pd_info::in, pd_info::out) is det.
|
|
|
|
append_goal(Goal0, BetweenGoals, GoalToAppend0, NonLocals0,
|
|
CurrBranch, Branches, Goal, !PDInfo) :-
|
|
( if set.member(CurrBranch, Branches) then
|
|
% Unfold the call.
|
|
pd_info_get_instmap(!.PDInfo, InstMap0),
|
|
list.foldl(pd_info_update_goal, [Goal0 | BetweenGoals], !PDInfo),
|
|
deforest_goal(GoalToAppend0, GoalToAppend, !PDInfo),
|
|
pd_info_set_instmap(InstMap0, !PDInfo)
|
|
else
|
|
GoalToAppend = GoalToAppend0
|
|
),
|
|
goal_to_conj_list(Goal0, GoalList0),
|
|
goal_to_conj_list(GoalToAppend, GoalListToAppend),
|
|
list.condense([GoalList0, BetweenGoals, GoalListToAppend], Goals),
|
|
|
|
goal_list_nonlocals(Goals, SubNonLocals),
|
|
set_of_var.intersect(NonLocals0, SubNonLocals, NonLocals),
|
|
goal_list_instmap_delta(Goals, Delta0),
|
|
instmap_delta_restrict(NonLocals, Delta0, Delta),
|
|
goal_list_determinism(Goals, Detism),
|
|
goal_list_purity(Goals, Purity),
|
|
goal_info_init(NonLocals, Delta, Detism, Purity, GoalInfo),
|
|
Goal = hlds_goal(conj(plain_conj, Goals), GoalInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred deforest_call(pred_id::in, proc_id::in, list(prog_var)::in,
|
|
sym_name::in, builtin_state::in, hlds_goal::in, hlds_goal::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
deforest_call(PredId, ProcId, Args, SymName, BuiltinState, Goal0, Goal,
|
|
!PDInfo) :-
|
|
pd_info_get_proc_arg_info(!.PDInfo, ProcArgInfos),
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
pd_info_get_instmap(!.PDInfo, InstMap),
|
|
Name = unqualify_name(SymName),
|
|
list.length(Args, Arity),
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
Context = goal_info_get_context(GoalInfo0),
|
|
|
|
pd_info_get_local_term_info(!.PDInfo, LocalTermInfo0),
|
|
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
SizeThreshold = OptTuple ^ ot_deforestation_size_threshold,
|
|
( if
|
|
% Check for extra information to the call.
|
|
map.search(ProcArgInfos, proc(PredId, ProcId), ProcArgInfo),
|
|
ProcArgInfo = pd_branch_info(_, LeftArgs, _),
|
|
set.member(LeftArg, LeftArgs),
|
|
list.det_index1(Args, LeftArg, Arg),
|
|
instmap_lookup_var(InstMap, Arg, ArgInst),
|
|
inst_is_bound_to_functors(ModuleInfo, ArgInst, [_]),
|
|
|
|
% We don't attempt to deforest predicates which have purity promises
|
|
% because the extra impurity propagated through the goal when such
|
|
% predicates are inlined will defeat any attempt at deforestation.
|
|
% XXX We should probably allow deforestation of semipure goals.
|
|
|
|
inlining.can_inline_proc(ModuleInfo, PredId, ProcId, BuiltinState,
|
|
may_not_inline_purity_promised_pred),
|
|
|
|
% Check the goal size.
|
|
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _,
|
|
CalledProcInfo),
|
|
proc_info_get_goal(CalledProcInfo, CalledGoal),
|
|
goal_size(CalledGoal, CalledGoalSize),
|
|
( SizeThreshold = -1
|
|
; CalledGoalSize < SizeThreshold
|
|
)
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message_context(!.PDInfo, "deforest_call", Context,
|
|
"Found extra information for call to %s/%i\n",
|
|
[s(Name), i(Arity)], !IO)
|
|
),
|
|
( if
|
|
pd_term.local_check(ModuleInfo, Goal0, InstMap,
|
|
LocalTermInfo0, LocalTermInfo)
|
|
then
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "deforest_call",
|
|
"Local termination check succeeded\n", [], !IO)
|
|
),
|
|
pd_info_set_local_term_info(LocalTermInfo, !PDInfo),
|
|
maybe_unfold_call(yes, yes, PredId, ProcId, Args, Optimized,
|
|
Goal0, Goal1, !PDInfo),
|
|
(
|
|
Optimized = yes,
|
|
deforest_goal(Goal1, Goal, !PDInfo)
|
|
;
|
|
Optimized = no,
|
|
Goal = Goal1
|
|
),
|
|
pd_info_set_local_term_info(LocalTermInfo0, !PDInfo)
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "deforest_call",
|
|
"Local termination check failed\n", [], !IO)
|
|
),
|
|
Goal = hlds_goal(GoalExpr0, GoalInfo0)
|
|
)
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message_context(!.PDInfo, "deforest_call", Context,
|
|
"No extra information for call to %s/%i\n",
|
|
[s(Name), i(Arity)], !IO)
|
|
),
|
|
Goal = Goal0
|
|
).
|
|
|
|
:- pred maybe_unfold_call(bool::in, bool::in, pred_id::in, proc_id::in,
|
|
list(prog_var)::in, bool::out, hlds_goal::in, hlds_goal::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
maybe_unfold_call(CheckImprovement, CheckVars, PredId, ProcId, Args,
|
|
Optimized, Goal0, Goal, !PDInfo) :-
|
|
pd_info_get_module_info(!.PDInfo, ModuleInfo),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
VarsThreshold = OptTuple ^ ot_deforestation_vars_threshold,
|
|
pd_info_get_proc_info(!.PDInfo, ProcInfo0),
|
|
proc_info_get_var_table(ProcInfo0, VarTable0),
|
|
var_table_count(VarTable0, NumVars),
|
|
( if
|
|
% Check that we haven't already got too many variables.
|
|
(
|
|
CheckVars = no
|
|
;
|
|
VarsThreshold = -1
|
|
% XXX The *default* value of the vars threshold is 200,
|
|
% so -1 does NOT mean that there is no threshold set.
|
|
;
|
|
NumVars < VarsThreshold
|
|
)
|
|
then
|
|
try_to_unfold_call(ModuleInfo, Globals, VarTable0, CheckImprovement,
|
|
PredId, ProcId, ProcInfo0, Args, Optimized, Goal0, Goal, !PDInfo)
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "maybe_unfold_call",
|
|
"too many variables - not inlining\n", [], !IO)
|
|
),
|
|
Goal = Goal0,
|
|
Optimized = no
|
|
).
|
|
|
|
:- pred try_to_unfold_call(module_info::in, globals::in, var_table::in,
|
|
bool::in, pred_id::in, proc_id::in, proc_info::in, list(prog_var)::in,
|
|
bool::out, hlds_goal::in, hlds_goal::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
try_to_unfold_call(ModuleInfo, Globals, VarTable0, CheckImprovement,
|
|
PredId, ProcId, ProcInfo0, Args, Optimized, Goal0, Goal, !PDInfo) :-
|
|
Goal0 = hlds_goal(_, GoalInfo0),
|
|
CallContext = goal_info_get_context(GoalInfo0),
|
|
pd_info_get_pred_info(!.PDInfo, PredInfo0),
|
|
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
|
|
CalledPredInfo, CalledProcInfo),
|
|
pred_info_get_typevarset(PredInfo0, TypeVarSet0),
|
|
pred_info_get_univ_quant_tvars(PredInfo0, UnivQVars),
|
|
proc_info_get_rtti_varmaps(ProcInfo0, RttiVarMaps0),
|
|
inlining.do_inline_call(ModuleInfo, UnivQVars, CallContext,
|
|
CalledPredInfo, CalledProcInfo, Args, Goal1, TypeVarSet0, TypeVarSet,
|
|
VarTable0, VarTable, RttiVarMaps0, RttiVarMaps),
|
|
pred_info_set_typevarset(TypeVarSet, PredInfo0, PredInfo),
|
|
proc_info_get_has_parallel_conj(CalledProcInfo, CalledHasParallelConj),
|
|
|
|
proc_info_set_var_table(VarTable, ProcInfo0, ProcInfo1),
|
|
proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo1, ProcInfo2),
|
|
(
|
|
CalledHasParallelConj = has_parallel_conj,
|
|
proc_info_set_has_parallel_conj(has_parallel_conj,
|
|
ProcInfo2, ProcInfo)
|
|
;
|
|
CalledHasParallelConj = has_no_parallel_conj,
|
|
% Leave the has_parallel_conj field of the proc_info as it is.
|
|
ProcInfo = ProcInfo2
|
|
),
|
|
|
|
pd_info_set_pred_info(PredInfo, !PDInfo),
|
|
pd_info_set_proc_info(ProcInfo, !PDInfo),
|
|
|
|
goal_cost(Goal1, OriginalCost),
|
|
pd_info_get_cost_delta(!.PDInfo, CostDelta0),
|
|
pd_info_get_size_delta(!.PDInfo, SizeDelta0),
|
|
pd_info_get_changed(!.PDInfo, Changed0),
|
|
|
|
% Update the quantification if not all the output arguments are used.
|
|
Goal1 = hlds_goal(_, GoalInfo1),
|
|
NonLocals1 = goal_info_get_nonlocals(GoalInfo1),
|
|
set_of_var.list_to_set(Args, NonLocals),
|
|
( if set_of_var.equal(NonLocals1, NonLocals) then
|
|
Goal2 = Goal1
|
|
else
|
|
pd_requantify_goal(NonLocals, Goal1, Goal2, !PDInfo)
|
|
),
|
|
|
|
% Push the extra information from the call through the goal.
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "try_to_unfold_call",
|
|
"running unique modes\n", [], !IO)
|
|
),
|
|
proc_info_arglives(ModuleInfo, CalledProcInfo, ArgLives),
|
|
get_live_vars(Args, ArgLives, LiveVars0),
|
|
set_of_var.list_to_set(LiveVars0, LiveVarsSet0),
|
|
set_of_var.intersect(NonLocals, LiveVarsSet0, LiveVarsSet),
|
|
pd_util.unique_modecheck_goal_live_vars(LiveVarsSet, Goal2, Goal3,
|
|
ModeErrors, !PDInfo),
|
|
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "try_to_unfold_call",
|
|
"running simplify\n", [], !IO)
|
|
),
|
|
find_simplify_tasks(Globals, do_not_generate_warnings, SimplifyTasks),
|
|
pd_util.pd_simplify_goal("try_to_unfold_call", SimplifyTasks,
|
|
Goal3, Goal4, !PDInfo),
|
|
|
|
choose_original_or_inlined(CheckImprovement, PredInfo0, ProcInfo0,
|
|
GoalInfo0, Changed0, ModeErrors, OriginalCost, CostDelta0, SizeDelta0,
|
|
Optimized, Goal0, Goal4, Goal, !PDInfo).
|
|
|
|
:- pred choose_original_or_inlined(bool::in, pred_info::in, proc_info::in,
|
|
hlds_goal_info::in, bool::in, list(T)::in, int::in, int::in, int::in,
|
|
bool::out, hlds_goal::in, hlds_goal::in, hlds_goal::out,
|
|
pd_info::in, pd_info::out) is det.
|
|
|
|
choose_original_or_inlined(CheckImprovement, PredInfo0, ProcInfo0, GoalInfo0,
|
|
Changed0, ModeErrors, OriginalCost, CostDelta0, SizeDelta0, Optimized,
|
|
Goal0, OptGoal, Goal, !PDInfo) :-
|
|
pd_info_get_cost_delta(!.PDInfo, CostDelta1),
|
|
CostDelta = CostDelta1 - CostDelta0,
|
|
goal_size(OptGoal, OptGoalSize),
|
|
SizeDelta = OptGoalSize - cost_of_call,
|
|
( if
|
|
ModeErrors = [],
|
|
(
|
|
CheckImprovement = no
|
|
;
|
|
CheckImprovement = yes,
|
|
( if is_simple_goal(OptGoal) then
|
|
true
|
|
else
|
|
% Very rough heuristics for checking improvement.
|
|
% This should lean towards allowing optimizations.
|
|
%
|
|
% XXX We should pay attention to ot_deforestation_cost_factor
|
|
% in OptTuple.
|
|
( if OptGoalSize =< 5 then
|
|
% For small increases in code size, accept any amount
|
|
% of optimization.
|
|
CostDelta > 0
|
|
else
|
|
PercentChange = CostDelta * 100 // OriginalCost,
|
|
PercentChange >= 5
|
|
)
|
|
)
|
|
)
|
|
then
|
|
Goal = OptGoal,
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "choose_original_or_inlined",
|
|
"inlined: cost(%i) size(%i)\n",
|
|
[i(CostDelta), i(SizeDelta)], !IO)
|
|
),
|
|
pd_info_incr_size_delta(SizeDelta, !PDInfo),
|
|
pd_info_set_changed(yes, !PDInfo),
|
|
Det0 = goal_info_get_determinism(GoalInfo0),
|
|
Goal = hlds_goal(_, GoalInfo),
|
|
Det = goal_info_get_determinism(GoalInfo),
|
|
|
|
% Rerun determinism analysis later if the determinism of any of
|
|
% the sub-goals changes - this avoids problems with inlining
|
|
% erroneous predicates.
|
|
( if Det = Det0 then
|
|
true
|
|
else
|
|
pd_info_set_rerun_det(yes, !PDInfo)
|
|
),
|
|
|
|
Optimized = yes
|
|
else
|
|
trace [io(!IO)] (
|
|
pd_debug_message(!.PDInfo, "choose_original_or_inlined",
|
|
"not enough improvement - " ++
|
|
"not inlining: cost(%i) size(%i)\n",
|
|
[i(CostDelta), i(SizeDelta)], !IO)
|
|
),
|
|
pd_info_set_pred_info(PredInfo0, !PDInfo),
|
|
pd_info_set_proc_info(ProcInfo0, !PDInfo),
|
|
pd_info_set_size_delta(SizeDelta0, !PDInfo),
|
|
pd_info_set_cost_delta(CostDelta0, !PDInfo),
|
|
pd_info_set_changed(Changed0, !PDInfo),
|
|
Goal = Goal0,
|
|
Optimized = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred is_simple_goal_list(list(hlds_goal)::in) is semidet.
|
|
|
|
is_simple_goal_list([]).
|
|
is_simple_goal_list([Goal | Goals]) :-
|
|
is_simple_goal(Goal),
|
|
is_simple_goal_list(Goals).
|
|
|
|
:- pred is_simple_goal(hlds_goal::in) is semidet.
|
|
|
|
is_simple_goal(hlds_goal(GoalExpr, _)) :-
|
|
(
|
|
goal_expr_has_subgoals(GoalExpr) = does_not_have_subgoals
|
|
;
|
|
GoalExpr = negation(Goal1),
|
|
% Handle a call or builtin + tests on the output.
|
|
goal_to_conj_list(Goal1, GoalList1),
|
|
is_simple_goal_list(GoalList1)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module transform_hlds.deforest.
|
|
%-----------------------------------------------------------------------------%
|