mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-13 04:44:39 +00:00
b86f973fa9
Branches: main Allow the use of Mercury abstract machine float registers for passing double-precision float arguments in higher order calls. In of itself this is not so useful for typical Mercury code. However, as all non-local procedures are potentially the targets of higher order calls, without this change first order calls to non-local procedures could not use float registers either. That is the actual motivation for this change. The basic mechanism is straightforward. As before, do_call_closure_* is invoked to place the closure's hidden arguments into r1, ..., rN, and extra input arguments shifted into rN+1, etc. With float registers, extra input arguments may also be in f1, f2, etc. and the closure may also have hidden float arguments. Optimising for calls, we order the closure's hidden arguments so that all float register arguments come after all regular register arguments in the vector. Having the arguments out of order does complicate code which needs to deconstruct closures, but that is not so important. Polymorphism complicates things. A closure with type pred(float) may be passed to a procedure expecting pred(T). Due to the `float' argument type, the closure expects its argument in a float register. But when passed to the procedure, the polymorphic argument type means it would be called with the argument in a regular register. Higher-order insts already contain information about the calling convention, without which a higher-order term cannot be called. We extend higher-order insts to include information about the register class required for each argument. For example, we can distinguish between: pred(in) is semidet /* arg regs: [reg_f] */ and pred(in) is semidet /* arg regs: [reg_r] */ Using this information, we can create a wrapper around a higher-order variable if it appears in a context requiring a different calling convention. We do this in a new HLDS pass, called float_regs.m. Note: Mercury code has a tendency to lose insts for higher-order terms, then "recover" them by hacky means. The float_regs pass depends on higher-order insts; it is impossible to create a wrapper for a procedure without knowing how to call it. The float_regs pass will report errors which we otherwise accepted, due to higher-order insts being unavailable. It should be possible for the user to adjust the code to satisfy the pass, though the user may not understand why it should be necessary. In most cases, it probably really *is* unnecessary. We may be able to make the float_regs pass more tolerant of missing higher-order insts in the future. Class method calls do not use float registers because I didn't want to deal with them yet. compiler/options.m: compiler/handle_options.m: Always enable float registers in low-level C grades when floats are wider than a word. compiler/make_hlds_passes.m: Always allow double word floats to be stored unboxed in cells on C grades. compiler/hlds_goal.m: Add an extra field to `generic_call' which gives the register class to use for each argument. This is set by the float_regs pass. compiler/prog_data.m: Add an extra field to `pred_inst_info' which records the register class to use for each argument. This is set by the float_regs pass. compiler/hlds_pred.m: Add a field to `proc_sub_info' which lists the headvars which must be passed via regular registers despite their types. Add a field to `pred_sub_info' to record the original unsubstituted argument types for instance method predicates. compiler/check_typeclass.m: In the pred_info of an instance method predicate, record the original argument types before substituting the type variables for the instance. compiler/float_regs.m: compiler/transform_hlds.m: Add the new HLDS pass. compiler/mercury_compile_middle_passes.m: Run the new pass if float registers are enabled. compiler/lambda.m: Export the predicate to produce a predicate from a lambda. This is reused by float_regs.m to create wrapper closures. Add an argument to `expand_lambda' to set the reg_r_headvars field on the newly created procedure. Delete some unused fields from `lambda_info'. compiler/arg_info.m: Make `generate_proc_arg_info' no longer always use regular registers for calls to exported procedures. Do always use regular registers for class methods calls. Add a version of `make_arg_infos' which takes an explicit list of argument registers. Rename the previous version. Add `generic_call_arg_reg_types' to return the argument registers for a generic call. Add a version of `compute_in_and_out_vars' which additionally separates arguments for float and regular registers. compiler/call_gen.m: Use float registers for argument passing in higher-order calls, as directed by the new field in `generic_call'. compiler/code_util.m: Add a function to encode the number of regular and float register arguments when making a higher-order call. compiler/llds.m: Say that the `do_call_closure_N' functions only work for zero float register arguments. compiler/follow_vars.m: compiler/interval.m: Account for the use of float registers by generic call goals in these passes. compiler/unify_gen.m: Move float register arguments to the end of a closure's hidden arguments vector, after regular register arguments. Count hidden regular and float register arguments separately, but encode them in the same word in the closure. This is preferable to using two words because it reduces the differences between grades with and without float registers present. Disable generating code which creates a closure from an existing closure, if float registers exist. That code does not understand the reordered hidden arguments vector yet. compiler/continuation_info.m: Replace an argument's type_info in the closure layout if the argument is a float *and* is passed via a regular register, when floats are normally passed via float registers. Instead, give it the type_info for `private_builtin.float_box'. compiler/builtin_lib_types.m: Add function to return the type of `private_builtin.float_box/0'. compiler/hlds_out_goal.m: compiler/hlds_out_pred.m: compiler/mercury_to_mercury.m: Dump the new fields added to `generic_call', `pred_inst_info' and `proc_sub_info'. compiler/prog_type.m: Add helper predicate. compiler/*.m: Conform to changes. library/private_builtin.m: Add a type `float_box'. runtime/mercury_ho_call.h: Describe the modified closure representation. Rename the field which counts the number of hidden arguments to prevent it being used incorrectly, as it now encodes two numbers (potentially). Add macros to unpack the encoded field. runtime/mercury_ho_call.c: Update the description of how higher-order calls work. Update code which extracts closure arguments to take account the arguments being reordered in the hidden arguments vector. runtime/mercury_deep_copy.c: runtime/mercury_deep_copy_body.h: runtime/mercury_layout_util.c: runtime/mercury_ml_expand_body.h: Update code which extracts closure arguments to take account the arguments being reordered in the hidden arguments vector. runtime/mercury_type_info.c: runtime/mercury_type_info.h: Add helper function. tools/make_spec_ho_call: Update the generated do_call_closure_* functions to place float register arguments. tests/hard_coded/Mercury.options: tests/hard_coded/Mmakefile: tests/hard_coded/ho_float_reg.exp: tests/hard_coded/ho_float_reg.m: Add new test case. tests/hard_coded/copy_pred.exp: tests/hard_coded/copy_pred.m: tests/hard_coded/deconstruct_arg.exp: tests/hard_coded/deconstruct_arg.exp2: tests/hard_coded/deconstruct_arg.m: Extend test cases with float arguments in closures. tests/debugger/higher_order.exp2: Add alternative output, changed due to closure wrapping. tests/hard_coded/ho_univ_to_type.m: Adjust test case so that the float_regs pass does not report errors about missing higher-order insts. compiler/notes/compiler_design.html: Describe the new module. Delete a duplicated paragraph. compiler/notes/todo.html: TODO: Delete one hundred billion year old todos.
816 lines
32 KiB
Mathematica
816 lines
32 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2005-2012 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: ordering_mode_constraints.m.
|
|
% Main author: richardf.
|
|
|
|
% This module contains code for ordering conjuncts in a predicate
|
|
% according to variable producer consumer relationships and
|
|
% other mode analysis constraints.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module check_hlds.ordering_mode_constraints.
|
|
:- interface.
|
|
|
|
:- import_module check_hlds.build_mode_constraints.
|
|
:- import_module check_hlds.prop_mode_constraints.
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module mdbcomp.goal_path.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module set.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Original position in a conjunction. Count starts at one.
|
|
%
|
|
:- type conjunct_id == int.
|
|
|
|
:- type mode_ordering_constraints == list(mode_ordering_constraint).
|
|
|
|
% Mode ordering constraints.
|
|
%
|
|
:- type mode_ordering_constraint
|
|
---> lt(
|
|
first :: conjunct_id, % Typically the producer
|
|
second :: conjunct_id % Typically the consumer
|
|
).
|
|
|
|
% Store for the ordering constraints for one conjunction.
|
|
%
|
|
:- type ordering_constraints_info
|
|
---> ordering_constraints_info(
|
|
oci_containing_map :: containing_goal_map,
|
|
|
|
% The number of conjucts in this conjunction
|
|
oci_num_conjuncts :: int,
|
|
|
|
% Constraints on the conjuncts.
|
|
oci_constraints :: set(mode_ordering_constraint)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% mode_reordering(Constraints, VarMap, SCCs, !ModuleInfo) orders
|
|
% conjunctions for each predicate in SCCs in the ModuleInfo
|
|
% according to the modes implied by the producer/consumer
|
|
% constraints in Constraints. All constraint variables relevant to
|
|
% the predicates in SCCs should be stored in the VarMap.
|
|
%
|
|
:- pred mode_reordering(pred_constraints_map::in, mc_var_map::in,
|
|
list(list(pred_id))::in, module_info::in, module_info::out) is det.
|
|
|
|
% dump_goal_paths(ModuleInfo, PredIds, !IO)
|
|
%
|
|
% Dumps the goal paths of each goal in the order they appear for each
|
|
% predicate in PredIds for the purposes of visually checking re-ordering.
|
|
%
|
|
:- pred dump_goal_paths(module_info::in, list(pred_id)::in, io::di, io::uo)
|
|
is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% add_ordering_constraint(Constraint, !OCI) adds Constraint
|
|
% to the ordering constraints store. It fails if it immediately
|
|
% detects a contradiction (at the moment, this means it has
|
|
% detected a loop in the producer consumer dependency graph,
|
|
% such as in the conjunction:
|
|
% (p(A, B), p(B, C), p(C, A)) where p is pred(in, out)).
|
|
%
|
|
% NOTE: behaviour when constrained conjuncts are outside the
|
|
% possible range is undefined.
|
|
%
|
|
:- pred add_ordering_constraint(mode_ordering_constraint::in,
|
|
ordering_constraints_info::in, ordering_constraints_info::out) is semidet.
|
|
|
|
% add_lt_constraint(A, B, !OCI) constrains conjunct A to come
|
|
% before conjunct B, in the constraints store.
|
|
%
|
|
:- pred add_lt_constraint(conjunct_id::in, conjunct_id::in,
|
|
ordering_constraints_info::in, ordering_constraints_info::out) is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.abstract_mode_constraints.
|
|
:- import_module check_hlds.clause_to_proc.
|
|
:- import_module check_hlds.mcsolver.
|
|
:- import_module hlds.hlds_clauses.
|
|
:- import_module hlds.hlds_error_util.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module mdbcomp.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.set_of_var.
|
|
|
|
:- import_module bimap.
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module multi_map.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
|
|
% This type stores information about mode analysis failures.
|
|
% The information is used when preparing error messages.
|
|
%
|
|
:- type mode_analysis_failures == list(mode_analysis_failure).
|
|
|
|
% This type stores information about a mode analysis failure.
|
|
% The information is used when preparing error messages.
|
|
%
|
|
:- type mode_analysis_failure
|
|
---> no_producer_consumer_sols(
|
|
% The predicate for which the producer/consumer analysis
|
|
% couldn't be solved.
|
|
failing_predicate :: pred_proc_id
|
|
)
|
|
; mode_inference_failed(
|
|
% The caller of the predicate for which mode inference
|
|
% has failed.
|
|
caller :: pred_id,
|
|
|
|
% The SCC of predicates to be mode inferred for which
|
|
% mode inference has failed.
|
|
scc :: list(pred_id)
|
|
)
|
|
; conjunct_ordering_failed(pred_proc_id).
|
|
|
|
% A map from program variables to related producer/consumer
|
|
% constraint variables' abstract representations. The constraint
|
|
% variables should each represent the proposition that the
|
|
% program variable is produced at some particular conjunct, all
|
|
% in the one conjunction.
|
|
%
|
|
:- type prog_var_at_conjuncts_map == multi_map(prog_var, mc_rep_var).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Predicate reordering
|
|
%
|
|
|
|
mode_reordering(PredConstraintsMap, VarMap, SCCs, !ModuleInfo) :-
|
|
list.foldl(scc_reordering(PredConstraintsMap, VarMap), SCCs, !ModuleInfo).
|
|
|
|
% scc_reording(PredConstraintsMap, VarMap, SCC, !ModuleInfo)
|
|
%
|
|
% Copies the clauses of predicates in SCC into the body goal of their
|
|
% procedures and performs conjunction reordering according to the
|
|
% producer consumer constraints in PredConstraintsMap.
|
|
%
|
|
:- pred scc_reordering(pred_constraints_map::in, mc_var_map::in,
|
|
list(pred_id)::in, module_info::in, module_info::out) is det.
|
|
|
|
scc_reordering(PredConstraintsMap, VarMap, SCC0, !ModuleInfo) :-
|
|
% Process only predicates from this module.
|
|
list.filter(module_info_pred_status_is_imported(!.ModuleInfo),
|
|
SCC0, _, SCC),
|
|
|
|
list.filter(
|
|
(pred(PredId::in) is semidet :-
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
|
|
pred_info_infer_modes(PredInfo)
|
|
), SCC, PredsToInfer, PredsToCheck),
|
|
|
|
(
|
|
PredsToInfer = [_ | _],
|
|
sorry($module, $pred, "NYI: mode inference")
|
|
;
|
|
PredsToInfer = []
|
|
),
|
|
|
|
list.foldl(pred_reordering(PredConstraintsMap, VarMap), PredsToCheck,
|
|
!ModuleInfo).
|
|
|
|
% pred_reordering(PredConstraintsMap, VarMap, PredId, !ModuleInfo)
|
|
% applies mode reordering to conjunctions in the body goal of the
|
|
% predicate PredId for each procedure in that predicate.
|
|
%
|
|
:- pred pred_reordering(pred_constraints_map::in, mc_var_map::in,
|
|
pred_id::in, module_info::in, module_info::out) is det.
|
|
|
|
pred_reordering(PredConstraintsMap, VarMap, PredId, !ModuleInfo) :-
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
|
|
( pred_info_infer_modes(PredInfo0) ->
|
|
% XXX GIVE UP FOR NOW!!!! In reality, execution shouldn't reach here
|
|
% if the pred is to be mode inferred, should it?
|
|
sorry($module, $pred, "mode inference constraints")
|
|
;
|
|
% XXX Maybe move this outside of this predicate - then
|
|
% the predicate can assume that the correct procedures
|
|
% have been created and that they have the correct bodies.
|
|
copy_module_clauses_to_procs([PredId], !ModuleInfo),
|
|
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo1),
|
|
|
|
map.lookup(PredConstraintsMap, PredId,
|
|
{ContainingGoalMap, PredConstraints}),
|
|
ProcIds = pred_info_all_procids(PredInfo1),
|
|
list.foldl2(
|
|
proc_reordering(ContainingGoalMap, PredConstraints, VarMap,
|
|
PredId),
|
|
ProcIds, [], Errors, PredInfo1, PredInfo),
|
|
|
|
(
|
|
Errors = [],
|
|
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
|
|
;
|
|
Errors = [_ | _],
|
|
% XXX Deal with mode errors here!
|
|
% This is a placeholder error message.
|
|
ErrorsString = string.string(Errors),
|
|
sorry($module, $pred, "mode checking failure: " ++ ErrorsString)
|
|
)
|
|
).
|
|
|
|
% proc_reordering(PredConstraints, VarMap, PredId, ProcId, !PredInfo)
|
|
%
|
|
% Orders conjunctions in procedure ProcId of predicate PredId, according
|
|
% to the producer consumer constraints in PredConstraints. The procedure
|
|
% with the modified body goal replaces its original in PredInfo.
|
|
%
|
|
:- pred proc_reordering(containing_goal_map::in, pred_p_c_constraints::in,
|
|
mc_var_map::in, pred_id::in, proc_id::in,
|
|
mode_analysis_failures::in, mode_analysis_failures::out,
|
|
pred_info::in, pred_info::out) is det.
|
|
|
|
proc_reordering(ContainingGoalMap, PredConstraints, VarMap, PredId, ProcId,
|
|
!Errors, !PredInfo) :-
|
|
pred_info_proc_info(!.PredInfo, ProcId, ProcInfo0),
|
|
proc_info_get_goal(ProcInfo0, Goal0),
|
|
|
|
ConstraintsForProc = all_constraints_for_proc(ProcId, PredConstraints),
|
|
|
|
PrepConstraints0 = new_prep_cstrts,
|
|
prepare_abstract_constraints(ConstraintsForProc, PrepConstraints0,
|
|
PrepConstraints1),
|
|
SolverConstraints = make_solver_cstrts(PrepConstraints1),
|
|
|
|
% solve_proc_reordering is cc_multi because each of its solutions
|
|
% is equivalent in the sense that they all contain the same goals
|
|
% and conjunctions are ordered according to some legitimate
|
|
% solution to the producing and consuming goals of program
|
|
% variables.
|
|
Errors0 = !.Errors,
|
|
promise_equivalent_solutions [Errors1, Goal] (
|
|
solve_proc_reordering(ContainingGoalMap, VarMap, PredId, ProcId,
|
|
SolverConstraints, Errors0, Errors1, Goal0, Goal)
|
|
),
|
|
!:Errors = Errors1,
|
|
|
|
proc_info_set_goal(Goal, ProcInfo0, ProcInfo),
|
|
pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo).
|
|
|
|
% solve_proc_reordering(VarMap, PredId, ProcId, SolverConstraints,
|
|
% !Errors, !Goal)
|
|
%
|
|
% Performs the nondeterministic constraint solving for proc_reordering
|
|
% - using the constraints in SolverConstraints to order the goals
|
|
% in Goal (from procedure ProcId in predicate PredId). Any failure
|
|
% is stored in Errors, and the predicate still proceeds.
|
|
% VarMap should contain any constraint variables referring to Goal
|
|
% and the program variables in it.
|
|
%
|
|
% solve_proc_reordering is cc_multi because each of its solutions
|
|
% is equivalent in the sense that they all contain the same goals
|
|
% and conjunctions are ordered according to some legitimate
|
|
% solution to the producing and consuming goals of program
|
|
% variables.
|
|
%
|
|
:- pred solve_proc_reordering(containing_goal_map::in, mc_var_map::in,
|
|
pred_id::in, proc_id::in, solver_cstrts::in,
|
|
mode_analysis_failures::in, mode_analysis_failures::out,
|
|
hlds_goal::in, hlds_goal::out) is cc_multi.
|
|
|
|
solve_proc_reordering(ContainingGoalMap, VarMap, PredId, ProcId,
|
|
SolverConstraints, !Errors, !Goal) :-
|
|
(
|
|
mcsolver.solve(SolverConstraints, Bindings),
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings, !Goal)
|
|
->
|
|
true
|
|
;
|
|
( mcsolver.solve(SolverConstraints, _) ->
|
|
list.cons(conjunct_ordering_failed(proc(PredId, ProcId)), !Errors)
|
|
;
|
|
list.cons(no_producer_consumer_sols(proc(PredId, ProcId)), !Errors)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Conjunction reordering.
|
|
%
|
|
|
|
% goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings, !Goal)
|
|
% applies mode reordering to conjunctions in Goal (from predicate PredId,
|
|
% which has the given ContainingGoalMap) and its children. VarMap should
|
|
% contain all producer/consumer constraint variables relevant to said
|
|
% conjunctions, and Bindings should contain bindings for them.
|
|
%
|
|
:- pred goal_reordering(containing_goal_map::in, pred_id::in,
|
|
mc_var_map::in, mc_bindings::in, hlds_goal::in, hlds_goal::out) is semidet.
|
|
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings, Goal0, Goal) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
|
|
(
|
|
( GoalExpr0 = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr0 = generic_call(_, _, _, _, _)
|
|
; GoalExpr0 = unify(_, _, _, _, _)
|
|
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
|
|
),
|
|
% Atomic goals cannot be reordered.
|
|
GoalExpr = GoalExpr0
|
|
;
|
|
GoalExpr0 = conj(ConjType, Goals0),
|
|
(
|
|
ConjType = plain_conj,
|
|
% Build constraints for this conjunction.
|
|
make_conjuncts_nonlocal_repvars(PredId, Goals0, RepVarMap),
|
|
OCInfo0 = ordering_init(ContainingGoalMap, list.length(Goals0)),
|
|
conjunct_ordering_constraints(VarMap, Bindings, RepVarMap,
|
|
OCInfo0, OCInfo),
|
|
|
|
% Then solve the constraints and reorder.
|
|
minimum_reordering(OCInfo, Order),
|
|
list.map(list.det_index1(Goals0), Order, Goals1),
|
|
|
|
% Then recurse on the reordered goals.
|
|
list.map(
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings),
|
|
Goals1, Goals)
|
|
;
|
|
ConjType = parallel_conj,
|
|
list.map(
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings),
|
|
Goals0, Goals)
|
|
),
|
|
GoalExpr = conj(ConjType, Goals)
|
|
;
|
|
GoalExpr0 = disj(Goals0),
|
|
list.map(goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings),
|
|
Goals0, Goals),
|
|
GoalExpr = disj(Goals)
|
|
;
|
|
GoalExpr0 = switch(_, _, _),
|
|
% We haven't yet even tried to turn disjunctions into switches.
|
|
unexpected($module, $pred, "switch")
|
|
;
|
|
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings,
|
|
Cond0, Cond),
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings,
|
|
Then0, Then),
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings,
|
|
Else0, Else),
|
|
GoalExpr = if_then_else(Vars, Cond, Then, Else)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings,
|
|
SubGoal0, SubGoal),
|
|
GoalExpr = negation(SubGoal)
|
|
;
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
% Is it possible to special-case the handling of
|
|
% from_ground_term_construct scopes?
|
|
goal_reordering(ContainingGoalMap, PredId, VarMap, Bindings,
|
|
SubGoal0, SubGoal),
|
|
GoalExpr = scope(Reason, SubGoal)
|
|
;
|
|
GoalExpr0 = shorthand(_),
|
|
% XXX We need to handle atomic goals.
|
|
% XXX We need to handle try goals.
|
|
unexpected($module, $pred, "NYI: shorthand")
|
|
),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% ordering_init(N) creates a new ordering constraint system for
|
|
% a conjunction with N conjuncts.
|
|
%
|
|
:- func ordering_init(containing_goal_map, int) = ordering_constraints_info.
|
|
|
|
ordering_init(ContainingGoalMap, N) =
|
|
ordering_constraints_info(ContainingGoalMap, N, set.init).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
add_ordering_constraint(Constraint, !OCI) :-
|
|
( set.member(Constraint, !.OCI ^ oci_constraints) ->
|
|
true
|
|
;
|
|
constraint_transitive_closure(!.OCI, Constraint, NewConstraints),
|
|
|
|
% No cycles. (lt(X, X) is a contradiction)
|
|
set.empty(set.filter(pred(lt(X, X)::in) is semidet, NewConstraints)),
|
|
|
|
!OCI ^ oci_constraints :=
|
|
set.union(NewConstraints, !.OCI ^ oci_constraints)
|
|
).
|
|
|
|
% constraint_transitive_closure(OCI, Constraint, NewConstraints)
|
|
% returns a list of constraints in NewConstraints containing
|
|
% Constraint itself, and also all constraints which must be added to
|
|
% OCI to maintain a transitive closure of partial ordering
|
|
% constraints.
|
|
%
|
|
:- pred constraint_transitive_closure(ordering_constraints_info::in,
|
|
mode_ordering_constraint::in, set(mode_ordering_constraint)::out) is det.
|
|
|
|
constraint_transitive_closure(OCI, Constraint, NewConstraints) :-
|
|
Constraints = OCI ^ oci_constraints,
|
|
Constraint = lt(From, To),
|
|
ComesBefore = set.filter_map(
|
|
func(lt(B, F)::in) = (B::out) is semidet :- F = From, Constraints),
|
|
ComesAfter = set.filter_map(
|
|
func(lt(T, A)::in) = (A::out) is semidet :- T = To, Constraints),
|
|
|
|
% Each conjunct in the ComesBefore set and the From conjunct must precede
|
|
% the To conjunct and each of the conjuncts in the ComesAfter set.
|
|
set.fold(insert_lt_constraints(set.insert(ComesAfter, To)),
|
|
set.insert(ComesBefore, From), set.init, NewConstraints).
|
|
|
|
% insert_lt_constraints(Bs, A, !Cs) adds a lt(A, B) constraint to
|
|
% the set of constraints Cs for each conjunct_id B in set Bs.
|
|
% Note the reversed order of Bs and A.
|
|
%
|
|
:- pred insert_lt_constraints(set(conjunct_id)::in, conjunct_id::in,
|
|
set(mode_ordering_constraint)::in, set(mode_ordering_constraint)::out)
|
|
is det.
|
|
|
|
insert_lt_constraints(Bs, A, !Cs) :-
|
|
set.fold(insert_lt_constraint(A), Bs, !Cs).
|
|
|
|
% insert_lt_constraint(A, B, !Cs) adds a lt(A, B) constraint to the set
|
|
% of constraints.
|
|
%
|
|
:- pred insert_lt_constraint(conjunct_id::in, conjunct_id::in,
|
|
set(mode_ordering_constraint)::in, set(mode_ordering_constraint)::out)
|
|
is det.
|
|
|
|
insert_lt_constraint(A, B, !Cs) :-
|
|
set.insert(lt(A, B), !Cs).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
add_lt_constraint(A, B, !OCI) :-
|
|
add_ordering_constraint(lt(A, B), !OCI).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% make_conjuncts_nonlocal_repvars(PredId, Goals, RepvarMap)
|
|
%
|
|
% The keys of RepvarMap are the program variables nonlocal to Goals that
|
|
% appear in goals. Each is mapped to the mc_rep_var representation of the
|
|
% proposition that it is produced at a Goal in Goals, for every Goal in
|
|
% Goals it is nonlocal to.
|
|
%
|
|
:- pred make_conjuncts_nonlocal_repvars(pred_id::in, hlds_goals::in,
|
|
prog_var_at_conjuncts_map::out) is det.
|
|
|
|
make_conjuncts_nonlocal_repvars(PredId, Goals, RepvarMap) :-
|
|
list.foldl(make_conjunct_nonlocal_repvars(PredId), Goals,
|
|
multi_map.init, RepvarMap).
|
|
|
|
% See make_conjuncts_nonlocal_repvars; acts on a single conjunct.
|
|
%
|
|
:- pred make_conjunct_nonlocal_repvars(pred_id::in, hlds_goal::in,
|
|
prog_var_at_conjuncts_map::in, prog_var_at_conjuncts_map::out) is det.
|
|
|
|
make_conjunct_nonlocal_repvars(PredId, Goal, !RepvarMap) :-
|
|
GoalInfo = Goal ^ hlds_goal_info,
|
|
Nonlocals = goal_info_get_nonlocals(GoalInfo),
|
|
GoalId = goal_info_get_goal_id(GoalInfo),
|
|
|
|
set_of_var.fold(
|
|
(pred(NL::in, RMap0::in, RMap::out) is det :-
|
|
multi_map.set(NL, NL `in` PredId `at` GoalId, RMap0, RMap)
|
|
),
|
|
Nonlocals, !RepvarMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% conjunct_ordering_constraints(VarMap, Bindings, RepVarMap, !OCInfo)
|
|
%
|
|
% Adds ordering constraints based on producer/consumer analysis of
|
|
% variables nonlocal to conjuncts in a single conjunction, to the
|
|
% OCInfo.
|
|
%
|
|
% For the conjunction in question, RepVarMap should contain any
|
|
% program variable nonlocal to any conjunct. The program variables
|
|
% should be mapped to any constraint variable concerning them
|
|
% related to any of the conjuncts in the conjunction. (Actually,
|
|
% they will be mapped to an abstract rep_var representing this
|
|
% constraint variable, and the VarMap is required to look up
|
|
% the constraint variable using the rep_var.) Bindings should
|
|
% contain bindings for all such constraint variables.
|
|
%
|
|
:- pred conjunct_ordering_constraints(mc_var_map::in, mc_bindings::in,
|
|
prog_var_at_conjuncts_map::in, ordering_constraints_info::in,
|
|
ordering_constraints_info::out) is semidet.
|
|
|
|
conjunct_ordering_constraints(VarMap, Bindings, RepVarMap, !OCInfo) :-
|
|
map.foldl(prog_var_ordering_constraints(VarMap, Bindings),
|
|
RepVarMap, !OCInfo).
|
|
|
|
% prog_var_ordering_constraints(VarMap, Bindings, ProgVar, RepVars,
|
|
% !OCInfo)
|
|
%
|
|
% Adds ordering constraints for a conjunction to OCInfo.
|
|
% Specifically, those relating to which conjuncts produce and which
|
|
% consume the variable ProgVar. See conjunct_ordering_constraints
|
|
% for details.
|
|
%
|
|
:- pred prog_var_ordering_constraints(mc_var_map::in, mc_bindings::in,
|
|
prog_var::in, list(mc_rep_var)::in,
|
|
ordering_constraints_info::in, ordering_constraints_info::out) is semidet.
|
|
|
|
prog_var_ordering_constraints(VarMap, Bindings, _ProgVar, RepVars, !OCInfo) :-
|
|
list.filter(produced_at_path(VarMap, Bindings), RepVars,
|
|
ProgVarAtProducers, ProgVarAtConsumers),
|
|
(
|
|
ProgVarAtProducers = []
|
|
% Variable not produced here - no constraints.
|
|
;
|
|
ProgVarAtProducers = [RepVar], % Should be only one producer
|
|
ContainingGoalMap = !.OCInfo ^ oci_containing_map,
|
|
get_position_in_conj(ContainingGoalMap, RepVar, First),
|
|
list.map(get_position_in_conj(ContainingGoalMap), ProgVarAtConsumers,
|
|
Laters),
|
|
|
|
list.foldl(add_lt_constraint(First), Laters, !OCInfo)
|
|
).
|
|
|
|
% produced_at_path(VarMap, Bindings, ProgVar `at` GoalPath `in` _)
|
|
% succeeds if ProgVar is produced at GoalPath, according to the
|
|
% solution to the producer/consumer constraint solutions in Bindings.
|
|
%
|
|
:- pred produced_at_path(mc_var_map::in, mc_bindings::in, mc_rep_var::in)
|
|
is semidet.
|
|
|
|
produced_at_path(VarMap, Bindings, RepVar) :-
|
|
map.lookup(Bindings, bimap.lookup(VarMap, RepVar)) = yes.
|
|
|
|
% get_position_in_conj(RepVar, N) fails if the deepest level of the
|
|
% goalpath in RepVar is not a conjunction, otherwise it returns in N
|
|
% the number of the conjunct the RepVar refers to.
|
|
%
|
|
:- pred get_position_in_conj(containing_goal_map::in, mc_rep_var::in,
|
|
conjunct_id::out) is semidet.
|
|
|
|
get_position_in_conj(ContainingGoalMap, _Var `in` _PredId `at` GoalId, N) :-
|
|
map.lookup(ContainingGoalMap, GoalId, ContainingGoal),
|
|
ContainingGoal = containing_goal(_, LastStep),
|
|
LastStep = step_conj(N).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% minimum_reordering(OCI, Order)
|
|
%
|
|
% Order is a minimum re-ordering of conjuncts, conforming to the
|
|
% constraints in OCI. The values of the conjunct_ids returned represent
|
|
% the original position of a conjunct, the position of the conjunct_id
|
|
% in the Order represents the new position of the conjunct.
|
|
%
|
|
% Fails if no reordering conforms with the constraints.
|
|
%
|
|
:- pred minimum_reordering(ordering_constraints_info::in,
|
|
list(conjunct_id)::out) is semidet.
|
|
|
|
minimum_reordering(OCI, Order) :-
|
|
% % Heavy handed - a topological sort can more easily be used to
|
|
% % achieve minimum reordering.
|
|
% original_order_constraints(OCI ^ num_conjuncts, OriginalOrderConstraints),
|
|
% constrain_if_possible(OriginalOrderConstraints, OCI0, OCI1),
|
|
|
|
Conjuncts = set.from_sorted_list(1 `..` OCI ^ oci_num_conjuncts),
|
|
topological_sort_min_reordering(OCI ^ oci_constraints, Conjuncts, Order).
|
|
|
|
% original_order_constraints(N, MOCs) produces a list of constraints MOCs
|
|
% that describe a complete order for N conjuncts, such that they are not
|
|
% reordered at all from their original positions.
|
|
%
|
|
:- pred original_order_constraints(int::in,
|
|
mode_ordering_constraints::out) is det.
|
|
|
|
original_order_constraints(N, MOCs) :-
|
|
complete_order_constraints(1 `..` N, MOCs).
|
|
|
|
% complete_order_constraints(Xs) produces a list of constraints that
|
|
% describe a compete order for Xs such that it is not reordered at all.
|
|
%
|
|
:- pred complete_order_constraints(list(conjunct_id)::in,
|
|
mode_ordering_constraints::out) is det.
|
|
|
|
complete_order_constraints(Xs, MOCs) :-
|
|
add_complete_order_constraints(Xs, set.init, MOCs0),
|
|
MOCs = set.to_sorted_list(MOCs0).
|
|
|
|
% add_complete_order_constraints(Xs, !MOCs) adds a list of constraints
|
|
% that describe a compete order for Xs such that it is not reordered
|
|
% at all.
|
|
%
|
|
:- pred add_complete_order_constraints(list(conjunct_id)::in,
|
|
set(mode_ordering_constraint)::in, set(mode_ordering_constraint)::out)
|
|
is det.
|
|
|
|
add_complete_order_constraints([], !MOCs).
|
|
add_complete_order_constraints([Conjunct | Conjuncts], !MOCs) :-
|
|
list.foldl(insert_lt_constraint(Conjunct), Conjuncts, !MOCs),
|
|
add_complete_order_constraints(Conjuncts, !MOCs).
|
|
|
|
% constraint_if_possible(Constraints, !OCI)
|
|
%
|
|
% Adds the given Constraints to the constraints info OCI, but only
|
|
% if no direct contradiction is found.
|
|
%
|
|
:- pred constrain_if_possible(mode_ordering_constraints::in,
|
|
ordering_constraints_info::in, ordering_constraints_info::out) is det.
|
|
|
|
constrain_if_possible([], !OCI).
|
|
constrain_if_possible([Constraint | Constraints], !OCI) :-
|
|
( add_ordering_constraint(Constraint, !OCI) ->
|
|
constrain_if_possible(Constraints, !OCI)
|
|
;
|
|
constrain_if_possible(Constraints, !OCI)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% topological_sort_min_reordering(Constraints, Conjuncts, Ordering)
|
|
%
|
|
% Succeeds if Ordering is a minimum re-ordering of Conjuncts
|
|
% consistent with the system of Constraints.
|
|
%
|
|
:- pred topological_sort_min_reordering(set(mode_ordering_constraint)::in,
|
|
set(conjunct_id)::in, list(conjunct_id)::out) is semidet.
|
|
|
|
topological_sort_min_reordering(Constraints0, Conjuncts0, Ordering) :-
|
|
NotFirst = set.map(func(lt(_From, To)) = To, Constraints0),
|
|
CandidatesForFirst = set.difference(Conjuncts0, NotFirst),
|
|
|
|
( set.remove_least(First, CandidatesForFirst, _) ->
|
|
% Remove First from the system.
|
|
set.remove(First, Conjuncts0, Conjuncts),
|
|
Constraints = set.filter(
|
|
(pred(lt(From, _To)::in) is semidet :- From \= First),
|
|
Constraints0),
|
|
|
|
% Order the rest, then put First at the head.
|
|
topological_sort_min_reordering(Constraints, Conjuncts, Ordering0),
|
|
Ordering = [First | Ordering0]
|
|
;
|
|
% No cantidates for First, so we are only done if there were
|
|
% no nodes (conjuncts) left to begin with.
|
|
set.empty(Conjuncts0),
|
|
Ordering = []
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
dump_goal_paths(ModuleInfo, PredIds0, !IO) :-
|
|
% Process only predicates from this module.
|
|
list.filter(module_info_pred_status_is_imported(ModuleInfo),
|
|
PredIds0, _, PredIds),
|
|
list.foldl(dump_pred_goal_paths(ModuleInfo), PredIds, !IO).
|
|
|
|
% dump_pred_goal_paths(ModuleInfo, PredId, !IO)
|
|
%
|
|
% Dumps the goal paths of each goal in the order they appear for
|
|
% predicate PredId for the purposes of visually checking re-ordering.
|
|
%
|
|
:- pred dump_pred_goal_paths(module_info::in, pred_id::in, io::di, io::uo)
|
|
is det.
|
|
|
|
dump_pred_goal_paths(ModuleInfo, PredId, !IO) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_procedures(PredInfo, ProcTable),
|
|
ProcIds = map.keys(ProcTable),
|
|
|
|
% Start with a blank line.
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
write_error_pieces_plain(Globals, [fixed("")], !IO),
|
|
|
|
PredHeaderFormat = [words("Goal paths for")] ++
|
|
describe_one_pred_info_name(should_module_qualify, PredInfo) ++
|
|
[suffix("."), nl],
|
|
|
|
write_error_pieces_plain(Globals, PredHeaderFormat, !IO),
|
|
|
|
(
|
|
ProcIds = [],
|
|
pred_info_get_clauses_info(PredInfo, ClausesInfo),
|
|
clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
|
|
get_clause_list(ClausesRep, Clauses),
|
|
Goals = list.map(func(Clause) = clause_body(Clause), Clauses),
|
|
Indent = 0,
|
|
list.foldl(dump_goal_goal_paths(Globals, Indent), Goals, !IO)
|
|
;
|
|
ProcIds = [_ | _],
|
|
list.foldl(dump_proc_goal_paths(Globals, ProcTable), ProcIds, !IO)
|
|
).
|
|
|
|
% dump_proc_goal_paths(Globals, ProcTable, ProcId, !IO)
|
|
%
|
|
% Dumps the goal paths of each goal in the order they appear for
|
|
% procedure ProcId for the purposes of visually checking re-ordering.
|
|
%
|
|
:- pred dump_proc_goal_paths(globals::in, proc_table::in, proc_id::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_proc_goal_paths(Globals, ProcTable, ProcId, !IO) :-
|
|
ProcIdString = string.from_int(proc_id_to_int(ProcId)),
|
|
ProcHeaderFormat = [words("mode"), words(ProcIdString), suffix(":")],
|
|
write_error_pieces_plain(Globals, ProcHeaderFormat, !IO),
|
|
map.lookup(ProcTable, ProcId, ProcInfo),
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
Indent = 0,
|
|
dump_goal_goal_paths(Globals, Indent, Goal, !IO).
|
|
|
|
% dump_goal_goal_paths(Globals, Indent, Goal, !IO)
|
|
%
|
|
% Dumps the goal paths for this goal at the indent depth Indent, then
|
|
% recurses for each sub-goal at one further level of indent,
|
|
% in the order they appear, for the purposes of visually checking
|
|
% re-ordering.
|
|
%
|
|
:- pred dump_goal_goal_paths(globals::in, int::in, hlds_goal::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_goal_goal_paths(Globals, Indent, Goal, !IO) :-
|
|
Goal = hlds_goal(GoalExpr, GoalInfo),
|
|
GoalId = goal_info_get_goal_id(GoalInfo),
|
|
GoalId = goal_id(GoalIdNum),
|
|
GoalIdPieces = [words(string.int_to_string(GoalIdNum)), nl],
|
|
write_error_pieces_maybe_with_context(Globals, no, Indent, GoalIdPieces,
|
|
!IO),
|
|
|
|
% Dump the goal paths for each subgoal in GoalExpr at SubGoalIndent,
|
|
% in the order they appear, for the purposes of visually checking
|
|
% reordering.
|
|
SubGoalIndent = Indent + 1,
|
|
(
|
|
( GoalExpr = plain_call(_, _, _, _, _, _)
|
|
; GoalExpr = generic_call(_, _, _, _, _)
|
|
; GoalExpr = unify(_, _, _, _, _)
|
|
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
|
|
)
|
|
% There are no subgoals to recurse on.
|
|
;
|
|
GoalExpr = conj(_, Goals),
|
|
list.foldl(dump_goal_goal_paths(Globals, SubGoalIndent), Goals, !IO)
|
|
;
|
|
GoalExpr = disj(Goals),
|
|
list.foldl(dump_goal_goal_paths(Globals, SubGoalIndent), Goals, !IO)
|
|
;
|
|
GoalExpr = switch(_, _, _),
|
|
unexpected($module, $pred, "switch")
|
|
;
|
|
GoalExpr = if_then_else(_, CondGoal, ThenGoal, ElseGoal),
|
|
Goals = [CondGoal, ThenGoal, ElseGoal],
|
|
list.foldl(dump_goal_goal_paths(Globals, SubGoalIndent), Goals, !IO)
|
|
;
|
|
GoalExpr = negation(SubGoal),
|
|
dump_goal_goal_paths(Globals, SubGoalIndent, SubGoal, !IO)
|
|
;
|
|
GoalExpr = scope(_, SubGoal),
|
|
dump_goal_goal_paths(Globals, SubGoalIndent, SubGoal, !IO)
|
|
;
|
|
GoalExpr = shorthand(ShortHand),
|
|
(
|
|
ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals, _),
|
|
Goals = [MainGoal | OrElseGoals],
|
|
list.foldl(dump_goal_goal_paths(Globals, SubGoalIndent), Goals,
|
|
!IO)
|
|
;
|
|
ShortHand = try_goal(_, _, _),
|
|
unexpected($module, $pred, "try_goal")
|
|
;
|
|
ShortHand = bi_implication(_, _),
|
|
unexpected($module, $pred, "bi_implication")
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module ordering_mode_constraints.
|
|
%-----------------------------------------------------------------------------%
|