[m-rev.] for review: tupling transformation (part 3)
Julien Fischer
juliensf at cs.mu.OZ.AU
Wed Mar 2 17:54:00 AEDT 2005
%-----------------------------------------------------------------------------%
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.15
diff -u -r1.15 transform_hlds.m
--- compiler/transform_hlds.m 15 Feb 2005 05:22:20 -0000 1.15
+++ compiler/transform_hlds.m 2 Mar 2005 00:15:48 -0000
@@ -63,6 +63,7 @@
:- include_module const_prop.
:- include_module loop_inv.
:- include_module size_prof.
+:- include_module tupling.
:- include_module untupling.
:- include_module mmc_analysis.
Index: compiler/tupling.m
===================================================================
RCS file: compiler/tupling.m
diff -N compiler/tupling.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/tupling.m 2 Mar 2005 00:15:49 -0000
@@ -0,0 +1,1990 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005 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: tupling.m.
+%
+% Author: wangp.
+%
+% This module takes the HLDS and performs a tupling transformation on the
+% locally-defined procedures. That is, instead of passing all of the
+% procedure's arguments separately, it will try to bundle some of them up and
+% pass them together as a tuple.
+%
+% The idea is that some arguments passed to a procedure may not be needed
+% immediately: between the start of the procedure and the first use of a
+% given argument there may be a flush point, such as a call to another
+% procedure. At these points all values residing in registers that will be
+% needed later in the procedure will need to be flushed to the stack, to be
+% restored later. In some cases, it may be beneficial to refer to some
+% arguments indirectly through a cell variable. Flushing the (address of
+% the) cell variable to the stack is enough to save all the field variables
+% of the cell. The downside is that accessing a field variable requires
+% going through a cell variable (the cost of which may be amortised if
+% multiple field variables are needed in the same interval).
+%
+% Another potentially good reason to pass arguments in a tuple is if many
+% procedures will be passing the same arguments to each other, e.g. as is
+% often the case in mutually-recursive procedures.
+%
+% This implementation works as follows:
+%
+% 1. The module is divided up into its constituent SCCs. We work our way
+% through each SCC, starting from the bottommost SCC in the call graph.
+%
+% 2. For each SCC, we take guesses at a good tupling scheme for the
+% procedures in the SCC and count the average number of loads and stores
+% between the registers and the stack for each given scheme.
+%
+% 3. If the best tupling scheme gives us an average number of loads/stores
+% that compares favourably against the original (untupled) scheme, we go
+% ahead and make the transformed versions of the procedures in the SCC and
+% add them to the HLDS.
+%
+% 4. After all the SCCs have been processed, we update all calls to the
+% original procedures to call their transformed versions instead.
+%
+% Step 2 in more detail:
+%
+% This implementation uses the names of input formal parameters to guess
+% which values are common between the procedures in an SCC (for SCCs with
+% more than one procedure). i.e. if a variable name occurs as an input
+% argument to more than one procedure in the SCC, those variables
+% corresponding that name are candidates for tupling. In the interests of
+% speeding up compilation times, the implementation only tries to tuple
+% contiguous runs of the candidate variables.
+% e.g. if the candidates are [A,B,C,D] these combinations would be tested in
+% turn, assuming a minimum run length of 3: {A,B,C,D}, {A,B,C}, {B,C,D}
+%
+% To count the average number of loads and stores in a procedure we traverse
+% the procedure's goal, remembering which values are available in registers
+% and the stack. When we reach a branch point, we use the relative
+% frequencies that each branch was taken in a sample run to weight the costs
+% incurred in each branch. The relative frequency data is gathered from the
+% trace count summary file that must be provided by the user.
+%
+% Ideas for further work:
+%
+% - Smarter / more aggressive choosing of arguments to tuple
+% - Inter-SCC analysis
+% - Inter-module optimisation
+% - Proper weighting of calls to procedures from within and without the SCC
+%
+% This transformation is similar in spirit to the transformation in
+% stack_opt.m. It also shares much code with it.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds__tupling.
+
+:- interface.
+
+:- import_module hlds__hlds_module.
+
+:- import_module io.
+
+:- pred tuple_arguments(module_info::in, module_info::out, io::di, io::uo)
+ is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module backend_libs.
+:- import_module backend_libs__interval.
+:- import_module check_hlds__goal_path.
+:- import_module check_hlds__mode_util.
+:- import_module check_hlds__type_util.
+:- import_module hlds__arg_info.
+:- import_module hlds__code_model.
+:- import_module hlds__goal_util.
+:- import_module hlds__hlds_goal.
+:- import_module hlds__hlds_llds.
+:- import_module hlds__hlds_out.
+:- import_module hlds__hlds_pred.
+:- import_module hlds__instmap.
+:- import_module hlds__quantification.
+:- import_module libs__globals.
+:- import_module libs__options.
+:- import_module ll_backend.
+:- import_module ll_backend__call_gen.
+:- import_module ll_backend__live_vars.
+:- import_module ll_backend__liveness.
+:- import_module mdbcomp__prim_data.
+:- use_module mdbcomp__program_representation.
+:- import_module mdbcomp__trace_counts.
+:- import_module parse_tree__error_util.
+:- import_module parse_tree__prog_data.
+:- import_module parse_tree__prog_mode.
+:- import_module parse_tree__prog_type.
+:- import_module parse_tree__prog_util.
+:- import_module transform_hlds__dependency_graph.
+
+:- import_module assoc_list, bool, counter, float, int, list, map, multi_map.
+:- import_module relation, require, set, std_util, string, svmap, svset.
+:- import_module svvarset, term, varset.
+
+%-----------------------------------------------------------------------------%
+%
+% Top-level
+%
+
+tuple_arguments(!ModuleInfo, !IO) :-
+ module_info_globals(!.ModuleInfo, Globals),
+ globals__lookup_string_option(Globals,
+ tuple_trace_counts_file, TraceCountsFile),
+ ( TraceCountsFile = "" ->
+ report_warning("Warning: --tuple requires " ++
+ "--tuple-trace-counts-file to work.\n", !IO)
+ ;
+ read_trace_counts(TraceCountsFile, Result, !IO),
+ (
+ Result = ok(TraceCounts),
+ tuple_arguments_2(!ModuleInfo, TraceCounts, !IO)
+ ;
+ Result = error_message(Message),
+ warn_trace_counts_error(TraceCountsFile, Message, !IO)
+ ;
+ Result = io_error(IOError),
+ warn_trace_counts_error(TraceCountsFile,
+ io__error_message(IOError), !IO)
+ )
+ ).
+
+:- pred tuple_arguments_2(module_info::in, module_info::out, trace_counts::in,
+ io::di, io::uo) is det.
+
+tuple_arguments_2(!ModuleInfo, TraceCounts0, !IO) :-
+ module_info_globals(!.ModuleInfo, Globals),
+ % We use the same cost options as for the stack optimisation.
+ globals__lookup_int_option(Globals,
+ optimize_saved_vars_cell_cv_load_cost, CellVarLoadCost),
+ globals__lookup_int_option(Globals,
+ optimize_saved_vars_cell_cv_store_cost, CellVarStoreCost),
+ globals__lookup_int_option(Globals,
+ optimize_saved_vars_cell_fv_load_cost, FieldVarLoadCost),
+ globals__lookup_int_option(Globals,
+ optimize_saved_vars_cell_fv_store_cost, FieldVarStoreCost),
+ globals__lookup_int_option(Globals,
+ tuple_costs_ratio, CostsRatio),
+ globals__lookup_int_option(Globals,
+ tuple_min_args, MinArgsToTuple),
+ % These are the costs for untupled variables. We just assume it is
+ % the lesser of the cell and field variable costs (usually the field
+ % variable costs should be smaller).
+ NormalVarStoreCost = min(CellVarStoreCost, FieldVarStoreCost),
+ NormalVarLoadCost = min(CellVarLoadCost, FieldVarLoadCost),
+ TuningParams = tuning_params(
+ NormalVarLoadCost, NormalVarStoreCost,
+ CellVarLoadCost, CellVarStoreCost,
+ FieldVarLoadCost, FieldVarStoreCost,
+ CostsRatio, MinArgsToTuple),
+
+ module_info_name(!.ModuleInfo, ModuleName),
+ restrict_trace_counts_to_module(ModuleName, TraceCounts0, TraceCounts),
+
+ module_info_ensure_dependency_info(!ModuleInfo),
+ module_info_dependency_info(!.ModuleInfo, DepInfo),
+ hlds_dependency_info_get_dependency_graph(DepInfo, DepGraph),
+ hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
+
+ % Add transformed versions of procedures that we think would be
+ % beneficial.
+ list__foldl4(maybe_tuple_scc(TraceCounts, TuningParams, DepGraph),
+ SCCs, !ModuleInfo, counter__init(0), _,
+ map__init, TransformMap, !IO),
+
+ % Update the callers of the original procedures to call their
+ % transformed versions instead. Do the same for the transformed
+ % procedures themselves.
+ list__foldl(fix_calls_in_procs(TransformMap), SCCs, !ModuleInfo),
+ fix_calls_in_transformed_procs(TransformMap, !ModuleInfo).
+
+:- pred warn_trace_counts_error(string::in, string::in, io::di, io::uo) is det.
+
+warn_trace_counts_error(TraceCountsFile, Reason, !IO) :-
+ string__format(
+ "Warning: unable to read trace count summary from %s (%s)\n",
+ [s(TraceCountsFile), s(Reason)], Message),
+ report_warning(Message, !IO).
+
+%-----------------------------------------------------------------------------%
+
+ % This predicate can be used in place of maybe_tuple_scc to evaluate
+ % and transform each procedure of an SCC individually. This is to
+ % mimic the behaviour from an earlier version of this file.
+ %
+:- pred maybe_tuple_scc_individual_procs(trace_counts::in, tuning_params::in,
+ dependency_graph::in, list(pred_proc_id)::in,
+ module_info::in, module_info::out, counter::in, counter::out,
+ transform_map::in, transform_map::out, io::di, io::uo) is det.
+
+maybe_tuple_scc_individual_procs(_TraceCounts, _TuningParams, _DepGraph,
+ [], !ModuleInfo, !Counter, !TransformMap, !IO).
+maybe_tuple_scc_individual_procs(TraceCounts, TuningParams, DepGraph,
+ [Proc | Procs], !ModuleInfo, !Counter, !TransformMap, !IO) :-
+ maybe_tuple_scc(TraceCounts, TuningParams, DepGraph,
+ [Proc], !ModuleInfo, !Counter, !TransformMap, !IO),
+ maybe_tuple_scc_individual_procs(TraceCounts, TuningParams, DepGraph,
+ Procs, !ModuleInfo, !Counter, !TransformMap, !IO).
+
+:- pred maybe_tuple_scc(trace_counts::in, tuning_params::in,
+ dependency_graph::in, list(pred_proc_id)::in(bound([ground | ground])),
+ module_info::in, module_info::out, counter::in, counter::out,
+ transform_map::in, transform_map::out, io::di, io::uo) is det.
+
+maybe_tuple_scc(TraceCounts, TuningParams, DepGraph, SCC,
+ !ModuleInfo, !Counter, !TransformMap, !IO) :-
+ module_info_globals(!.ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, very_verbose, VeryVerbose),
+ (
+ VeryVerbose = yes,
+ io.write_string("% Considering tupling in ", !IO),
+ list__foldl((pred(PredProcId::in, IO0::di, IO::uo) is det :-
+ PredProcId = proc(PredId, ProcId),
+ hlds_out__write_pred_proc_id(!.ModuleInfo,
+ PredId, ProcId, IO0, IO)),
+ SCC, !IO),
+ io.write_string("\n", !IO)
+ ;
+ VeryVerbose = no
+ ),
+ ( scc_has_local_callers(SCC, DepGraph) ->
+ ( SCC = [SingleProc] ->
+ candidate_headvars_of_proc(!.ModuleInfo, SingleProc,
+ CandidateHeadVars)
+ ;
+ common_candidate_headvars_of_procs(!.ModuleInfo, SCC,
+ CandidateHeadVars)
+ ),
+ MinArgsToTuple = TuningParams ^ min_args_to_tuple,
+ ( list__length(CandidateHeadVars) < MinArgsToTuple ->
+ (
+ VeryVerbose = yes,
+ io__write_string(
+ "% Too few candidate headvars\n", !IO)
+ ;
+ VeryVerbose = no
+ )
+ ;
+ maybe_tuple_scc_2(TraceCounts, TuningParams,
+ SCC, CandidateHeadVars, !ModuleInfo,
+ !Counter, !TransformMap, !IO, VeryVerbose)
+ )
+ ;
+ % No need to work on this SCC if there are no callers to it
+ % within this module.
+ (
+ VeryVerbose = yes,
+ io__write_string("% SCC has no local callers\n", !IO)
+ ;
+ VeryVerbose = no
+ )
+ ).
+
+:- pred scc_has_local_callers(list(pred_proc_id)::in, dependency_graph::in)
+ is semidet.
+
+scc_has_local_callers(CalleeProcs, DepGraph) :-
+ some [CalleeProc] (
+ CalleeProc `member` CalleeProcs,
+ proc_has_local_callers(CalleeProc, DepGraph)
+ ).
+
+:- pred proc_has_local_callers(pred_proc_id::in, dependency_graph::in)
+ is semidet.
+
+proc_has_local_callers(CalleeProc, DepGraph) :-
+ relation__lookup_element(DepGraph, CalleeProc, CalleeKey),
+ relation__lookup_to(DepGraph, CalleeKey, CallingKeys),
+ not set__empty(CallingKeys).
+
+%-----------------------------------------------------------------------------%
+
+:- pred maybe_tuple_scc_2(trace_counts::in, tuning_params::in,
+ list(pred_proc_id)::in, candidate_headvars::in,
+ module_info::in, module_info::out, counter::in, counter::out,
+ transform_map::in, transform_map::out, io::di, io::uo, bool::in)
+ is det.
+
+maybe_tuple_scc_2(TraceCounts, TuningParams, PredProcIds, CandidateHeadVars,
+ !ModuleInfo, !Counter, !TransformMap, !IO, VeryVerbose) :-
+ list__foldl2(prepare_proc_for_counting, PredProcIds, !ModuleInfo, !IO),
+ % Count the average number of loads/stores without any transformation.
+ count_load_stores_for_scc(TraceCounts, TuningParams, !.ModuleInfo,
+ map__init, PredProcIds, CostsWithoutTupling),
+ (
+ VeryVerbose = yes,
+ CostsWithoutTupling = costs(LoadsWoTupling, StoresWoTupling),
+ io.format("%% SCC costs without tupling = {%g, %g}\n",
+ [f(LoadsWoTupling), f(StoresWoTupling)], !IO)
+ ;
+ VeryVerbose = no
+ ),
+ ( CostsWithoutTupling = costs(0.0, 0.0) ->
+ % Don't bother continuing.
+ true
+ ;
+ maybe_tuple_scc_3(TraceCounts, TuningParams, PredProcIds,
+ CandidateHeadVars, CostsWithoutTupling,
+ !ModuleInfo, !Counter, !TransformMap, !IO,
+ VeryVerbose)
+ ).
+
+:- pred maybe_tuple_scc_3(trace_counts::in, tuning_params::in,
+ list(pred_proc_id)::in, candidate_headvars::in, costs::in,
+ module_info::in, module_info::out, counter::in, counter::out,
+ transform_map::in, transform_map::out, io::di, io::uo, bool::in)
+ is det.
+
+maybe_tuple_scc_3(TraceCounts, TuningParams, PredProcIds, CandidateHeadVars,
+ CostsWithoutTupling,
+ !ModuleInfo, !Counter, !TransformMap, !IO, VeryVerbose) :-
+ find_best_tupling_scheme(TraceCounts, TuningParams, !.ModuleInfo,
+ PredProcIds, CandidateHeadVars, MaybeBestScheme),
+ (
+ MaybeBestScheme = no
+ ;
+ MaybeBestScheme = yes(CostsWithTupling-TuplingScheme),
+ CostsWithTupling = costs(LoadsWithTupling, StoresWithTupling),
+ (
+ VeryVerbose = yes,
+ io.format("%% SCC costs with tupling = {%g, %g}\n",
+ [f(LoadsWithTupling), f(StoresWithTupling)],
+ !IO)
+ ;
+ VeryVerbose = no
+ ),
+ (
+ should_use_tupling_scheme(TuningParams,
+ CostsWithoutTupling, CostsWithTupling)
+ ->
+ (
+ VeryVerbose = yes,
+ io.print("% Proceeding with tupling\n", !IO)
+ ;
+ VeryVerbose = no
+ ),
+ add_transformed_procs(TuplingScheme,
+ !ModuleInfo, !Counter, !TransformMap)
+ ;
+ true
+ )
+ ).
+
+:- pred should_use_tupling_scheme(tuning_params::in, costs::in, costs::in)
+ is semidet.
+
+should_use_tupling_scheme(TuningParams,
+ costs(LoadsWithoutTupling, StoresWithoutTupling),
+ costs(LoadsWithTupling, StoresWithTupling)) :-
+ CostsRatio = float(TuningParams ^ costs_ratio),
+ TotalWithoutTupling = LoadsWithoutTupling + StoresWithoutTupling,
+ TotalWithTupling = LoadsWithTupling + StoresWithTupling,
+ ( TotalWithTupling = 0.0 ->
+ TotalWithoutTupling > 0.0
+ ;
+ (TotalWithoutTupling * 100.0 / TotalWithTupling) >= CostsRatio
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % The "candidate headvars" of a procedure are the input arguments of
+ % a procedure that we are considering to pass to the procedure as a
+ % tuple.
+ %
+ % The "common" candidate headvars of an SCC (of more than one
+ % procedure) are the input arguments that, when passed as a tuple, we
+ % hope can be reused in calls to other procedures in the same SCC.
+ % The heuristic used to find candidates is to look for input arguments
+ % which have the same name in more than one procedure in the SCC.
+ %
+ % For each candidate, the name is put in an association list along
+ % with a mappping to the actual variable within each procedure (if
+ % that procedure has an input variable of the given name). The order
+ % of the elements in the association list is important later on,
+ % since we only try tupling contiguous runs of the candidate
+ % variables.
+ %
+
+:- type candidate_headvars == assoc_list(string, candidate_headvar_origins).
+
+:- type candidate_headvar_origins == map(pred_proc_id, prog_var).
+
+:- pred candidate_headvars_of_proc(module_info::in, pred_proc_id::in,
+ candidate_headvars::out) is det.
+
+candidate_headvars_of_proc(ModuleInfo, PredProcId @ proc(PredId, ProcId),
+ CandidateHeadVars) :-
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+ proc_info_varset(ProcInfo, VarSet),
+ proc_info_vartypes(ProcInfo, VarTypes),
+ proc_info_headvars(ProcInfo, HeadVars),
+ proc_info_argmodes(ProcInfo, ArgModes),
+ CandidateHeadVars = list__filter_map_corresponding(
+ candidate_headvars_of_proc_2(PredProcId, VarSet, VarTypes,
+ ModuleInfo),
+ HeadVars, ArgModes).
+
+:- func candidate_headvars_of_proc_2(pred_proc_id, prog_varset, vartypes,
+ module_info, prog_var, (mode))
+ = pair(string, candidate_headvar_origins) is semidet.
+
+candidate_headvars_of_proc_2(PredProcId, VarSet, VarTypes, ModuleInfo,
+ HeadVar, ArgMode) = (Name - Origins) :-
+ % We only tuple input arguments.
+ mode_is_input(ModuleInfo, ArgMode),
+ % Don't touch introduced typeinfo arguments.
+ map__lookup(VarTypes, HeadVar, Type),
+ not is_introduced_type_info_type(Type),
+ varset__search_name(VarSet, HeadVar, Name),
+ map__det_insert(map__init, PredProcId, HeadVar, Origins).
+
+:- pred common_candidate_headvars_of_procs(module_info::in,
+ list(pred_proc_id)::in, candidate_headvars::out) is det.
+
+common_candidate_headvars_of_procs(ModuleInfo, PredProcIds,
+ CandidateHeadVars) :-
+ list__map(candidate_headvars_of_proc(ModuleInfo),
+ PredProcIds, ListsOfCandidates),
+ list__condense(ListsOfCandidates, FlatListOfCandidates),
+ multi_map__from_flat_assoc_list(FlatListOfCandidates,
+ CandidatesMultiMap),
+ map__foldl(common_candidate_headvars_of_procs_2,
+ CandidatesMultiMap,
+ [], CandidateHeadVars).
+
+:- pred common_candidate_headvars_of_procs_2(
+ string::in, list(candidate_headvar_origins)::in,
+ candidate_headvars::in, candidate_headvars::out) is det.
+
+common_candidate_headvars_of_procs_2(HeadVarName, ListOfOrigins,
+ CandidateHeadVars0, CandidateHeadVars) :-
+ % Only include this variable in the list of candidates if
+ % there are two or more procedures in the SCC with head
+ % variables having the same name.
+ ( ListOfOrigins = [_, _ | _] ->
+ list__foldl(map__merge, ListOfOrigins, map__init, Origins),
+ CandidateHeadVars = CandidateHeadVars0 ++
+ [HeadVarName - Origins]
+ ;
+ CandidateHeadVars = CandidateHeadVars0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % This is a mapping from the id of a procedure to the proposed
+ % tupling that would be performed on the procedure's input arguments.
+ %
+:- type tupling_scheme == map(pred_proc_id, tupling_proposal).
+
+:- type tupling_proposal
+ ---> no_tupling
+ ; tupling(
+ cell_var :: prog_var,
+ field_vars :: prog_vars,
+ field_var_arg_pos :: assoc_list(prog_var, int)
+ ).
+
+:- pred find_best_tupling_scheme(trace_counts::in, tuning_params::in,
+ module_info::in, list(pred_proc_id)::in, candidate_headvars::in,
+ maybe(pair(costs, tupling_scheme))::out) is det.
+
+find_best_tupling_scheme(TraceCounts, TuningParams, ModuleInfo,
+ PredProcIds, CandidateHeadVars, MaybeBestScheme) :-
+ MinArgsToTuple = TuningParams ^ min_args_to_tuple,
+ fold_over_list_runs(find_best_tupling_scheme_2(TraceCounts,
+ TuningParams, ModuleInfo, PredProcIds),
+ CandidateHeadVars, MinArgsToTuple,
+ no, MaybeBestScheme).
+
+:- pred find_best_tupling_scheme_2(trace_counts::in, tuning_params::in,
+ module_info::in, list(pred_proc_id)::in, candidate_headvars::in,
+ maybe(pair(costs, tupling_scheme))::in,
+ maybe(pair(costs, tupling_scheme))::out) is det.
+
+find_best_tupling_scheme_2(TraceCounts, TuningParams, ModuleInfo,
+ PredProcIds, CandidateHeadVars,
+ MaybeBestScheme0, MaybeBestScheme) :-
+ MinArgsToTuple = TuningParams ^ min_args_to_tuple,
+ list__map(make_tupling_proposal(ModuleInfo, CandidateHeadVars,
+ MinArgsToTuple),
+ PredProcIds, TuplingProposals),
+ map__from_corresponding_lists(PredProcIds, TuplingProposals,
+ TuplingScheme),
+ count_load_stores_for_scc(TraceCounts, TuningParams,
+ ModuleInfo, TuplingScheme, PredProcIds, Costs),
+ (
+ (
+ MaybeBestScheme0 = no
+ ;
+ MaybeBestScheme0 = yes(PrevCosts - _),
+ less_total_cost(Costs, PrevCosts)
+ )
+ ->
+ MaybeBestScheme = yes(Costs - TuplingScheme)
+ ;
+ MaybeBestScheme = MaybeBestScheme0
+ ).
+
+:- pred make_tupling_proposal(module_info::in, candidate_headvars::in,
+ int::in, pred_proc_id::in, tupling_proposal::out) is det.
+
+make_tupling_proposal(ModuleInfo, CandidateHeadVars, MinArgsToTuple,
+ PredProcId @ proc(PredId, ProcId), TuplingProposal) :-
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+ proc_info_varset(ProcInfo, VarSet),
+ proc_info_headvars(ProcInfo, HeadVars),
+ FieldVarArgPos = list__filter_map(
+ (func(_ - Annotation) = (Var - Pos) is semidet :-
+ map__search(Annotation, PredProcId, Var),
+ list__nth_member_search(HeadVars, Var, Pos)),
+ CandidateHeadVars),
+ ( list__length(FieldVarArgPos) < MinArgsToTuple ->
+ TuplingProposal = no_tupling
+ ;
+ % We need a new variable to act as the cell variable while
+ % counting loads/stores for a proposed tupling, but we don't
+ % add that variable to the varset permanently.
+ varset__new_named_var(VarSet, "DummyCellVar", DummyCellVar, _),
+ FieldVars = assoc_list__keys(FieldVarArgPos),
+ TuplingProposal = tupling(DummyCellVar, FieldVars,
+ FieldVarArgPos)
+ ).
+
+:- pred less_total_cost(costs::in, costs::in) is semidet.
+
+less_total_cost(costs(LoadsA, StoresA), costs(LoadsB, StoresB)) :-
+ TotalA = LoadsA + StoresA,
+ TotalB = LoadsB + StoresB,
+ TotalA < TotalB.
+
+%-----------------------------------------------------------------------------%
+
+ % fold_over_list_runs(Pred, List, MinRunLength, !Acc)
+ % Call Pred for each consecutive run of elements in List of a length
+ % greater or equal to MinRunLength, threading an accumulator through
+ % it.
+ %
+:- pred fold_over_list_runs(pred(list(L), A, A), list(L), int, A, A).
+:- mode fold_over_list_runs(pred(in, in, out) is det, in, in, in, out) is det.
+
+fold_over_list_runs(_, [], _, !Acc).
+fold_over_list_runs(Pred, List @ [_ | Tail], MinLength, !Acc) :-
+ fold_over_list_runs_2(Pred, List, MinLength, !Acc),
+ fold_over_list_runs(Pred, Tail, MinLength, !Acc).
+
+:- pred fold_over_list_runs_2(pred(list(L), A, A), list(L), int, A, A).
+:- mode fold_over_list_runs_2(pred(in, in, out) is det, in, in, in, out) is det.
+
+fold_over_list_runs_2(Pred, List, Length, !Acc) :-
+ ( list__take(Length, List, Front) ->
+ Pred(Front, !Acc),
+ fold_over_list_runs_2(Pred, List, Length+1, !Acc)
+ ;
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Transforming procedures.
+%
+
+:- pred add_transformed_procs(tupling_scheme::in, module_info::in,
+ module_info::out, counter::in, counter::out, transform_map::in,
+ transform_map::out) is det.
+
+add_transformed_procs(TuplingScheme, !ModuleInfo, !Counter, !TransformMap) :-
+ map__foldl3(add_transformed_proc, TuplingScheme,
+ !ModuleInfo, !Counter, !TransformMap).
+
+:- pred add_transformed_proc(pred_proc_id::in, tupling_proposal::in,
+ module_info::in, module_info::out, counter::in, counter::out,
+ transform_map::in, transform_map::out) is det.
+
+add_transformed_proc(PredProcId, tupling(_, FieldVars, _),
+ !ModuleInfo, !Counter, !TransformMap) :-
+ PredProcId = proc(PredId, ProcId),
+ some [!ProcInfo] (
+ module_info_pred_proc_info(!.ModuleInfo,
+ PredId, ProcId, PredInfo, !:ProcInfo),
+
+ % Build up information about intervals and which
+ % variables are needed in each interval.
+ build_interval_info(!.ModuleInfo, !.ProcInfo, IntervalInfo),
+
+ % Create the cell variable.
+ list__length(FieldVars, TupleArity),
+ proc_info_vartypes(!.ProcInfo, VarTypes),
+ list__map(map__lookup(VarTypes), FieldVars, TupleArgTypes),
+ construct_type(unqualified("{}") - TupleArity, TupleArgTypes,
+ TupleConsType),
+ proc_info_create_var_from_type(TupleConsType,
+ yes("TuplingCellVar"), CellVar, !ProcInfo),
+
+ % Get the argument positions of the parameters to be tupled.
+ proc_info_headvars(!.ProcInfo, HeadVars),
+ list__map(nth_member_lookup(HeadVars), FieldVars, ArgsToTuple),
+
+ % Build an insertion map of where the deconstruction
+ % unifications are needed.
+ build_insert_map(CellVar, FieldVars, IntervalInfo, InsertMap),
+
+ % Make a transformed version of the procedure and add it to
+ % the module.
+ make_transformed_proc(CellVar, FieldVars, InsertMap,
+ !ProcInfo),
+ recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ counter__allocate(Num, !Counter),
+ create_aux_pred(PredId, ProcId, PredInfo, !.ProcInfo, Num,
+ AuxPredProcId, CallAux, !ModuleInfo),
+
+ % Add an entry to the transform map for the new procedure.
+ TransformedProc = transformed_proc(AuxPredProcId,
+ TupleConsType, ArgsToTuple, CallAux),
+ svmap__det_insert(PredProcId, TransformedProc, !TransformMap)
+ ).
+
+add_transformed_proc(_, no_tupling, !ModuleInfo, !TransformMap, !Counter).
+
+:- pred nth_member_lookup(list(T)::in, T::in, int::out) is det.
+
+nth_member_lookup(List, Elem, Position) :-
+ ( list__nth_member_search(List, Elem, PositionPrime) ->
+ Position = PositionPrime
+ ;
+ error("nth_member_lookup/3: element not found in list")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred make_transformed_proc(prog_var::in, prog_vars::in, insert_map::in,
+ proc_info::in, proc_info::out) is det.
+
+make_transformed_proc(CellVar, FieldVarsList, InsertMap, !ProcInfo) :-
+ % Modify the procedure's formal parameters.
+ proc_info_headvars(!.ProcInfo, HeadVars0),
+ proc_info_argmodes(!.ProcInfo, ArgModes0),
+ HeadVarsAndModes = list__filter_map_corresponding(
+ (func(Var, Mode) = (Var - Mode) is semidet :-
+ not Var `member` FieldVarsList),
+ HeadVars0, ArgModes0),
+ assoc_list__keys_and_values(HeadVarsAndModes, HeadVars, ArgModes),
+ proc_info_set_headvars(HeadVars ++ [CellVar], !ProcInfo),
+ proc_info_set_argmodes(ArgModes ++ [in_mode], !ProcInfo),
+
+ % Insert the necessary deconstruction unifications.
+ proc_info_goal(!.ProcInfo, Goal0),
+ proc_info_vartypes(!.ProcInfo, VarTypes0),
+ proc_info_varset(!.ProcInfo, VarSet0),
+ % XXX: I haven't checked if adding this feature has any effect.
+ MaybeGoalFeature = yes(tuple_opt),
+ record_decisions_in_goal(Goal0, Goal1, VarSet0, VarSet1,
+ VarTypes0, VarTypes1, map__init, RenameMapA, InsertMap,
+ MaybeGoalFeature),
+
+ % In some cases some of the fields variables need to be available at
+ % the very beginning of the procedure. The required deconstructions
+ % for those variables won't show up in the insert map. To handle this
+ % we just to insert a deconstruction unification at the start of the
+ % procedure and let a simplification pass remove it later if not
+ % required.
+ %
+ % We could make build_insert_map add such required unifications
+ % to the insert map, but record_decisions_in_goal would need to be
+ % modified as well.
+ %
+ deconstruct_tuple(CellVar, FieldVarsList, ProcStartDeconstruct),
+ ProcStartInsert = insert_spec(ProcStartDeconstruct,
+ set__from_list(FieldVarsList)),
+ insert_proc_start_deconstruction(Goal1, Goal2,
+ VarSet1, VarSet, VarTypes1, VarTypes,
+ RenameMapB, ProcStartInsert),
+ rename_vars_in_goal(Goal2, RenameMapB, Goal3),
+
+ map__merge(RenameMapA, RenameMapB, RenameMap),
+ apply_headvar_correction(set__from_list(HeadVars), RenameMap,
+ Goal3, Goal),
+ proc_info_set_goal(Goal, !ProcInfo),
+ proc_info_set_varset(VarSet, !ProcInfo),
+ proc_info_set_vartypes(VarTypes, !ProcInfo),
+ requantify_proc(!ProcInfo).
+
+:- pred insert_proc_start_deconstruction(hlds_goal::in, hlds_goal::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ rename_map::out, insert_spec::in) is det.
+
+insert_proc_start_deconstruction(Goal0, Goal,
+ !VarSet, !VarTypes, VarRename, Insert) :-
+ % The tuple_opt feature is not used for this goal as we do
+ % want other transformations to remove it if possible.
+ make_inserted_goal(!VarSet, !VarTypes, map__init, VarRename,
+ Insert, no, InsertGoal),
+ Goal0 = _ - GoalInfo,
+ conj_list_to_goal([InsertGoal, Goal0], GoalInfo, Goal).
+
+%-----------------------------------------------------------------------------%
+
+ % This predicate makes a new version of the given procedure in a
+ % module. Amongst other things the new procedure is given a new
+ % pred_id and proc_id, a new name and a new goal.
+ %
+ % CallAux is an output variable, which is unified with a goal that
+ % can be used as a template for constructing calls to the newly
+ % created procedure.
+ %
+ % See also create_aux_pred in loop_inv.m.
+ %
+:- pred create_aux_pred(pred_id::in, proc_id::in, pred_info::in,
+ proc_info::in, int::in, pred_proc_id::out, hlds_goal::out,
+ module_info::in, module_info::out) is det.
+
+create_aux_pred(PredId, ProcId, PredInfo, ProcInfo, Counter,
+ AuxPredProcId, CallAux, ModuleInfo0, ModuleInfo) :-
+ module_info_name(ModuleInfo0, ModuleName),
+
+ proc_info_headvars(ProcInfo, AuxHeadVars),
+ proc_info_goal(ProcInfo, Goal @ (_GoalExpr - GoalInfo)),
+ proc_info_get_initial_instmap(ProcInfo, ModuleInfo0,
+ InitialAuxInstMap),
+ pred_info_typevarset(PredInfo, TVarSet),
+ proc_info_vartypes(ProcInfo, VarTypes),
+ pred_info_get_class_context(PredInfo, ClassContext),
+ proc_info_typeinfo_varmap(ProcInfo, TVarMap),
+ proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
+ proc_info_varset(ProcInfo, VarSet),
+ proc_info_inst_varset(ProcInfo, InstVarSet),
+ pred_info_get_markers(PredInfo, Markers),
+ pred_info_get_aditi_owner(PredInfo, Owner),
+ pred_info_get_origin(PredInfo, OrigOrigin),
+
+ PredName = pred_info_name(PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ goal_info_get_context(GoalInfo, Context),
+ term__context_line(Context, Line),
+ proc_id_to_int(ProcId, ProcNo),
+ AuxNamePrefix = string__format("tupling_%d", [i(ProcNo)]),
+ make_pred_name_with_context(ModuleName, AuxNamePrefix,
+ PredOrFunc, PredName, Line, Counter, AuxPredSymName),
+ (
+ AuxPredSymName = unqualified(AuxPredName)
+ ;
+ AuxPredSymName = qualified(_ModuleSpecifier, AuxPredName)
+ ),
+
+ Origin = transformed(tuple(ProcNo), OrigOrigin, PredId),
+ hlds_pred__define_new_pred(
+ Origin, % in
+ Goal, % in
+ CallAux, % out
+ AuxHeadVars, % in
+ _ExtraArgs, % out
+ InitialAuxInstMap, % in
+ AuxPredName, % in
+ TVarSet, % in
+ VarTypes, % in
+ ClassContext, % in
+ TVarMap, % in
+ TCVarMap, % in
+ VarSet, % in
+ InstVarSet, % in
+ Markers, % in
+ Owner, % in
+ address_is_not_taken, % in
+ ModuleInfo0,
+ ModuleInfo,
+ AuxPredProcId
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Counting loads and stores between the stack and registers.
+%
+
+:- type count_info
+ ---> count_info(
+ count_info_pred_proc_id :: pred_proc_id,
+ % Which procedure is being counted.
+ count_info_proc :: proc_info,
+ count_info_module :: module_info,
+ count_info_proc_counts :: proc_trace_counts,
+ count_info_params :: tuning_params,
+ tupling_scheme :: tupling_scheme
+ ).
+
+:- type tuning_params
+ ---> tuning_params(
+ normal_var_load_cost :: int,
+ normal_var_store_cost :: int,
+ cell_var_load_cost :: int,
+ cell_var_store_cost :: int,
+ field_var_load_cost :: int,
+ field_var_store_cost :: int,
+ costs_ratio :: int,
+ min_args_to_tuple :: int
+ ).
+
+:- type count_state
+ ---> count_state(
+ reg_vars :: set(prog_var),
+ stack_vars :: set(prog_var),
+ load_costs :: float,
+ store_costs :: float
+ ).
+
+:- type costs
+ ---> costs(
+ avg_loads :: float,
+ avg_stores :: float
+ ).
+
+:- func get_tupling_proposal(count_info, pred_proc_id) = tupling_proposal
+ is det.
+
+get_tupling_proposal(CountInfo, PredProcId) = TuplingProposal :-
+ ( map__search(CountInfo ^ tupling_scheme, PredProcId, Probe) ->
+ TuplingProposal = Probe
+ ;
+ TuplingProposal = no_tupling
+ ).
+
+:- func get_own_tupling_proposal(count_info) = tupling_proposal is det.
+
+get_own_tupling_proposal(CountInfo) =
+ get_tupling_proposal(CountInfo, CountInfo ^ count_info_pred_proc_id).
+
+%-----------------------------------------------------------------------------%
+
+ % Collect all the information for a procedure that is required for
+ % the count_load_stores_in_proc predicate to work.
+ %
+:- pred prepare_proc_for_counting(pred_proc_id::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+prepare_proc_for_counting(PredProcId, !ModuleInfo, !IO) :-
+ PredProcId = proc(PredId, ProcId),
+ some [!ProcInfo] (
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+ PredInfo, !:ProcInfo),
+ pred_info_arg_types(PredInfo, ArgTypes),
+ generate_proc_arg_info(ArgTypes, !.ModuleInfo, !ProcInfo),
+
+ detect_liveness_proc(PredId, ProcId, !.ModuleInfo, !ProcInfo,
+ !IO),
+ initial_liveness(!.ProcInfo, PredId, !.ModuleInfo, Liveness0),
+ module_info_globals(!.ModuleInfo, Globals),
+ body_should_use_typeinfo_liveness(PredInfo, Globals,
+ TypeInfoLiveness),
+ globals__lookup_bool_option(Globals,
+ opt_no_return_calls, OptNoReturnCalls),
+ AllocData = alloc_data(!.ModuleInfo, !.ProcInfo,
+ TypeInfoLiveness, OptNoReturnCalls),
+ goal_path__fill_slots(!.ModuleInfo, !ProcInfo),
+ proc_info_goal(!.ProcInfo, Goal0),
+ OptStackAlloc0 = opt_stack_alloc,
+ set__init(FailVars),
+ set__init(NondetLiveness0),
+ build_live_sets_in_goal(Goal0, Goal, FailVars,
+ AllocData, OptStackAlloc0, _OptStackAlloc,
+ Liveness0, _Liveness,
+ NondetLiveness0, _NondetLiveness),
+ proc_info_set_goal(Goal, !ProcInfo),
+
+ module_info_set_pred_proc_info(PredId, ProcId,
+ PredInfo, !.ProcInfo, !ModuleInfo)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+% The opt_stack_alloc structure is constructed by live_vars.m. As far as I can
+% tell we don't need such a thing for this module so we just define some stubs.
+
+:- type opt_stack_alloc ---> opt_stack_alloc.
+
+:- 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 opt_at_call_site(need_across_call::in, hlds_goal_info::in,
+ opt_stack_alloc::in, opt_stack_alloc::out) is det.
+
+opt_at_call_site(_NeedAtCall, _GoalInfo, StackAlloc, StackAlloc).
+
+:- pred opt_at_resume_site(need_in_resume::in, hlds_goal_info::in,
+ opt_stack_alloc::in, opt_stack_alloc::out) is det.
+
+opt_at_resume_site(_NeedAtResume, _GoalInfo, StackAlloc, StackAlloc).
+
+:- pred opt_at_par_conj(need_in_par_conj::in, hlds_goal_info::in,
+ opt_stack_alloc::in, opt_stack_alloc::out) is det.
+
+opt_at_par_conj(_NeedParConj, _GoalInfo, StackAlloc, StackAlloc).
+
+%-----------------------------------------------------------------------------%
+
+:- pred count_load_stores_for_scc(trace_counts::in, tuning_params::in,
+ module_info::in, tupling_scheme::in, list(pred_proc_id)::in,
+ costs::out) is det.
+
+count_load_stores_for_scc(TraceCounts, TuningParams, ModuleInfo,
+ TuplingScheme, PredProcIds, costs(Loads, Stores)) :-
+ list__foldl2(count_load_stores_for_scc_2(TraceCounts,
+ TuningParams, ModuleInfo, TuplingScheme),
+ PredProcIds,
+ 0.0, Loads, 0.0, Stores).
+
+:- pred count_load_stores_for_scc_2(trace_counts::in, tuning_params::in,
+ module_info::in, tupling_scheme::in, pred_proc_id::in,
+ float::in, float::out, float::in, float::out) is det.
+
+count_load_stores_for_scc_2(TraceCounts, TuningParams, ModuleInfo,
+ TuplingScheme, PredProcId, !Loads, !Stores) :-
+ PredProcId = proc(PredId, ProcId),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ PredInfo, ProcInfo),
+ % XXX: Different declaring vs defining modules not handled.
+ ProcLabel = proc(pred_info_module(PredInfo),
+ pred_info_is_pred_or_func(PredInfo),
+ pred_info_module(PredInfo),
+ pred_info_name(PredInfo),
+ pred_info_orig_arity(PredInfo),
+ proc_id_to_int(ProcId)),
+ ( get_proc_counts(TraceCounts, ProcLabel, yes(ProcCounts)) ->
+ count_load_stores_in_proc(count_info(PredProcId, ProcInfo,
+ ModuleInfo, ProcCounts, TuningParams, TuplingScheme),
+ ProcLoads, ProcStores),
+ % XXX: There is a problem somewhere causing CALL and EXIT
+ % events not to show up for some procedures in trace count
+ % files. The weighting of the procedure's costs is disabled.
+ % However, if working, it still wouldn't be ideal as we don't
+ % know how many of the calls to the procedure came from within
+ % or without the SCC.
+ /*get_proc_calls(ProcCounts, Weight),*/
+ Weight = 1,
+ !:Loads = !.Loads + float(Weight) * ProcLoads,
+ !:Stores = !.Stores + float(Weight) * ProcStores
+ ;
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred count_load_stores_in_proc(count_info::in, float::out, float::out)
+ is det.
+
+count_load_stores_in_proc(CountInfo, Loads, Stores) :-
+ proc(PredId, _) = CountInfo ^ count_info_pred_proc_id,
+ ProcInfo = CountInfo ^ count_info_proc,
+ ModuleInfo = CountInfo ^ count_info_module,
+ initial_liveness(ProcInfo, PredId, ModuleInfo, InitialLiveness),
+ CountState0 = count_state(InitialLiveness, set__init, 0.0, 0.0),
+ proc_info_goal(ProcInfo, Goal),
+ count_load_stores_in_goal(Goal, CountInfo, CountState0, CountState1),
+ arg_info__partition_proc_args(ProcInfo, ModuleInfo, _, OutputArgs, _),
+ cls_require_in_regs(CountInfo, set__to_sorted_list(OutputArgs),
+ CountState1, CountState),
+ CountState = count_state(_, _, Loads, Stores).
+
+%-----------------------------------------------------------------------------%
+
+ % This code is based on interval__build_interval_info_in_goal.
+
+:- pred count_load_stores_in_goal(hlds_goal::in, count_info::in,
+ count_state::in, count_state::out) is det.
+
+count_load_stores_in_goal(Goal - GoalInfo, CountInfo, !CountState) :-
+ Goal = foreign_proc(_Attributes, PredId, ProcId, Args, ExtraArgs,
+ _PragmaCode),
+ ModuleInfo = CountInfo ^ count_info_module,
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ _PredInfo, ProcInfo),
+ ArgVars = list__map(foreign_arg_var, Args),
+ ExtraVars = list__map(foreign_arg_var, ExtraArgs),
+ CallingProcInfo = CountInfo ^ count_info_proc,
+ proc_info_vartypes(CallingProcInfo, VarTypes),
+ arg_info__partition_proc_call_args(ProcInfo, VarTypes,
+ ModuleInfo, ArgVars, InputArgVarSet, OutputArgVarSet, _),
+ set__to_sorted_list(InputArgVarSet, InputArgVars),
+ list__append(InputArgVars, ExtraVars, InputVars),
+ (
+ goal_info_maybe_get_maybe_need_across_call(GoalInfo,
+ MaybeNeedAcrossCall),
+ MaybeNeedAcrossCall = yes(_)
+ ->
+ count_load_stores_for_call(CountInfo, InputVars,
+ OutputArgVarSet, MaybeNeedAcrossCall, GoalInfo,
+ !CountState)
+ ;
+ cls_require_in_regs(CountInfo, InputVars, !CountState),
+ cls_clobber_regs(OutputArgVarSet, !CountState)
+ ).
+
+count_load_stores_in_goal(Goal - GoalInfo, CountInfo, !CountState) :-
+ Goal = generic_call(GenericCall, ArgVars, ArgModes, Detism),
+ ProcInfo = CountInfo ^ count_info_proc,
+ ModuleInfo = CountInfo ^ count_info_module,
+ goal_info_get_maybe_need_across_call(GoalInfo, MaybeNeedAcrossCall),
+ proc_info_vartypes(ProcInfo, VarTypes),
+ list__map(map__lookup(VarTypes), ArgVars, ArgTypes),
+ arg_info__compute_in_and_out_vars(ModuleInfo, ArgVars,
+ ArgModes, ArgTypes, InputArgs, OutputArgs),
+ determinism_to_code_model(Detism, CodeModel),
+
+ % unsafe_casts are generated inline.
+ ( GenericCall = unsafe_cast ->
+ cls_require_in_regs(CountInfo, InputArgs, !CountState),
+ cls_put_in_regs(OutputArgs, !CountState)
+ ;
+ call_gen__generic_call_info(CodeModel, GenericCall, _,
+ GenericVarsArgInfos, _),
+ assoc_list__keys(GenericVarsArgInfos, GenericVars),
+ list__append(GenericVars, InputArgs, Inputs),
+ set__list_to_set(OutputArgs, Outputs),
+ count_load_stores_for_call(CountInfo, Inputs, Outputs,
+ MaybeNeedAcrossCall, GoalInfo, !CountState)
+ ).
+
+count_load_stores_in_goal(Goal - GoalInfo, CountInfo, !CountState) :-
+ Goal = call(PredId, ProcId, _, Builtin, _, _),
+ (
+ Builtin = not_builtin,
+ TuplingProposal = get_tupling_proposal(CountInfo,
+ proc(PredId, ProcId)),
+ TuplingProposal = tupling(_, _, _)
+ ->
+ count_load_stores_in_call_to_tupled(Goal - GoalInfo,
+ CountInfo, TuplingProposal, !CountState)
+ ;
+ count_load_stores_in_call_to_not_tupled(Goal - GoalInfo,
+ CountInfo, !CountState)
+ ).
+
+count_load_stores_in_goal(Goal - _GoalInfo, CountInfo, !CountState) :-
+ Goal = unify(_, _, _, Unification, _),
+ (
+ Unification = construct(CellVar, _ConsId, ArgVars, _ArgModes,
+ _HowToConstruct, _, _),
+ cls_require_in_regs(CountInfo, ArgVars, !CountState),
+ cls_put_in_regs([CellVar], !CountState)
+ ;
+ Unification = deconstruct(CellVar, _ConsId, ArgVars,
+ _ArgModes, _, _),
+ cls_put_in_regs_via_deconstruct(CountInfo, CellVar, ArgVars,
+ !CountState)
+ ;
+ Unification = assign(ToVar, FromVar),
+ cls_require_in_reg(CountInfo, FromVar, !CountState),
+ cls_put_in_regs([ToVar], !CountState)
+ ;
+ Unification = simple_test(Var1, Var2),
+ cls_require_in_regs(CountInfo, [Var1, Var2], !CountState)
+ ;
+ Unification = complicated_unify(_, _, _),
+ error("count_load_stores_in_goal: complicated_unify")
+ ).
+
+count_load_stores_in_goal(some(_Vars, _CanRemove, Goal) - _GoalInfo, CountInfo,
+ !CountState) :-
+ count_load_stores_in_goal(Goal, CountInfo, !CountState).
+
+count_load_stores_in_goal(conj(Goals) - _GoalInfo, CountInfo, !CountState) :-
+ count_load_stores_in_conj(Goals, CountInfo, !CountState).
+
+count_load_stores_in_goal(par_conj(_) - _, _, !_) :-
+ sorry(this_file, "tupling with parallel conjunctions").
+
+count_load_stores_in_goal(disj(Goals) - _GoalInfo, CountInfo, !CountState) :-
+ count_load_stores_in_disj(Goals, CountInfo, !CountState).
+
+count_load_stores_in_goal(switch(_Var, _Det, Cases) - _GoalInfo, CountInfo,
+ !CountState) :-
+ count_load_stores_in_cases(Cases, CountInfo, !CountState).
+
+count_load_stores_in_goal(not(Goal) - _GoalInfo, CountInfo, !CountState) :-
+ goal_info_get_resume_point(snd(Goal), ResumePoint),
+ (
+ ResumePoint = resume_point(LiveVars, _ResumeLocs),
+ cls_require_flushed(CountInfo, LiveVars, !CountState)
+ ;
+ ResumePoint = no_resume_point,
+ error("count_load_stores_in_goal: no_resume_point for not")
+ ),
+ count_load_stores_in_goal(Goal, CountInfo, !CountState).
+
+count_load_stores_in_goal(if_then_else(_, Cond, Then, Else) - _GoalInfo,
+ CountInfo, !CountState) :-
+ goal_info_get_resume_point(snd(Cond), ResumePoint),
+ (
+ ResumePoint = resume_point(LiveVars, _ResumeLocs),
+ cls_require_flushed(CountInfo, LiveVars, !CountState),
+ count_load_stores_in_goal(Cond, CountInfo, !CountState),
+
+ reset_count_state_counts(!.CountState, ResetCountInfo),
+ count_load_stores_in_goal(Then, CountInfo,
+ ResetCountInfo, ThenCountInfo),
+ count_load_stores_in_goal(Else, CountInfo,
+ ResetCountInfo, ElseCountInfo),
+
+ ProcCounts = CountInfo ^ count_info_proc_counts,
+ goal_info_get_goal_path(snd(Then), ThenGoalPath),
+ goal_info_get_goal_path(snd(Else), ElseGoalPath),
+ get_ite_relative_frequencies(ProcCounts,
+ ThenGoalPath, ElseGoalPath,
+ ThenRelFreq, ElseRelFreq),
+
+ add_branch_costs(ThenCountInfo, ThenRelFreq, !CountState),
+ add_branch_costs(ElseCountInfo, ElseRelFreq, !CountState)
+ ;
+ ResumePoint = no_resume_point,
+ unexpected(this_file,
+ "count_load_stores_in_goal: " ++
+ "no_resume_point for if_then_else")
+ ).
+
+count_load_stores_in_goal(shorthand(_) - _, _, !_) :-
+ unexpected(this_file,
+ "count_load_stores_in_goal: unexpected shorthand").
+
+%-----------------------------------------------------------------------------%
+
+:- inst call_goal_expr
+ == bound(call(ground, ground, ground, ground, ground, ground)).
+:- mode in_call_goal
+ == in(pair(call_goal_expr, ground)).
+
+:- pred count_load_stores_in_call_to_tupled(hlds_goal::in_call_goal,
+ count_info::in,
+ tupling_proposal::in(bound(tupling(ground, ground, ground))),
+ count_state::in, count_state::out) is det.
+
+count_load_stores_in_call_to_tupled(Goal - GoalInfo, CountInfo,
+ CalleeTuplingProposal, !CountState) :-
+ Goal = call(CalleePredId, CalleeProcId, ArgVars, _, _, _),
+ CalleeTuplingProposal = tupling(CellVar, FieldVars, FieldVarArgPos),
+ ModuleInfo = CountInfo ^ count_info_module,
+ module_info_pred_proc_info(ModuleInfo, CalleePredId, CalleeProcId,
+ _, CalleeProcInfo),
+ CallingProcInfo = CountInfo ^ count_info_proc,
+ proc_info_vartypes(CallingProcInfo, VarTypes),
+ arg_info__partition_proc_call_args(CalleeProcInfo, VarTypes,
+ ModuleInfo, ArgVars, InputArgs0, Outputs, _),
+ (
+ % If the caller is a tupled procedure, and every field
+ % variable of the tuple appears as an input argument to the
+ % callee AND every such argument is in a position matching
+ % the field variable's position in the tupling proposal, then
+ % the cell var of the caller can be reused as the call var
+ % for the callee.
+ %
+ % TODO: If we kept track of the aliases of field variables,
+ % then they could be checked also.
+ get_own_tupling_proposal(CountInfo) = tupling(_, _, _),
+ all [Var] Var `member` FieldVars => (
+ Var `member` InputArgs0,
+ assoc_list__search(FieldVarArgPos, Var, Pos),
+ list__nth_member_search(ArgVars, Var, Pos)
+ )
+ ->
+ % In this case, the cell var is not being used to
+ % access field variables, so it should not incur
+ % the cell var cost.
+ cls_require_normal_var_in_reg(CountInfo, CellVar,
+ !CountState),
+ set__delete_list(InputArgs0, FieldVars, InputArgs)
+ ;
+ % The cell var cannot be used for the callee, so we
+ % must add the cost of constructing a new tuple.
+ TuplingParams = CountInfo ^ count_info_params,
+ CellVarStoreCost = float(TuplingParams ^ cell_var_store_cost),
+ !:CountState = (!.CountState ^ store_costs :=
+ (!.CountState ^ store_costs + CellVarStoreCost)),
+ InputArgs = InputArgs0
+ ),
+ set__to_sorted_list(InputArgs, Inputs),
+ goal_info_get_maybe_need_across_call(GoalInfo, MaybeNeedAcrossCall),
+ count_load_stores_for_call(CountInfo, Inputs, Outputs,
+ MaybeNeedAcrossCall, GoalInfo, !CountState).
+
+:- pred count_load_stores_in_call_to_not_tupled(hlds_goal::in_call_goal,
+ count_info::in, count_state::in, count_state::out) is det.
+
+count_load_stores_in_call_to_not_tupled(Goal - GoalInfo, CountInfo,
+ !CountState) :-
+ Goal = call(PredId, ProcId, ArgVars, Builtin, _, _),
+ ModuleInfo = CountInfo ^ count_info_module,
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ _PredInfo, CalleeProcInfo),
+ ProcInfo = CountInfo ^ count_info_proc,
+ proc_info_vartypes(ProcInfo, VarTypes),
+ arg_info__partition_proc_call_args(CalleeProcInfo, VarTypes,
+ ModuleInfo, ArgVars, InputArgs, Outputs, _),
+ set__to_sorted_list(InputArgs, Inputs),
+ ( Builtin = inline_builtin ->
+ cls_require_in_regs(CountInfo, Inputs, !CountState),
+ cls_put_in_regs(set__to_sorted_list(Outputs), !CountState)
+ ;
+ goal_info_get_maybe_need_across_call(GoalInfo,
+ MaybeNeedAcrossCall),
+ count_load_stores_for_call(CountInfo, Inputs, Outputs,
+ MaybeNeedAcrossCall, GoalInfo, !CountState)
+ ).
+
+:- pred count_load_stores_for_call(count_info::in, prog_vars::in,
+ set(prog_var)::in, maybe(need_across_call)::in,
+ hlds_goal_info::in, count_state::in, count_state::out) is det.
+
+count_load_stores_for_call(CountInfo, Inputs, Outputs, MaybeNeedAcrossCall,
+ _GoalInfo, !CountState) :-
+ cls_require_in_regs(CountInfo, Inputs, !CountState),
+ (
+ MaybeNeedAcrossCall = yes(NeedAcrossCall),
+ NeedAcrossCall = need_across_call(ForwardVars,
+ ResumeVars, NondetLiveVars),
+ AllVars = set__union_list([ForwardVars, ResumeVars,
+ NondetLiveVars]),
+ cls_require_flushed(CountInfo, AllVars, !CountState),
+ cls_clobber_regs(Outputs, !CountState)
+ ;
+ MaybeNeedAcrossCall = no,
+ error("handle_call: no need across call")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred count_load_stores_in_conj(hlds_goals::in, count_info::in,
+ count_state::in, count_state::out) is det.
+
+count_load_stores_in_conj([], _CountInfo, !CountState).
+count_load_stores_in_conj([Goal | Goals], CountInfo, !CountState) :-
+ count_load_stores_in_goal(Goal, CountInfo, !CountState),
+ count_load_stores_in_conj(Goals, CountInfo, !CountState).
+
+:- pred count_load_stores_in_disj(hlds_goals::in, count_info::in,
+ count_state::in, count_state::out) is det.
+
+count_load_stores_in_disj([], _CountInfo, !CountState).
+count_load_stores_in_disj([Goal | Goals], CountInfo, !CountState) :-
+ GoalInfo = snd(Goal),
+ goal_info_get_resume_point(GoalInfo, ResumePoint),
+ (
+ ResumePoint = resume_point(LiveVars, _ResumeLocs),
+ cls_require_flushed(CountInfo, LiveVars, !CountState)
+ ;
+ ResumePoint = no_resume_point
+ ),
+ reset_count_state_counts(!.CountState, BranchCountState0),
+ count_load_stores_in_goal(Goal, CountInfo,
+ BranchCountState0, BranchCountState),
+ ProcCounts = CountInfo ^ count_info_proc_counts,
+ goal_info_get_goal_path(GoalInfo, GoalPath),
+ get_disjunct_relative_frequency(ProcCounts, GoalPath, RelFreq),
+ add_branch_costs(BranchCountState, RelFreq, !CountState),
+ count_load_stores_in_disj(Goals, CountInfo, !CountState).
+
+:- pred count_load_stores_in_cases(list(case)::in, count_info::in,
+ count_state::in, count_state::out) is det.
+
+count_load_stores_in_cases([], _CountInfo, !CountState).
+count_load_stores_in_cases([Case | Cases], CountInfo, !CountState) :-
+ Case = case(_ConsId, Goal),
+ GoalInfo = snd(Goal),
+ goal_info_get_resume_point(GoalInfo, ResumePoint),
+ (
+ ResumePoint = resume_point(LiveVars, _ResumeLocs),
+ cls_require_flushed(CountInfo, LiveVars, !CountState)
+ ;
+ ResumePoint = no_resume_point
+ ),
+ reset_count_state_counts(!.CountState, BranchCountState0),
+ count_load_stores_in_goal(Goal, CountInfo, BranchCountState0,
+ BranchCountState),
+ ProcCounts = CountInfo ^ count_info_proc_counts,
+ goal_info_get_goal_path(GoalInfo, GoalPath),
+ get_case_relative_frequency(ProcCounts, GoalPath, RelFreq),
+ add_branch_costs(BranchCountState, RelFreq, !CountState),
+ count_load_stores_in_cases(Cases, CountInfo, !CountState).
+
+%-----------------------------------------------------------------------------%
+
+ % Make the values of the given variables available in registers.
+ %
+:- pred cls_require_in_regs(count_info::in, prog_vars::in, count_state::in,
+ count_state::out) is det.
+
+cls_require_in_regs(CountInfo, Vars, !CountState) :-
+ list__foldl(cls_require_in_reg(CountInfo), Vars, !CountState).
+
+:- pred cls_require_in_reg(count_info::in, prog_var::in, count_state::in,
+ count_state::out) is det.
+
+cls_require_in_reg(CountInfo, Var, !CountState) :-
+ (
+ TuplingProposal = get_own_tupling_proposal(CountInfo),
+ TuplingProposal = tupling(_, FieldVars, _),
+ Var `member` FieldVars
+ ->
+ cls_require_field_var_in_reg(CountInfo, TuplingProposal,
+ Var, !CountState)
+ ;
+ cls_require_normal_var_in_reg(CountInfo, Var, !CountState)
+ ).
+
+:- pred cls_require_normal_var_in_reg(count_info::in, prog_var::in,
+ count_state::in, count_state::out) is det.
+
+cls_require_normal_var_in_reg(CountInfo, Var, !CountState) :-
+ TuningParams = CountInfo ^ count_info_params,
+ NormalLoadCost = TuningParams ^ normal_var_load_cost,
+ cls_require_var_in_reg_with_cost(NormalLoadCost, Var, !CountState).
+
+:- pred cls_require_field_var_in_reg(count_info::in,
+ tupling_proposal::in(bound(tupling(ground, ground, ground))),
+ prog_var::in, count_state::in, count_state::out) is det.
+
+cls_require_field_var_in_reg(CountInfo, TuplingProposal, FieldVar,
+ CountState0, CountState) :-
+ CountState0 = count_state(RegVars0, StackVars, Loads0, Stores),
+ ( FieldVar `member` RegVars0 ->
+ CountState = CountState0
+ ;
+ TuplingProposal = tupling(CellVar, _, _),
+ TuningParams = CountInfo ^ count_info_params,
+ CvLoadCost = float(TuningParams ^ cell_var_load_cost),
+ FvLoadCost = float(TuningParams ^ field_var_load_cost),
+ ( CellVar `member` RegVars0 ->
+ RegVars = RegVars0 `insert` FieldVar,
+ Loads = Loads0 + FvLoadCost
+ ;
+ RegVars = RegVars0 `insert_list` [CellVar, FieldVar],
+ Loads = Loads0 + CvLoadCost + FvLoadCost
+ ),
+ CountState = count_state(RegVars, StackVars, Loads, Stores)
+ ).
+
+:- pred cls_require_var_in_reg_with_cost(int::in, prog_var::in,
+ count_state::in, count_state::out) is det.
+
+cls_require_var_in_reg_with_cost(LoadCost, Var, CountState0, CountState) :-
+ CountState0 = count_state(RegVars0, StackVars, Loads0, Stores),
+ ( Var `member` RegVars0 ->
+ CountState = CountState0
+ ;
+ RegVars = RegVars0 `insert` Var,
+ Loads = Loads0 + float(LoadCost),
+ CountState = count_state(RegVars, StackVars, Loads, Stores)
+ ).
+
+ % Put the values of the given variables into registers.
+ %
+:- pred cls_put_in_regs(prog_vars::in, count_state::in, count_state::out)
+ is det.
+
+cls_put_in_regs(Vars, State0, State) :-
+ RegVars0 = (State0 ^ reg_vars),
+ State = (State0 ^ reg_vars := RegVars0 `insert_list` Vars).
+
+:- pred cls_put_in_regs_via_deconstruct(count_info::in, prog_var::in,
+ prog_vars::in, count_state::in, count_state::out) is det.
+
+cls_put_in_regs_via_deconstruct(CountInfo,
+ DeconstructCellVar, DeconstructFieldVars, !State) :-
+ TuningParams = CountInfo ^ count_info_params,
+ CvLoadCost = TuningParams ^ cell_var_load_cost,
+ FvLoadCost = TuningParams ^ field_var_load_cost,
+ TuplingProposal = get_own_tupling_proposal(CountInfo),
+ (
+ TuplingProposal = no_tupling,
+ cls_require_var_in_reg_with_cost(CvLoadCost,
+ DeconstructCellVar, !State),
+ list__foldl(cls_require_var_in_reg_with_cost(FvLoadCost),
+ DeconstructFieldVars, !State)
+ ;
+ TuplingProposal = tupling(_, TupleFieldVars, _),
+ VarsToLoad = set__difference(
+ set__from_list(DeconstructFieldVars),
+ set__from_list(TupleFieldVars)),
+ ( set__non_empty(VarsToLoad) ->
+ cls_require_var_in_reg_with_cost(CvLoadCost,
+ DeconstructCellVar, !State),
+ set__fold(cls_require_var_in_reg_with_cost(FvLoadCost),
+ VarsToLoad, !State)
+ ;
+ % All the variables generated by this deconstruction
+ % can be gotten from the proposed tupling, so it can be
+ % ignored. The costs of loading those variables from
+ % the tuple will be counted as they come.
+ true
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % Copy the given variables to the stack, if they have not been copied
+ % previously.
+ %
+:- pred cls_require_flushed(count_info::in, set(prog_var)::in,
+ count_state::in, count_state::out) is det.
+
+cls_require_flushed(CountInfo, Vars, !CountState) :-
+ TuplingProposal = get_own_tupling_proposal(CountInfo),
+ TuningParams = CountInfo ^ count_info_params,
+ set__fold(cls_require_flushed_2(TuplingProposal, TuningParams),
+ Vars, !CountState).
+
+:- pred cls_require_flushed_2(tupling_proposal::in, tuning_params::in,
+ prog_var::in, count_state::in, count_state::out) is det.
+
+cls_require_flushed_2(no_tupling, TuningParams, Var, !CountState) :-
+ StoreCost = TuningParams ^ normal_var_store_cost,
+ cls_require_flushed_with_cost(StoreCost, Var, !CountState).
+
+cls_require_flushed_2(tupling(CellVar, FieldVars, _), TuningParams, Var,
+ !CountState) :-
+ ( Var `member` FieldVars ->
+ FvStoreCost = TuningParams ^ field_var_store_cost,
+ cls_require_flushed_with_cost(FvStoreCost, CellVar,
+ !CountState)
+ ;
+ StoreCost = TuningParams ^ normal_var_store_cost,
+ cls_require_flushed_with_cost(StoreCost, Var, !CountState)
+ ).
+
+:- pred cls_require_flushed_with_cost(int::in, prog_var::in, count_state::in,
+ count_state::out) is det.
+
+cls_require_flushed_with_cost(StoreCost, Var,
+ count_state(RegVars, StackVars0, Loads, Stores0),
+ count_state(RegVars, StackVars, Loads, Stores)) :-
+ ( Var `member` StackVars0 ->
+ StackVars = StackVars0,
+ Stores = Stores0
+ ;
+ StackVars = StackVars0 `insert` Var,
+ Stores = Stores0 + float(StoreCost)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % Clear out the contents of the registers and replace them with the
+ % values of the given variables.
+ %
+:- pred cls_clobber_regs(set(prog_var)::in, count_state::in, count_state::out)
+ is det.
+
+cls_clobber_regs(NewVars, CountState0, CountState0 ^ reg_vars := NewVars).
+
+%-----------------------------------------------------------------------------%
+
+:- pred reset_count_state_counts(count_state::in, count_state::out) is det.
+
+reset_count_state_counts(CountState0, CountState) :-
+ CountState = ((CountState0
+ ^ load_costs := 0.0)
+ ^ store_costs := 0.0).
+
+:- pred add_branch_costs(count_state::in, float::in,
+ count_state::in, count_state::out) is det.
+
+add_branch_costs(BranchState, Weight, CountState0, CountState) :-
+ BranchState = count_state(_, _, BranchLoads, BranchStores),
+ CountState0 = count_state(_, _, Loads0, Stores0),
+ CountState = ((CountState0
+ ^ load_costs := Loads0 + Weight * BranchLoads)
+ ^ store_costs := Stores0 + Weight * BranchStores).
+
+%-----------------------------------------------------------------------------%
+%
+% Building information about intervals and insert maps.
+%
+
+:- pred build_interval_info(module_info::in, proc_info::in, interval_info::out)
+ is det.
+
+build_interval_info(ModuleInfo, ProcInfo, IntervalInfo) :-
+ proc_info_goal(ProcInfo, Goal),
+ proc_info_vartypes(ProcInfo, VarTypes),
+ arg_info__partition_proc_args(ProcInfo, ModuleInfo,
+ _InputArgs, OutputArgs, _UnusedArgs),
+ Counter0 = counter__init(1),
+ counter__allocate(CurInterval, Counter0, Counter),
+ CurIntervalId = interval_id(CurInterval),
+ EndMap = map__det_insert(map__init, CurIntervalId, proc_end),
+ StartMap = map__init,
+ SuccMap = map__det_insert(map__init, CurIntervalId, []),
+ VarsMap = map__det_insert(map__init, CurIntervalId, OutputArgs),
+ IntParams = interval_params(ModuleInfo, VarTypes, no),
+ IntervalInfo0 = interval_info(IntParams, set__init,
+ OutputArgs, map__init, map__init, map__init,
+ CurIntervalId, Counter,
+ set__make_singleton_set(CurIntervalId),
+ map__init, set__init, StartMap, EndMap,
+ SuccMap, VarsMap, map__init),
+ build_interval_info_in_goal(Goal, IntervalInfo0, IntervalInfo,
+ nothing, _).
+
+ % This is needed only to satisfy the interface of interval.m
+ %
+:- type nothing ---> nothing.
+
+:- instance build_interval_info_acc(nothing) where [
+ pred(use_cell/8) is tupling__use_cell
+].
+
+:- pred use_cell(prog_var::in, list(prog_var)::in, cons_id::in, hlds_goal::in,
+ interval_info::in, interval_info::out, nothing::in,
+ nothing::out) is det.
+
+use_cell(_CellVar, _FieldVarList, _ConsId, _Goal, !IntervalInfo, !Nothing).
+
+%-----------------------------------------------------------------------------%
+
+ % This predicate uses the interval information built previously to
+ % build an insertion map, i.e. a mapping from a left anchor to a
+ % deconstruction unification that is to be inserted _after_ the
+ % interval beginning with that left anchor.
+ %
+:- pred build_insert_map(prog_var::in, prog_vars::in, interval_info::in,
+ insert_map::out) is det.
+
+build_insert_map(CellVar, FieldVars, IntervalInfo, InsertMap) :-
+ FieldVarsSet = set__from_list(FieldVars),
+ map__foldl(build_insert_map_2(CellVar, FieldVars, FieldVarsSet),
+ IntervalInfo ^ anchor_follow_map,
+ map__init, InsertMap).
+
+:- pred build_insert_map_2(prog_var::in, list(prog_var)::in, set(prog_var)::in,
+ anchor::in, anchor_follow_info::in, insert_map::in, insert_map::out)
+ is det.
+
+build_insert_map_2(CellVar, FieldVars, FieldVarsSet,
+ Anchor, FollowVars - _, !InsertMap) :-
+ NeededFieldVars = FieldVarsSet `set__intersect` FollowVars,
+ ( set__empty(NeededFieldVars) ->
+ true
+ ;
+ deconstruct_tuple(CellVar, FieldVars, Goal),
+ InsertSpec = insert_spec(Goal, NeededFieldVars),
+ add_insert_spec(Anchor, InsertSpec, !InsertMap)
+ ).
+
+:- pred add_insert_spec(anchor::in, insert_spec::in, insert_map::in,
+ insert_map::out) is det.
+
+add_insert_spec(Anchor, InsertSpec, !InsertMap) :-
+ ( map__search(!.InsertMap, Anchor, InsertSpecs0) ->
+ combine_inserts(InsertSpec, InsertSpecs0, InsertSpecs),
+ svmap__det_update(Anchor, InsertSpecs, !InsertMap)
+ ;
+ svmap__det_insert(Anchor, [InsertSpec], !InsertMap)
+ ).
+
+:- pred combine_inserts(insert_spec::in, list(insert_spec)::in,
+ list(insert_spec)::out) is det.
+
+combine_inserts(A, [], [A]).
+combine_inserts(A, [B | Bs], [C | Cs]) :-
+ (
+ A = insert_spec(Goal, ASet),
+ B = insert_spec(Goal, BSet)
+ ->
+ C = insert_spec(Goal, ASet `set__union` BSet),
+ Cs = Bs
+ ;
+ C = B,
+ combine_inserts(A, Bs, Cs)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Fixing calls to transformed procedures.
+%
+
+:- type transform_map == map(pred_proc_id, transformed_proc).
+
+:- type transformed_proc --->
+ transformed_proc(
+ transformed_pred_proc_id :: pred_proc_id,
+ tuple_cons_type :: (type),
+ args_to_tuple :: list(int),
+ call_template :: hlds_goal
+ ).
+
+:- pred fix_calls_in_procs(transform_map::in, list(pred_proc_id)::in,
+ module_info::in, module_info::out) is det.
+
+fix_calls_in_procs(TransformMap, PredProcIds, !ModuleInfo) :-
+ list__foldl(fix_calls_in_proc(TransformMap),
+ PredProcIds, !ModuleInfo).
+
+:- pred fix_calls_in_transformed_procs(transform_map::in,
+ module_info::in, module_info::out) is det.
+
+fix_calls_in_transformed_procs(TransformMap, !ModuleInfo) :-
+ map__foldl(fix_calls_in_transformed_procs_2(TransformMap),
+ TransformMap, !ModuleInfo).
+
+:- pred fix_calls_in_transformed_procs_2(transform_map::in, pred_proc_id::in,
+ transformed_proc::in, module_info::in, module_info::out) is det.
+
+fix_calls_in_transformed_procs_2(TransformMap,
+ _, transformed_proc(PredProcId, _, _, _), !ModuleInfo) :-
+ fix_calls_in_proc(TransformMap, PredProcId, !ModuleInfo).
+
+:- pred fix_calls_in_proc(transform_map::in, pred_proc_id::in,
+ module_info::in, module_info::out) is det.
+
+fix_calls_in_proc(TransformMap, proc(PredId, ProcId), !ModuleInfo) :-
+ some [!ProcInfo] (
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+ PredInfo, !:ProcInfo),
+ % XXX: Don't modify predicates that were created by type
+ % specialisation. This is a last-minute workaround for some
+ % linking problems that occurred when such predicates in the
+ % library were made to call tupled procedures.
+ pred_info_get_origin(PredInfo, Origin),
+ ( Origin = transformed(type_specialization(_), _, _) ->
+ true
+ ;
+ proc_info_goal(!.ProcInfo, Goal0),
+ proc_info_vartypes(!.ProcInfo, VarTypes0),
+ proc_info_varset(!.ProcInfo, VarSet0),
+ fix_calls_in_goal(Goal0, Goal, VarSet0, VarSet,
+ VarTypes0, VarTypes, TransformMap),
+ proc_info_set_goal(Goal, !ProcInfo),
+ proc_info_set_varset(VarSet, !ProcInfo),
+ proc_info_set_vartypes(VarTypes, !ProcInfo),
+ requantify_proc(!ProcInfo),
+ recompute_instmap_delta_proc(yes, !ProcInfo,
+ !ModuleInfo),
+ module_info_set_pred_proc_info(PredId, ProcId,
+ PredInfo, !.ProcInfo, !ModuleInfo)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred fix_calls_in_goal(hlds_goal::in, hlds_goal::out, prog_varset::in,
+ prog_varset::out, vartypes::in, vartypes::out, transform_map::in)
+ is det.
+
+fix_calls_in_goal(Goal - GoalInfo, Goal - GoalInfo, !_, !_, _TransformMap) :-
+ Goal = foreign_proc(_, _, _, _, _, _).
+
+fix_calls_in_goal(Goal - GoalInfo, Goal - GoalInfo, !_, !_, _TransformMap) :-
+ Goal = generic_call(_, _, _, _).
+
+fix_calls_in_goal(Goal0 - GoalInfo0, Goal, !VarSet, !VarTypes, TransformMap) :-
+ Goal0 = call(CalledPredId0, CalledProcId0, Args0, Builtin,
+ _Context, _SymName),
+ (
+ Builtin = not_builtin,
+ map__search(TransformMap, proc(CalledPredId0, CalledProcId0),
+ transformed_proc(_,
+ TupleConsType,
+ ArgsToTuple,
+ CallAux0 - CallAuxInfo))
+ ->
+ svvarset__new_named_var("TuplingCellVarForCall", CellVar,
+ !VarSet),
+ svmap__det_insert(CellVar, TupleConsType, !VarTypes),
+ extract_tupled_args_from_list(Args0, ArgsToTuple,
+ TupledArgs, UntupledArgs),
+ construct_tuple(CellVar, TupledArgs, ConstructGoal),
+ (
+ NewArgs = UntupledArgs ++ [CellVar],
+ CallAux = CallAux0 ^ call_args := NewArgs
+ ->
+ CallGoal = CallAux - CallAuxInfo
+ ;
+ unexpected(this_file,
+ "fix_calls_in_goal: not a call template")
+ ),
+ conj_list_to_goal([ConstructGoal, CallGoal], GoalInfo0, Goal1),
+ RequantifyVars = set__from_list([CellVar | Args0]),
+ implicitly_quantify_goal(RequantifyVars, _, Goal1, Goal,
+ !VarSet, !VarTypes)
+ ;
+ Goal = Goal0 - GoalInfo0
+ ).
+
+fix_calls_in_goal(Goal - GoalInfo, Goal - GoalInfo, !_, !_, _TransformMap) :-
+ Goal = unify(_, _, _, _, _).
+
+fix_calls_in_goal(not(Goal0) - GoalInfo, not(Goal) - GoalInfo,
+ !VarSet, !VarTypes, TransformMap) :-
+ fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap).
+
+fix_calls_in_goal(some(Vars, CanRemove, Goal0) - GoalInfo,
+ some(Vars, CanRemove, Goal) - GoalInfo,
+ !VarSet, !VarTypes, TransformMap) :-
+ fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap).
+
+fix_calls_in_goal(conj(Goals0) - GoalInfo, conj(Goals) - GoalInfo,
+ !VarSet, !VarTypes, TransformMap) :-
+ fix_calls_in_conj(Goals0, Goals, !VarSet, !VarTypes, TransformMap).
+
+fix_calls_in_goal(par_conj(Goals0) - GoalInfo, par_conj(Goals) - GoalInfo,
+ !VarSet, !VarTypes, TransformMap) :-
+ % I am not sure whether parallel conjunctions should be treated
+ % with fix_calls_in_goal or fix_calls_in_goal_list. At any rate,
+ % this is untested.
+ fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
+ TransformMap).
+
+fix_calls_in_goal(disj(Goals0) - GoalInfo, disj(Goals) - GoalInfo,
+ !VarSet, !VarTypes, TransformMap) :-
+ fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
+ TransformMap).
+
+fix_calls_in_goal(switch(Var, CanFail, Cases0) - GoalInfo,
+ switch(Var, CanFail, Cases) - GoalInfo,
+ !VarSet, !VarTypes, TransformMap) :-
+ fix_calls_in_cases(Cases0, Cases, !VarSet, !VarTypes, TransformMap).
+
+fix_calls_in_goal(if_then_else(Vars, Cond0, Then0, Else0) - GoalInfo,
+ if_then_else(Vars, Cond, Then, Else) - GoalInfo,
+ !VarSet, !VarTypes, TransformMap) :-
+ fix_calls_in_goal(Cond0, Cond, !VarSet, !VarTypes, TransformMap),
+ fix_calls_in_goal(Then0, Then, !VarSet, !VarTypes, TransformMap),
+ fix_calls_in_goal(Else0, Else, !VarSet, !VarTypes, TransformMap).
+
+fix_calls_in_goal(shorthand(_) - _, _, !VarSet, !VarTypes, _TransformMap) :-
+ error("fix_calls_in_goal: unexpected shorthand").
+
+%-----------------------------------------------------------------------------%
+
+:- pred fix_calls_in_conj(hlds_goals::in, hlds_goals::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ transform_map::in) is det.
+
+fix_calls_in_conj([], [], !VarSet, !VarTypes, _).
+fix_calls_in_conj([Goal0 | Goals0], Goals, !VarSet, !VarTypes, TransformMap) :-
+ fix_calls_in_goal(Goal0, Goal1, !VarSet, !VarTypes, TransformMap),
+ fix_calls_in_conj(Goals0, Goals1, !VarSet, !VarTypes, TransformMap),
+ (if Goal1 = conj(ConjGoals) - _ then
+ Goals = ConjGoals ++ Goals1
+ else
+ Goals = [Goal1 | Goals1]
+ ).
+
+:- pred fix_calls_in_goal_list(hlds_goals::in, hlds_goals::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ transform_map::in) is det.
+
+fix_calls_in_goal_list([], [], !VarSet, !VarTypes, _TransformMap).
+fix_calls_in_goal_list([Goal0 | Goals0], [Goal | Goals], !VarSet, !VarTypes,
+ TransformMap) :-
+ fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap),
+ fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
+ TransformMap).
+
+:- pred fix_calls_in_cases(list(case)::in, list(case)::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ transform_map::in) is det.
+
+fix_calls_in_cases([], [], !VarSet, !VarTypes, _TransformMap).
+fix_calls_in_cases([Case0 | Cases0], [Case | Cases], !VarSet, !VarTypes,
+ TransformMap) :-
+ Case0 = case(Functor, Goal0),
+ fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap),
+ Case = case(Functor, Goal),
+ fix_calls_in_cases(Cases0, Cases, !VarSet, !VarTypes, TransformMap).
+
+%-----------------------------------------------------------------------------%
+
+ % extract_tupled_args_from_list(ArgList, Indices,
+ % Selected, NotSelected)
+ %
+ % Pick out the elements of ArgList by the indices given and put them
+ % in the list Selected, in exactly the order that they are referenced
+ % in Indices. The list NotSelected is to contain all the elements
+ % of ArgList which did not end up in Selected, in the order that they
+ % appeared in ArgList.
+ %
+ % Note again that the ordering of Selected and NotSelected are
+ % determined by different lists!
+ %
+:- pred extract_tupled_args_from_list(prog_vars::in, list(int)::in,
+ prog_vars::out, prog_vars::out) is det.
+
+extract_tupled_args_from_list(ArgList, Indices, Selected, NotSelected) :-
+ list__map(list__index1_det(ArgList), Indices, Selected),
+ extract_tupled_args_from_list_2(ArgList, 1, Indices, NotSelected).
+
+:- pred extract_tupled_args_from_list_2(prog_vars::in, int::in, list(int)::in,
+ prog_vars::out) is det.
+
+extract_tupled_args_from_list_2([], _Num, _Indices, []).
+extract_tupled_args_from_list_2([H | T], Num, Indices, NotSelected) :-
+ ( Num `member` Indices ->
+ extract_tupled_args_from_list_2(T, Num+1, Indices,
+ NotSelected)
+ ;
+ NotSelected = [H | NotSelected1],
+ extract_tupled_args_from_list_2(T, Num+1, Indices,
+ NotSelected1)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Trace count summaries.
+%
+
+:- type mdbcomp_goal_path_step
+ == mdbcomp__program_representation__goal_path_step.
+:- type mdbcomp_goal_path
+ == mdbcomp__program_representation__goal_path.
+
+:- pred get_proc_counts(trace_counts::in, proc_label::in,
+ maybe(proc_trace_counts)::out) is det.
+
+get_proc_counts(TraceCounts, ProcLabel, MaybeProcCounts) :-
+ ( map__search(TraceCounts, ProcLabel, ProcCounts) ->
+ MaybeProcCounts = yes(ProcCounts)
+ ;
+ MaybeProcCounts = no
+ ).
+
+:- pred get_proc_calls(proc_trace_counts::in, int::out) is det.
+
+get_proc_calls(ProcCounts, Count) :-
+ map__lookup(ProcCounts, port_only(call), Count).
+
+:- pred get_path_only_count(proc_trace_counts::in, mdbcomp_goal_path::in,
+ int::out) is det.
+
+get_path_only_count(ProcCounts, GoalPath, Count) :-
+ PathPort = path_only(GoalPath),
+ ( map__search(ProcCounts, PathPort, CountPrime) ->
+ Count = CountPrime
+ ;
+ Count = 0
+ ).
+
+:- pred get_ite_relative_frequencies(proc_trace_counts::in,
+ goal_path::in, goal_path::in, float::out, float::out) is det.
+
+get_ite_relative_frequencies(ProcCounts, ThenGoalPath, ElseGoalPath,
+ ThenRelFreq, ElseRelFreq) :-
+ goal_path_to_mdbcomp_goal_path(ThenGoalPath, MdbThenGoalPath),
+ goal_path_to_mdbcomp_goal_path(ElseGoalPath, MdbElseGoalPath),
+ get_path_only_count(ProcCounts, MdbThenGoalPath, ThenCounts),
+ get_path_only_count(ProcCounts, MdbElseGoalPath, ElseCounts),
+ Total = ThenCounts + ElseCounts,
+ ( Total > 0 ->
+ ThenRelFreq = float(ThenCounts) / float(Total),
+ ElseRelFreq = float(ElseCounts) / float(Total)
+ ;
+ ThenRelFreq = 0.5,
+ ElseRelFreq = 0.5
+ ).
+
+:- pred get_disjunct_relative_frequency(proc_trace_counts::in, goal_path::in,
+ float::out) is det.
+
+get_disjunct_relative_frequency(ProcCounts, GoalPath, RelFreq) :-
+ ( GoalPath = [disj(Num) | GoalPathRest] ->
+ goal_path_to_mdbcomp_goal_path(GoalPathRest, MdbGoalPathRest),
+ get_path_only_count(ProcCounts,
+ [mdbcomp__program_representation__disj(Num) |
+ MdbGoalPathRest], DisjCount),
+ get_path_only_count(ProcCounts,
+ [mdbcomp__program_representation__disj(1) |
+ MdbGoalPathRest], FirstDisjCount),
+ ( FirstDisjCount = 0 ->
+ RelFreq = 0.0
+ ;
+ RelFreq = float(DisjCount) / float(FirstDisjCount)
+ )
+ ;
+ unexpected(this_file,
+ "get_disjunct_relative_frequency/3 " ++
+ "did not see disj(N) at head of goal path")
+ ).
+
+:- pred get_case_relative_frequency(proc_trace_counts::in, goal_path::in,
+ float::out) is det.
+
+get_case_relative_frequency(ProcCounts, GoalPath, RelFreq) :-
+ goal_path_to_mdbcomp_goal_path(GoalPath, MdbGoalPath),
+ get_path_only_count(ProcCounts, MdbGoalPath, CaseTotal),
+ get_switch_total_count(ProcCounts, MdbGoalPath, SwitchTotal),
+ ( SwitchTotal = 0 ->
+ RelFreq = 0.0
+ ;
+ RelFreq = float(CaseTotal) / float(SwitchTotal)
+ ).
+
+:- pred get_switch_total_count(proc_trace_counts::in, mdbcomp_goal_path::in,
+ int::out) is det.
+
+get_switch_total_count(ProcCounts, MdbGoalPath, Total) :-
+ map__foldl(get_switch_total_count_2(MdbGoalPath),
+ ProcCounts, 0, Total).
+
+:- pred get_switch_total_count_2(mdbcomp_goal_path::in, path_port::in, int::in,
+ int::in, int::out) is det.
+
+get_switch_total_count_2(SwitchGoalPath, PathPort, Count,
+ TotalAcc0, TotalAcc) :-
+ ( case_in_switch(SwitchGoalPath, PathPort) ->
+ TotalAcc = TotalAcc0 + Count
+ ;
+ TotalAcc = TotalAcc0
+ ).
+
+:- pred case_in_switch(mdbcomp_goal_path::in, path_port::in) is semidet.
+
+case_in_switch([mdbcomp.program_representation.switch(_) | Prefix],
+ path_only([mdbcomp.program_representation.switch(_) | Prefix])).
+
+%-----------------------------------------------------------------------------%
+
+% XXX: This would not be necessary if there were not two definitions of
+% goal_paths. The only difference between them is that the mdbcomp version
+% has switch/1 instead of switch/2.
+
+:- pred goal_path_to_mdbcomp_goal_path(goal_path::in, mdbcomp_goal_path::out)
+ is det.
+
+goal_path_to_mdbcomp_goal_path(GoalPath, MdbGoalPath) :-
+ list__map(goal_path_step_to_mdbcomp_goal_path_step,
+ GoalPath, MdbGoalPath).
+
+:- pred goal_path_step_to_mdbcomp_goal_path_step(goal_path_step::in,
+ mdbcomp_goal_path_step::out) is det.
+
+goal_path_step_to_mdbcomp_goal_path_step(
+ conj(N), mdbcomp.program_representation.conj(N)).
+goal_path_step_to_mdbcomp_goal_path_step(
+ disj(N), mdbcomp.program_representation.disj(N)).
+goal_path_step_to_mdbcomp_goal_path_step(
+ switch(N, _), mdbcomp.program_representation.switch(N)).
+goal_path_step_to_mdbcomp_goal_path_step(
+ ite_cond, mdbcomp.program_representation.ite_cond).
+goal_path_step_to_mdbcomp_goal_path_step(
+ ite_then, mdbcomp.program_representation.ite_then).
+goal_path_step_to_mdbcomp_goal_path_step(
+ ite_else, mdbcomp.program_representation.ite_else).
+goal_path_step_to_mdbcomp_goal_path_step(
+ neg, mdbcomp.program_representation.neg).
+goal_path_step_to_mdbcomp_goal_path_step(
+ exist(cut), mdbcomp.program_representation.exist(
+ mdbcomp.program_representation.cut)).
+goal_path_step_to_mdbcomp_goal_path_step(
+ exist(no_cut), mdbcomp.program_representation.exist(
+ mdbcomp.program_representation.no_cut)).
+goal_path_step_to_mdbcomp_goal_path_step(
+ first, mdbcomp.program_representation.first).
+goal_path_step_to_mdbcomp_goal_path_step(
+ later, mdbcomp.program_representation.later).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "tupling.m".
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.2
diff -u -r1.2 untupling.m
--- compiler/untupling.m 14 Feb 2005 04:49:11 -0000 1.2
+++ compiler/untupling.m 2 Mar 2005 00:15:50 -0000
@@ -114,8 +114,8 @@
:- import_module parse_tree__prog_type.
:- import_module parse_tree__prog_util.
-:- import_module bool, counter, list, map, require, std_util, string, svmap.
-:- import_module svvarset, term, varset.
+:- import_module bool, counter, int, list, map, require, std_util, string.
+:- import_module svmap, svvarset, term, varset.
% The transform_map structure records which procedures were
% transformed into what procedures during the first pass.
@@ -319,10 +319,9 @@
Expansion),
(
Expansion = expansion(ConsId, NewTypes),
- NumVars = list__length(NewTypes),
- svvarset__new_vars(NumVars, NewHeadVars, !VarSet),
- svmap__det_insert_from_corresponding_lists(
- NewHeadVars, NewTypes, !VarTypes),
+ varset__lookup_name(!.VarSet, HeadVar0, ParentName),
+ create_untuple_vars(ParentName, 0, NewTypes, NewHeadVars,
+ !VarSet, !VarTypes),
list__duplicate(list__length(NewHeadVars), ArgMode0,
NewArgModes),
MaybeHeadVarsAndArgModes = yes(NewHeadVars - NewArgModes),
@@ -345,6 +344,19 @@
MaybeHeadVarsAndArgModes = no,
ContainerTypes = ContainerTypes0
).
+
+:- pred create_untuple_vars(string::in, int::in, list(type)::in,
+ list(prog_var)::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out) is det.
+
+create_untuple_vars(_, _, [], [], !VarSet, !VarTypes).
+create_untuple_vars(ParentName, Num, [Type | Types], [NewVar | NewVars],
+ !VarSet, !VarTypes) :-
+ string__format("Untupled_%s_%d", [s(ParentName), i(Num)], Name),
+ svvarset__new_named_var(Name, NewVar, !VarSet),
+ svmap__det_insert(NewVar, Type, !VarTypes),
+ create_untuple_vars(ParentName, Num+1, Types, NewVars,
+ !VarSet, !VarTypes).
:- pred conjoin_goals_keep_detism(hlds_goal::in, hlds_goal::in,
hlds_goal::out) is det.
Index: mdbcomp/trace_counts.m
===================================================================
RCS file: /home/mercury1/repository/mercury/mdbcomp/trace_counts.m,v
retrieving revision 1.3
diff -u -r1.3 trace_counts.m
--- mdbcomp/trace_counts.m 10 Feb 2005 04:10:30 -0000 1.3
+++ mdbcomp/trace_counts.m 2 Mar 2005 00:15:50 -0000
@@ -43,6 +43,9 @@
:- mode string_to_trace_port(in, out) is semidet.
:- mode string_to_trace_port(out, in) is det.
+:- pred restrict_trace_counts_to_module(module_name::in, trace_counts::in,
+ trace_counts::out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -220,3 +223,19 @@
string__length(String, Length),
string__substring(String, 1, Length-2, SubString),
path_from_string(SubString, Path).
+
+%-----------------------------------------------------------------------------%
+
+restrict_trace_counts_to_module(ModuleName, TraceCounts0, TraceCounts) :-
+ map__foldl(restrict_trace_counts_2(ModuleName), TraceCounts0,
+ map__init, TraceCounts).
+
+:- pred restrict_trace_counts_2(module_name::in, proc_label::in,
+ proc_trace_counts::in, trace_counts::in, trace_counts::out) is det.
+
+restrict_trace_counts_2(ModuleName, ProcLabel, ProcCounts, Acc0, Acc) :-
+ (if ProcLabel = proc(ModuleName, _, _, _, _, _) then
+ map__det_insert(Acc0, ProcLabel, ProcCounts, Acc)
+ else
+ Acc = Acc0
+ ).
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list