mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-18 19:03:45 +00:00
5f50259d16
Right now, most parts of the compiler write to the "current output stream".
This was a pragmatic choice at the time, but has not aged well. The problem
is that the answer to the question "where is the current output stream going?"
is not obvious in *all* places in the compiler (although it is obvious in
most). When using such implicit streams, finding where the output is going
to in a given predicate requires inspecting not just the ancestors of that
predicate, but also all their older siblings (since any of them could have
changed the current stream), *including* their entire call trees. This is
usually an infeasible task. By constrast, if we explicitly pass streams
to all output operations, we need only follow the places where the variable
representing that stream is bound, which the mode system makes easy.
This diff switches large parts of the compiler over to doing output only
to explicitly passed streams, never to the implicit "current output stream".
The parts it switches over are the parts that rely to a significant degree
on the innermost change, which is to the "output" typeclass in
parse_tree_out_info.m. This is the part that has to be switched over to
explicit streams first, because (a) many modules such as mercury_to_mercury.m
rely on the output typeclass, and (b) most other modules that do output
call predicates in these modules. Starting anywhere else would be like
building a skyscraper starting at the top.
This typeclass, output(U), has two instances: output(io), and output(string),
so you could output either to the current output stream, or to a string.
To allow the specification of the destination stream in the first case,
this diff changes the typeclass to output(S, U) with a functional dependency
from U to S, with the two instances being output(io.text_output_stream, io)
and output(unit, string). (The unit arg is ignored in the second case.)
There is a complication with the output typeclass method, add_list, that
outputs a list of items. The complication is that each item is output
by a predicate supplied by the caller, but the separator between the items
(usually a comma) is output by add_list itself. We don't want to give
callers of this method the opportunity to screw up by specifying (possibly
implicitly) two different output streams for these two purposes, so we want
(a) the caller to tell add_list where to put the separators, and then
(b) for add_list, not its caller, tell the user-supplied predicate what
stream to write to. This works only if the stream argument is just before
the di,uo pair of I/O state arguments, which differs from our usual practice
of passing the stream at or near the left edge of the argument list,
not near the right. The result of this complication is that two categories
of predicates that are and are not used to print items in a list differ
in where they put the stream in their argument lists. This makes it easy
to pass the stream in the wrong argument position if you call a predicate
without looking up its signature, and may require *changing* the argument
order when a predicate is used to print an item in a list for the first time.
A complete switch over to always passing the stream just before !IO
would fix this inconsistency, but is far to big a change to make all at once.
compiler/parse_tree_out_info.m:
Make the changes described above.
Add write_out_list, which is a variant of io.write_list specifically
designed to address the "complication" described above. It also has
the arguments in an order that is better suited for higher-order use.
Make the same change to argument order in the class method add_list
as well.
Almost all of the following changes consist of passing an extra stream
argument to output predicates. In some places, where I thought this would
aid readability, I replaced sequences of calls to output predicates
with a single io.format.
compiler/prog_out.m:
This module had many predicates that wrote things to the current output
stream. This diff adds versions of these predicates that take an
explicit stream argument.
If the originals are still needed after the changes to the other modules,
keep them, but add "_to_cur_stream" to the end of their names.
Otherwise, delete them. (Many of the changes below replace
write_xyz(..., !IO) with io.write_string(Stream, xyz_to_string(...), !IO),
especially when write_xyz did nothing except call xyz_to_string
and wrote out the result.)
compiler/c_util.m:
Add either an explicit stream argument to the argument list, or a
"_current_stream" suffix to the name, of every predicate defined
in this module that does output.
Add a new predicate to print out the block comment containing
input for mkinit. This factors out common code in the LLDS and MLDS
backends.
compiler/name_mangle.m:
Delete all predicates that used to write to the current output stream,
after replacing them if necessary with functions that return a string,
which the caller can print to wherever it wants. (The "if necessary"
part is there because some of the "replacement" functions already
existed.)
When converting a proc_label to a string, *always* require the caller
to say whether the label prefix should be added to the string,
instead of silently assuming "yes, add it", as calls to one of the old,
now deleted predicates had it.
compiler/file_util.m:
Add output_to_file_stream, a version of output_to_file which
simply passes the output file stream it opens to the predicate
that is intended to define the contents of the newly created or
updated file. The existing output_to_file, which instead sets
and resets the current output stream around the equivalent
predicate call, is still needed e.g. by the MLDS backend,
but hopefully for not too long.
compiler/mercury_to_mercury.m:
compiler/parse_tree_out.m:
compiler/parse_tree_out_clause.m:
compiler/parse_tree_out_inst.m:
compiler/parse_tree_out_pragma.m:
compiler/parse_tree_out_pred_decl.m:
compiler/parse_tree_out_term.m:
compiler/parse_tree_out_type_repn.m:
Change the code writing out parse trees to explicitly pass a stream
to every predicate that does output.
In some places, this allows us to avoid changing the identity
of the current output stream.
compiler/hlds_out.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_mode.m:
compiler/hlds_out_module.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/intermod.m:
Change the code writing out HLDS code to explicitly pass a stream
to every predicate that does output. (The changes to these modules
belong in this diff because these modules call many of the output
predicates in the parse tree package.)
In hlds_out_util.m, delete some write_to_xyz(...) predicates that wrote
the result of xyz_to_string(...) to the current output stream.
Replace calls to the deleted predicates with calls to io.write_string
with the string being written being computed by xyz_to_string.
Add a predicate to hlds_out_util.m that outputs a comment containing
the current context, if it is valid. This factors out code that used
to be common to several of the other modules.
In a few places in hlds_out_module.m, the new code generates a
slighly different set of blank lines, but this should not be a problem.
compiler/layout_out.m:
compiler/llds_out_code_addr.m:
compiler/llds_out_data.m:
compiler/llds_out_file.m:
compiler/llds_out_global.m:
compiler/llds_out_instr.m:
compiler/llds_out_util.m:
compiler/opt_debug.m:
compiler/rtti_out.m:
Change the code writing out the LLDS to explicitly pass a stream
to every predicate that does output. (The changes to these modules
belong in this diff because layout_out.m and rtti_out.m call
many of the output predicates in the parse tree package,
and through them, the rest of the LLDS backend is affected as well.)
compiler/make.module_dep_file.m:
compiler/mercury_compile_main.m:
compiler/mercury_compile_middle_passes.m:
Replace code that sets and resets the current output stream
with code that simply passes an explicit output stream to a
predicate that now *takes* an explicit stream as an argument.
compiler/accumulator.m:
compiler/add_clause.m:
compiler/code_gen.m:
compiler/code_loc_dep.m:
compiler/cse_detection.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/det_analysis.m:
compiler/error_msg_inst.m:
compiler/export.m:
compiler/format_call.m:
compiler/goal_expr_to_goal.m:
compiler/ite_gen.m:
compiler/lco.m:
compiler/liveness.m:
compiler/lp_rational.m:
compiler/mercury_compile_front_end.m:
compiler/mercury_compile_llds_back_end.m:
compiler/mlds_to_c_file.m:
compiler/mlds_to_c_global.m:
compiler/mode_debug.m:
compiler/mode_errors.m:
compiler/modes.m:
compiler/optimize.m:
compiler/passes_aux.m:
compiler/pd_debug.m:
compiler/pragma_c_gen.m:
compiler/proc_gen.m:
compiler/prog_ctgc.m:
compiler/push_goals_together.m:
compiler/rat.m:
compiler/recompilation.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/rtti.m:
compiler/saved_vars.m:
compiler/simplify_goal_conj.m:
compiler/stack_opt.m:
compiler/structure_reuse.analysis.m:
compiler/structure_reuse.domain.m:
compiler/structure_reuse.indirect.m:
compiler/structure_sharing.analysis.m:
compiler/superhomogeneous.m:
compiler/term_constr_build.m:
compiler/term_constr_data.m:
compiler/term_constr_fixpoint.m:
compiler/term_constr_pass2.m:
compiler/term_constr_util.m:
compiler/tupling.m:
compiler/type_assign.m:
compiler/unneeded_code.m:
compiler/write_deps_file.m:
Conform to the changes above, mostly by passing streams explicitly.
compiler/hlds_dependency_graph.m:
Conform to the changes above, mostly by passing streams explicitly.
Move a predicate's definition next it only use.
compiler/Mercury.options:
Specify --warn-implicit-stream-calls for all the modules in which
this diff has replaced all implicit streams with explicit streams.
(Unfortunately, debugging this diff has shown that --warn-implicit-
stream-calls detects only *some*, and not *all*, uses of implicit
streams.)
library/term_io.m:
Fix documentation.
1148 lines
47 KiB
Mathematica
1148 lines
47 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2002-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 stack_opt.
|
|
% Author: zs.
|
|
%
|
|
% The input to this module is a HLDS structure with annotations on three kinds
|
|
% of goals:
|
|
%
|
|
% - calls, including generic calls and foreign_proc goals which may
|
|
% call back to Mercury, should have need_across_call annotations;
|
|
%
|
|
% - goals that have resume points before them (the conditions of if-then-elses
|
|
% and the non-last disjuncts of disjunction) should have need_in_resume
|
|
% annotations on them, provided that the resume point has a label that
|
|
% expects its variables to be on the stack;
|
|
%
|
|
% - parallel conjunctions should have need_in_par_conj annotations.
|
|
%
|
|
% The code in this module puts stack_save_map annotations on goals that have
|
|
% need_across_call annotations, on if-then-else goals whose condition has a
|
|
% need_in_resume annotation, and on disjunction goals whose first disjunct has
|
|
% a need_in_resume annotation. The stack_save map annotation tells the
|
|
% code generator which of the relevant variables need to be saved in their own
|
|
% stack slots, and which can be accessed through other variables on the stack.
|
|
%
|
|
% The code in this module processes procedures one by one. It makes two passes
|
|
% over each procedure.
|
|
%
|
|
% The first pass traverses the procedure body backward, building a graph
|
|
% structure as it goes along. The nodes of the graphs are *anchors*. Points
|
|
% at which stack flushes may be required are anchors, and so are the beginnings
|
|
% and ends of branched control structures and of the procedure body itself.
|
|
% The graph associates with the edge between two anchors the set of variables
|
|
% accessed by the program fragment between those two anchors.
|
|
%
|
|
% When the traversal reaches a deconstruction unification, we sweep forward
|
|
% over the graph. During this sweep, we build a set of *paths*, with the
|
|
% intention that this set should contain an element for each path that control
|
|
% can take from the starting unification to the end of the procedure body.
|
|
% Each path is a sequence of *intervals*. An interval starts either at the
|
|
% starting unification or at a stack flush point; it ends at a stack flush
|
|
% point or the end of the procedure body. An interval is associated with one
|
|
% or more edges in the graph; the first of these associated edges will not
|
|
% have a left anchor yet.
|
|
%
|
|
% We give each path to the matching algorithm one by one. The matching
|
|
% algorithm finds out which set of variables should be accessed via
|
|
% the cell variable on that path. Since the decisions made for different
|
|
% paths are not independent, we have to apply a fixpoint iteration until
|
|
% we get a consistent set of answers.
|
|
%
|
|
% The first pass (whose main predicate is optimize_live_sets_in_goal) records
|
|
% its results in the left_anchor_inserts field of the stack_opt_info data
|
|
% structure it passes around. This field then becomes the main input to the
|
|
% second pass (whose main predicate is record_decisions_in_goal), which
|
|
% performs the source-to-source transformation that makes each segment access
|
|
% via the cell variable the field variables that have been selected to be so
|
|
% accessed by the first pass.
|
|
%
|
|
% The principles of this optimization are documented in the paper "Using the
|
|
% heap to eliminate stack accesses" by Zoltan Somogyi and Peter Stuckey.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module ll_backend.stack_opt.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred stack_opt_cell(pred_proc_id::in, proc_info::in, proc_info::out,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module backend_libs.
|
|
:- import_module backend_libs.interval.
|
|
:- import_module backend_libs.matching.
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module check_hlds.simplify.
|
|
:- import_module check_hlds.simplify.simplify_proc.
|
|
:- import_module check_hlds.simplify.simplify_tasks.
|
|
:- import_module check_hlds.type_util.
|
|
:- import_module hlds.arg_info.
|
|
:- import_module hlds.goal_path.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_llds.
|
|
:- import_module hlds.hlds_out.
|
|
:- import_module hlds.hlds_out.hlds_out_goal.
|
|
:- import_module hlds.hlds_out.hlds_out_util.
|
|
:- import_module hlds.quantification.
|
|
:- import_module hlds.vartypes.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.optimization_options.
|
|
:- import_module libs.options.
|
|
:- import_module ll_backend.live_vars.
|
|
:- import_module ll_backend.liveness.
|
|
:- import_module ll_backend.store_alloc.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.goal_path.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.set_of_var.
|
|
|
|
:- import_module array.
|
|
:- import_module bool.
|
|
:- import_module counter.
|
|
:- import_module int.
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module term.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The opt_stack_alloc structure is constructed by live_vars.m. It contains
|
|
% the set of vars that definitely need their own stack slots, and which this
|
|
% optimization should not try to make reachable from a heap cell. At the
|
|
% moment, the only variables we treat this way are those that are required to
|
|
% be on the stack by a parallel conjunction or loop control scope.
|
|
|
|
:- type opt_stack_alloc
|
|
---> opt_stack_alloc(
|
|
% XXX: this is an over-simplification, it gives stack slots to
|
|
% variables that may not need them. For example, vars local to
|
|
% loop control scopes and parallel conjunctions, And vars used
|
|
% after a loop control scope but before a recursive call don't
|
|
% need to be placed here.
|
|
par_conj_own_slots :: set_of_progvar
|
|
).
|
|
|
|
:- type stack_opt_params
|
|
---> stack_opt_params(
|
|
sop_matching_params :: matching_params,
|
|
sop_all_path_node_ratio :: int,
|
|
sop_fixpoint_loop :: maybe_opt_svcell_loop,
|
|
sop_full_path :: maybe_opt_svcell_full_path,
|
|
sop_on_stack :: maybe_opt_svcell_on_stack,
|
|
sop_non_candidate_vars :: set_of_progvar
|
|
).
|
|
|
|
:- type matching_result
|
|
---> matching_result(
|
|
prog_var,
|
|
cons_id,
|
|
list(prog_var),
|
|
set_of_progvar,
|
|
goal_id,
|
|
set(interval_id),
|
|
set(interval_id),
|
|
set(anchor),
|
|
set(anchor)
|
|
).
|
|
|
|
:- type stack_opt_info
|
|
---> stack_opt_info(
|
|
soi_stack_opt_params :: stack_opt_params,
|
|
soi_left_anchor_inserts :: insert_map,
|
|
soi_matching_results :: list(matching_result)
|
|
).
|
|
|
|
stack_opt_cell(PredProcId, !ProcInfo, !ModuleInfo) :-
|
|
PredProcId = proc(PredId, ProcId),
|
|
% This simplication is necessary to fix some bad inputs from
|
|
% getting to the liveness computation.
|
|
% (see tests/valid/stack_opt_simplify.m)
|
|
SimplifyTasks = list_to_simplify_tasks([]),
|
|
simplify_proc(SimplifyTasks, PredId, ProcId, !ModuleInfo, !ProcInfo),
|
|
detect_liveness_proc(!.ModuleInfo, PredProcId, !ProcInfo),
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
|
|
initial_liveness(!.ModuleInfo, PredInfo, !.ProcInfo, Liveness0),
|
|
module_info_get_globals(!.ModuleInfo, Globals),
|
|
body_should_use_typeinfo_liveness(PredInfo, Globals, TypeInfoLiveness),
|
|
globals.lookup_bool_option(Globals, opt_no_return_calls,
|
|
OptNoReturnCalls),
|
|
array.init(1, is_not_dummy_type, DummyDummyTypeArray),
|
|
AllocData = alloc_data(!.ModuleInfo, !.ProcInfo, PredProcId,
|
|
TypeInfoLiveness, OptNoReturnCalls, DummyDummyTypeArray),
|
|
fill_goal_id_slots_in_proc(!.ModuleInfo, _, !ProcInfo),
|
|
proc_info_get_goal(!.ProcInfo, Goal2),
|
|
OptStackAlloc0 = init_opt_stack_alloc,
|
|
set.init(FailVars),
|
|
set.init(NondetLiveness0),
|
|
build_live_sets_in_goal_no_par_stack(Goal2, Goal, set_to_bitset(FailVars),
|
|
AllocData, OptStackAlloc0, OptStackAlloc, Liveness0, _Liveness,
|
|
set_to_bitset(NondetLiveness0), _NondetLiveness),
|
|
proc_info_set_goal(Goal, !ProcInfo),
|
|
allocate_store_maps(for_stack_opt, !.ModuleInfo, PredProcId, !ProcInfo),
|
|
globals.lookup_int_option(Globals, debug_stack_opt, DebugStackOpt),
|
|
pred_id_to_int(PredId, PredIdInt),
|
|
trace [io(!IO)] (
|
|
maybe_write_progress_message(
|
|
"\nbefore stack opt cell",
|
|
DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO)
|
|
),
|
|
optimize_live_sets(!.ModuleInfo, OptStackAlloc, !ProcInfo,
|
|
Changed, DebugStackOpt, PredIdInt),
|
|
(
|
|
Changed = yes,
|
|
trace [io(!IO)] (
|
|
maybe_write_progress_message(
|
|
"\nafter stack opt transformation",
|
|
DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO)
|
|
),
|
|
requantify_proc_general(ordinary_nonlocals_no_lambda, !ProcInfo),
|
|
trace [io(!IO)] (
|
|
maybe_write_progress_message(
|
|
"\nafter stack opt requantify",
|
|
DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO)
|
|
),
|
|
recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
|
|
!ProcInfo, !ModuleInfo),
|
|
trace [io(!IO)] (
|
|
maybe_write_progress_message("
|
|
\nafter stack opt recompute instmaps",
|
|
DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO)
|
|
)
|
|
;
|
|
Changed = no
|
|
).
|
|
|
|
:- func init_opt_stack_alloc = opt_stack_alloc.
|
|
|
|
init_opt_stack_alloc = opt_stack_alloc(set_of_var.init).
|
|
|
|
:- pred optimize_live_sets(module_info::in, opt_stack_alloc::in,
|
|
proc_info::in, proc_info::out, bool::out, int::in, int::in) is det.
|
|
|
|
optimize_live_sets(ModuleInfo, OptAlloc, !ProcInfo, Changed, DebugStackOpt,
|
|
PredIdInt) :-
|
|
proc_info_get_goal(!.ProcInfo, Goal0),
|
|
proc_info_get_vartypes(!.ProcInfo, VarTypes0),
|
|
proc_info_get_varset(!.ProcInfo, VarSet0),
|
|
OptAlloc = opt_stack_alloc(ParConjOwnSlot),
|
|
arg_info.partition_proc_args(!.ProcInfo, ModuleInfo,
|
|
InputArgs, OutputArgs, UnusedArgs),
|
|
HeadVars = set.union_list([InputArgs, OutputArgs, UnusedArgs]),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
CandHeadvars = OptTuple ^ ot_opt_svcell_candidate_headvars,
|
|
(
|
|
CandHeadvars = do_not_opt_svcell_candidate_headvars,
|
|
set_of_var.union(set_to_bitset(HeadVars), ParConjOwnSlot,
|
|
NonCandidateVars)
|
|
;
|
|
CandHeadvars = opt_svcell_candidate_headvars,
|
|
NonCandidateVars = ParConjOwnSlot
|
|
),
|
|
Counter0 = counter.init(1),
|
|
counter.allocate(CurInterval, Counter0, Counter1),
|
|
CurIntervalId = interval_id(CurInterval),
|
|
EndMap0 = map.singleton(CurIntervalId, anchor_proc_end),
|
|
map.init(InsertMap0),
|
|
map.init(StartMap0),
|
|
SuccMap0 = map.singleton(CurIntervalId, []),
|
|
VarsMap0 = map.singleton(CurIntervalId, set_to_bitset(OutputArgs)),
|
|
CellVarStoreCost = OptTuple ^ ot_opt_svcell_cv_store_cost,
|
|
CellVarLoadCost = OptTuple ^ ot_opt_svcell_cv_load_cost,
|
|
FieldVarStoreCost = OptTuple ^ ot_opt_svcell_fv_store_cost,
|
|
FieldVarLoadCost = OptTuple ^ ot_opt_svcell_fv_load_cost,
|
|
OpRatio = OptTuple ^ ot_opt_svcell_op_ratio,
|
|
NodeRatio = OptTuple ^ ot_opt_svcell_node_ratio,
|
|
InclAllCand = OptTuple ^ ot_opt_svcell_all_candidates,
|
|
MatchingParams = matching_params(CellVarStoreCost, CellVarLoadCost,
|
|
FieldVarStoreCost, FieldVarLoadCost, OpRatio, NodeRatio, InclAllCand),
|
|
AllPathNodeRatio = OptTuple ^ ot_opt_svcell_all_path_node_ratio,
|
|
FixpointLoop = OptTuple ^ ot_opt_svcell_loop,
|
|
FullPath = OptTuple ^ ot_opt_svcell_full_path,
|
|
OnStack = OptTuple ^ ot_opt_svcell_on_stack,
|
|
globals.lookup_bool_option(Globals, opt_no_return_calls, OptNoReturnCalls),
|
|
IntParams = interval_params(ModuleInfo, VarTypes0, OptNoReturnCalls),
|
|
IntervalInfo0 = interval_info(IntParams,
|
|
set_of_var.init, set_to_bitset(OutputArgs),
|
|
map.init, map.init, map.init, CurIntervalId, Counter1,
|
|
set.make_singleton_set(CurIntervalId),
|
|
map.init, set.init, StartMap0, EndMap0,
|
|
SuccMap0, VarsMap0, map.init),
|
|
StackOptParams = stack_opt_params(MatchingParams, AllPathNodeRatio,
|
|
FixpointLoop, FullPath, OnStack, NonCandidateVars),
|
|
StackOptInfo0 = stack_opt_info(StackOptParams, InsertMap0, []),
|
|
build_interval_info_in_goal(Goal0, IntervalInfo0, IntervalInfo,
|
|
StackOptInfo0, StackOptInfo),
|
|
( if DebugStackOpt = PredIdInt then
|
|
trace [io(!IO)] (
|
|
dump_interval_info(IntervalInfo, !IO),
|
|
dump_stack_opt_info(StackOptInfo, !IO)
|
|
)
|
|
else
|
|
true
|
|
),
|
|
InsertMap = StackOptInfo ^ soi_left_anchor_inserts,
|
|
( if map.is_empty(InsertMap) then
|
|
Changed = no
|
|
else
|
|
record_decisions_in_goal(Goal0, Goal1, VarSet0, VarSet,
|
|
VarTypes0, VarTypes, map.init, RenameMap,
|
|
InsertMap, yes(feature_stack_opt)),
|
|
apply_headvar_correction(set_to_bitset(HeadVars), RenameMap,
|
|
Goal1, Goal),
|
|
proc_info_set_goal(Goal, !ProcInfo),
|
|
proc_info_set_varset(VarSet, !ProcInfo),
|
|
proc_info_set_vartypes(VarTypes, !ProcInfo),
|
|
Changed = yes
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- instance stack_alloc_info(opt_stack_alloc) where [
|
|
pred(at_call_site/4) is opt_at_call_site,
|
|
pred(at_resume_site/4) is opt_at_resume_site,
|
|
pred(at_par_conj/4) is opt_at_par_conj,
|
|
pred(at_recursive_call_for_loop_control/4) is
|
|
opt_at_recursive_call_for_loop_control
|
|
].
|
|
|
|
:- pred opt_at_call_site(need_across_call::in, alloc_data::in,
|
|
opt_stack_alloc::in, opt_stack_alloc::out) is det.
|
|
|
|
opt_at_call_site(_NeedAtCall, _AllocData, !StackAlloc).
|
|
|
|
:- pred opt_at_resume_site(need_in_resume::in, alloc_data::in,
|
|
opt_stack_alloc::in, opt_stack_alloc::out) is det.
|
|
|
|
opt_at_resume_site(_NeedAtResume, _AllocData, !StackAlloc).
|
|
|
|
:- pred opt_at_par_conj(need_in_par_conj::in, alloc_data::in,
|
|
opt_stack_alloc::in, opt_stack_alloc::out) is det.
|
|
|
|
opt_at_par_conj(NeedParConj, _AllocData, !StackAlloc) :-
|
|
NeedParConj = need_in_par_conj(StackVars),
|
|
ParConjOwnSlots0 = !.StackAlloc ^ par_conj_own_slots,
|
|
ParConjOwnSlots = set_of_var.union(StackVars, ParConjOwnSlots0),
|
|
!StackAlloc ^ par_conj_own_slots := ParConjOwnSlots.
|
|
|
|
:- pred opt_at_recursive_call_for_loop_control(need_for_loop_control::in,
|
|
alloc_data::in, opt_stack_alloc::in, opt_stack_alloc::out) is det.
|
|
|
|
opt_at_recursive_call_for_loop_control(NeedLC, _AllocData, !StackAlloc) :-
|
|
NeedLC = need_for_loop_control(StackVarsSets),
|
|
StackVars = set_of_var.union_list(StackVarsSets),
|
|
ParConjOwnSlots0 = !.StackAlloc ^ par_conj_own_slots,
|
|
ParConjOwnSlots = set_of_var.union(StackVars, ParConjOwnSlots0),
|
|
!StackAlloc ^ par_conj_own_slots := ParConjOwnSlots.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- instance build_interval_info_acc(stack_opt_info) where [
|
|
pred(use_cell/8) is stack_opt.use_cell
|
|
].
|
|
|
|
:- type match_path_info
|
|
---> match_path_info(
|
|
% The set of vars referenced in the first interval,
|
|
% before the first flush point.
|
|
set_of_progvar,
|
|
|
|
% The set of vars referenced in later intervals,
|
|
% after the first flush point.
|
|
list(set_of_progvar)
|
|
).
|
|
|
|
:- type match_info
|
|
---> match_info(
|
|
% Information about the variables used along each path.
|
|
list(match_path_info),
|
|
|
|
% The variables used after the deconstruction
|
|
% goes out of scope.
|
|
set_of_progvar,
|
|
|
|
% Have we stepped over a model_non goal?
|
|
bool,
|
|
|
|
% The set of save points to which the results of the
|
|
% matching applies.
|
|
set(anchor),
|
|
|
|
set(interval_id)
|
|
).
|
|
|
|
:- pred use_cell(prog_var::in, list(prog_var)::in, cons_id::in,
|
|
hlds_goal::in, interval_info::in, interval_info::out, stack_opt_info::in,
|
|
stack_opt_info::out) is det.
|
|
|
|
use_cell(CellVar, FieldVarList, ConsId, Goal, !IntervalInfo, !StackOptInfo) :-
|
|
FlushedLater = !.IntervalInfo ^ ii_flushed_later,
|
|
StackOptParams = !.StackOptInfo ^ soi_stack_opt_params,
|
|
NonCandidateVars = StackOptParams ^ sop_non_candidate_vars,
|
|
FieldVars = set_of_var.list_to_set(FieldVarList),
|
|
set_of_var.intersect(FieldVars, FlushedLater, FlushedLaterFieldVars),
|
|
set_of_var.difference(FlushedLaterFieldVars, NonCandidateVars,
|
|
CandidateArgVars0),
|
|
( if
|
|
set_of_var.is_empty(CandidateArgVars0)
|
|
then
|
|
true
|
|
else if
|
|
ConsId = cons(_Name, _Arity, _TypeCtor),
|
|
IntParams = !.IntervalInfo ^ ii_interval_params,
|
|
VarTypes = IntParams ^ ip_var_types,
|
|
lookup_var_type(VarTypes, CellVar, Type),
|
|
( if
|
|
type_is_tuple(Type, _)
|
|
then
|
|
FreeOfCost = no
|
|
else if
|
|
ModuleInfo = IntParams ^ ip_module_info,
|
|
get_cons_repn_defn(ModuleInfo, ConsId, ConsRepn)
|
|
then
|
|
ConsTag = ConsRepn ^ cr_tag,
|
|
( if ConsTag = no_tag then
|
|
FreeOfCost = yes
|
|
else
|
|
FreeOfCost = no
|
|
)
|
|
else
|
|
fail
|
|
)
|
|
then
|
|
set_of_var.insert(CellVar, FieldVars, RelevantVars),
|
|
find_all_branches_from_cur_interval(RelevantVars, MatchInfo,
|
|
!.IntervalInfo, !.StackOptInfo),
|
|
MatchInfo = match_info(PathsInfo, RelevantAfterVars,
|
|
AfterModelNon, InsertAnchors, InsertIntervals),
|
|
(
|
|
FreeOfCost = yes,
|
|
set_of_var.difference(CandidateArgVars0, RelevantAfterVars,
|
|
ViaCellVars),
|
|
record_matching_result(CellVar, ConsId, FieldVarList, ViaCellVars,
|
|
Goal, InsertAnchors, InsertIntervals, !IntervalInfo,
|
|
!StackOptInfo)
|
|
;
|
|
FreeOfCost = no,
|
|
(
|
|
AfterModelNon = no,
|
|
OnStack = StackOptParams ^ sop_on_stack,
|
|
set_of_var.difference(CandidateArgVars0, RelevantAfterVars,
|
|
CandidateArgVars),
|
|
(
|
|
OnStack = opt_svcell_on_stack,
|
|
( if set_of_var.member(FlushedLater, CellVar) then
|
|
CellVarFlushedLater = yes
|
|
else
|
|
CellVarFlushedLater = no
|
|
)
|
|
;
|
|
OnStack = do_not_opt_svcell_on_stack,
|
|
( if
|
|
list.member(PathInfo, PathsInfo),
|
|
PathInfo = match_path_info(_, Segments),
|
|
list.member(Segment, Segments),
|
|
set_of_var.member(Segment, CellVar)
|
|
then
|
|
CellVarFlushedLater = yes
|
|
else
|
|
CellVarFlushedLater = no
|
|
)
|
|
),
|
|
apply_matching(CellVar, CellVarFlushedLater, IntParams,
|
|
StackOptParams, PathsInfo, CandidateArgVars, ViaCellVars),
|
|
record_matching_result(CellVar, ConsId, FieldVarList,
|
|
ViaCellVars, Goal, InsertAnchors, InsertIntervals,
|
|
!IntervalInfo, !StackOptInfo)
|
|
;
|
|
AfterModelNon = yes
|
|
)
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred apply_matching(prog_var::in, bool::in, interval_params::in,
|
|
stack_opt_params::in, list(match_path_info)::in,
|
|
set_of_progvar::in, set_of_progvar::out) is det.
|
|
|
|
apply_matching(CellVar, CellVarFlushedLater, IntParams, StackOptParams,
|
|
PathInfos, CandidateArgVars0, ViaCellVars) :-
|
|
apply_matching_loop(CellVar, CellVarFlushedLater, IntParams,
|
|
StackOptParams, PathInfos, CandidateArgVars0,
|
|
BenefitNodeSets, CostNodeSets, ViaCellVars0),
|
|
BenefitNodes = set.union_list(BenefitNodeSets),
|
|
CostNodes = set.union_list(CostNodeSets),
|
|
set.count(BenefitNodes, NumBenefitNodes),
|
|
set.count(CostNodes, NumCostNodes),
|
|
AllPathNodeRatio = StackOptParams ^ sop_all_path_node_ratio,
|
|
( if NumBenefitNodes * 100 >= NumCostNodes * AllPathNodeRatio then
|
|
ViaCellVars = ViaCellVars0
|
|
else
|
|
ViaCellVars = set_of_var.init
|
|
).
|
|
|
|
:- pred apply_matching_loop(prog_var::in, bool::in, interval_params::in,
|
|
stack_opt_params::in, list(match_path_info)::in, set_of_progvar::in,
|
|
list(set(benefit_node))::out, list(set(cost_node))::out,
|
|
set_of_progvar::out) is det.
|
|
|
|
apply_matching_loop(CellVar, CellVarFlushedLater, IntParams, StackOptParams,
|
|
PathInfos, CandidateArgVars0, BenefitNodeSets, CostNodeSets,
|
|
ViaCellVars) :-
|
|
list.map3(apply_matching_for_path(CellVar, CellVarFlushedLater,
|
|
StackOptParams, CandidateArgVars0), PathInfos,
|
|
BenefitNodeSets0, CostNodeSets0, PathViaCellVars),
|
|
( if list.all_same(PathViaCellVars) then
|
|
BenefitNodeSets = BenefitNodeSets0,
|
|
CostNodeSets = CostNodeSets0,
|
|
(
|
|
PathViaCellVars = [ViaCellVars | _]
|
|
;
|
|
PathViaCellVars = [],
|
|
ViaCellVars = set_of_var.init
|
|
)
|
|
else
|
|
CandidateArgVars1 = set_of_var.intersect_list(PathViaCellVars),
|
|
FixpointLoop = StackOptParams ^ sop_fixpoint_loop,
|
|
(
|
|
FixpointLoop = do_not_opt_svcell_loop,
|
|
BenefitNodeSets = BenefitNodeSets0,
|
|
CostNodeSets = CostNodeSets0,
|
|
ViaCellVars = CandidateArgVars1
|
|
;
|
|
FixpointLoop = opt_svcell_loop,
|
|
apply_matching_loop(CellVar, CellVarFlushedLater,
|
|
IntParams, StackOptParams, PathInfos, CandidateArgVars1,
|
|
BenefitNodeSets, CostNodeSets, ViaCellVars)
|
|
)
|
|
).
|
|
|
|
:- pred apply_matching_for_path(prog_var::in, bool::in, stack_opt_params::in,
|
|
set_of_progvar::in, match_path_info::in,
|
|
set(benefit_node)::out, set(cost_node)::out, set_of_progvar::out) is det.
|
|
|
|
apply_matching_for_path(CellVar, CellVarFlushedLater, StackOptParams,
|
|
CandidateArgVars, PathInfo, BenefitNodes, CostNodes, ViaCellVars) :-
|
|
( if set_of_var.is_empty(CandidateArgVars) then
|
|
BenefitNodes = set.init,
|
|
CostNodes = set.init,
|
|
ViaCellVars = set_of_var.init
|
|
else
|
|
PathInfo = match_path_info(FirstSegment, LaterSegments),
|
|
MatchingParams = StackOptParams ^ sop_matching_params,
|
|
find_via_cell_vars(CellVar, CandidateArgVars, CellVarFlushedLater,
|
|
FirstSegment, LaterSegments, MatchingParams,
|
|
BenefitNodes, CostNodes, ViaCellVars)
|
|
).
|
|
|
|
:- pred record_matching_result(prog_var::in, cons_id::in,
|
|
list(prog_var)::in, set_of_progvar::in, hlds_goal::in, set(anchor)::in,
|
|
set(interval_id)::in, interval_info::in, interval_info::out,
|
|
stack_opt_info::in, stack_opt_info::out) is det.
|
|
|
|
record_matching_result(CellVar, ConsId, ArgVars, ViaCellVars, Goal,
|
|
PotentialAnchors, PotentialIntervals, !IntervalInfo, !StackOptInfo) :-
|
|
( if set_of_var.is_empty(ViaCellVars) then
|
|
true
|
|
else
|
|
set.to_sorted_list(PotentialIntervals, PotentialIntervalList),
|
|
set.to_sorted_list(PotentialAnchors, PotentialAnchorList),
|
|
list.foldl3(record_cell_var_for_interval(CellVar, ViaCellVars),
|
|
PotentialIntervalList, !IntervalInfo, !StackOptInfo,
|
|
set.init, InsertIntervals),
|
|
list.foldl3(add_anchor_inserts(Goal, ViaCellVars, InsertIntervals),
|
|
PotentialAnchorList, !IntervalInfo, !StackOptInfo,
|
|
set.init, InsertAnchors),
|
|
Goal = hlds_goal(_, GoalInfo),
|
|
GoalId = goal_info_get_goal_id(GoalInfo),
|
|
MatchingResult = matching_result(CellVar, ConsId,
|
|
ArgVars, ViaCellVars, GoalId,
|
|
PotentialIntervals, InsertIntervals,
|
|
PotentialAnchors, InsertAnchors),
|
|
MatchingResults0 = !.StackOptInfo ^ soi_matching_results,
|
|
MatchingResults = [MatchingResult | MatchingResults0],
|
|
!StackOptInfo ^ soi_matching_results := MatchingResults
|
|
).
|
|
|
|
:- pred record_cell_var_for_interval(prog_var::in, set_of_progvar::in,
|
|
interval_id::in, interval_info::in, interval_info::out,
|
|
stack_opt_info::in, stack_opt_info::out,
|
|
set(interval_id)::in, set(interval_id)::out) is det.
|
|
|
|
record_cell_var_for_interval(CellVar, ViaCellVars, IntervalId,
|
|
!IntervalInfo, !StackOptInfo, !InsertIntervals) :-
|
|
record_interval_vars(IntervalId, [CellVar], !IntervalInfo),
|
|
delete_interval_vars(IntervalId, ViaCellVars, DeletedVars, !IntervalInfo),
|
|
( if set_of_var.is_non_empty(DeletedVars) then
|
|
set.insert(IntervalId, !InsertIntervals)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred add_anchor_inserts(hlds_goal::in, set_of_progvar::in,
|
|
set(interval_id)::in, anchor::in, interval_info::in,
|
|
interval_info::out, stack_opt_info::in, stack_opt_info::out,
|
|
set(anchor)::in, set(anchor)::out) is det.
|
|
|
|
add_anchor_inserts(Goal, ArgVarsViaCellVar, InsertIntervals, Anchor,
|
|
!IntervalInfo, !StackOptInfo, !InsertAnchors) :-
|
|
map.lookup(!.IntervalInfo ^ ii_anchor_follow_map, Anchor, AnchorFollow),
|
|
AnchorFollow = anchor_follow_info(_, AnchorIntervals),
|
|
set.intersect(AnchorIntervals, InsertIntervals,
|
|
AnchorInsertIntervals),
|
|
( if set.is_non_empty(AnchorInsertIntervals) then
|
|
Insert = insert_spec(Goal, ArgVarsViaCellVar),
|
|
InsertMap0 = !.StackOptInfo ^ soi_left_anchor_inserts,
|
|
( if map.search(InsertMap0, Anchor, Inserts0) then
|
|
Inserts = [Insert | Inserts0],
|
|
map.det_update(Anchor, Inserts, InsertMap0, InsertMap)
|
|
else
|
|
Inserts = [Insert],
|
|
map.det_insert(Anchor, Inserts, InsertMap0, InsertMap)
|
|
),
|
|
!StackOptInfo ^ soi_left_anchor_inserts := InsertMap,
|
|
set.insert(Anchor, !InsertAnchors)
|
|
else
|
|
true
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type current_segment_first_flush
|
|
---> current_is_before_first_flush
|
|
; current_is_after_first_flush.
|
|
|
|
:- type path
|
|
---> path(
|
|
flush_state :: current_segment_first_flush,
|
|
current_segment :: set_of_progvar,
|
|
first_segment :: set_of_progvar,
|
|
other_segments :: list(set_of_progvar),
|
|
flush_anchors :: set(anchor),
|
|
occurring_intervals :: set(interval_id)
|
|
).
|
|
|
|
:- type all_paths
|
|
---> all_paths(
|
|
% The set of all paths so far.
|
|
paths_so_far :: set(path),
|
|
|
|
% Have we stepped over model_non goals?
|
|
stepped_over_model_non :: bool,
|
|
|
|
% The vars which are known to be used after the deconstruction
|
|
% goes out of scope.
|
|
used_after_scope :: set_of_progvar
|
|
).
|
|
|
|
:- pred extract_match_and_save_info(path::in, match_path_info::out,
|
|
set(anchor)::out, set(interval_id)::out) is det.
|
|
|
|
extract_match_and_save_info(Path0, MatchPathInfo, Anchors, Intervals) :-
|
|
Path = close_path(Path0),
|
|
FirstSegment = Path ^ first_segment,
|
|
OtherSegments = Path ^ other_segments,
|
|
MatchPathInfo = match_path_info(FirstSegment, OtherSegments),
|
|
Anchors = Path ^ flush_anchors,
|
|
Intervals = Path ^ occurring_intervals.
|
|
|
|
:- func close_path(path) = path.
|
|
|
|
close_path(Path0) = Path :-
|
|
Path0 = path(FlushState, CurSegment, FirstSegment0, OtherSegments0,
|
|
FlushAnchors, IntervalIds),
|
|
(
|
|
FlushState = current_is_before_first_flush,
|
|
expect(set_of_var.is_empty(FirstSegment0), $pred,
|
|
"FirstSegment0 not empty"),
|
|
FirstSegment = CurSegment,
|
|
OtherSegments = OtherSegments0
|
|
;
|
|
FlushState = current_is_after_first_flush,
|
|
( if set_of_var.is_empty(CurSegment) then
|
|
FirstSegment = FirstSegment0,
|
|
OtherSegments = OtherSegments0
|
|
else
|
|
FirstSegment = FirstSegment0,
|
|
OtherSegments = [CurSegment | OtherSegments0]
|
|
)
|
|
),
|
|
Path = path(current_is_after_first_flush, set_of_var.init,
|
|
FirstSegment, OtherSegments, FlushAnchors, IntervalIds).
|
|
|
|
:- func add_interval_to_path(interval_id, set_of_progvar, path) = path.
|
|
|
|
add_interval_to_path(IntervalId, Vars, !.Path) = !:Path :-
|
|
( if set_of_var.is_empty(Vars) then
|
|
true
|
|
else
|
|
CurSegment0 = !.Path ^ current_segment,
|
|
CurSegment = set_of_var.union(Vars, CurSegment0),
|
|
OccurringIntervals0 = !.Path ^ occurring_intervals,
|
|
set.insert(IntervalId, OccurringIntervals0, OccurringIntervals),
|
|
!Path ^ current_segment := CurSegment,
|
|
!Path ^ occurring_intervals := OccurringIntervals
|
|
).
|
|
|
|
:- func add_anchor_to_path(anchor, path) = path.
|
|
|
|
add_anchor_to_path(Anchor, !.Path) = !:Path :-
|
|
Anchors0 = !.Path ^ flush_anchors,
|
|
set.insert(Anchor, Anchors0, Anchors),
|
|
!Path ^ flush_anchors := Anchors.
|
|
|
|
:- func anchor_requires_close(interval_info, anchor) = bool.
|
|
|
|
anchor_requires_close(_, anchor_proc_start) = no.
|
|
anchor_requires_close(_, anchor_proc_end) = yes.
|
|
anchor_requires_close(IntervalInfo, anchor_branch_start(_, GoalId)) =
|
|
resume_save_status_requires_close(ResumeSaveStatus) :-
|
|
map.lookup(IntervalInfo ^ ii_branch_resume_map, GoalId,
|
|
ResumeSaveStatus).
|
|
anchor_requires_close(_, anchor_cond_then(_)) = no.
|
|
anchor_requires_close(_, anchor_branch_end(BranchType, _)) = NeedsClose :-
|
|
(
|
|
BranchType = branch_neg,
|
|
NeedsClose = no
|
|
;
|
|
( BranchType = branch_ite
|
|
; BranchType = branch_disj
|
|
; BranchType = branch_switch
|
|
; BranchType = branch_par_conj
|
|
),
|
|
NeedsClose = yes
|
|
).
|
|
anchor_requires_close(_, anchor_call_site(_)) = yes.
|
|
|
|
:- func resume_save_status_requires_close(resume_save_status) = bool.
|
|
|
|
resume_save_status_requires_close(has_resume_save) = yes.
|
|
resume_save_status_requires_close(has_no_resume_save) = no.
|
|
|
|
:- func may_have_no_successor(anchor) = bool.
|
|
|
|
may_have_no_successor(anchor_proc_start) = no.
|
|
may_have_no_successor(anchor_proc_end) = yes.
|
|
may_have_no_successor(anchor_branch_start(_, _)) = no.
|
|
may_have_no_successor(anchor_cond_then(_)) = no.
|
|
may_have_no_successor(anchor_branch_end(_, _)) = no.
|
|
may_have_no_successor(anchor_call_site(_)) = yes. % if the call cannot succeed
|
|
|
|
:- func may_have_one_successor(anchor) = bool.
|
|
|
|
may_have_one_successor(anchor_proc_start) = yes.
|
|
may_have_one_successor(anchor_proc_end) = no.
|
|
may_have_one_successor(anchor_branch_start(_, _)) = yes.
|
|
may_have_one_successor(anchor_cond_then(_)) = yes.
|
|
may_have_one_successor(anchor_branch_end(_, _)) = yes.
|
|
may_have_one_successor(anchor_call_site(_)) = yes.
|
|
|
|
:- func may_have_more_successors(anchor) = bool.
|
|
|
|
may_have_more_successors(anchor_proc_start) = no.
|
|
may_have_more_successors(anchor_proc_end) = no.
|
|
may_have_more_successors(anchor_branch_start(BranchType, _)) = MaybeHaveMore :-
|
|
(
|
|
BranchType = branch_neg,
|
|
MaybeHaveMore = no
|
|
;
|
|
( BranchType = branch_ite
|
|
; BranchType = branch_disj
|
|
; BranchType = branch_switch
|
|
; BranchType = branch_par_conj
|
|
),
|
|
MaybeHaveMore = yes
|
|
).
|
|
may_have_more_successors(anchor_cond_then(_)) = no.
|
|
may_have_more_successors(anchor_branch_end(_, _)) = no.
|
|
may_have_more_successors(anchor_call_site(_)) = no.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred find_all_branches_from_cur_interval(set_of_progvar::in,
|
|
match_info::out, interval_info::in, stack_opt_info::in) is det.
|
|
|
|
find_all_branches_from_cur_interval(RelevantVars, MatchInfo, IntervalInfo,
|
|
StackOptInfo) :-
|
|
IntervalId = IntervalInfo ^ ii_cur_interval,
|
|
map.lookup(IntervalInfo ^ ii_interval_vars, IntervalId, IntervalVars),
|
|
IntervalRelevantVars = set_of_var.intersect(RelevantVars, IntervalVars),
|
|
Path0 = path(current_is_before_first_flush, IntervalRelevantVars,
|
|
set_of_var.init, [], set.init, set.init),
|
|
AllPaths0 = all_paths(set.make_singleton_set(Path0), no, set_of_var.init),
|
|
find_all_branches(RelevantVars, IntervalId, no, IntervalInfo,
|
|
StackOptInfo, AllPaths0, AllPaths),
|
|
AllPaths = all_paths(Paths, AfterModelNon, RelevantAfter),
|
|
set.to_sorted_list(Paths, PathList),
|
|
list.map3(extract_match_and_save_info, PathList,
|
|
MatchInputs, FlushAnchorSets, OccurringIntervalSets),
|
|
FlushAnchors = set.union_list(FlushAnchorSets),
|
|
OccurringIntervals = set.union_list(OccurringIntervalSets),
|
|
MatchInfo = match_info(MatchInputs, RelevantAfter, AfterModelNon,
|
|
FlushAnchors, OccurringIntervals).
|
|
|
|
:- pred find_all_branches(set_of_progvar::in, interval_id::in,
|
|
maybe(anchor)::in, interval_info::in, stack_opt_info::in,
|
|
all_paths::in, all_paths::out) is det.
|
|
|
|
find_all_branches(RelevantVars, IntervalId, MaybeSearchAnchor0,
|
|
IntervalInfo, StackOptInfo, !AllPaths) :-
|
|
map.lookup(IntervalInfo ^ ii_interval_end, IntervalId, End),
|
|
map.lookup(IntervalInfo ^ ii_interval_succ, IntervalId, SuccessorIds),
|
|
(
|
|
SuccessorIds = [],
|
|
expect(unify(may_have_no_successor(End), yes), $pred,
|
|
"unexpected no successor")
|
|
% expect(unify(MaybeSearchAnchor0, no), $pred,
|
|
% "find_all_branches: no successor while in search"),
|
|
% that test may fail if we come to a call that cannot succeed
|
|
;
|
|
SuccessorIds = [SuccessorId | MoreSuccessorIds],
|
|
(
|
|
MoreSuccessorIds = [],
|
|
expect(unify(may_have_one_successor(End), yes), $pred,
|
|
"unexpected one successor")
|
|
;
|
|
MoreSuccessorIds = [_ | _],
|
|
expect(unify(may_have_more_successors(End), yes), $pred,
|
|
"unexpected more successors")
|
|
),
|
|
( if
|
|
MaybeSearchAnchor0 = yes(SearchAnchor0),
|
|
End = SearchAnchor0
|
|
then
|
|
!AllPaths ^ used_after_scope := set_of_var.init
|
|
else if
|
|
End = anchor_branch_end(_, EndGoalId),
|
|
map.lookup(IntervalInfo ^ ii_branch_end_map, EndGoalId,
|
|
BranchEndInfo),
|
|
OnStackAfterBranch = BranchEndInfo ^ flushed_after_branch,
|
|
AccessedAfterBranch = BranchEndInfo ^ accessed_after_branch,
|
|
NeededAfterBranch = set_of_var.union(OnStackAfterBranch,
|
|
AccessedAfterBranch),
|
|
RelevantAfter = set_of_var.intersect(RelevantVars,
|
|
NeededAfterBranch),
|
|
set_of_var.is_non_empty(RelevantAfter)
|
|
then
|
|
!AllPaths ^ used_after_scope := RelevantAfter
|
|
else
|
|
find_all_branches_from(End, RelevantVars,
|
|
MaybeSearchAnchor0, IntervalInfo, StackOptInfo,
|
|
[SuccessorId | MoreSuccessorIds], !AllPaths)
|
|
)
|
|
).
|
|
|
|
:- pred find_all_branches_from(anchor::in, set_of_progvar::in,
|
|
maybe(anchor)::in, interval_info::in, stack_opt_info::in,
|
|
list(interval_id)::in, all_paths::in, all_paths::out) is det.
|
|
|
|
find_all_branches_from(End, RelevantVars, MaybeSearchAnchor0, IntervalInfo,
|
|
StackOptInfo, SuccessorIds, !AllPaths) :-
|
|
AnchorRequiresClose = anchor_requires_close(IntervalInfo, End),
|
|
(
|
|
AnchorRequiresClose = yes,
|
|
Paths0 = !.AllPaths ^ paths_so_far,
|
|
Paths1 = set.map(close_path, Paths0),
|
|
!AllPaths ^ paths_so_far := Paths1
|
|
;
|
|
AnchorRequiresClose = no
|
|
),
|
|
StackOptParams = StackOptInfo ^ soi_stack_opt_params,
|
|
FullPath = StackOptParams ^ sop_full_path,
|
|
( if
|
|
FullPath = opt_svcell_full_path,
|
|
End = anchor_branch_start(branch_disj, EndGoalId)
|
|
then
|
|
MaybeSearchAnchor1 = yes(anchor_branch_end(branch_disj, EndGoalId)),
|
|
one_after_another(RelevantVars, MaybeSearchAnchor1,
|
|
IntervalInfo, StackOptInfo, SuccessorIds, !AllPaths),
|
|
map.lookup(IntervalInfo ^ ii_branch_end_map, EndGoalId,
|
|
BranchEndInfo),
|
|
ContinueId = BranchEndInfo ^ interval_after_branch,
|
|
apply_interval_find_all_branches(RelevantVars, MaybeSearchAnchor0,
|
|
IntervalInfo, StackOptInfo, ContinueId, !AllPaths)
|
|
else if
|
|
FullPath = opt_svcell_full_path,
|
|
End = anchor_branch_start(branch_ite, EndGoalId)
|
|
then
|
|
( if SuccessorIds = [ElseStartIdPrime, CondStartIdPrime] then
|
|
ElseStartId = ElseStartIdPrime,
|
|
CondStartId = CondStartIdPrime
|
|
else
|
|
unexpected($pred, "ite not else, cond")
|
|
),
|
|
MaybeSearchAnchorCond = yes(anchor_cond_then(EndGoalId)),
|
|
apply_interval_find_all_branches(RelevantVars,
|
|
MaybeSearchAnchorCond, IntervalInfo, StackOptInfo,
|
|
CondStartId, !AllPaths),
|
|
MaybeSearchAnchorEnd = yes(anchor_branch_end(branch_ite, EndGoalId)),
|
|
CondEndMap = IntervalInfo ^ ii_cond_end_map,
|
|
map.lookup(CondEndMap, EndGoalId, ThenStartId),
|
|
one_after_another(RelevantVars, MaybeSearchAnchorEnd,
|
|
IntervalInfo, StackOptInfo, [ThenStartId, ElseStartId], !AllPaths),
|
|
map.lookup(IntervalInfo ^ ii_branch_end_map, EndGoalId,
|
|
BranchEndInfo),
|
|
ContinueId = BranchEndInfo ^ interval_after_branch,
|
|
apply_interval_find_all_branches(RelevantVars, MaybeSearchAnchor0,
|
|
IntervalInfo, StackOptInfo, ContinueId, !AllPaths)
|
|
else if
|
|
End = anchor_branch_start(BranchType, EndGoalId)
|
|
then
|
|
MaybeSearchAnchor1 = yes(anchor_branch_end(BranchType, EndGoalId)),
|
|
list.map(apply_interval_find_all_branches_map(RelevantVars,
|
|
MaybeSearchAnchor1, IntervalInfo, StackOptInfo, !.AllPaths),
|
|
SuccessorIds, AllPathsList),
|
|
consolidate_after_join(AllPathsList, !:AllPaths),
|
|
map.lookup(IntervalInfo ^ ii_branch_end_map, EndGoalId,
|
|
BranchEndInfo),
|
|
ContinueId = BranchEndInfo ^ interval_after_branch,
|
|
apply_interval_find_all_branches(RelevantVars, MaybeSearchAnchor0,
|
|
IntervalInfo, StackOptInfo, ContinueId, !AllPaths)
|
|
else
|
|
( if SuccessorIds = [SuccessorId] then
|
|
apply_interval_find_all_branches(RelevantVars,
|
|
MaybeSearchAnchor0, IntervalInfo,
|
|
StackOptInfo, SuccessorId, !AllPaths)
|
|
else
|
|
unexpected($pred, "more successor ids")
|
|
)
|
|
).
|
|
|
|
:- pred one_after_another(set_of_progvar::in, maybe(anchor)::in,
|
|
interval_info::in, stack_opt_info::in, list(interval_id)::in,
|
|
all_paths::in, all_paths::out) is det.
|
|
|
|
one_after_another(_, _, _, _, [], !AllPaths).
|
|
one_after_another(RelevantVars, MaybeSearchAnchor1, IntervalInfo, StackOptInfo,
|
|
[SuccessorId | MoreSuccessorIds], !AllPaths) :-
|
|
apply_interval_find_all_branches(RelevantVars, MaybeSearchAnchor1,
|
|
IntervalInfo, StackOptInfo, SuccessorId, !AllPaths),
|
|
one_after_another(RelevantVars, MaybeSearchAnchor1, IntervalInfo,
|
|
StackOptInfo, MoreSuccessorIds, !AllPaths).
|
|
|
|
% We need a version of apply_interval_find_all_branches with this
|
|
% argument order for use in higher order caode.
|
|
%
|
|
:- pred apply_interval_find_all_branches_map(set_of_progvar::in,
|
|
maybe(anchor)::in, interval_info::in, stack_opt_info::in,
|
|
all_paths::in, interval_id::in, all_paths::out) is det.
|
|
|
|
apply_interval_find_all_branches_map(RelevantVars, MaybeSearchAnchor0,
|
|
IntervalInfo, StackOptInfo, !.AllPaths, IntervalId, !:AllPaths) :-
|
|
apply_interval_find_all_branches(RelevantVars, MaybeSearchAnchor0,
|
|
IntervalInfo, StackOptInfo, IntervalId, !AllPaths).
|
|
|
|
:- pred apply_interval_find_all_branches(set_of_progvar::in,
|
|
maybe(anchor)::in, interval_info::in, stack_opt_info::in,
|
|
interval_id::in, all_paths::in, all_paths::out) is det.
|
|
|
|
apply_interval_find_all_branches(RelevantVars, MaybeSearchAnchor0,
|
|
IntervalInfo, StackOptInfo, IntervalId, !AllPaths) :-
|
|
map.lookup(IntervalInfo ^ ii_interval_vars, IntervalId, IntervalVars),
|
|
RelevantIntervalVars = set_of_var.intersect(RelevantVars, IntervalVars),
|
|
!.AllPaths = all_paths(Paths0, AfterModelNon0, RelevantAfter),
|
|
Paths1 = set.map(add_interval_to_path(IntervalId, RelevantIntervalVars),
|
|
Paths0),
|
|
map.lookup(IntervalInfo ^ ii_interval_start, IntervalId, Start),
|
|
( if
|
|
% Check if intervals starting at Start use any RelevantVars.
|
|
( Start = anchor_call_site(_)
|
|
; Start = anchor_branch_end(_, _)
|
|
; Start = anchor_branch_start(_, _)
|
|
),
|
|
map.search(IntervalInfo ^ ii_anchor_follow_map, Start, StartInfo),
|
|
StartInfo = anchor_follow_info(AnchorFollowVars, _),
|
|
set_of_var.intersect(RelevantVars, AnchorFollowVars, NeededVars),
|
|
set_of_var.is_non_empty(NeededVars)
|
|
then
|
|
Paths2 = set.map(add_anchor_to_path(Start), Paths1)
|
|
else
|
|
Paths2 = Paths1
|
|
),
|
|
( if set.member(Start, IntervalInfo ^ ii_model_non_anchors) then
|
|
AfterModelNon = yes
|
|
else
|
|
AfterModelNon = AfterModelNon0
|
|
),
|
|
!:AllPaths = all_paths(Paths2, AfterModelNon, RelevantAfter),
|
|
find_all_branches(RelevantVars, IntervalId,
|
|
MaybeSearchAnchor0, IntervalInfo, StackOptInfo, !AllPaths).
|
|
|
|
:- pred consolidate_after_join(list(all_paths)::in, all_paths::out) is det.
|
|
|
|
consolidate_after_join([], _) :-
|
|
unexpected($pred, "no paths to join").
|
|
consolidate_after_join([First | Rest], AllPaths) :-
|
|
PathsList = list.map(project_paths_from_all_paths, [First | Rest]),
|
|
Paths0 = set.union_list(PathsList),
|
|
Paths = compress_paths(Paths0),
|
|
AfterModelNonList = list.map(project_after_model_non_from_all_paths,
|
|
[First | Rest]),
|
|
bool.or_list(AfterModelNonList, AfterModelNon),
|
|
AllPaths = all_paths(Paths, AfterModelNon, set_of_var.init).
|
|
|
|
:- func project_paths_from_all_paths(all_paths) = set(path).
|
|
|
|
project_paths_from_all_paths(all_paths(Paths, _, _)) = Paths.
|
|
|
|
:- func project_after_model_non_from_all_paths(all_paths) = bool.
|
|
|
|
project_after_model_non_from_all_paths(all_paths(_, AfterModelNon, _)) =
|
|
AfterModelNon.
|
|
|
|
:- func compress_paths(set(path)) = set(path).
|
|
|
|
compress_paths(Paths) = Paths.
|
|
% XXX should reduce the cardinality of Paths below a threshold.
|
|
% XXX should try to preserve the current segment.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% This predicate can help debug the correctness of the transformation.
|
|
|
|
:- pred maybe_write_progress_message(string::in, int::in, int::in,
|
|
proc_info::in, module_info::in, io::di, io::uo) is det.
|
|
|
|
maybe_write_progress_message(Message, DebugStackOpt, PredIdInt, ProcInfo,
|
|
ModuleInfo, !IO) :-
|
|
( if DebugStackOpt = PredIdInt then
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
proc_info_get_varset(ProcInfo, VarSet),
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
io.output_stream(Stream, !IO),
|
|
io.write_string(Stream, Message, !IO),
|
|
io.write_string(Stream, ":\n", !IO),
|
|
OutInfo = init_hlds_out_info(Globals, output_debug),
|
|
write_goal(OutInfo, Stream, ModuleInfo, VarSet, print_name_and_num,
|
|
0, "\n", Goal, !IO),
|
|
io.write_string(Stream, "\n", !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% This predicate (along with dump_interval_info) can help debug the
|
|
% performance of the transformation.
|
|
%
|
|
:- pred dump_stack_opt_info(stack_opt_info::in, io::di, io::uo) is det.
|
|
|
|
dump_stack_opt_info(StackOptInfo, !IO) :-
|
|
map.to_assoc_list(StackOptInfo ^ soi_left_anchor_inserts, Inserts),
|
|
io.write_string("\nANCHOR INSERT:\n", !IO),
|
|
list.foldl(dump_anchor_inserts, Inserts, !IO),
|
|
|
|
io.write_string("\nMATCHING RESULTS:\n", !IO),
|
|
list.foldl(dump_matching_result, StackOptInfo ^ soi_matching_results, !IO),
|
|
io.write_string("\n", !IO).
|
|
|
|
:- pred dump_anchor_inserts(pair(anchor, list(insert_spec))::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_anchor_inserts(Anchor - InsertSpecs, !IO) :-
|
|
io.write_string("\ninsertions after ", !IO),
|
|
io.write(Anchor, !IO),
|
|
io.write_string(":\n", !IO),
|
|
list.foldl(dump_insert, InsertSpecs, !IO).
|
|
|
|
:- pred dump_insert(insert_spec::in, io::di, io::uo) is det.
|
|
|
|
dump_insert(insert_spec(Goal, Vars), !IO) :-
|
|
list.map(term.var_to_int, set_of_var.to_sorted_list(Vars), VarNums),
|
|
io.write_string("vars [", !IO),
|
|
write_int_list(VarNums, !IO),
|
|
io.write_string("]: ", !IO),
|
|
( if
|
|
Goal = hlds_goal(unify(_, _, _, Unification, _), _),
|
|
Unification = deconstruct(CellVar, ConsId, ArgVars, _,_,_)
|
|
then
|
|
term.var_to_int(CellVar, CellVarNum),
|
|
io.write_int(CellVarNum, !IO),
|
|
io.write_string(" => ", !IO),
|
|
io.write_string(cons_id_and_arity_to_string(ConsId), !IO),
|
|
io.write_string("(", !IO),
|
|
list.map(term.var_to_int, ArgVars, ArgVarNums),
|
|
write_int_list(ArgVarNums, !IO),
|
|
io.write_string(")\n", !IO)
|
|
else
|
|
io.write_string("BAD INSERT GOAL\n", !IO)
|
|
).
|
|
|
|
:- pred dump_matching_result(matching_result::in,
|
|
io::di, io::uo) is det.
|
|
|
|
dump_matching_result(MatchingResult, !IO) :-
|
|
MatchingResult = matching_result(CellVar, ConsId, ArgVars, ViaCellVars,
|
|
GoalId, PotentialIntervals, InsertIntervals,
|
|
PotentialAnchors, InsertAnchors),
|
|
io.write_string("\nmatching result at ", !IO),
|
|
io.write(GoalId, !IO),
|
|
io.write_string("\n", !IO),
|
|
term.var_to_int(CellVar, CellVarNum),
|
|
list.map(term.var_to_int, ArgVars, ArgVarNums),
|
|
list.map(term.var_to_int, set_of_var.to_sorted_list(ViaCellVars),
|
|
ViaCellVarNums),
|
|
io.write_int(CellVarNum, !IO),
|
|
io.write_string(" => ", !IO),
|
|
io.write_string(cons_id_and_arity_to_string(ConsId), !IO),
|
|
io.write_string("(", !IO),
|
|
write_int_list(ArgVarNums, !IO),
|
|
io.write_string("): via cell ", !IO),
|
|
write_int_list(ViaCellVarNums, !IO),
|
|
io.write_string("\n", !IO),
|
|
|
|
io.write_string("potential intervals: ", !IO),
|
|
PotentialIntervalNums = list.map(interval_id_to_int,
|
|
set.to_sorted_list(PotentialIntervals)),
|
|
write_int_list(PotentialIntervalNums, !IO),
|
|
io.write_string("\n", !IO),
|
|
io.write_string("insert intervals: ", !IO),
|
|
InsertIntervalNums = list.map(interval_id_to_int,
|
|
set.to_sorted_list(InsertIntervals)),
|
|
write_int_list(InsertIntervalNums, !IO),
|
|
io.write_string("\n", !IO),
|
|
|
|
io.write_string("potential anchors: ", !IO),
|
|
io.write_list(set.to_sorted_list(PotentialAnchors), " ", io.write, !IO),
|
|
io.write_string("\n", !IO),
|
|
io.write_string("insert anchors: ", !IO),
|
|
io.write_list(set.to_sorted_list(InsertAnchors), " ", io.write, !IO),
|
|
io.write_string("\n", !IO).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module ll_backend.stack_opt.
|
|
%-----------------------------------------------------------------------------%
|