mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-17 10:23:46 +00:00
Code Issues Projects Releases Wiki Activity
Files
b357a3dadcdf29c8d8ca184d65f7634a1a94de36
mercury/compiler/size_prof.m
Zoltan Somogyi 625ec287f1 Carve five new modules out of prog_type.m. 
compiler/prog_type_construct.m:
    New module for constructing types.

compiler/prog_type_repn.m:
    New module for testing things related to type representation.

compiler/prog_type_scan.m:
    New module for gather type vars in types.

compiler/prog_type_test.m:
    New module containing simple tests on types.

compiler/prog_type_unify.m:
    New module for testing whether two types unify, or whether
    one type subsumes another.

compiler/prog_type.m:
    Delete the code moved to the new modules.

compiler/parse_tree.m:
    Include the new modules.

compiler/notes/compiler_design.html:
    Document the new modules.

compiler/*.m:
    Conform to the changes above, by adjusting imports as needed,
    and by deleting any explicit module qualifications that
    this diff makes obsolete.
2023-10-06 08:42:43 +11:00

1321 lines
58 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2003-2012 The University of Melbourne.
% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: size_prof.m
% Author: zs.
%
% This module performs a source-to-source program transformation that
% implements term size profiling. The objective of the transformation is to
% make it possible to find out the size of every term in constant time, i.e.
% *without* traversing the term. (If finding out the size of a term required
% traversing the term, the cost of this traversal would dominate the cost of
% most procedures that took that term as input, and thus the traversal
% overhead would introduce a "noise" that would overwhelm the "signal" that
% profiling is trying to measure.) We can thus match the time taken by a
% procedure against the size of its inputs, and use curve-fitting to find out
% its actual complexity. (The theoretical minimum and maxiumum complexities of
% most real algorithms are so different that they are of no use.)
%
% The obvious way to avoid the traversal overhead on size lookup is to
% calculate the size when the term is being constructed, which requires
% traversing it anyway. In term profiling grades, we reserve an extra word at
% the start of every memory cell (with a few exceptions explained below) that
% stores the size of the whole term the memory cell is the top of. The size
% is defined as the memory words in the term or the number of memory cells in
% the term, depending on the grade.
%
% The main job of this module is to annotate every construction unification
% with the information that the code generator needs to fill in the term size
% slot. In order to do this, it must be able to find out the sizes of the
% arguments, which in turn requires knowing the arguments' types. (Without
% type information, we cannot distinguish a pointer from an integer.) Most of
% the code in this module is concerned with adding code to the procedure being
% transformed to find or construct the typeinfos we need in order to find out
% the sizes of subterms, mainly because we want to minimize the number of
% goals that construct typeinfos that we add to the procedure body.
%
% A minor job of this transformation is to look for places where the procedure
% fills in a previously undefined field in a cell, and to add code at those
% places to destructively increment the size slot of the cell by the size of
% the newly added subterm.
%
% In theory, when this happens, we should also increase the sizes of all the
% terms containing the term that had one or more of its fields instantiated.
% We do not do so, because doing that would require a lot more machinery.
% However, given our lack of support for partially instantiated data
% structures, and the fact that the correctness of the program does not in
% fact require term sizes to be computed accurately, the problem this poses
% can be safely ignored.
%
% The transformation we perform is not optimal: for example, if two branches
% of a switch bind a variable to terms of the same size, we don't exploit this
% fact. The transformation tries to get all the "low-hanging fruit"; we will
% go after higher hanging fruit if and when a performance evaluation says we
% need to.
%
% We do not associate sizes with the memory cells of a small set of types,
% including type_infos, type_class_infos, closures and boxed floats. The two
% reasons for this are that (1) the sizes of values of these types practically
% never control the complexity of a procedure, so there is no need for their
% sizes, and (2) this allows us to create e.g. static type_info structures
% without worrying about term size slots. The set of type categories whose
% values are always considered zero sized is defined by the predicate
% zero_size_type in term_norm.m.
%
% We currently do not associate sizes with data types which are handled mostly
% by hand-written C code in the runtime system or in the standard library:
% strings, arrays, higher-order values and foreign types. Keeping their sizes
% would require a lot of extra work and (in the case of foreign types)
% cooperation from the programmer. In the case of arrays, their destructive
% updates also pose the same problems with respect to the propagation of size
% changes as the instantiation of free variables in cells. Maintaining sizes
% for strings and arrays would be desirable, since real programs do contain
% predicates whose complexity is governed by the length of an array or a
% string, but this remains future work.
%
%-----------------------------------------------------------------------------%
:- module transform_hlds.size_prof.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module io.
%-----------------------------------------------------------------------------%
% Specifies how term sizes are to be measured.
%
:- type construct_transform
---> term_words
; term_cells.
% Perform the transformation on the specified predicate.
%
:- pred size_prof_process_proc_msg(io.text_output_stream::in,
construct_transform::in, pred_proc_id::in, proc_info::in, proc_info::out,
module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.
:- import_module check_hlds.inst_test.
:- import_module check_hlds.polymorphism_type_info.
:- import_module check_hlds.recompute_instmap_deltas.
:- 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.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_proc_util.
:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module hlds.make_goal.
:- import_module hlds.passes_aux.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_construct.
:- import_module parse_tree.prog_type_test.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_table.
:- import_module transform_hlds.term_norm.
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
% The transformation maintains several maps that allows it to minimize
% the number of constructions of typeinfos it needs to add to the procedure
% body.
%
% If there is a variable live at the current program point that already
% contains a type_info for a given type, then the type_info_map will record
% its identity. The type_ctor_map does likewise for variables that contain the
% type_ctor_infos of type constructors. However, we treat type_ctor_map
% differently from type_info_maps, because the tradeoff are different.
% Creating a new type_ctor_info reference is cheap: just return a pointer to a
% static compiler-generated data structure. Creating a new type_info isn't
% cheap: it requires memory allocation. This is why in some places (calls,
% ends of branched control structures) we simply clean out the type_ctor_map:
% it is cheaper to recreate a type_ctor_info than to store it or move it
% around.
%
% The rev_type_info_map and rev_type_ctor_map contain the same information
% as type_info_map and type_ctor_map respectively, only indexed by the
% program variable, not by the type or type constructor.
%
% If each arm of a branched control structure creates a type_info for a given
% type but make different variables hold this type_info, then the code after
% the branched control structure, not knowing which branch was taken, cannot
% look up the type_info in any one of these variables, and is instead forced
% to allocate that same type_info anew. The purpose of the target_type_info_map
% is to minimize the number of places where we have to do this. If an earlier
% branch has put the typeinfo for a given type into a given variable, then we
% record this fact in the target_type_info_map, so that when a later branch
% needs a type_info for the same type, it will put it into the same variable.
% Of course, this pays off only if all branches allocate a type_info for the
% type, but this does happen reasonably often. When it doesn't, the variable
% that two or more branches use to store the type_into may need to be named
% apart, which is why we invoke quantification after our transformation is
% finished.
%
% It is of course better to find out the sizes of terms at compile time
% than at runtime. The known_size_map maps each variable whose size is known
% to its size.
%
% The varset and vartypes fields come from the proc_info of the procedure being
% transformed, and their modified versions (updated when the transformation
% creates new variables) are put back into the procedure's new proc_info.
%
% The construct_transform field specifies how term sizes are to be measured.
%
% The rtti_varmaps specifies which program variables hold the type_infos
% of which type variables.
%
% The module_info is needed by some utility predicates called by the
% transformation.
:- type type_info_map == map(mer_type, prog_var).
:- type type_ctor_map == map(type_ctor, prog_var).
:- type rev_type_info_map == map(prog_var, mer_type).
:- type rev_type_ctor_map == map(prog_var, type_ctor).
:- type known_size_map == map(prog_var, int).
:- type size_prof_info
---> size_prof_info(
spi_module_info :: module_info,
spi_type_ctor_map :: type_ctor_map,
spi_type_info_map :: type_info_map,
spi_rev_type_ctor_map :: rev_type_ctor_map,
spi_rev_type_info_map :: rev_type_info_map,
spi_target_type_info_map :: type_info_map,
spi_known_size_map :: known_size_map,
spi_var_table :: var_table,
spi_transform_op :: construct_transform,
spi_rtti_varmaps :: rtti_varmaps
).
size_prof_process_proc_msg(ProgressStream, Transform, PredProcId,
!ProcInfo, !ModuleInfo) :-
trace [io(!IO)] (
maybe_write_proc_progress_message(ProgressStream, !.ModuleInfo,
"Size profiling", PredProcId, !IO)
),
size_prof_process_proc(Transform, PredProcId, !ProcInfo, !ModuleInfo).
:- pred size_prof_process_proc(construct_transform::in, pred_proc_id::in,
proc_info::in, proc_info::out,
module_info::in, module_info::out) is det.
size_prof_process_proc(Transform, proc(PredId, ProcId), !ProcInfo,
!ModuleInfo) :-
module_info_get_globals(!.ModuleInfo, Globals),
SimplifyTasks = list_to_simplify_tasks(Globals, []),
simplify_proc(maybe.no, SimplifyTasks, PredId, ProcId,
!ModuleInfo, !ProcInfo),
proc_info_get_goal(!.ProcInfo, Goal0),
proc_info_get_var_table(!.ProcInfo, VarTable0),
proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InstMap0),
proc_info_get_rtti_varmaps(!.ProcInfo, RttiVarMaps0),
% The with_types are needed to avoid a combinatorial explosion
% of ambiguity in the type checker.
TypeCtorMap0 = map.init : type_ctor_map,
TypeInfoMap0 = map.init : type_info_map,
RevTypeCtorMap0 = map.init : rev_type_ctor_map,
RevTypeInfoMap0 = map.init : rev_type_info_map,
TargetTypeInfoMap0 = map.init : type_info_map,
KnownSizeMap0 = map.init : known_size_map,
Info0 = size_prof_info(!.ModuleInfo, TypeCtorMap0, TypeInfoMap0,
RevTypeCtorMap0, RevTypeInfoMap0, TargetTypeInfoMap0,
KnownSizeMap0, VarTable0, Transform, RttiVarMaps0),
rtti_varmaps_tvars(RttiVarMaps0, TVars),
list.foldl(record_typeinfo_in_type_info_varmap(RttiVarMaps0), TVars,
Info0, Info1),
size_prof_process_goal(Goal0, Goal1, Info1, Info),
% We need to fix up goal_infos by recalculating
% the nonlocal vars and the non-atomic instmap deltas.
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
implicitly_quantify_clause_body_general(ord_nl_no_lambda,
HeadVars, _Warnings, Goal1, Goal2,
Info ^ spi_var_table, VarTable,
Info ^ spi_rtti_varmaps, RttiVarMaps),
recompute_instmap_delta(no_recomp_atomics,
VarTable, InstVarSet, InstMap0, Goal2, Goal, !ModuleInfo),
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_var_table(VarTable, !ProcInfo),
proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo).
:- pred size_prof_process_goal(hlds_goal::in, hlds_goal::out,
size_prof_info::in, size_prof_info::out) is det.
size_prof_process_goal(Goal0, Goal, !Info) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
GoalExpr0 = unify(LHS, RHS, UniMode, Unify0, UnifyContext),
(
Unify0 = construct(Var, ConsId, Args, ArgModes, How, Unique, _),
size_prof_process_construct(LHS, RHS, UniMode, UnifyContext,
Var, ConsId, Args, ArgModes, How, Unique, GoalInfo0, GoalExpr,
!Info)
;
Unify0 = deconstruct(Var, ConsId, Args, ArgModes,
_CanFail, _CanCGC),
( if
% The following test is an optimization. If
% BindingArgModes = [], which is almost 100% likely,
% then size_prof_process_deconstruct would return GoalExpr0 as
% GoalExpr anyway, but would take longer.
list.filter(binds_arg_in_cell(!.Info), ArgModes,
BindingArgModes),
BindingArgModes = [_ | _]
then
size_prof_process_deconstruct(Var, ConsId, Args, ArgModes,
Goal0, GoalExpr, !Info)
else
GoalExpr = GoalExpr0
)
;
( Unify0 = assign(_, _)
; Unify0 = simple_test(_, _)
),
GoalExpr = GoalExpr0
;
Unify0 = complicated_unify(_, _, _),
% These should have been expanded out by now.
unexpected($pred, "complicated_unify")
)
;
GoalExpr0 = plain_call(_, _, _, _, _, _),
% We don't want to save type_ctor_info variables across calls,
% because saving/restoring them is more expensive than defining
% them again.
!Info ^ spi_type_ctor_map := map.init,
!Info ^ spi_rev_type_ctor_map := map.init,
GoalExpr = GoalExpr0
;
GoalExpr0 = generic_call(_, _, _, _, _),
% We don't want to save type_ctor_info variables across calls,
% because saving/restoring them is more expensive than defining
% them again.
!Info ^ spi_type_ctor_map := map.init,
!Info ^ spi_rev_type_ctor_map := map.init,
GoalExpr = GoalExpr0
;
GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
GoalExpr = GoalExpr0
;
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
size_prof_process_conj(Goals0, Goals, !Info)
;
ConjType = parallel_conj,
% This transformation produces code that is much less than
% optimal. However, it ought to be more robust than any better
% transformation, and there is no point in spending time on a
% better transformation while parallel conjunctions are rare.
TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
TypeInfoMap0 = !.Info ^ spi_type_info_map,
RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
size_prof_process_par_conj(Goals0, Goals, !Info,
TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0),
!Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
!Info ^ spi_type_info_map := TypeInfoMap0,
!Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
!Info ^ spi_type_ctor_map := map.init,
!Info ^ spi_rev_type_ctor_map := map.init,
!Info ^ spi_known_size_map := KnownSizeMap0
),
GoalExpr = conj(ConjType, Goals)
;
GoalExpr0 = switch(SwitchVar, CanFail, Cases0),
(
Cases0 = [First0 | Later0],
TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
TypeInfoMap0 = !.Info ^ spi_type_info_map,
RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
size_prof_process_switch(First0, First, Later0, Later, !Info,
TargetTypeInfoMap0,
TypeInfoMap0, RevTypeInfoMap0,
TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMap, KnownSizeMap0, KnownSizeMap),
!Info ^ spi_type_info_map := TypeInfoMap,
% The rev_type_info_map field is updated by
% the call to update_rev_maps below.
!Info ^ spi_type_ctor_map := map.init,
!Info ^ spi_rev_type_ctor_map := map.init,
!Info ^ spi_known_size_map := KnownSizeMap,
Cases = [First | Later]
;
Cases0 = [],
unexpected($pred, "empty switch")
),
update_rev_maps(!Info),
update_target_map(!Info),
GoalExpr = switch(SwitchVar, CanFail, Cases)
;
GoalExpr0 = disj(Disjuncts0),
(
Disjuncts0 = [First0 | Later0],
TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
TypeInfoMap0 = !.Info ^ spi_type_info_map,
RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
size_prof_process_disj(First0, First, Later0, Later, !Info,
TargetTypeInfoMap0,
TypeInfoMap0, RevTypeInfoMap0,
TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMap, KnownSizeMap0, KnownSizeMap),
!Info ^ spi_type_info_map := TypeInfoMap,
% The rev_type_info_map field is updated by
% the call to update_rev_maps below.
!Info ^ spi_type_ctor_map := map.init,
!Info ^ spi_rev_type_ctor_map := map.init,
!Info ^ spi_known_size_map := KnownSizeMap,
Disjuncts = [First | Later]
;
Disjuncts0 = [],
% An empty disj represents `fail'.
!Info ^ spi_type_info_map := map.init,
!Info ^ spi_rev_type_ctor_map := map.init,
!Info ^ spi_type_info_map := map.init,
!Info ^ spi_rev_type_ctor_map := map.init,
Disjuncts = []
),
update_rev_maps(!Info),
update_target_map(!Info),
GoalExpr = disj(Disjuncts)
;
GoalExpr0 = if_then_else(Quant, Cond0, Then0, Else0),
TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
TypeInfoMap0 = !.Info ^ spi_type_info_map,
RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
!Info ^ spi_target_type_info_map := map.init,
size_prof_process_goal(Cond0, Cond, !Info),
!Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
size_prof_process_goal(Then0, Then, !Info),
TargetTypeInfoMapThen = !.Info ^ spi_target_type_info_map,
TypeInfoMapThen = !.Info ^ spi_type_info_map,
KnownSizeMapThen = !.Info ^ spi_known_size_map,
map.union(select_first, TargetTypeInfoMapThen,
TargetTypeInfoMap0, ElseTargetTypeInfoMap),
!Info ^ spi_target_type_info_map := ElseTargetTypeInfoMap,
!Info ^ spi_type_info_map := TypeInfoMap0,
!Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
!Info ^ spi_type_ctor_map := TypeCtorMap0,
!Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
!Info ^ spi_known_size_map := KnownSizeMap0,
size_prof_process_goal(Else0, Else, !Info),
TypeInfoMapElse = !.Info ^ spi_type_info_map,
KnownSizeMapElse = !.Info ^ spi_known_size_map,
TypeInfoMap = map.common_subset(TypeInfoMapThen, TypeInfoMapElse),
KnownSizeMap = map.common_subset(KnownSizeMapThen, KnownSizeMapElse),
!Info ^ spi_type_info_map := TypeInfoMap,
!Info ^ spi_type_ctor_map := map.init,
!Info ^ spi_known_size_map := KnownSizeMap,
update_rev_maps(!Info),
update_target_map(!Info),
GoalExpr = if_then_else(Quant, Cond, Then, Else)
;
GoalExpr0 = negation(NegGoal0),
TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
TypeInfoMap0 = !.Info ^ spi_type_info_map,
RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
KnownSizeMap0 = !.Info ^ spi_known_size_map,
size_prof_process_goal(NegGoal0, NegGoal, !Info),
% Variables constructed in negated goals are not available after the
% negated goal fails and the negation succeeds. The sizes we learn
% in NegGoal0 don't apply after NegGoal0 fails.
!Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
!Info ^ spi_type_info_map := TypeInfoMap0,
!Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
!Info ^ spi_type_ctor_map := TypeCtorMap0,
!Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
!Info ^ spi_known_size_map := KnownSizeMap0,
GoalExpr = negation(NegGoal)
;
GoalExpr0 = scope(Reason0, SubGoal0),
% The code inside from_ground_term_construct scopes wants to construct
% terms statically, but for term size profiling, we need to construct
% terms dynamically,
( if
Reason0 = from_ground_term(TermVar, from_ground_term_construct)
then
Reason = from_ground_term(TermVar, from_ground_term_other)
else
Reason = Reason0
),
size_prof_process_goal(SubGoal0, SubGoal, !Info),
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = shorthand(_),
unexpected($pred, "shorthand")
),
Goal = hlds_goal(GoalExpr, GoalInfo0).
%---------------------------------------------------------------------------%
:- pred size_prof_process_conj(list(hlds_goal)::in, list(hlds_goal)::out,
size_prof_info::in, size_prof_info::out) is det.
size_prof_process_conj([], [], !Info).
size_prof_process_conj([Goal0 | Goals0], Conj, !Info) :-
size_prof_process_goal(Goal0, Goal, !Info),
size_prof_process_conj(Goals0, Goals, !Info),
( if Goal = hlds_goal(conj(plain_conj, SubConj), _) then
% Flatten out any conjunction introduced by size_prof_process_goal.
% We never create conjunctions more than one level deep,
% so this single test is sufficient to ensure that we never
% leave conjunctions nested more deeply than the input goal.
Conj = list.append(SubConj, Goals)
else
Conj = [Goal | Goals]
).
%---------------------------------------------------------------------------%
:- pred size_prof_process_par_conj(list(hlds_goal)::in, list(hlds_goal)::out,
size_prof_info::in, size_prof_info::out,
type_info_map::in, type_info_map::in,
type_ctor_map::in, known_size_map::in) is det.
size_prof_process_par_conj([], [], !Info, _, _, _, _).
size_prof_process_par_conj([Goal0 | Goals0], [Goal | Goals], !Info,
TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0) :-
!Info ^ spi_target_type_info_map := TargetTypeInfoMap0,
!Info ^ spi_type_info_map := TypeInfoMap0,
!Info ^ spi_type_ctor_map := TypeCtorMap0,
!Info ^ spi_known_size_map := KnownSizeMap0,
size_prof_process_goal(Goal0, Goal, !Info),
size_prof_process_par_conj(Goals0, Goals, !Info,
TargetTypeInfoMap0, TypeInfoMap0, TypeCtorMap0, KnownSizeMap0).
%---------------------------------------------------------------------------%
:- pred size_prof_process_disj(hlds_goal::in, hlds_goal::out,
list(hlds_goal)::in, list(hlds_goal)::out,
size_prof_info::in, size_prof_info::out,
type_info_map::in, type_info_map::in, rev_type_info_map::in,
type_ctor_map::in, rev_type_ctor_map::in,
type_info_map::out, known_size_map::in, known_size_map::out) is det.
size_prof_process_disj(First0, First, Later0, Later, !Info, TargetTypeInfoMap,
TypeInfoMap0, RevTypeInfoMap0, TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMap, KnownSizeMap0, KnownSizeMap) :-
!Info ^ spi_type_info_map := TypeInfoMap0,
!Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
!Info ^ spi_type_ctor_map := TypeCtorMap0,
!Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
!Info ^ spi_known_size_map := KnownSizeMap0,
size_prof_process_goal(First0, First, !Info),
TypeInfoMapFirst = !.Info ^ spi_type_info_map,
KnownSizeMapFirst = !.Info ^ spi_known_size_map,
(
Later0 = [Head0 | Tail0],
map.union(select_first, TypeInfoMapFirst,
TargetTypeInfoMap, LaterTargetTypeInfoMap),
!Info ^ spi_target_type_info_map := LaterTargetTypeInfoMap,
size_prof_process_disj(Head0, Head, Tail0, Tail, !Info,
TargetTypeInfoMap,
TypeInfoMap0, RevTypeInfoMap0, TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMapLater, KnownSizeMap0, KnownSizeMapLater),
TypeInfoMap = map.common_subset(TypeInfoMapFirst, TypeInfoMapLater),
KnownSizeMap = map.common_subset(KnownSizeMapFirst, KnownSizeMapLater),
Later = [Head | Tail]
;
Later0 = [],
Later = [],
TypeInfoMap = TypeInfoMapFirst,
KnownSizeMap = KnownSizeMapFirst
).
%---------------------------------------------------------------------------%
:- pred size_prof_process_switch(case::in, case::out,
list(case)::in, list(case)::out, size_prof_info::in, size_prof_info::out,
type_info_map::in, type_info_map::in, rev_type_info_map::in,
type_ctor_map::in, rev_type_ctor_map::in,
type_info_map::out, known_size_map::in, known_size_map::out) is det.
size_prof_process_switch(First0, First, Later0, Later, !Info,
TargetTypeInfoMap, TypeInfoMap0, RevTypeInfoMap0,
TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMap, KnownSizeMap0, KnownSizeMap) :-
!Info ^ spi_type_info_map := TypeInfoMap0,
!Info ^ spi_rev_type_info_map := RevTypeInfoMap0,
!Info ^ spi_type_ctor_map := TypeCtorMap0,
!Info ^ spi_rev_type_ctor_map := RevTypeCtorMap0,
!Info ^ spi_known_size_map := KnownSizeMap0,
First0 = case(FirstMainConsId, FirstOtherConsIds, FirstGoal0),
size_prof_process_goal(FirstGoal0, FirstGoal, !Info),
TypeInfoMapFirst = !.Info ^ spi_type_info_map,
KnownSizeMapFirst = !.Info ^ spi_known_size_map,
First = case(FirstMainConsId, FirstOtherConsIds, FirstGoal),
(
Later0 = [Head0 | Tail0],
map.union(select_first, TargetTypeInfoMap,
TypeInfoMapFirst, LaterTargetTypeInfoMap),
!Info ^ spi_target_type_info_map := LaterTargetTypeInfoMap,
size_prof_process_switch(Head0, Head, Tail0, Tail, !Info,
TargetTypeInfoMap, TypeInfoMap0, RevTypeInfoMap0,
TypeCtorMap0, RevTypeCtorMap0,
TypeInfoMapLater, KnownSizeMap0, KnownSizeMapLater),
TypeInfoMap = map.common_subset(TypeInfoMapFirst, TypeInfoMapLater),
KnownSizeMap = map.common_subset(KnownSizeMapFirst, KnownSizeMapLater),
Later = [Head | Tail]
;
Later0 = [],
Later = [],
TypeInfoMap = TypeInfoMapFirst,
KnownSizeMap = KnownSizeMapFirst
).
%---------------------------------------------------------------------------%
:- pred size_prof_process_construct(prog_var::in, unify_rhs::in,
unify_mode::in, unify_context::in, prog_var::in, cons_id::in,
list(prog_var)::in, list(unify_mode)::in, how_to_construct::in,
cell_is_unique::in, hlds_goal_info::in, hlds_goal_expr::out,
size_prof_info::in, size_prof_info::out) is det.
size_prof_process_construct(LHS, RHS, UniMode, UnifyContext, Var, ConsId,
Args, ArgModes, How, Unique, GoalInfo, GoalExpr, !Info) :-
lookup_var_type(!.Info ^ spi_var_table, Var, VarType),
type_to_ctor_det(VarType, VarTypeCtor),
type_ctor_module_name_arity(VarTypeCtor,
VarTypeCtorModule, VarTypeCtorName, _),
( if
ctor_is_type_info_related(VarTypeCtorModule, VarTypeCtorName)
then
( if VarTypeCtorName = "type_info" then
( if
ConsId = type_info_cell_constructor(_),
Args = [TypeCtorInfoVar | ArgTypeInfoVars]
then
record_known_type_info(Var, TypeCtorInfoVar, ArgTypeInfoVars,
!Info)
else if
ConsId = type_ctor_info_const(M, N, A)
then
% When type specialization creates a procedure with a type
% substitution such as K=int, it leaves the type of
% TypeInfo_for_K as type_info, not type_ctor_info.
record_known_type_ctor_info(Var, M, N, A, !Info)
else
unexpected($pred, "bad type_info")
)
else if VarTypeCtorName = "type_ctor_info" then
( if ConsId = type_ctor_info_const(M, N, A) then
record_known_type_ctor_info(Var, M, N, A, !Info)
else
unexpected($pred, "bad type_ctor_info")
)
else
!:Info = !.Info
),
Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
no_construct_sub_info),
GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
else if
ConsId = cons(_Name, _Arity, _TypeCtor),
Args = [_ | _]
then
size_prof_process_cons_construct(LHS, RHS, UniMode, UnifyContext,
Var, VarType, ConsId, Args, ArgModes, How, Unique,
GoalInfo, GoalExpr, !Info)
else
% All ConsIds other than cons/2 with at least one argument
% construct terms that we consider zero-sized.
record_known_size(Var, 0, !Info),
Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
no_construct_sub_info),
GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
).
%-----------------------------------------------------------------------------%
:- pred size_prof_process_deconstruct(prog_var::in, cons_id::in,
list(prog_var)::in, list(unify_mode)::in, hlds_goal::in,
hlds_goal_expr::out, size_prof_info::in, size_prof_info::out) is det.
size_prof_process_deconstruct(Var, ConsId, Args, ArgModes, Goal0, GoalExpr,
!Info) :-
lookup_var_type(!.Info ^ spi_var_table, Var, VarType),
type_to_ctor_det(VarType, VarTypeCtor),
type_ctor_module_name_arity(VarTypeCtor, VarTypeCtorModule,
VarTypeCtorName, _),
( if
ctor_is_type_info_related(VarTypeCtorModule, VarTypeCtorName)
then
Goal0 = hlds_goal(GoalExpr, _)
else if
( ConsId = cons(_Name, _Arity, _TypeCtor)
; ConsId = tuple_cons(_Arity)
),
Args = [_ | _]
then
size_prof_process_cons_deconstruct(Var, Args, ArgModes, Goal0,
GoalExpr, !Info)
else
% All ConsIds other than cons/2 deconstruct terms that we
% consider zero-sized.
record_known_size(Var, 0, !Info),
Goal0 = hlds_goal(GoalExpr, _)
).
%-----------------------------------------------------------------------------%
:- pred size_prof_process_cons_construct(prog_var::in, unify_rhs::in,
unify_mode::in, unify_context::in, prog_var::in, mer_type::in,
cons_id::in, list(prog_var)::in, list(unify_mode)::in,
how_to_construct::in, cell_is_unique::in, hlds_goal_info::in,
hlds_goal_expr::out, size_prof_info::in, size_prof_info::out) is det.
size_prof_process_cons_construct(LHS, RHS, UniMode, UnifyContext, Var, _Type,
ConsId, Args, ArgModes, How, Unique, GoalInfo0, GoalExpr, !Info) :-
FunctorSize = compute_functor_size(Args, !.Info),
find_defined_args(Args, ArgModes, DefinedArgs, NonDefinedArgs, !.Info),
Context = goal_info_get_context(GoalInfo0),
size_prof_process_args(DefinedArgs, FunctorSize, KnownSize,
no, MaybeDynamicSizeVar, Context, ArgGoals, !Info),
(
MaybeDynamicSizeVar = no,
expect(unify(ArgGoals, []), $pred, "nonempty ArgGoals"),
(
NonDefinedArgs = [],
record_known_size(Var, KnownSize, !Info)
;
NonDefinedArgs = [_ | _],
% The size of the term may change as some of its
% currently free arguments become bound.
true
),
Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
construct_sub_info(no, yes(known_size(KnownSize)))),
GoalExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext)
;
MaybeDynamicSizeVar = yes(SizeVar0),
generate_size_var(SizeVar0, KnownSize, Context, SizeVar, SizeGoals,
!Info),
Unification = construct(Var, ConsId, Args, ArgModes, How, Unique,
construct_sub_info(no, yes(dynamic_size(SizeVar)))),
UnifyExpr = unify(LHS, RHS, UniMode, Unification, UnifyContext),
NonLocals0 = goal_info_get_nonlocals(GoalInfo0),
set_of_var.insert(SizeVar, NonLocals0, NonLocals),
goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
UnifyGoal = hlds_goal(UnifyExpr, GoalInfo),
Goals = list.condense([ArgGoals, SizeGoals, [UnifyGoal]]),
GoalExpr = conj(plain_conj, Goals)
).
%-----------------------------------------------------------------------------%
:- pred size_prof_process_cons_deconstruct(prog_var::in, list(prog_var)::in,
list(unify_mode)::in, hlds_goal::in, hlds_goal_expr::out,
size_prof_info::in, size_prof_info::out) is det.
size_prof_process_cons_deconstruct(Var, Args, ArgModes, UnifyGoal, GoalExpr,
!Info) :-
find_defined_args(Args, ArgModes, DefinedArgs, _NonDefArgs, !.Info),
UnifyGoal = hlds_goal(GoalExpr0, GoalInfo0),
Context = goal_info_get_context(GoalInfo0),
size_prof_process_args(DefinedArgs, 0, KnownSize,
no, MaybeDynamicSizeVar, Context, ArgGoals, !Info),
(
MaybeDynamicSizeVar = no,
expect(unify(ArgGoals, []), $pred, "nonempty ArgGoals"),
GoalExpr = GoalExpr0
;
MaybeDynamicSizeVar = yes(SizeVar0),
generate_size_var(SizeVar0, KnownSize, Context, SizeVar, SizeGoals,
!Info),
% The increment_size primitive doesn't need Var's type_info,
% so we make it a no_type_info_builtin.
TermSizeProfBuiltin = mercury_term_size_prof_builtin_module,
generate_plain_call(!.Info ^ spi_module_info, pf_predicate,
TermSizeProfBuiltin, "increment_size",
[], [Var, SizeVar], instmap_delta_bind_no_var, only_mode,
detism_det, purity_impure, [], Context, UpdateGoal),
% Put UnifyGoal first in case it fails.
Goals = [UnifyGoal] ++ ArgGoals ++ SizeGoals ++ [UpdateGoal],
GoalExpr = conj(plain_conj, Goals)
).
%-----------------------------------------------------------------------------%
% Process the variables representing the fields being bound in a memory
% cell, computing the contribution they make to the increase in size of
% that cell. The increase is in two parts: the statically known part,
% and the part that can be known only at runtime. We record the former
% in the KnownSize accumulator and the latter in the MaybeSizeVar
% accumulator. We allocate a variable to hold the dynamically-computed part
% of the size only if the sum of the arguments' sizes is not static.
% In that case, the Goals we return will be nonempty.
%
:- pred size_prof_process_args(list(prog_var)::in, int::in, int::out,
maybe(prog_var)::in, maybe(prog_var)::out, prog_context::in,
list(hlds_goal)::out, size_prof_info::in, size_prof_info::out) is det.
size_prof_process_args([], !KnownSize, !MaybeSizeVar, _, [], !Info).
size_prof_process_args([Arg | Args], !KnownSize, !MaybeSizeVar, Context, Goals,
!Info) :-
lookup_var_type(!.Info ^ spi_var_table, Arg, Type),
( if map.search(!.Info ^ spi_known_size_map, Arg, ArgSize) then
!:KnownSize = !.KnownSize + ArgSize,
ArgGoals = []
else if zero_size_type(!.Info ^ spi_module_info, Type) then
ArgGoals = []
else
make_type_info(Context, Type, TypeInfoVar, TypeInfoGoals, !Info),
make_size_goal(TypeInfoVar, Arg, Context, SizeGoal, !MaybeSizeVar,
!Info),
list.append(TypeInfoGoals, [SizeGoal], ArgGoals)
),
size_prof_process_args(Args, !KnownSize, !MaybeSizeVar, Context,
LaterGoals, !Info),
Goals = ArgGoals ++ LaterGoals.
%-----------------------------------------------------------------------------%
% Given that KnownSize is the static part of the sum of sizes of the fields
% being defined and SizeVar0 is a variable containing the dynamic part,
% return a variable SizeVar that contains their sum and the Goals needed to
% compute it.
%
:- pred generate_size_var(prog_var::in, int::in, prog_context::in,
prog_var::out, list(hlds_goal)::out,
size_prof_info::in, size_prof_info::out) is det.
generate_size_var(SizeVar0, KnownSize, Context, SizeVar, Goals, !Info) :-
( if KnownSize = 0 then
SizeVar = SizeVar0,
Goals = []
else
VarTable0 = !.Info ^ spi_var_table,
make_int_const_construction_alloc(KnownSize, "KnownSize",
KnownSizeGoal, KnownSizeVar, VarTable0, VarTable1),
!Info ^ spi_var_table := VarTable1,
get_new_var("FinalSizeVar", int_type, is_not_dummy_type, SizeVar,
!Info),
TermSizeProfModule = mercury_term_size_prof_builtin_module,
generate_plain_call(!.Info ^ spi_module_info, pf_function,
TermSizeProfModule, "term_size_plus",
[], [SizeVar0, KnownSizeVar, SizeVar],
instmap_delta_bind_var(SizeVar), mode_no(0),
detism_det, purity_pure, [], Context, AddGoal),
Goals = [KnownSizeGoal, AddGoal]
).
%-----------------------------------------------------------------------------%
% Create a type_info for a given type as cheaply as possible, with the
% cheapest methods involving the reuse of existing type_infos and/or
% type_ctor_infos. Return the variable holding the type_info in
% TypeInfoVar, and the goals needed to create it in TypeInfoGoals.
:- pred make_type_info(prog_context::in, mer_type::in, prog_var::out,
list(hlds_goal)::out, size_prof_info::in, size_prof_info::out) is det.
make_type_info(Context, Type, TypeInfoVar, TypeInfoGoals, !Info) :-
( if map.search(!.Info ^ spi_type_info_map, Type, TypeInfoVarPrime) then
TypeInfoVar = TypeInfoVarPrime,
TypeInfoGoals = []
else if type_has_variable_arity_ctor(Type, TypeCtor, ArgTypes) then
construct_type_info(Context, Type, TypeCtor, ArgTypes, yes,
TypeInfoVar, TypeInfoGoals, !Info)
else if type_to_ctor_and_args(Type, TypeCtor, ArgTypes) then
(
ArgTypes = [],
make_type_ctor_info(TypeCtor, [], TypeCtorVar, TypeCtorGoals,
!Info),
TypeInfoVar = TypeCtorVar,
TypeInfoGoals = TypeCtorGoals
;
ArgTypes = [_ | _],
construct_type_info(Context, Type, TypeCtor, ArgTypes,
no, TypeInfoVar, TypeInfoGoals, !Info)
)
else if Type = type_variable(TVar, _) then
rtti_lookup_type_info_locn(!.Info ^ spi_rtti_varmaps, TVar, TVarLocn),
(
TVarLocn = type_info(TypeInfoVar),
TypeInfoGoals = []
;
TVarLocn = typeclass_info(TypeClassInfoVar, Slot),
TargetTypeInfoMap = !.Info ^ spi_target_type_info_map,
VarTable0 = !.Info ^ spi_var_table,
( if map.search(TargetTypeInfoMap, Type, TargetVar) then
TypeInfoVar = TargetVar,
VarTable1 = VarTable0
else
RttiVarMaps0 = !.Info ^ spi_rtti_varmaps,
new_type_info_var_vt(Type, type_info, TypeInfoVar,
VarTable0, VarTable1, RttiVarMaps0, RttiVarMaps),
!Info ^ spi_rtti_varmaps := RttiVarMaps
),
make_int_const_construction_alloc(Slot, "TypeClassInfoSlot",
SlotGoal, SlotVar, VarTable1, VarTable),
!Info ^ spi_var_table := VarTable,
PrivateBuiltin = mercury_private_builtin_module,
generate_plain_call(!.Info ^ spi_module_info, pf_predicate,
PrivateBuiltin, "type_info_from_typeclass_info",
[], [TypeClassInfoVar, SlotVar, TypeInfoVar],
instmap_delta_bind_var(TypeInfoVar), only_mode,
detism_det, purity_pure, [], Context, ExtractGoal),
record_type_info_var(Type, TypeInfoVar, !Info),
TypeInfoGoals = [SlotGoal, ExtractGoal]
)
else
% Type_to_ctor_and_args can fail only if Type is a type variable,
% or acts like one. The tests in our callers should have filtered
% out both cases.
unexpected($pred, "cannot happen")
).
% Construct a type_info for Type = TypeCtor(ArgTypes), given that we know
% there is no variable that currently holds a type_info for Type. Return
% the variable holding the type_info in TypeInfoVar, and the goals needed
% to create it in TypeInfoGoals.
%
:- pred construct_type_info(prog_context::in, mer_type::in, type_ctor::in,
list(mer_type)::in, bool::in, prog_var::out, list(hlds_goal)::out,
size_prof_info::in, size_prof_info::out) is det.
construct_type_info(Context, Type, TypeCtor, ArgTypes, CtorIsVarArity,
TypeInfoVar, TypeInfoGoals, !Info) :-
list.map2_foldl(make_type_info(Context), ArgTypes,
ArgTypeInfoVars, ArgTypeInfoGoalLists, !Info),
ArgTypeInfoGoals = list.condense(ArgTypeInfoGoalLists),
make_type_ctor_info(TypeCtor, ArgTypes, TypeCtorVar, TypeCtorGoals, !Info),
(
CtorIsVarArity = yes,
list.length(ArgTypes, Arity),
VarTable0 = !.Info ^ spi_var_table,
make_int_const_construction_alloc(Arity, "TupleArity", ArityGoal,
ArityVar, VarTable0, VarTable1),
!Info ^ spi_var_table := VarTable1,
FrontGoals = list.append(TypeCtorGoals, [ArityGoal]),
ArgVars = [TypeCtorVar, ArityVar | ArgTypeInfoVars]
;
CtorIsVarArity = no,
FrontGoals = TypeCtorGoals,
ArgVars = [TypeCtorVar | ArgTypeInfoVars]
),
VarTable2 = !.Info ^ spi_var_table,
RttiVarMaps2 = !.Info ^ spi_rtti_varmaps,
TargetTypeInfoMap = !.Info ^ spi_target_type_info_map,
( if map.search(TargetTypeInfoMap, Type, TypeInfoVarPrime) then
TypeInfoVar = TypeInfoVarPrime,
VarTable = VarTable2,
RttiVarMaps3 = RttiVarMaps2
else
new_type_info_var_vt(Type, type_info, TypeInfoVar,
VarTable2, VarTable, RttiVarMaps2, RttiVarMaps3)
),
init_type_info_var(Type, ArgVars, TypeInfoVar, TypeInfoGoal,
RttiVarMaps3, RttiVarMaps),
!Info ^ spi_var_table := VarTable,
!Info ^ spi_rtti_varmaps := RttiVarMaps,
TypeInfoGoals = ArgTypeInfoGoals ++ FrontGoals ++ [TypeInfoGoal].
% Create a type_ctor_info for a given type constructor as cheaply as
% possible, with the cheapest method being the reuse of an existing
% type_ctor_info. Return the variable holding the type_ctor_info in
% TypeCtorVar, and the goals needed to create it in TypeCtorGoals.
%
:- pred make_type_ctor_info(type_ctor::in, list(mer_type)::in, prog_var::out,
list(hlds_goal)::out, size_prof_info::in, size_prof_info::out) is det.
make_type_ctor_info(TypeCtor, TypeArgs, TypeCtorVar, TypeCtorGoals, !Info) :-
( if
map.search(!.Info ^ spi_type_ctor_map, TypeCtor, TypeCtorVarPrime)
then
TypeCtorVar = TypeCtorVarPrime,
TypeCtorGoals = []
else
( if
type_ctor_is_higher_order(TypeCtor, Purity, PredOrFunc, EvalMethod)
then
construct_higher_order_type(Purity, PredOrFunc, EvalMethod,
TypeArgs, Type)
else
construct_type(TypeCtor, [], Type)
),
VarTable0 = !.Info ^ spi_var_table,
RttiVarMaps0 = !.Info ^ spi_rtti_varmaps,
init_const_type_ctor_info_var(Type, TypeCtor, TypeCtorVar, _ConsId,
TypeCtorGoal, VarTable0, VarTable, RttiVarMaps0, RttiVarMaps),
TypeCtorGoals = [TypeCtorGoal],
!Info ^ spi_var_table := VarTable,
!Info ^ spi_rtti_varmaps := RttiVarMaps
).
%-----------------------------------------------------------------------------%
% Generate a goal that looks up the size of Arg at runtime, given that the
% type_info of Arg's type is in TypeInfoVar.
%
% We ultimately always want to compute the sum of the sizes of the fields
% being defined, so if we have previously looked up the sizes of other
% fields, then combine the operation of looking up Arg's size with adding
% that size to the sum of the (dynamic) sizes so far: measure_size_acc
% does both these operations.
%
:- pred make_size_goal(prog_var::in, prog_var::in, prog_context::in,
hlds_goal::out, maybe(prog_var)::in, maybe(prog_var)::out,
size_prof_info::in, size_prof_info::out) is det.
make_size_goal(TypeInfoVar, Arg, Context, SizeGoal,
MaybeSizeVar0, MaybeSizeVar, !Info) :-
get_new_var("SizeVar", int_type, is_not_dummy_type, SizeVar, !Info),
(
MaybeSizeVar0 = yes(SizeVar0),
Pred = "measure_size_acc",
ArgVars = [Arg, SizeVar0, SizeVar]
;
MaybeSizeVar0 = no,
Pred = "measure_size",
ArgVars = [Arg, SizeVar]
),
TermSizeProfBuiltin = mercury_term_size_prof_builtin_module,
generate_plain_call(!.Info ^ spi_module_info, pf_predicate,
TermSizeProfBuiltin, Pred,
[TypeInfoVar], ArgVars, instmap_delta_bind_var(SizeVar), only_mode,
detism_det, purity_pure, [], Context, SizeGoal),
MaybeSizeVar = yes(SizeVar).
%---------------------------------------------------------------------------%
% Create a new variable with a name constructed from Prefix and the
% variable number.
%
:- pred get_new_var(string::in, mer_type::in, is_dummy_type::in, prog_var::out,
size_prof_info::in, size_prof_info::out) is det.
get_new_var(Prefix, Type, IsDummy, Var, !Info) :-
VarTable0 = !.Info ^ spi_var_table,
add_prefix_number_var_entry(Prefix, Type, IsDummy, Var,
VarTable0, VarTable),
!Info ^ spi_var_table := VarTable.
%---------------------------------------------------------------------------%
% These predicates record information about the procedure body (that was
% either there originally or was made true by our transformation) for later
% use in optimizating the transformation of the rest of the procedure body.
%
% The reason why the implementation uses map.set instead of
% map.det_insert is that it is possible for Var to already exist in the
% maps. This can happen e.g. when each branch of a branched structure
% generates a value of an existential type, and thus also generates
% the type_info describing that type. The first branch will insert the
% variable holding that type_info into the maps, and the later branches
% will be given the resulting map as guidance.
%
% We override any old settings here, for use in the rest of the current
% branch. Other branches will do likewise. The correct handling of the code
% after the branched structure is ensured by size_prof_process_goal
% returning only the common subsets of the maps constructed by the
% various branches to be used when processing the following code.
%
:- pred record_known_type_ctor_info(prog_var::in, module_name::in, string::in,
int::in, size_prof_info::in, size_prof_info::out) is det.
record_known_type_ctor_info(Var, TypeCtorModule, TypeCtorName, TypeCtorArity,
!Info) :-
TypeCtor = type_ctor(qualified(TypeCtorModule, TypeCtorName),
TypeCtorArity),
TypeCtorMap0 = !.Info ^ spi_type_ctor_map,
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
map.set(TypeCtor, Var, TypeCtorMap0, TypeCtorMap),
map.set(Var, TypeCtor, RevTypeCtorMap0, RevTypeCtorMap),
!Info ^ spi_type_ctor_map := TypeCtorMap,
!Info ^ spi_rev_type_ctor_map := RevTypeCtorMap.
:- pred record_known_type_info(prog_var::in, prog_var::in, list(prog_var)::in,
size_prof_info::in, size_prof_info::out) is det.
record_known_type_info(Var, TypeCtorInfoVar, ArgTypeInfoVars, !Info) :-
RevTypeCtorMap0 = !.Info ^ spi_rev_type_ctor_map,
( if map.search(RevTypeCtorMap0, TypeCtorInfoVar, TypeCtor0) then
RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
( if
list.map(map.search(RevTypeInfoMap0), ArgTypeInfoVars, ArgTypes)
then
list.length(ArgTypes, Arity),
% Just in case TypeCtorInfo0 has fake arity, e.g. if it is a tuple.
TypeCtor0 = type_ctor(SymName, _DeclArity),
TypeCtor1 = type_ctor(SymName, Arity),
construct_type(TypeCtor1, ArgTypes, Type),
record_type_info_var(Type, Var, !Info)
else
true
)
else
% We don't know what type is being constructed, because we have
% forgotten what type constructor the type constructor variable
% stands for due to an intervening call. This cannot happen
% for HLDS code constructed directly by polymorphism.m, but
% can happen after that code has been rearranged by other
% compiler passes.
true
).
:- pred record_type_info_var(mer_type::in, prog_var::in,
size_prof_info::in, size_prof_info::out) is det.
record_type_info_var(Type, Var, !Info) :-
RevTypeInfoMap0 = !.Info ^ spi_rev_type_info_map,
TypeInfoMap0 = !.Info ^ spi_type_info_map,
map.set(Type, Var, TypeInfoMap0, TypeInfoMap),
( if map.insert(Var, Type, RevTypeInfoMap0, RevTypeInfoMap1) then
RevTypeInfoMap = RevTypeInfoMap1
else
% This can happen because inlining XXX can leave a type_info_varmap
% saying that one type_info variable holds the typeinfo for
% more than one type.
RevTypeInfoMap = RevTypeInfoMap0
),
!Info ^ spi_type_info_map := TypeInfoMap,
!Info ^ spi_rev_type_info_map := RevTypeInfoMap.
:- pred record_known_size(prog_var::in, int::in,
size_prof_info::in, size_prof_info::out) is det.
record_known_size(Var, KnownSize, !Info) :-
KnownSizeMap0 = !.Info ^ spi_known_size_map,
map.det_insert(Var, KnownSize, KnownSizeMap0, KnownSizeMap),
!Info ^ spi_known_size_map := KnownSizeMap.
:- pred record_typeinfo_in_type_info_varmap(rtti_varmaps::in, tvar::in,
size_prof_info::in, size_prof_info::out) is det.
record_typeinfo_in_type_info_varmap(RttiVarMaps, TVar, !Info) :-
rtti_lookup_type_info_locn(RttiVarMaps, TVar, TypeInfoLocn),
% XXX kind inference:
% we assume the kind is `star'.
Type = type_variable(TVar, kind_star),
(
TypeInfoLocn = type_info(TypeInfoVar),
record_type_info_var(Type, TypeInfoVar, !Info)
;
TypeInfoLocn = typeclass_info(_TypeClassInfoVar, _Offset)
% We could record this information and then look for calls that
% extract typeinfos from typeclass_infos, but code that does
% that is rare enough that it is not worth optimizing.
% TypeClassInfoMap0 = !.Info ^ spi_type_class_info_map,
% map.det_insert(TypeClassInfoMap0,
% TypeClassInfoVar - Offset, Type, TypeClassInfoMap),
% !Info ^ spi_type_class_info_map := TypeClassInfoMap
).
%---------------------------------------------------------------------------%
% We must ensure that we record that a branched control structure is
% considered to generate a type_ctor_info or type_info variable only
% if all the branches generate it. The code above takes the intersections
% of the forward maps (type to type_info or type_ctor_info var maps)
% produced by different branches directly, but calls update_rev_maps
% to ensure that the reverse maps
%
% (a) contain only entries that are also in the forward maps, i.e. do not
% contain entries that the intersection process removed, and
% (b) do not contain entries derived from inconsistent forward map entries
% (since a forward map can say that e.g. both the type int and the type
% constructor int/0 have their typeinfo in the same variable).
%
:- pred update_rev_maps(size_prof_info::in, size_prof_info::out) is det.
update_rev_maps(!Info) :-
map.to_sorted_assoc_list(!.Info ^ spi_type_info_map, TypeInfoList),
map.to_sorted_assoc_list(!.Info ^ spi_type_ctor_map, TypeCtorList),
map.init(VarCounts0),
count_appearances(TypeInfoList, VarCounts0, VarCounts1),
count_appearances(TypeCtorList, VarCounts1, VarCounts),
construct_rev_map(TypeInfoList, VarCounts, map.init, RevTypeInfoMap),
construct_rev_map(TypeCtorList, VarCounts, map.init, RevTypeCtorMap),
!Info ^ spi_rev_type_info_map := RevTypeInfoMap,
!Info ^ spi_rev_type_ctor_map := RevTypeCtorMap.
:- pred count_appearances(assoc_list(T, prog_var)::in,
map(prog_var, int)::in, map(prog_var, int)::out) is det.
count_appearances([], !VarCounts).
count_appearances([_ - Var | AssocList], !VarCounts) :-
( if map.search(!.VarCounts, Var, Count) then
map.det_update(Var, Count + 1, !VarCounts)
else
map.det_insert(Var, 1, !VarCounts)
),
count_appearances(AssocList, !VarCounts).
:- pred construct_rev_map(assoc_list(T, prog_var)::in,
map(prog_var, int)::in,
map(prog_var, T)::in, map(prog_var, T)::out) is det.
construct_rev_map([], _, !RevMap).
construct_rev_map([T - Var | AssocList], VarCounts, !RevMap) :-
map.lookup(VarCounts, Var, Count),
( if Count = 1 then
map.det_insert(Var, T, !RevMap)
else
true
),
construct_rev_map(AssocList, VarCounts, !RevMap).
%---------------------------------------------------------------------------%
% During the processing of a branched control structure, we add entries
% to the target type_info map in an effort to encourage different branches
% to use the same variable to store the type_info for the same type,
% since this increases the probability that all branches define a type_info
% for the type and that thus we will be able to use the variable holding
% that type_info after the branched control structure without recreating
% it. However, if some branches define the target variable but others
% don't, then the branched control structure cannot define the variable
% for later code. We must therefore remove the variable from the target
% type_info map used by later code.
%
:- pred update_target_map(size_prof_info::in, size_prof_info::out) is det.
update_target_map(!Info) :-
TargetTypeInfoMap0 = !.Info ^ spi_target_type_info_map,
TypeInfoMap = !.Info ^ spi_type_info_map,
map.to_sorted_assoc_list(TargetTypeInfoMap0, TargetTypeInfoList),
list.foldl(include_in_target_map(TypeInfoMap), TargetTypeInfoList,
map.init, TargetTypeInfoMap),
!Info ^ spi_target_type_info_map := TargetTypeInfoMap.
:- pred include_in_target_map(type_info_map::in, pair(mer_type, prog_var)::in,
type_info_map::in, type_info_map::out) is det.
include_in_target_map(TypeInfoMap, Type - TypeInfoVar, !TargetTypeInfoMap) :-
( if map.search(TypeInfoMap, Type, TypeInfoVar) then
map.det_insert(Type, TypeInfoVar, !TargetTypeInfoMap)
else
true
).
%---------------------------------------------------------------------------%
:- func compute_functor_size(list(prog_var), size_prof_info) = int.
compute_functor_size(Args, Info) = FunctorSize :-
TransformOp = Info ^ spi_transform_op,
(
TransformOp = term_cells,
FunctorSize = 1
;
TransformOp = term_words,
FunctorSize = list.length(Args)
).
:- pred find_defined_args(list(prog_var)::in, list(unify_mode)::in,
list(prog_var)::out, list(prog_var)::out, size_prof_info::in) is det.
find_defined_args(Args, Modes, DefinedArgs, NonDefinedArgs, Info) :-
(
Args = [],
Modes = [],
DefinedArgs = [],
NonDefinedArgs = []
;
Args = [],
Modes = [_ | _],
unexpected($pred, "length mismatch")
;
Args = [_ | _],
Modes = [],
unexpected($pred, "length mismatch")
;
Args = [FirstArg | LaterArgs],
Modes = [FirstMode | LaterModes],
find_defined_args(LaterArgs, LaterModes, LaterDefinedArgs,
LaterNonDefinedArgs, Info),
( if binds_arg_in_cell(Info, FirstMode) then
DefinedArgs = [FirstArg | LaterDefinedArgs],
NonDefinedArgs = LaterNonDefinedArgs
else
DefinedArgs = LaterDefinedArgs,
NonDefinedArgs = [FirstArg | LaterNonDefinedArgs]
)
).
:- pred binds_arg_in_cell(size_prof_info::in, unify_mode::in) is semidet.
binds_arg_in_cell(Info, UnifyMode) :-
ModuleInfo = Info ^ spi_module_info,
UnifyMode = unify_modes_li_lf_ri_rf(CellInitInst, CellFinalInst, _, _),
inst_is_free(ModuleInfo, CellInitInst),
inst_is_bound(ModuleInfo, CellFinalInst).
%---------------------------------------------------------------------------%
:- pred select_first(T::in, T::in, T::out) is det.
select_first(X, _, X).
%---------------------------------------------------------------------------%
:- pred ctor_is_type_info_related(module_name::in, string::in) is semidet.
ctor_is_type_info_related(VarTypeCtorModule, VarTypeCtorName) :-
VarTypeCtorModule = mercury_private_builtin_module,
( VarTypeCtorName = "type_info"
; VarTypeCtorName = "type_ctor_info"
; VarTypeCtorName = "typeclass_info"
; VarTypeCtorName = "base_typeclass_info"
).
%---------------------------------------------------------------------------%
:- end_module transform_hlds.size_prof.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink